content: {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE OverloadedStrings #-}
  -----------------------------------------------------------------------------
  --
  -- Module      :  Language.Javascript.JSaddle.WebSockets
  -- Copyright   :  (c) Hamish Mackenzie
  -- License     :  MIT
  --
  -- Maintainer  :  Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com>
  --
  -- |
  --
  -----------------------------------------------------------------------------
  
  module Language.Javascript.JSaddle.Debug (
      contexts
    , addContext
    , removeContext
    , runOnAll
    , runOnAll_
  ) where
  
  import Language.Javascript.JSaddle
         (runJSM, askJSM, JSM, JSContextRef(..))
  import Data.IORef (readIORef, atomicModifyIORef', newIORef, IORef)
  import System.IO.Unsafe (unsafePerformIO)
  import Data.Monoid ((<>))
  import Control.Monad.IO.Class (MonadIO(..))
  import Data.Int (Int64)
  
  contexts :: IORef [JSContextRef]
  contexts = unsafePerformIO $ newIORef []
  {-# NOINLINE contexts #-}
  
  addContext :: JSM ()
  addContext = do
      ctx <- askJSM
      liftIO $ atomicModifyIORef' contexts $ \c -> (c <> [ctx], ())
  
  removeContext :: MonadIO m => Int64 -> m ()
  removeContext cid =
      liftIO $ atomicModifyIORef' contexts $ \c -> (filter ((/= cid) . contextId) c, ())
  
  runOnAll :: MonadIO m => JSM a -> m [a]
  runOnAll f = liftIO (readIORef contexts) >>= mapM (runJSM f)
  
  runOnAll_ :: MonadIO m => JSM a -> m ()
  runOnAll_ f = liftIO (readIORef contexts) >>= mapM_ (runJSM f)
  