Fix mistakes in Final, add atomic/StateToIO (#218)

* Fix for mistakes in Final that slipped through the cracks.

* Add @sinces, atomic/StateToIO

* Update changelog

ChangeLog.md

@@ -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

src/Polysemy/AtomicState.hs

@@ -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.

src/Polysemy/Final.hs

@@ -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

src/Polysemy/Fixpoint.hs

@@ -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

src/Polysemy/Internal.hs

@@ -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

src/Polysemy/Internal/Writer.hs

@@ -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

src/Polysemy/Output.hs

@@ -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)

src/Polysemy/State.hs

@@ -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

src/Polysemy/Writer.hs

@@ -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)