/
State.hs
70 lines (59 loc) · 1.68 KB
/
State.hs
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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
module Control.Effect.Implicit.Transform.State
where
import Control.Monad.State.Class (MonadState (..))
import Control.Monad.Trans.State.Strict (StateT, evalStateT)
import Control.Monad.Trans.Class
(MonadTrans (..))
import Control.Effect.Implicit.Base
import Control.Effect.Implicit.Computation
import Control.Effect.Implicit.Ops.Env
import Control.Effect.Implicit.Ops.State
(StateEff, StateOps(..))
liftStateT
:: forall s eff . (Effect eff)
=> LiftEff eff (StateT s eff)
liftStateT = mkLiftEff lift
stateTOps
:: forall eff s
. (Effect eff, MonadState s eff)
=> StateOps s eff
stateTOps = StateOps {
getOp = get,
putOp = put
}
stateTHandler
:: forall eff s .
(Effect eff, MonadState s eff)
=> Handler NoEff (StateEff s) eff
stateTHandler = mkHandler $
\lifter -> applyEffmap lifter stateTOps
{-# INLINE stateTPipeline #-}
stateTPipeline
:: forall s eff1 comp .
(Effect eff1, EffFunctor comp)
=> SimplePipeline (EnvEff s) (StateEff s) comp eff1
stateTPipeline = transformerPipeline $ genericComputation handler
where
{-# INLINE handler #-}
handler :: forall eff
. (EffConstraint (EnvEff s) eff)
=> TransformerHandler (StateT s) (StateEff s) eff
handler = TransformerHandler stateTOps liftStateT $ mkLiftEff $
\comp -> do
i <- ask
evalStateT comp i
withStateTAndOps
:: forall ops s r eff .
( ImplicitOps ops
, EffConstraint ops eff
)
=> s
-> ((EffConstraint (StateEff s ∪ ops) (StateT s eff))
=> StateT s eff r)
-> eff r
withStateTAndOps i comp1 = evalStateT comp2 i
where
comp2 :: StateT s eff r
comp2 = withOps ops comp1
ops :: Operation (StateEff s ∪ ops) (StateT s eff)
ops = stateTOps ∪ effmap lift captureOps