diff --git a/ChangeLog.md b/ChangeLog.md index 76b8be7..491ce9b 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -2,6 +2,12 @@ ## Unreleased +### Breaking Changes + +### Other Changes + +* Added interpreters for `AtomicState` that run in terms of `State`. + ## 1.6.0.0 (2021-07-12) ### Breaking Changes diff --git a/src/Polysemy/AtomicState.hs b/src/Polysemy/AtomicState.hs index dfaaf3b..e44f49d 100644 --- a/src/Polysemy/AtomicState.hs +++ b/src/Polysemy/AtomicState.hs @@ -18,6 +18,9 @@ module Polysemy.AtomicState , runAtomicStateTVar , atomicStateToIO , atomicStateToState + , runAtomicStateViaState + , evalAtomicStateViaState + , execAtomicStateViaState ) where @@ -170,3 +173,42 @@ atomicStateToState = interpret $ \case return a AtomicGet -> get {-# INLINE atomicStateToState #-} + +------------------------------------------------------------------------------ +-- | Run an 'AtomicState' with local state semantics, discarding +-- the notion of atomicity, by transforming it into 'State' and running it +-- with the provided initial state. +-- +-- @since TODO +runAtomicStateViaState :: s + -> Sem (AtomicState s ': r) a + -> Sem r (s, a) +runAtomicStateViaState s = + runState s . atomicStateToState . raiseUnder +{-# INLINE runAtomicStateViaState #-} + +------------------------------------------------------------------------------ +-- | Evaluate an 'AtomicState' with local state semantics, discarding +-- the notion of atomicity, by transforming it into 'State' and running it +-- with the provided initial state. +-- +-- @since TODO +evalAtomicStateViaState :: s + -> Sem (AtomicState s ': r) a + -> Sem r a +evalAtomicStateViaState s = + evalState s . atomicStateToState . raiseUnder +{-# INLINE evalAtomicStateViaState #-} + +------------------------------------------------------------------------------ +-- | Execute an 'AtomicState' with local state semantics, discarding +-- the notion of atomicity, by transforming it into 'State' and running it +-- with the provided initial state. +-- +-- @since TODO +execAtomicStateViaState :: s + -> Sem (AtomicState s ': r) a + -> Sem r s +execAtomicStateViaState s = + execState s . atomicStateToState . raiseUnder +{-# INLINE execAtomicStateViaState #-}