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

--- ---------------------------------------------------------------------------
--- A combination of Error and state monad like `ErrorT State` in Haskell.
---
--- @author Bjoern Peemoeller
--- @version September 2014
--- @category general
--- ----------------------------------------------------------------------------

module ErrorState where

infixl 1 >+, >+=
infixl 4 <$>, <*>

--- Error state monad.
type ES e s a = s -> Either e (a, s)

--- Evaluate an `ES` monad
evalES :: ES e s a -> s -> Either e a
evalES m s = case m s of
  Left  e      -> Left e
  Right (x, _) -> Right x

--- Lift a value into the `ES` monad
returnES :: a -> ES e s a
returnES x s = Right (x, s)

--- Failing computation in the `ES` monad
failES :: e -> ES e s a
failES e _ = Left e

--- Bind of the `ES` monad
(>+=) :: ES e s a -> (a -> ES e s b) -> ES e s b
m >+= f = \s -> case m s of
                  Left  e       -> Left e
                  Right (x, s') -> f x s'

--- Sequence operator of the `ES` monad
(>+) :: ES e s a -> ES e s b -> ES e s b
m >+ n = m >+= \_ -> n

--- Apply a pure function onto a monadic value.
(<$>) :: (a -> b) -> ES e s a -> ES e s b
f <$> act = act >+= \x -> returnES (f x)

--- Apply a function yielded by a monadic action to a monadic value.
(<*>) :: ES e s (a -> b) -> ES e s a -> ES e s b
sf <*> sx = sf >+= \f -> sx >+= \x -> returnES (f x)

--- Retrieve the current state
gets :: ES e s s
gets s = Right (s, s)

--- Replace the current state
puts :: s -> ES e s ()
puts s _ = Right ((), s)

--- Modify the current state
modify :: (s -> s) -> ES e s ()
modify f s = Right ((), f s)

--- Map a monadic function on all elements of a list by sequencing
--- the effects.
mapES :: (a -> ES e s b) -> [a] -> ES e s [b]
mapES _ []       = returnES []
mapES f (x : xs) = f x        >+= \y  ->
                   mapES f xs >+= \ys ->
                   returnES (y:ys)

--- Same as `concatMap`, but for a monadic function.
concatMapES :: (a -> ES e s [b]) -> [a] -> ES e s [b]
concatMapES f xs = concat <$> mapES f xs

--- Same as `mapES` but with an additional accumulator threaded through.
mapAccumES :: (a -> b -> ES e s (a, c)) -> a -> [b] -> ES e s (a, [c])
mapAccumES _ s []       = returnES (s, [])
mapAccumES f s (x : xs) = f s x >+= \(s', y) ->
                          mapAccumES f s' xs >+= \(s'', ys) ->
                          returnES (s'', y:ys)