@@ -85,8 +85,8 @@ import Data.Kind
8585import Data.Proxy
8686import Data.Reflection
8787
88+import Ether.Handler
8889import Ether.Internal
89−import Ether.TaggedTrans
9090
9191class Monad m => MonadState tag s m | m tag -> s where
9292
@@ -114,44 +114,55 @@ instance {-# OVERLAPPABLE #-}
114114 , MonadState tag s m
115115 ) => MonadState tag s (t m)
116116 where
117+
117118 get = Lift.lift (get @tag)
119+ {-# INLINE get #-}
120+
118121 put = Lift.lift . put @tag
122+ {-# INLINE put #-}
123+
119124 state = Lift.lift . state @tag
125+ {-# INLINE state #-}
120126
121127instance {-# OVERLAPPABLE #-}
122128 ( Monad (trans m)
123− , MonadState tag s (TaggedTrans effs trans m)
124− ) => MonadState tag s (TaggedTrans (eff ': effs) trans (m :: Type -> Type))
129+ , MonadState tag s (Handler effs trans m)
130+ ) => MonadState tag s (Handler (eff ': effs) trans (m :: Type -> Type))
125131 where
126132
127133 get =
128134 (coerce ::
129− TaggedTrans effs trans m s ->
130− TaggedTrans (eff ': effs) trans m s)
135+ Handler effs trans m s ->
136+ Handler (eff ': effs) trans m s)
131137 (get @tag)
138+ {-# INLINE get #-}
132139
133140 put =
134141 (coerce ::
135− (s -> TaggedTrans effs trans m ()) ->
136− (s -> TaggedTrans (eff ': effs) trans m ()))
142+ (s -> Handler effs trans m ()) ->
143+ (s -> Handler (eff ': effs) trans m ()))
137144 (put @tag)
145+ {-# INLINE put #-}
138146
139147 state =
140148 (coerce :: forall a .
141− ((s -> (a, s)) -> TaggedTrans effs trans m a) ->
142− ((s -> (a, s)) -> TaggedTrans (eff ': effs) trans m a))
149+ ((s -> (a, s)) -> Handler effs trans m a) ->
150+ ((s -> (a, s)) -> Handler (eff ': effs) trans m a))
143151 (state @tag)
152+ {-# INLINE state #-}
153+
154+-- | Encode type-level information for 'StateT'.
155+data STATE
144156
145157-- | Modifies the state inside a state monad.
146158modify :: forall tag s m . MonadState tag s m => (s -> s) -> m ()
147159modify f = state @tag (\s -> ((), f s))
160+{-# INLINABLE modify #-}
148161
149162-- | Gets specific component of the state, using a projection function supplied.
150163gets :: forall tag s m a . MonadState tag s m => (s -> a) -> m a
151164gets f = fmap f (get @tag)
152−
153−-- | Encode type-level information for 'StateT'.
154−data STATE
165+{-# INLINABLE gets #-}
155166
156167type instance HandleSuper STATE s trans = ()
157168type instance HandleConstraint STATE s trans m =
@@ -159,56 +170,64 @@ type instance HandleConstraint STATE s trans m =
159170
160171instance Handle STATE s (T.Strict.StateT s) where
161172 handling r = r
173+ {-# INLINE handling #-}
162174
163175instance Handle STATE s (T.Lazy.StateT s) where
164176 handling r = r
177+ {-# INLINE handling #-}
165178
166179instance
167180 ( Handle STATE s trans
168181 , Monad m, Monad (trans m)
169− ) => MonadState tag s (TaggedTrans (TAGGED STATE tag) trans m)
182+ ) => MonadState tag s (Handler (TAGGED STATE tag) trans m)
170183 where
171184
172185 get =
173186 handling @STATE @s @trans @m $
174187 coerce (T.get @s @(trans m))
188+ {-# INLINE get #-}
175189
176190 put =
177191 handling @STATE @s @trans @m $
178192 coerce (T.put @s @(trans m))
193+ {-# INLINE put #-}
179194
180195 state =
181196 handling @STATE @s @trans @m $
182197 coerce (T.state @s @(trans m) @a) ::
183− forall eff a . (s -> (a, s)) -> TaggedTrans eff trans m a
198+ forall eff a . (s -> (a, s)) -> Handler eff trans m a
199+ {-# INLINE state #-}
184200
185201instance
186202 ( HasLens tag payload s
187203 , Handle STATE payload trans
188204 , Monad m, Monad (trans m)
189− ) => MonadState tag s (TaggedTrans (TAGGED STATE tag ': effs) trans m)
205+ ) => MonadState tag s (Handler (TAGGED STATE tag ': effs) trans m)
190206 where
191207
192208 get =
193209 handling @STATE @payload @trans @m $
194210 (coerce :: forall eff a .
195211 trans m a ->
196− TaggedTrans eff trans m a)
212+ Handler eff trans m a)
197213 (T.gets (view (lensOf @tag @payload @s)))
214+ {-# INLINE get #-}
198215
199216 put s =
200217 handling @STATE @payload @trans @m $
201218 (coerce :: forall eff a .
202219 trans m a ->
203− TaggedTrans eff trans m a)
220+ Handler eff trans m a)
204221 (T.modify (over (lensOf @tag @payload @s) (const s)))
222+ {-# INLINE put #-}
205223
206224 state f =
207225 handling @STATE @payload @trans @m $
208226 (coerce :: forall eff a .
209227 trans m a ->
210− TaggedTrans eff trans m a)
228+ Handler eff trans m a)
211229 (T.state (lensOf @tag @payload @s f))
230+ {-# INLINE state #-}
212231
213232-- | The parametrizable state monad.
214233--
@@ -222,41 +241,48 @@ type State tag r = StateT tag r Identity
222241--
223242-- The 'return' function leaves the state unchanged, while '>>=' uses
224243-- 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)
244+type StateT tag s = Handler (TAGGED STATE tag) (T.Strict.StateT s)
226245
227246-- | Constructor for computations in the state monad transformer.
228247stateT :: forall tag s m a . (s -> m (a, s)) -> StateT tag s m a
229248stateT = coerce (T.Strict.StateT @s @m @a)
249+{-# INLINE stateT #-}
230250
231251-- | Runs a 'StateT' with the given initial state
232252-- and returns both the final value and the final state.
233253runStateT :: forall tag s m a . StateT tag s m a -> s -> m (a, s)
234254runStateT = coerce (T.Strict.runStateT @s @m @a)
255+{-# INLINE runStateT #-}
235256
236257-- | Runs a 'StateT' with the given initial state
237258-- and returns the final value, discarding the final state.
238259evalStateT :: forall tag s m a . Monad m => StateT tag s m a -> s -> m a
239260evalStateT = coerce (T.Strict.evalStateT @m @s @a)
261+{-# INLINE evalStateT #-}
240262
241263-- | Runs a 'StateT' with the given initial state
242264-- and returns the final state, discarding the final value.
243265execStateT :: forall tag s m a . Monad m => StateT tag s m a -> s -> m s
244266execStateT = coerce (T.Strict.execStateT @m @s @a)
267+{-# INLINE execStateT #-}
245268
246269-- | Runs a 'State' with the given initial state
247270-- and returns both the final value and the final state.
248271runState :: forall tag s a . State tag s a -> s -> (a, s)
249272runState = coerce (T.Strict.runState @s @a)
273+{-# INLINE runState #-}
250274
251275-- | Runs a 'State' with the given initial state
252276-- and returns the final value, discarding the final state.
253277evalState :: forall tag s a . State tag s a -> s -> a
254278evalState = coerce (T.Strict.evalState @s @a)
279+{-# INLINE evalState #-}
255280
256281-- | Runs a 'State' with the given initial state
257282-- and returns the final state, discarding the final value.
258283execState :: forall tag s a . State tag s a -> s -> s
259284execState = coerce (T.Strict.execState @s @a)
285+{-# INLINE execState #-}
260286
261287-- | The parametrizable state monad.
262288--
@@ -270,127 +296,159 @@ type LazyState tag r = LazyStateT tag r Identity
270296--
271297-- The 'return' function leaves the state unchanged, while '>>=' uses
272298-- 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)
299+type LazyStateT tag s = Handler (TAGGED STATE tag) (T.Lazy.StateT s)
274300
275301-- | Constructor for computations in the state monad transformer.
276302lazyStateT :: forall tag s m a . (s -> m (a, s)) -> LazyStateT tag s m a
277303lazyStateT = coerce (T.Lazy.StateT @s @m @a)
304+{-# INLINE lazyStateT #-}
278305
279306-- | Runs a 'StateT' with the given initial state
280307-- and returns both the final value and the final state.
281308runLazyStateT :: forall tag s m a . LazyStateT tag s m a -> s -> m (a, s)
282309runLazyStateT = coerce (T.Lazy.runStateT @s @m @a)
310+{-# INLINE runLazyStateT #-}
283311
284312-- | Runs a 'StateT' with the given initial state
285313-- and returns the final value, discarding the final state.
286314evalLazyStateT :: forall tag s m a . Monad m => LazyStateT tag s m a -> s -> m a
287315evalLazyStateT = coerce (T.Lazy.evalStateT @m @s @a)
316+{-# INLINE evalLazyStateT #-}
288317
289318-- | Runs a 'StateT' with the given initial state
290319-- and returns the final state, discarding the final value.
291320execLazyStateT :: forall tag s m a . Monad m => LazyStateT tag s m a -> s -> m s
292321execLazyStateT = coerce (T.Lazy.execStateT @m @s @a)
322+{-# INLINE execLazyStateT #-}
293323
294324-- | Runs a 'State' with the given initial state
295325-- and returns both the final value and the final state.
296326runLazyState :: forall tag s a . LazyState tag s a -> s -> (a, s)
297327runLazyState = coerce (T.Lazy.runState @s @a)
328+{-# INLINE runLazyState #-}
298329
299330-- | Runs a 'State' with the given initial state
300331-- and returns the final value, discarding the final state.
301332evalLazyState :: forall tag s a . LazyState tag s a -> s -> a
302333evalLazyState = coerce (T.Lazy.evalState @s @a)
334+{-# INLINE evalLazyState #-}
303335
304336-- | Runs a 'State' with the given initial state
305337-- and returns the final state, discarding the final value.
306338execLazyState :: forall tag s a . LazyState tag s a -> s -> s
307339execLazyState = coerce (T.Lazy.execState @s @a)
340+{-# INLINE execLazyState #-}
308341
309342type family STATES (ts :: HList xs) :: [Type] where
310343 STATES 'HNil = '[]
311344 STATES ('HCons t ts) = TAGGED STATE t ': STATES ts
312345
313−type StatesT s = TaggedTrans (STATES (Tags s)) (T.Strict.StateT s)
346+type StatesT s = Handler (STATES (Tags s)) (T.Strict.StateT s)
314347
315348type States s = StatesT s Identity
316349
317350runStatesT :: forall p m a . StatesT p m a -> p -> m (a, p)
318351runStatesT = coerce (T.Strict.runStateT @p @m @a)
352+{-# INLINE runStatesT #-}
319353
320354runStates :: forall p a . States p a -> p -> (a, p)
321355runStates = coerce (T.Strict.runState @p @a)
356+{-# INLINE runStates #-}
322357
323358type StateT' s = StateT s s
324359
325360stateT' :: (s -> m (a, s)) -> StateT' s m a
326361stateT' = stateT
362+{-# INLINE stateT' #-}
327363
328364runStateT' :: StateT' s m a -> s -> m (a, s)
329365runStateT' = runStateT
366+{-# INLINE runStateT' #-}
330367
331368runState' :: State' s a -> s -> (a, s)
332369runState' = runState
370+{-# INLINE runState' #-}
333371
334372evalStateT' :: Monad m => StateT' s m a -> s -> m a
335373evalStateT' = evalStateT
374+{-# INLINE evalStateT' #-}
336375
337376type State' s = State s s
338377
339378evalState' :: State' s a -> s -> a
340379evalState' = evalState
380+{-# INLINE evalState' #-}
341381
342382execStateT' :: Monad m => StateT' s m a -> s -> m s
343383execStateT' = execStateT
384+{-# INLINE execStateT' #-}
344385
345386execState' :: State' s a -> s -> s
346387execState' = execState
388+{-# INLINE execState' #-}
347389
348390type LazyStateT' s = LazyStateT s s
349391
350392lazyStateT' :: (s -> m (a, s)) -> LazyStateT' s m a
351393lazyStateT' = lazyStateT
394+{-# INLINE lazyStateT' #-}
352395
353396runLazyStateT' :: LazyStateT' s m a -> s -> m (a, s)
354397runLazyStateT' = runLazyStateT
398+{-# INLINE runLazyStateT' #-}
355399
356400runLazyState' :: LazyState' s a -> s -> (a, s)
357401runLazyState' = runLazyState
402+{-# INLINE runLazyState' #-}
358403
359404evalLazyStateT' :: Monad m => LazyStateT' s m a -> s -> m a
360405evalLazyStateT' = evalLazyStateT
406+{-# INLINE evalLazyStateT' #-}
361407
362408type LazyState' s = LazyState s s
363409
364410evalLazyState' :: LazyState' s a -> s -> a
365411evalLazyState' = evalLazyState
412+{-# INLINE evalLazyState' #-}
366413
367414execLazyStateT' :: Monad m => LazyStateT' s m a -> s -> m s
368415execLazyStateT' = execLazyStateT
416+{-# INLINE execLazyStateT' #-}
369417
370418execLazyState' :: LazyState' s a -> s -> s
371419execLazyState' = execLazyState
420+{-# INLINE execLazyState' #-}
372421
373422type MonadState' s = MonadState s s
374423
375424get' :: forall s m . MonadState' s m => m s
376425get' = get @s
426+{-# INLINE get' #-}
377427
378428gets' :: forall s m a . MonadState' s m => (s -> a) -> m a
379429gets' = gets @s
430+{-# INLINE gets' #-}
380431
381432put' :: forall s m . MonadState' s m => s -> m ()
382433put' = put @s
434+{-# INLINE put' #-}
383435
384436state' :: forall s m a . MonadState' s m => (s -> (a, s)) -> m a
385437state' = state @s
438+{-# INLINE state' #-}
386439
387440modify' :: forall s m . MonadState' s m => (s -> s) -> m ()
388441modify' = modify @s
442+{-# INLINE modify' #-}
389443
390444-- | Encode type-level information for 'zoom'.
391445data ZOOM t z
392446
393−type ZoomT t (z :: Type) = TaggedTrans (ZOOM t z) IdentityT
447+type ZoomT t (z :: Type) = Handler (ZOOM t z) IdentityT
448+
449+newtype ReifiedLens s t a b = Lens (Lens s t a b)
450+
451+type ReifiedLens' s a = ReifiedLens s s a a
394452
395453-- | Zoom into a part of a state using a lens.
396454zoom
@@ -399,17 +457,19 @@ zoom
399457 -> (forall z . Reifies z (ReifiedLens' sOuter sInner) => ZoomT tag z m a)
400458 -> m a
401459zoom l m = reify (Lens l) (\(_ :: Proxy z) -> coerce (m @z))
460+{-# INLINE zoom #-}
402461
403462instance
404463 ( MonadState tag sOuter m
405464 , Reifies z (ReifiedLens' sOuter sInner)
406465 , trans ~ IdentityT
407− ) => MonadState tag sInner (TaggedTrans (ZOOM tag z) trans m)
466+ ) => MonadState tag sInner (Handler (ZOOM tag z) trans m)
408467 where
409468 state =
410469 (coerce :: forall eff r a .
411− (r -> m a) ->
412− (r -> TaggedTrans eff trans m a))
470+ (r -> m a) ->
471+ (r -> Handler eff trans m a))
413472 (state @tag . l)
414473 where
415474 Lens l = reflect (Proxy :: Proxy z)
475+ {-# INLINE state #-}