@@ -1,177 +1,5 @@
1−{-# LANGUAGE DeriveGeneric #-}
2−{-# LANGUAGE MultiParamTypeClasses #-}
3−{-# LANGUAGE TypeFamilies #-}
4−{-# LANGUAGE FlexibleInstances #-}
5−{-# LANGUAGE FlexibleContexts #-}
6−{-# LANGUAGE UndecidableInstances #-}
7−{-# LANGUAGE DataKinds #-}
8−{-# LANGUAGE TypeOperators #-}
9−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
101module Control.Monad.Trans.Ether.State
11− (
12− -- * The State monad
13− State
14− , state
15− , runState
16− , evalState
17− , execState
18− -- * The StateT monad transformer
19− , StateT
20− , stateT
21− , runStateT
22− , evalStateT
23− , execStateT
24− , mapStateT
25− -- * State operations
26− , get
27− , put
28− -- * Litfing other operations
29− , liftCatch
30− , liftCallCC'
31− , liftListen
32− , liftPass
2+ ( module Control.Monad.Trans.Ether.State.Lazy
333 ) where
344
35−import Data.Proxy (Proxy(Proxy))
36−import Data.Functor.Identity (Identity(..))
37−import Data.Coerce (coerce)
38−import Control.Applicative (Alternative)
39−import Control.Monad (MonadPlus)
40−import Control.Monad.Fix (MonadFix)
41−import Control.Monad.Trans.Class (MonadTrans, lift)
42−import Control.Monad.IO.Class (MonadIO)
43−import Control.Ether.Tags (Taggable(..), Tagged(..))
44−import GHC.Generics (Generic)
45−import qualified Control.Newtype as NT
46−
47−import qualified Control.Monad.Signatures as Sig
48−import qualified Control.Monad.Trans.State.Lazy as Trans
49−
50−import qualified Control.Monad.Cont.Class as Class
51−import qualified Control.Monad.Reader.Class as Class
52−import qualified Control.Monad.State.Class as Class
53−import qualified Control.Monad.Writer.Class as Class
54−import qualified Control.Monad.Error.Class as Class
55−
56−
57−-- | The parametrizable state monad.
58−--
59−-- Computations have access to a mutable state.
60−--
61−-- The 'return' function leaves the state unchanged, while '>>=' uses
62−-- the final state of the first computation as the initial state of the second.
63−type State tag r = StateT tag r Identity
64−
65−-- | The state monad transformer.
66−--
67−-- The 'return' function leaves the state unchanged, while '>>=' uses
68−-- the final state of the first computation as the initial state of the second.
69−newtype StateT tag s m a = StateT (Trans.StateT s m a)
70− deriving ( Generic
71− , Functor, Applicative, Alternative, Monad, MonadPlus
72− , MonadFix, MonadTrans, MonadIO )
73−
74−instance NT.Newtype (StateT tag s m a)
75−
76−instance Taggable (StateT tag s m) where
77− type Tag (StateT tag s m) = 'Just tag
78− type Inner (StateT tag s m) = 'Just m
79−
80−instance Tagged (StateT tag s m) tag where
81− type Untagged (StateT tag s m) = Trans.StateT s m
82−
83−-- | Constructor for computations in the state monad transformer.
84−stateT :: proxy tag -> (s -> m (a, s)) -> StateT tag s m a
85−stateT t = tagged t . Trans.StateT
86−
87−-- | Constructor for computations in the state monad
88−-- (the inverse of 'runState').
89−state :: Monad m => proxy tag -> (s -> (a, s)) -> StateT tag s m a
90−state t = tagged t . Trans.state
91−
92−-- | Runs a 'StateT' with the given initial state
93−-- and returns both the final value and the final state.
94−runStateT :: proxy tag -> StateT tag s m a -> s -> m (a, s)
95−runStateT t = Trans.runStateT . untagged t
96−
97−-- | Runs a 'StateT' with the given initial state
98−-- and returns the final value, discarding the final state.
99−evalStateT :: Monad m => proxy tag -> StateT tag s m a -> s -> m a
100−evalStateT t = Trans.evalStateT . untagged t
101−
102−-- | Runs a 'StateT' with the given initial state
103−-- and returns the final state, discarding the final value.
104−execStateT :: Monad m => proxy tag -> StateT tag s m a -> s -> m s
105−execStateT t = Trans.execStateT . untagged t
106−
107−-- | Runs a 'State' with the given initial state
108−-- and returns both the final value and the final state.
109−runState :: proxy tag -> State tag s a -> s -> (a, s)
110−runState t = Trans.runState . untagged t
111−
112−-- | Runs a 'State' with the given initial state
113−-- and returns the final value, discarding the final state.
114−evalState :: proxy tag -> State tag s a -> s -> a
115−evalState t = Trans.evalState . untagged t
116−
117−-- | Runs a 'State' with the given initial state
118−-- and returns the final state, discarding the final value.
119−execState :: proxy tag -> State tag s a -> s -> s
120−execState t = Trans.execState . untagged t
121−
122−-- | Transform the computation inside a 'StateT'.
123−--
124−-- * @'runStateT' tag ('mapStateT' tag f m) = f . 'runStateT' tag m@
125−mapStateT :: proxy tag -> (m (a, s) -> n (b, s)) -> StateT tag s m a -> StateT tag s n b
126−mapStateT t f m = tagged t $ Trans.mapStateT f (coerce m)
127−
128−-- | Fetch the current value of the state within the monad.
129−get :: Monad m => proxy tag -> StateT tag s m s
130−get t = tagged t Trans.get
131−
132−-- | Set the value of the state within the monad.
133−put :: Monad m => proxy tag -> s -> StateT tag s m ()
134−put t = tagged t . Trans.put
135−
136−-- | Lift a @catchE@ operation to the new monad.
137−liftCatch :: proxy tag -> Sig.Catch e m (a, s) -> Sig.Catch e (StateT tag s m) a
138−liftCatch t f m h = tagged t $ Trans.liftCatch f (coerce m) (coerce h)
139−
140−-- | Lift a @listen@ operation to the new monad.
141−liftListen :: Monad m => proxy tag -> Sig.Listen w m (a, s) -> Sig.Listen w (StateT tag s m) a
142−liftListen t listen m = tagged t $ Trans.liftListen listen (coerce m)
143−
144−-- | In-situ lifting of a @callCC@ operation to the new monad.
145−-- This version uses the current state on entering the continuation.
146−-- It does not satisfy the uniformity property (see "Control.Monad.Signatures").
147−liftCallCC' :: proxy tag -> Sig.CallCC m (a, s) (b, s) -> Sig.CallCC (StateT tag s m) a b
148−liftCallCC' t callCC f = tagged t $ Trans.liftCallCC' callCC (coerce f)
149−
150−-- | Lift a @pass@ operation to the new monad.
151−liftPass :: Monad m => proxy tag -> Sig.Pass w m (a,s) -> Sig.Pass w (StateT tag s m) a
152−liftPass t pass m = tagged t $ Trans.liftPass pass (coerce m)
153−
154−-- Instances for mtl classes
155−
156−instance Class.MonadCont m => Class.MonadCont (StateT tag s m) where
157− callCC = liftCallCC' Proxy Class.callCC
158−
159−instance Class.MonadReader r m => Class.MonadReader r (StateT tag s m) where
160− ask = lift Class.ask
161− local = mapStateT Proxy . Class.local
162− reader = lift . Class.reader
163−
164−instance Class.MonadState s' m => Class.MonadState s' (StateT tag s m) where
165− get = lift Class.get
166− put = lift . Class.put
167− state = lift . Class.state
168−
169−instance Class.MonadWriter w m => Class.MonadWriter w (StateT tag s m) where
170− writer = lift . Class.writer
171− tell = lift . Class.tell
172− listen = liftListen Proxy Class.listen
173− pass = liftPass Proxy Class.pass
174−
175−instance Class.MonadError e m => Class.MonadError e (StateT tag s m) where
176− throwError = lift . Class.throwError
177− catchError = liftCatch Proxy Class.catchError
5+import Control.Monad.Trans.Ether.State.Lazy