module Graphics.Web.Processing.Core.Monad (
ProcM
, runProcM, execProcM
, runProcMWith
, ProcMonad (..)
, newVarNumber
, getVarNumber
, setVarNumber
) where
import Control.Arrow (second)
import Control.Monad.Trans.Class
import Control.Monad.Trans.Writer.Strict
import Control.Monad.Trans.State.Strict
import Graphics.Web.Processing.Core.Primal
import Control.Applicative (Applicative (..))
import Data.Text (Text)
newtype ProcM c a = ProcM { unProcM :: StateT Int (Writer (ProcCode c)) a }
runProcM :: ProcM c a -> (a,ProcCode c)
runProcM = runProcMWith 0
runProcMWith :: Int -> ProcM c a -> (a,ProcCode c)
runProcMWith n = second reduce . runWriter . (\sw -> evalStateT sw n) . unProcM
execProcM :: ProcM c a -> ProcCode c
execProcM = snd . runProcM
instance Functor (ProcM c) where
fmap f (ProcM w) = ProcM $ fmap f w
instance Applicative (ProcM c) where
pure x = ProcM $ pure x
pf <*> p = ProcM $ unProcM pf <*> unProcM p
instance Monad (ProcM c) where
return = pure
(ProcM w) >>= f = ProcM $ w >>= unProcM . f
newVarNumber :: ProcM c Int
newVarNumber = ProcM $ modify (+1) >> get
getVarNumber :: ProcM c Int
getVarNumber = ProcM get
setVarNumber :: Int -> ProcM c ()
setVarNumber = ProcM . put
class ProcMonad m where
commandM :: Text -> [ProcArg] -> m c ()
assignM :: ProcAsign -> m c ()
createVarM :: ProcAsign -> m c ()
writeComment :: Text -> m c ()
iff :: Proc_Bool
-> m c a
-> m c b
-> m c ()
liftProc :: ProcM c a -> m c a
instance ProcMonad ProcM where
commandM n as = ProcM $ lift $ tell $ command n as
assignM = ProcM . lift . tell . assignment
createVarM = ProcM . lift . tell . createVar
writeComment = ProcM . lift . tell . comment
iff b (ProcM e1) (ProcM e2) = ProcM $ do
i0 <- get
let (i1,c1) = runWriter $ execStateT e1 i0
(i2,c2) = runWriter $ execStateT e2 i1
put i2
lift $ tell $ conditional b c1 c2
liftProc = id