blob: 304c6019bb3a482a46b87d6d9a342c134fb10cc6 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
|
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
module Settlr.Scripts
( ScriptM
, runScript
, Toast(..)
, pushToast
, getToasts
) where
import Control.Monad.Reader (ReaderT, runReaderT)
import Control.Monad.State (StateT, evalStateT, MonadState (get, put), gets)
import Settlr.Config (Config)
import Network.CGI (CGI, CGIT)
import Network.CGI.Monad (MonadCGI(..))
import Data.Text (Text)
import Control.Monad.Trans (lift)
newtype Toast = Toast Text
-- Execution state in a script.
data State = State
{ stateToasts :: ![Toast] -- ^ Toast messages to display at the top of the page; collected during script execution.
}
-- A script is an executable unit with a request config and a small state.
type ScriptM = StateT State (ReaderT Config (CGIT IO))
instance MonadCGI ScriptM where
cgiAddHeader x y = lift $ lift $ cgiAddHeader x y
cgiGet x = lift $ lift $ cgiGet x
runScript :: ScriptM a -> Config -> CGI a
runScript x = runReaderT (evalStateT x initialState)
where initialState = State { stateToasts = [] }
pushToast :: Toast -> ScriptM ()
pushToast toast = do state <- get
put $ State { stateToasts = (toast : stateToasts state) }
getToasts :: ScriptM [Toast]
getToasts = gets stateToasts
|
