blob: d30fdd554ce36d393e2e07d134e7df5dd7820bf0 (
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
|
module State where
import MonadIO
import MonadTrans
newtype StateT s m a =
StateT { runStateT :: s -> m (a, s) }
-- 1
instance (Functor m)
=> Functor (StateT s m) where
fmap f (StateT m) = StateT $ \s -> fmap first $ m s
where first = uncurry (\t1 t2 -> ((f t1), t2))
-- 2
-- Links:
-- http://stackoverflow.com/questions/18673525/is-it-possible-to-implement-applicative-m-applicative-statet-s-m
-- https://github.com/NICTA/course/issues/134
instance (Monad m)
=> Applicative (StateT s m) where
pure x = StateT $ (\s -> pure (x, s))
StateT g <*> StateT h = StateT $ \s -> keepFirst <$> g s <*> h s
where keepFirst (f, s') (x, _) = (f x, s')
-- 3
instance (Monad m)
=> Monad (StateT s m) where
return = pure
(StateT sma) >>= f =
StateT $ \s -> do
a <- sma s
runStateT (f $ fst a) s
instance MonadTrans (StateT s) where
lift c = StateT $ \s -> c >>= (\x -> return (x, s))
instance (MonadIO m)
=> MonadIO (StateT s m) where
liftIO = lift . liftIO
|
