module ExecutionContext where

import Control.Concurrent
import Control.Monad
import Control.Monad.State
import Data.Typeable

import Dict

type Context = MVar Dict

type XIO a = StateT Context IO a

-- evalStateT :: Monad m => StateT s m a -> s -> m a
runWithContext :: Context -> XIO a -> IO a
runWithContext ctx xio = evalStateT xio ctx

runWithEmptyContext :: XIO a -> IO a
runWithEmptyContext xio = do
  ctx <- newMVar emptyDict
  runWithContext ctx xio

lookupWithRegister :: Typeable a => IO a -> XIO a
lookupWithRegister xio = do
  ctx <- get
  -- modifyMVar :: MVar a -> (a -> IO (a, b)) -> IO b
  r <- liftIO $ modifyMVar ctx $ \dict -> do
    case lookupDict dict of
      Nothing -> do
        v <- xio
        let (Just dict') = addToDict dict v
        return (dict', v)
      Just v -> do
        return (dict, v)
  put ctx
  return r

withEmptyContext :: XIO a -> XIO a
withEmptyContext xio = liftIO $ runWithEmptyContext xio

liftIO2 :: (IO a -> IO b) -> XIO a -> XIO b
liftIO2 f xio = do
  ctx <- get
  liftIO $ f (runWithContext ctx xio)