mirror of
https://github.com/polysemy-research/polysemy.git
synced 2024-09-11 02:25:43 +03:00
Fix mistakes in Final, add atomic/StateToIO (#218)
* Fix for mistakes in Final that slipped through the cracks. * Add @sinces, atomic/StateToIO * Update changelog
This commit is contained in:
parent
4a5f2ce92a
commit
d1faef0be6
@ -10,7 +10,8 @@
|
||||
- `runFixpoint` and `runFixpointM` have been deprecated in favor of `fixpointToFinal`.
|
||||
- The semantics for `runNonDet` when `<|>` is used inside a higher-order action of
|
||||
another effect has been changed.
|
||||
- Type variables for certain internal functions and `failToEmbed` have been rearranged.
|
||||
- Type variables for certain internal functions, `failToEmbed`,
|
||||
and `atomicState'` have been rearranged.
|
||||
|
||||
## Other changes
|
||||
|
||||
@ -23,6 +24,8 @@
|
||||
- Added `fixpointToFinal`, a better alternative of `runFixpoint` and `runFixpointM`
|
||||
- Added `resourceToIOFinal`, a better alternative of `lowerResource`
|
||||
- Added `outputToIOMonoid` and `outputToIOMonoidAssocR`
|
||||
- Added `stateToIO`
|
||||
- Added `atomicStateToIO`
|
||||
- Added `runWriterTVar`, `writerToIOFinal`, and `writerToIOAssocRFinal`
|
||||
- Added `writerToEndoWriter`
|
||||
- Added `subsume` operation
|
||||
|
@ -15,6 +15,7 @@ module Polysemy.AtomicState
|
||||
-- * Interpretations
|
||||
, runAtomicStateIORef
|
||||
, runAtomicStateTVar
|
||||
, atomicStateToIO
|
||||
, atomicStateToState
|
||||
) where
|
||||
|
||||
@ -26,6 +27,10 @@ import Polysemy.State
|
||||
|
||||
import Data.IORef
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- | A variant of 'State' that supports atomic operations.
|
||||
--
|
||||
-- @since 1.1.0.0
|
||||
data AtomicState s m a where
|
||||
AtomicState :: (s -> (s, a)) -> AtomicState s m a
|
||||
AtomicGet :: AtomicState s m s
|
||||
@ -46,9 +51,10 @@ atomicGet :: forall s r
|
||||
-----------------------------------------------------------------------------
|
||||
-- | A variant of 'atomicState' in which the computation is strict in the new
|
||||
-- state and return value.
|
||||
atomicState' :: Member (AtomicState s) r
|
||||
=> (s -> (s, a))
|
||||
-> Sem r a
|
||||
atomicState' :: forall s a r
|
||||
. Member (AtomicState s) r
|
||||
=> (s -> (s, a))
|
||||
-> Sem r a
|
||||
atomicState' f = do
|
||||
-- KingoftheHomeless: return value needs to be forced due to how
|
||||
-- 'atomicModifyIORef' is implemented: the computation
|
||||
@ -87,7 +93,8 @@ atomicModify' f = do
|
||||
------------------------------------------------------------------------------
|
||||
-- | Run an 'AtomicState' effect by transforming it into atomic operations
|
||||
-- over an 'IORef'.
|
||||
runAtomicStateIORef :: Member (Embed IO) r
|
||||
runAtomicStateIORef :: forall s r a
|
||||
. Member (Embed IO) r
|
||||
=> IORef s
|
||||
-> Sem (AtomicState s ': r) a
|
||||
-> Sem r a
|
||||
@ -111,6 +118,35 @@ runAtomicStateTVar tvar = interpret $ \case
|
||||
AtomicGet -> embed $ readTVarIO tvar
|
||||
{-# INLINE runAtomicStateTVar #-}
|
||||
|
||||
--------------------------------------------------------------------
|
||||
-- | Run an 'AtomicState' effect in terms of atomic operations
|
||||
-- in 'IO'.
|
||||
--
|
||||
-- Internally, this simply creates a new 'IORef', passes it to
|
||||
-- 'runAtomicStateIORef', and then returns the result and the final value
|
||||
-- of the 'IORef'.
|
||||
--
|
||||
-- /Beware/: As this uses an 'IORef' internally,
|
||||
-- all other effects will have local
|
||||
-- state semantics in regards to 'AtomicState' effects
|
||||
-- interpreted this way.
|
||||
-- For example, 'Polysemy.Error.throw' and 'Polysemy.Error.catch' will
|
||||
-- never revert 'atomicModify's, even if 'Polysemy.Error.runError' is used
|
||||
-- after 'atomicStateToIO'.
|
||||
--
|
||||
-- @since 1.2.0.0
|
||||
atomicStateToIO :: forall s r a
|
||||
. Member (Embed IO) r
|
||||
=> s
|
||||
-> Sem (AtomicState s ': r) a
|
||||
-> Sem r (s, a)
|
||||
atomicStateToIO s sem = do
|
||||
ref <- embed $ newIORef s
|
||||
res <- runAtomicStateIORef ref sem
|
||||
end <- embed $ readIORef ref
|
||||
return (end, res)
|
||||
{-# INLINE atomicStateToIO #-}
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- | Transform an 'AtomicState' effect to a 'State' effect, discarding
|
||||
-- the notion of atomicity.
|
||||
|
@ -101,6 +101,8 @@ type ThroughWeavingToFinal m z a =
|
||||
-- State semantics between effects that are interpreted in terms of the final monad
|
||||
-- depend on the final monad. For example, if the final monad is a monad transformer
|
||||
-- stack, then state semantics will depend on the order monad transformers are stacked.
|
||||
--
|
||||
-- @since 1.2.0.0
|
||||
newtype Final m z a where
|
||||
WithWeavingToFinal
|
||||
:: ThroughWeavingToFinal m z a
|
||||
@ -120,7 +122,7 @@ makeSem_ ''Final
|
||||
-- in application code, as it ties your application code directly to
|
||||
-- the final monad.
|
||||
withWeavingToFinal
|
||||
:: forall m a r
|
||||
:: forall m r a
|
||||
. Member (Final m) r
|
||||
=> ThroughWeavingToFinal m (Sem r) a
|
||||
-> Sem r a
|
||||
@ -207,8 +209,8 @@ runFinal = usingSem $ \u -> case extract u of
|
||||
------------------------------------------------------------------------------
|
||||
-- | Given natural transformations between @m1@ and @m2@, run a @'Final' m1@
|
||||
-- effect by transforming it into a @'Final' m2@ effect.
|
||||
finalToFinal :: forall m1 m2 a r
|
||||
. (Member (Final m2) r, Functor m2)
|
||||
finalToFinal :: forall m1 m2 r a
|
||||
. Member (Final m2) r
|
||||
=> (forall x. m1 x -> m2 x)
|
||||
-> (forall x. m2 x -> m1 x)
|
||||
-> Sem (Final m1 ': r) a
|
||||
|
@ -58,6 +58,8 @@ import Polysemy.Internal.Fixpoint
|
||||
-- If 'fixpointToFinal' throws an exception for you, and it can't
|
||||
-- be due to any of the above, then open an issue over at the
|
||||
-- GitHub repository for polysemy.
|
||||
--
|
||||
-- @since 1.2.0.0
|
||||
fixpointToFinal :: forall m r a
|
||||
. (Member (Final m) r, MonadFix m)
|
||||
=> Sem (Fixpoint ': r) a
|
||||
|
@ -344,6 +344,7 @@ raise = hoistSem $ hoist raise . weaken
|
||||
-- . 'raiseUnder' -- Introduces Bar under Foo
|
||||
-- @
|
||||
--
|
||||
-- @since 1.2.0.0
|
||||
raiseUnder :: ∀ e2 e1 r a. Sem (e1 ': r) a -> Sem (e1 ': e2 ': r) a
|
||||
raiseUnder = hoistSem $ hoist raiseUnder . weakenUnder
|
||||
where
|
||||
@ -357,6 +358,8 @@ raiseUnder = hoistSem $ hoist raiseUnder . weakenUnder
|
||||
------------------------------------------------------------------------------
|
||||
-- | Like 'raise', but introduces two new effects underneath the head of the
|
||||
-- list.
|
||||
--
|
||||
-- @since 1.2.0.0
|
||||
raiseUnder2 :: ∀ e2 e3 e1 r a. Sem (e1 ': r) a -> Sem (e1 ': e2 ': e3 ': r) a
|
||||
raiseUnder2 = hoistSem $ hoist raiseUnder2 . weakenUnder2
|
||||
where
|
||||
@ -370,6 +373,8 @@ raiseUnder2 = hoistSem $ hoist raiseUnder2 . weakenUnder2
|
||||
------------------------------------------------------------------------------
|
||||
-- | Like 'raise', but introduces two new effects underneath the head of the
|
||||
-- list.
|
||||
--
|
||||
-- @since 1.2.0.0
|
||||
raiseUnder3 :: ∀ e2 e3 e4 e1 r a. Sem (e1 ': r) a -> Sem (e1 ': e2 ': e3 ': e4 ': r) a
|
||||
raiseUnder3 = hoistSem $ hoist raiseUnder3 . weakenUnder3
|
||||
where
|
||||
@ -386,6 +391,8 @@ raiseUnder3 = hoistSem $ hoist raiseUnder3 . weakenUnder3
|
||||
-- without immediately consuming the newly introduced effect.
|
||||
-- Using such an interpreter recursively may result in duplicate effects,
|
||||
-- which may then be eliminated using 'subsume'.
|
||||
--
|
||||
-- @since 1.2.0.0
|
||||
subsume :: Member e r => Sem (e ': r) a -> Sem r a
|
||||
subsume = hoistSem $ \u -> hoist subsume $ case decomp u of
|
||||
Right w -> injWeaving w
|
||||
|
@ -30,6 +30,8 @@ makeSem ''Writer
|
||||
--
|
||||
-- This can be used together with 'raiseUnder' in order to create
|
||||
-- @-AssocR@ variants out of regular 'Writer' interpreters.
|
||||
--
|
||||
-- @since 1.2.0.0
|
||||
writerToEndoWriter
|
||||
:: (Monoid o, Member (Writer (Endo o)) r)
|
||||
=> Sem (Writer o ': r) a
|
||||
|
@ -77,6 +77,8 @@ runOutputMonoid f = runState mempty . reinterpret
|
||||
--
|
||||
-- You should always use this instead of 'runOutputMonoid' if the monoid
|
||||
-- is a list, such as 'String'.
|
||||
--
|
||||
-- @since 1.1.0.0
|
||||
runOutputMonoidAssocR
|
||||
:: forall o m r a
|
||||
. Monoid m
|
||||
@ -91,6 +93,8 @@ runOutputMonoidAssocR f =
|
||||
------------------------------------------------------------------------------
|
||||
-- | Run an 'Output' effect by transforming it into atomic operations
|
||||
-- over an 'IORef'.
|
||||
--
|
||||
-- @since 1.1.0.0
|
||||
runOutputMonoidIORef
|
||||
:: forall o m r a
|
||||
. (Monoid m, Member (Embed IO) r)
|
||||
@ -105,6 +109,8 @@ runOutputMonoidIORef ref f = interpret $ \case
|
||||
------------------------------------------------------------------------------
|
||||
-- | Run an 'Output' effect by transforming it into atomic operations
|
||||
-- over a 'TVar'.
|
||||
--
|
||||
-- @since 1.1.0.0
|
||||
runOutputMonoidTVar
|
||||
:: forall o m r a
|
||||
. (Monoid m, Member (Embed IO) r)
|
||||
@ -134,6 +140,8 @@ runOutputMonoidTVar tvar f = interpret $ \case
|
||||
-- For example, 'Polysemy.Error.throw' and 'Polysemy.Error.catch' will
|
||||
-- never revert 'output's, even if 'Polysemy.Error.runError' is used
|
||||
-- after 'outputToIOMonoid'.
|
||||
--
|
||||
-- @since 1.2.0.0
|
||||
outputToIOMonoid
|
||||
:: forall o m r a
|
||||
. (Monoid m, Member (Embed IO) r)
|
||||
@ -162,6 +170,8 @@ outputToIOMonoid f sem = do
|
||||
-- For example, 'Polysemy.Error.throw' and 'Polysemy.Error.catch' will
|
||||
-- never revert 'output's, even if 'Polysemy.Error.runError' is used
|
||||
-- after 'outputToIOMonoidAssocR'.
|
||||
--
|
||||
-- @since 1.2.0.0
|
||||
outputToIOMonoidAssocR
|
||||
:: forall o m r a
|
||||
. (Monoid m, Member (Embed IO) r)
|
||||
|
@ -17,6 +17,7 @@ module Polysemy.State
|
||||
, runLazyState
|
||||
, evalLazyState
|
||||
, runStateIORef
|
||||
, stateToIO
|
||||
|
||||
-- * Interoperation with MTL
|
||||
, hoistStateIntoStateT
|
||||
@ -122,6 +123,39 @@ runStateIORef ref = interpret $ \case
|
||||
Put s -> embed $ writeIORef ref s
|
||||
{-# INLINE runStateIORef #-}
|
||||
|
||||
--------------------------------------------------------------------
|
||||
-- | Run an 'State' effect in terms of operations
|
||||
-- in 'IO'.
|
||||
--
|
||||
-- Internally, this simply creates a new 'IORef', passes it to
|
||||
-- 'runStateIORef', and then returns the result and the final value
|
||||
-- of the 'IORef'.
|
||||
--
|
||||
-- /Note/: This is not safe in a concurrent setting, as 'modify' isn't atomic.
|
||||
-- If you need operations over the state to be atomic,
|
||||
-- use 'Polysemy.AtomicState.atomicStateToIO' instead.
|
||||
--
|
||||
-- /Beware/: As this uses an 'IORef' internally,
|
||||
-- all other effects will have local
|
||||
-- state semantics in regards to 'State' effects
|
||||
-- interpreted this way.
|
||||
-- For example, 'Polysemy.Error.throw' and 'Polysemy.Error.catch' will
|
||||
-- never revert 'put's, even if 'Polysemy.Error.runError' is used
|
||||
-- after 'stateToIO'.
|
||||
--
|
||||
-- @since 1.2.0.0
|
||||
stateToIO
|
||||
:: forall s r a
|
||||
. Member (Embed IO) r
|
||||
=> s
|
||||
-> Sem (State s ': r) a
|
||||
-> Sem r (s, a)
|
||||
stateToIO s sem = do
|
||||
ref <- embed $ newIORef s
|
||||
res <- runStateIORef ref sem
|
||||
end <- embed $ readIORef ref
|
||||
return (end, res)
|
||||
{-# INLINE stateToIO #-}
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- | Hoist a 'State' effect into a 'S.StateT' monad transformer. This can be
|
||||
|
@ -89,6 +89,8 @@ runWriter = runState mempty . reinterpretH
|
||||
--
|
||||
-- You should always use this instead of 'runWriter' if the monoid
|
||||
-- is a list, such as 'String'.
|
||||
--
|
||||
-- @since 1.1.0.0
|
||||
runWriterAssocR
|
||||
:: Monoid o
|
||||
=> Sem (Writer o ': r) a
|
||||
@ -103,6 +105,8 @@ runWriterAssocR =
|
||||
--------------------------------------------------------------------
|
||||
-- | Transform a 'Writer' effect into atomic operations
|
||||
-- over a 'TVar' through final 'IO'.
|
||||
--
|
||||
-- @since 1.2.0.0
|
||||
runWriterTVar :: (Monoid o, Member (Final IO) r)
|
||||
=> TVar o
|
||||
-> Sem (Writer o ': r) a
|
||||
@ -124,6 +128,8 @@ runWriterTVar tvar = runWriterSTMAction $ \o -> do
|
||||
-- /Beware/: Effects that aren't interpreted in terms of 'IO'
|
||||
-- will have local state semantics in regards to 'Writer' effects
|
||||
-- interpreted this way. See 'Final'.
|
||||
--
|
||||
-- @since 1.2.0.0
|
||||
writerToIOFinal :: (Monoid o, Member (Final IO) r)
|
||||
=> Sem (Writer o ': r) a
|
||||
-> Sem r (o, a)
|
||||
@ -146,6 +152,8 @@ writerToIOFinal sem = do
|
||||
-- /Beware/: Effects that aren't interpreted in terms of 'IO'
|
||||
-- will have local state semantics in regards to 'Writer' effects
|
||||
-- interpreted this way. See 'Final'.
|
||||
--
|
||||
-- @since 1.2.0.0
|
||||
writerToIOAssocRFinal :: (Monoid o, Member (Final IO) r)
|
||||
=> Sem (Writer o ': r) a
|
||||
-> Sem r (o, a)
|
||||
|
Loading…
Reference in New Issue
Block a user