@@ -1,415 +0,0 @@
15− -- * The StateT monad transformer
21− -- * The State monad (lazy)
26− -- * The StateT monad transformer (lazy)
32− -- * The State monad (flattened)
35− -- * The StateT monad transformer (flattened)
38− -- * MonadState class (implicit)
45− -- * The State monad (implicit)
50− -- * The StateT monad transformer (implicit)
56− -- * The State monad (lazy, implicit)
61− -- * The StateT monad transformer (lazy, implicit)
77−import qualified Control.Monad.State.Class as T
78−import qualified Control.Monad.Trans as Lift
79−import Control.Monad.Trans.Identity
80−import qualified Control.Monad.Trans.State.Lazy as T.Lazy
81−import qualified Control.Monad.Trans.State.Strict as T.Strict
83−import Data.Functor.Identity
86−import Data.Reflection
89−import Ether.TaggedTrans
91−class Monad m => MonadState tag s m | m tag -> s where
93− {-# MINIMAL state | get, put #-}
95− -- | Return the state from the internals of the monad.
97− get = state @tag (\s -> (s, s))
99− -- | Replace the state inside the monad.
101− put s = state @tag (\_ -> ((), s))
103− -- | Embed a simple state action into the monad.
104− state :: (s -> (a, s)) -> m a
111−instance {-# OVERLAPPABLE #-}
114− , MonadState tag s m
115− ) => MonadState tag s (t m)
117− get = Lift.lift (get @tag)
118− put = Lift.lift . put @tag
119− state = Lift.lift . state @tag
121−instance {-# OVERLAPPABLE #-}
123− , MonadState tag s (TaggedTrans effs trans m)
124− ) => MonadState tag s (TaggedTrans (eff ': effs) trans (m :: Type -> Type))
129− TaggedTrans effs trans m s ->
130− TaggedTrans (eff ': effs) trans m s)
135− (s -> TaggedTrans effs trans m ()) ->
136− (s -> TaggedTrans (eff ': effs) trans m ()))
140− (coerce :: forall a .
141− ((s -> (a, s)) -> TaggedTrans effs trans m a) ->
142− ((s -> (a, s)) -> TaggedTrans (eff ': effs) trans m a))
145−-- | Modifies the state inside a state monad.
146−modify :: forall tag s m . MonadState tag s m => (s -> s) -> m ()
147−modify f = state @tag (\s -> ((), f s))
149−-- | Gets specific component of the state, using a projection function supplied.
150−gets :: forall tag s m a . MonadState tag s m => (s -> a) -> m a
151−gets f = fmap f (get @tag)
153−-- | Encode type-level information for 'StateT'.
156−type instance HandleSuper STATE s trans = ()
157−type instance HandleConstraint STATE s trans m =
158− T.MonadState s (trans m)
160−instance Handle STATE s (T.Strict.StateT s) where
163−instance Handle STATE s (T.Lazy.StateT s) where
167− ( Handle STATE s trans
168− , Monad m, Monad (trans m)
169− ) => MonadState tag s (TaggedTrans (TAGGED STATE tag) trans m)
173− handling @STATE @s @trans @m $
174− coerce (T.get @s @(trans m))
177− handling @STATE @s @trans @m $
178− coerce (T.put @s @(trans m))
181− handling @STATE @s @trans @m $
182− coerce (T.state @s @(trans m) @a) ::
183− forall eff a . (s -> (a, s)) -> TaggedTrans eff trans m a
186− ( HasLens tag payload s
187− , Handle STATE payload trans
188− , Monad m, Monad (trans m)
189− ) => MonadState tag s (TaggedTrans (TAGGED STATE tag ': effs) trans m)
193− handling @STATE @payload @trans @m $
194− (coerce :: forall eff a .
196− TaggedTrans eff trans m a)
197− (T.gets (view (lensOf @tag @payload @s)))
200− handling @STATE @payload @trans @m $
201− (coerce :: forall eff a .
203− TaggedTrans eff trans m a)
204− (T.modify (over (lensOf @tag @payload @s) (const s)))
207− handling @STATE @payload @trans @m $
208− (coerce :: forall eff a .
210− TaggedTrans eff trans m a)
211− (T.state (lensOf @tag @payload @s f))
213−-- | The parametrizable state monad.
215−-- Computations have access to a mutable state.
217−-- The 'return' function leaves the state unchanged, while '>>=' uses
218−-- the final state of the first computation as the initial state of the second.
219−type State tag r = StateT tag r Identity
221−-- | The state monad transformer.
223−-- The 'return' function leaves the state unchanged, while '>>=' uses
224−-- the final state of the first computation as the initial state of the second.
225−type StateT tag s = TaggedTrans (TAGGED STATE tag) (T.Strict.StateT s)
227−-- | Constructor for computations in the state monad transformer.
228−stateT :: forall tag s m a . (s -> m (a, s)) -> StateT tag s m a
229−stateT = coerce (T.Strict.StateT @s @m @a)
231−-- | Runs a 'StateT' with the given initial state
232−-- and returns both the final value and the final state.
233−runStateT :: forall tag s m a . StateT tag s m a -> s -> m (a, s)
234−runStateT = coerce (T.Strict.runStateT @s @m @a)
236−-- | Runs a 'StateT' with the given initial state
237−-- and returns the final value, discarding the final state.
238−evalStateT :: forall tag s m a . Monad m => StateT tag s m a -> s -> m a
239−evalStateT = coerce (T.Strict.evalStateT @m @s @a)
241−-- | Runs a 'StateT' with the given initial state
242−-- and returns the final state, discarding the final value.
243−execStateT :: forall tag s m a . Monad m => StateT tag s m a -> s -> m s
244−execStateT = coerce (T.Strict.execStateT @m @s @a)
246−-- | Runs a 'State' with the given initial state
247−-- and returns both the final value and the final state.
248−runState :: forall tag s a . State tag s a -> s -> (a, s)
249−runState = coerce (T.Strict.runState @s @a)
251−-- | Runs a 'State' with the given initial state
252−-- and returns the final value, discarding the final state.
253−evalState :: forall tag s a . State tag s a -> s -> a
254−evalState = coerce (T.Strict.evalState @s @a)
256−-- | Runs a 'State' with the given initial state
257−-- and returns the final state, discarding the final value.
258−execState :: forall tag s a . State tag s a -> s -> s
259−execState = coerce (T.Strict.execState @s @a)
261−-- | The parametrizable state monad.
263−-- Computations have access to a mutable state.
265−-- The 'return' function leaves the state unchanged, while '>>=' uses
266−-- the final state of the first computation as the initial state of the second.
267−type LazyState tag r = LazyStateT tag r Identity
269−-- | The state monad transformer.
271−-- The 'return' function leaves the state unchanged, while '>>=' uses
272−-- the final state of the first computation as the initial state of the second.
273−type LazyStateT tag s = TaggedTrans (TAGGED STATE tag) (T.Lazy.StateT s)
275−-- | Constructor for computations in the state monad transformer.
276−lazyStateT :: forall tag s m a . (s -> m (a, s)) -> LazyStateT tag s m a
277−lazyStateT = coerce (T.Lazy.StateT @s @m @a)
279−-- | Runs a 'StateT' with the given initial state
280−-- and returns both the final value and the final state.
281−runLazyStateT :: forall tag s m a . LazyStateT tag s m a -> s -> m (a, s)
282−runLazyStateT = coerce (T.Lazy.runStateT @s @m @a)
284−-- | Runs a 'StateT' with the given initial state
285−-- and returns the final value, discarding the final state.
286−evalLazyStateT :: forall tag s m a . Monad m => LazyStateT tag s m a -> s -> m a
287−evalLazyStateT = coerce (T.Lazy.evalStateT @m @s @a)
289−-- | Runs a 'StateT' with the given initial state
290−-- and returns the final state, discarding the final value.
291−execLazyStateT :: forall tag s m a . Monad m => LazyStateT tag s m a -> s -> m s
292−execLazyStateT = coerce (T.Lazy.execStateT @m @s @a)
294−-- | Runs a 'State' with the given initial state
295−-- and returns both the final value and the final state.
296−runLazyState :: forall tag s a . LazyState tag s a -> s -> (a, s)
297−runLazyState = coerce (T.Lazy.runState @s @a)
299−-- | Runs a 'State' with the given initial state
300−-- and returns the final value, discarding the final state.
301−evalLazyState :: forall tag s a . LazyState tag s a -> s -> a
302−evalLazyState = coerce (T.Lazy.evalState @s @a)
304−-- | Runs a 'State' with the given initial state
305−-- and returns the final state, discarding the final value.
306−execLazyState :: forall tag s a . LazyState tag s a -> s -> s
307−execLazyState = coerce (T.Lazy.execState @s @a)
309−type family STATES (ts :: HList xs) :: [Type] where
311− STATES ('HCons t ts) = TAGGED STATE t ': STATES ts
313−type StatesT s = TaggedTrans (STATES (Tags s)) (T.Strict.StateT s)
315−type States s = StatesT s Identity
317−runStatesT :: forall p m a . StatesT p m a -> p -> m (a, p)
318−runStatesT = coerce (T.Strict.runStateT @p @m @a)
320−runStates :: forall p a . States p a -> p -> (a, p)
321−runStates = coerce (T.Strict.runState @p @a)
323−type StateT' s = StateT s s
325−stateT' :: (s -> m (a, s)) -> StateT' s m a
328−runStateT' :: StateT' s m a -> s -> m (a, s)
329−runStateT' = runStateT
331−runState' :: State' s a -> s -> (a, s)
334−evalStateT' :: Monad m => StateT' s m a -> s -> m a
335−evalStateT' = evalStateT
337−type State' s = State s s
339−evalState' :: State' s a -> s -> a
340−evalState' = evalState
342−execStateT' :: Monad m => StateT' s m a -> s -> m s
343−execStateT' = execStateT
345−execState' :: State' s a -> s -> s
346−execState' = execState
348−type LazyStateT' s = LazyStateT s s
350−lazyStateT' :: (s -> m (a, s)) -> LazyStateT' s m a
351−lazyStateT' = lazyStateT
353−runLazyStateT' :: LazyStateT' s m a -> s -> m (a, s)
354−runLazyStateT' = runLazyStateT
356−runLazyState' :: LazyState' s a -> s -> (a, s)
357−runLazyState' = runLazyState
359−evalLazyStateT' :: Monad m => LazyStateT' s m a -> s -> m a
360−evalLazyStateT' = evalLazyStateT
362−type LazyState' s = LazyState s s
364−evalLazyState' :: LazyState' s a -> s -> a
365−evalLazyState' = evalLazyState
367−execLazyStateT' :: Monad m => LazyStateT' s m a -> s -> m s
368−execLazyStateT' = execLazyStateT
370−execLazyState' :: LazyState' s a -> s -> s
371−execLazyState' = execLazyState
373−type MonadState' s = MonadState s s
375−get' :: forall s m . MonadState' s m => m s
378−gets' :: forall s m a . MonadState' s m => (s -> a) -> m a
381−put' :: forall s m . MonadState' s m => s -> m ()
384−state' :: forall s m a . MonadState' s m => (s -> (a, s)) -> m a
387−modify' :: forall s m . MonadState' s m => (s -> s) -> m ()
390−-- | Encode type-level information for 'zoom'.
393−type ZoomT t (z :: Type) = TaggedTrans (ZOOM t z) IdentityT
395−-- | Zoom into a part of a state using a lens.
397− :: forall tag sOuter sInner m a
398− . Lens' sOuter sInner
399− -> (forall z . Reifies z (ReifiedLens' sOuter sInner) => ZoomT tag z m a)
401−zoom l m = reify (Lens l) (\(_ :: Proxy z) -> coerce (m @z))
404− ( MonadState tag sOuter m
405− , Reifies z (ReifiedLens' sOuter sInner)
407− ) => MonadState tag sInner (TaggedTrans (ZOOM tag z) trans m)
410− (coerce :: forall eff r a .
412− (r -> TaggedTrans eff trans m a))
415− Lens l = reflect (Proxy :: Proxy z)