module Control.Monad.Trans.Crtn.EventHandler where
import Control.Concurrent.MVar
import Control.Monad.State
import Control.Monad.Trans.Either
import Control.Monad.Trans.Crtn.Event
import Control.Monad.Trans.Crtn.Driver
import Control.Monad.Trans.Crtn.Logger
eventHandler :: MVar (Maybe (Driver e IO ())) -> e -> IO ()
eventHandler evar ev = do
mnext <- takeMVar evar
case mnext of
Nothing -> return ()
Just drv -> do
(r,drv') <- eaction drv
putMVar evar (Just drv')
case r of
Left err -> scribe (show err)
Right Nothing -> return ()
Right (Just (ActionOrder act)) ->
act (eventHandler evar) >>= eventHandler evar
where eaction = runStateT (runEitherT $ fire ev)