@@ -0,0 +1,415 @@
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)