diff options
Diffstat (limited to 'src/Control/Monad/SariulClocks.hs')
-rw-r--r-- | src/Control/Monad/SariulClocks.hs | 40 |
1 files changed, 40 insertions, 0 deletions
diff --git a/src/Control/Monad/SariulClocks.hs b/src/Control/Monad/SariulClocks.hs new file mode 100644 index 0000000..d143375 --- /dev/null +++ b/src/Control/Monad/SariulClocks.hs @@ -0,0 +1,40 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE FlexibleInstances #-} + +module Control.Monad.SariulClocks ( SariulClocks + , putSession + , getSession + , putScores + , getScores) where + +import Control.Monad (liftM) +import Control.Monad.Trans (MonadIO, lift) +import Control.Monad.State (StateT, MonadState, get, put) +import Types.Session +import Types.Scores +import Types.Classes +import Network.CGI.Monad (CGIT, MonadCGI, cgiAddHeader, cgiGet) + +newtype SariulClocks a = + SC { runSariulClocks :: StateT (Session, ScoresList) (CGIT IO) a } + deriving (Monad, MonadIO, MonadState (Session, ScoresList)) + +instance MonadCGI SariulClocks where + cgiAddHeader n v = SC . lift $ cgiAddHeader n v + cgiGet x = SC . lift $ cgiGet x + +putSession :: Session -> SariulClocks () +putSession s = do + (_, y) <- get + put (s, y) + +getSession :: SariulClocks Session +getSession = liftM fst get + +getScores :: SariulClocks ScoresList +getScores = liftM snd get + +putScores :: ScoresList -> SariulClocks () +putScores s = do + (x, _) <- get + put (x, s) |