@@ -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 #-}
10module Control.Monad.Trans.Ether.State
1module Control.Monad.Trans.Ether.State
11− (
2+ ( module Control.Monad.Trans.Ether.State.Lazy
18− -- * The StateT monad transformer
25− -- * State operations
28− -- * Litfing other operations
35−import Data.Proxy (Proxy(Proxy))
5+import Control.Monad.Trans.Ether.State.Lazy
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
47−import qualified Control.Monad.Signatures as Sig
48−import qualified Control.Monad.Trans.State.Lazy as Trans
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
57−-- | The parametrizable state monad.
59−-- Computations have access to a mutable state.
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
65−-- | The state monad transformer.
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)
71− , Functor, Applicative, Alternative, Monad, MonadPlus
72− , MonadFix, MonadTrans, MonadIO )
74−instance NT.Newtype (StateT tag s m a)
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
80−instance Tagged (StateT tag s m) tag where
81− type Untagged (StateT tag s m) = Trans.StateT s m
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
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
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
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
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
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
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
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
122−-- | Transform the computation inside a 'StateT'.
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)
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
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
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)
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)
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)
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)
154−-- Instances for mtl classes
156−instance Class.MonadCont m => Class.MonadCont (StateT tag s m) where
157− callCC = liftCallCC' Proxy Class.callCC
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
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
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
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