module Transient.EVars where
import Transient.Base
import qualified Data.Map as M
import Data.Typeable
import Control.Concurrent
import Control.Applicative
import Data.IORef
import Control.Monad.IO.Class
import Control.Monad.State
newtype EVars= EVars (IORef (M.Map Int [EventF])) deriving Typeable
data EVar a= EVar Int (IORef (Maybe a))
newEVar :: TransientIO (EVar a)
newEVar = Transient $ do
EVars ref <- getSessionData `onNothing` do
ref <- liftIO $ newIORef M.empty
setSData $ EVars ref
return (EVars ref)
id <- genNewId
ref <- liftIO $ newIORef Nothing
return . Just $ EVar id ref
readEVar :: EVar a -> TransIO a
readEVar (EVar id ref1)= Transient $ do
mr <- liftIO $ readIORef ref1
case mr of
Just _ -> return mr
Nothing -> do
cont <- getCont
EVars ref <- getSessionData `onNothing` error "No Events context"
map <- liftIO $ readIORef ref
let Just conts= M.lookup id map <|> Just []
liftIO $ writeIORef ref $ M.insert id (cont:conts) map
return Nothing
writeEVar (EVar id ref1) x= Transient $ do
EVars ref <- getSessionData `onNothing` error "No Events context"
liftIO $ writeIORef ref1 $ Just x
map <- liftIO $ readIORef ref
let Just conts= M.lookup id map <|> Just []
mapM runCont conts
liftIO $ writeIORef ref1 Nothing
return $ Just ()