/
State.purs
125 lines (95 loc) · 3.72 KB
/
State.purs
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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
module Control.Monad.Transformerless.State where
import Prelude
import Control.Alt (class Alt)
import Control.Lazy (class Lazy)
import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRec)
import Data.Newtype (class Newtype)
import Data.Tuple (Tuple(..), fst, snd)
newtype State s a = State (s -> Tuple a s)
derive instance newtypeState :: Newtype (State s a) _
runState :: forall s a. State s a -> s -> Tuple a s
runState (State s) = s
evalState :: forall s a. State s a -> s -> a
evalState (State s) i = fst (s i)
execState :: forall s a. State s a -> s -> s
execState (State s) i = snd (s i)
mapState :: forall s a b. (Tuple a s -> Tuple b s) -> State s a -> State s b
mapState f (State s) = State (f <<< s)
mapS :: forall s a b. (a -> b) -> State s a -> State s b
mapS f (State s) = State \ st ->
let Tuple a s' = s st
in Tuple (f a) s'
infixl 4 mapS as |->
applyS :: forall s a b. State s (a -> b) -> State s a -> State s b
applyS (State ff) (State fa) = State \ s ->
let Tuple f s' = ff s
Tuple a s'' = fa s'
in Tuple (f a) s''
infixl 4 applyS as ~
pureS :: forall s a. a -> State s a
pureS a = State (Tuple a)
bindS :: forall s a b. State s a -> (a -> State s b) -> State s b
bindS (State fa) k = State \ s ->
let Tuple a s' = fa s
Tuple b s'' = runState (k a) s'
in Tuple b s''
infixl 1 bindS as >>-
deferS :: forall s a. (Unit -> State s a) -> State s a
deferS f = State \ s -> case f unit of State f' -> f' s
tailRecS :: forall s a b. (a -> State s (Step a b)) -> a -> State s b
tailRecS f a = State \ s -> tailRec f' (Tuple a s)
where
f' (Tuple x s) =
let Tuple m s1 = runState (f x) s
in case m of
Loop l -> Loop (Tuple l s1)
Done r -> Done (Tuple r s1)
-- | This satisfies associativity and `get <<< x` = `x <<< get`, but neither is the same as `x`.
-- | This is because composition of two `State`s uses neither in the
-- | computation of the final state.
instance semigroupoidState :: Semigroupoid State where
compose :: forall a b c. State b c -> State a b -> State a c
compose (State bc) (State ab) = State \ a -> Tuple (fst (bc (fst (ab a)))) a
instance functorState :: Functor (State s) where
map :: forall a b. (a -> b) -> State s a -> State s b
map f (State s) = State \ st ->
let Tuple a s' = s st
in Tuple (f a) s'
instance applyState :: Apply (State s) where
apply :: forall a b. State s (a -> b) -> State s a -> State s b
apply (State ff) (State fa) = State \ s ->
let Tuple f s' = ff s
Tuple a s'' = fa s'
in Tuple (f a) s''
instance applicativeState :: Applicative (State s) where
pure :: forall a. a -> State s a
pure a = State (Tuple a)
instance altState :: Alt (State s) where
alt f _ = f
instance bindState :: Bind (State s) where
bind :: forall a b. State s a -> (a -> State s b) -> State s b
bind (State fa) k = State \ s ->
let Tuple a s' = fa s
Tuple b s'' = runState (k a) s'
in Tuple b s''
instance monadState :: Monad (State s)
instance lazyState :: Lazy (State s a) where
defer :: (Unit -> State s a) -> State s a
defer f = State \ s -> case f unit of State f' -> f' s
instance monadrecState :: MonadRec (State s) where
tailRecM :: forall a b. (a -> State s (Step a b)) -> a -> State s b
tailRecM f a = State \ s -> tailRec f' (Tuple a s)
where
f' (Tuple x s) =
let Tuple m s1 = runState (f x) s
in case m of
Loop l -> Loop (Tuple l s1)
Done r -> Done (Tuple r s1)
get :: forall s. State s s
get = State \ st -> Tuple st st
gets :: forall s a. (s -> a) -> State s a
gets f = State \ st -> Tuple (f st) st
put :: forall s. s -> State s Unit
put s = State \ _ -> Tuple unit s
modify :: forall s. (s -> s) -> State s Unit
modify f = State \ s -> Tuple unit (f s)