From 4a5f2ce92a752cfbf96ae8a31ee12b100e2c0482 Mon Sep 17 00:00:00 2001
From: KingoftheHomeless <combiner8761@gmail.com>
Date: Fri, 30 Aug 2019 22:38:53 +0200
Subject: [PATCH] Add Final Effect (#217)

* Add Final Effect

* Changes per review, Final at top-level, doc changes

* Update Changelog

* Final touches to Final

* Revert change to stack.yaml
---
 ChangeLog.md                          |  29 +++
 README.md                             |   8 +-
 package.yaml                          |   2 +-
 polysemy-plugin/package.yaml          |   2 +-
 polysemy-plugin/polysemy-plugin.cabal |   4 +-
 polysemy-plugin/test/ExampleSpec.hs   |   8 +-
 polysemy.cabal                        |   8 +-
 src/Polysemy.hs                       |   9 +
 src/Polysemy/Async.hs                 |  48 ++++-
 src/Polysemy/Error.hs                 |  46 ++++-
 src/Polysemy/Fail.hs                  |   2 +-
 src/Polysemy/Final.hs                 | 242 ++++++++++++++++++++++++++
 src/Polysemy/Fixpoint.hs              |  53 ++++--
 src/Polysemy/Internal.hs              |  20 ++-
 src/Polysemy/Internal/Fixpoint.hs     |   7 +-
 src/Polysemy/Internal/Forklift.hs     |   3 +-
 src/Polysemy/Internal/Strategy.hs     | 101 +++++++++++
 src/Polysemy/Internal/Union.hs        |   2 +-
 src/Polysemy/Internal/Writer.hs       | 156 +++++++++++++++++
 src/Polysemy/Output.hs                |  62 ++++++-
 src/Polysemy/Resource.hs              |  46 ++++-
 src/Polysemy/Writer.hs                | 105 +++++++----
 stack.yaml                            |   2 +-
 test/AsyncSpec.hs                     |   1 -
 test/FinalSpec.hs                     |  96 ++++++++++
 test/FixpointSpec.hs                  |  39 +++--
 test/OutputSpec.hs                    |  15 +-
 test/WriterSpec.hs                    |  73 +++++++-
 28 files changed, 1086 insertions(+), 103 deletions(-)
 create mode 100644 src/Polysemy/Final.hs
 create mode 100644 src/Polysemy/Internal/Strategy.hs
 create mode 100644 src/Polysemy/Internal/Writer.hs
 create mode 100644 test/FinalSpec.hs

diff --git a/ChangeLog.md b/ChangeLog.md
index e4c22d3..e66c2d2 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,5 +1,34 @@
 # Changelog for polysemy
 
+
+## 1.2.0.0 (TODO)
+
+### Breaking Changes
+
+- All `lower-` interpreters have been deprecated, in favor of corresponding
+    `-Final` interpreters.
+- `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.
+
+## Other changes
+
+- Added `Final` effect, an effect for embedding higher-order actions in the
+    final monad of the effect stack. Any interpreter should use this instead of
+    requiring to be provided an explicit lowering function to the final monad.
+- Added `Strategy` environment for use together with `Final`
+- Added `asyncToIOFinal`, a better alternative of `lowerAsync`
+- Added `errorToIOFinal`, a better alternative of `lowerError`
+- Added `fixpointToFinal`, a better alternative of `runFixpoint` and `runFixpointM`
+- Added `resourceToIOFinal`, a better alternative of `lowerResource`
+- Added `outputToIOMonoid` and `outputToIOMonoidAssocR`
+- Added `runWriterTVar`, `writerToIOFinal`, and `writerToIOAssocRFinal`
+- Added `writerToEndoWriter`
+- Added `subsume` operation
+- Exposed `raiseUnder`/`2`/`3` in `Polysemy`
+
+
 ## 1.1.0.0 (2019-08-15)
 
 ### Breaking Changes
diff --git a/README.md b/README.md
index 413aa28..d95519c 100644
--- a/README.md
+++ b/README.md
@@ -153,7 +153,13 @@ program = catch @CustomException work $ \e -> writeTTY ("Caught " ++ show e)
             _             -> writeTTY input >> writeTTY "no exceptions"
 
 main :: IO (Either CustomException ())
-main = (runM .@ lowerResource .@@ lowerError @CustomException) . teletypeToIO $ program
+main =
+    runFinal
+  . embedToFinal @IO
+  . resourceToIOFinal
+  . errorToIOFinal @CustomException
+  . teletypeToIO
+  $ program
 ```
 
 Easy.
diff --git a/package.yaml b/package.yaml
index 91564ea..5fe88f5 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name:                polysemy
-version:             1.1.0.0
+version:             1.2.0.0
 github:              "isovector/polysemy"
 license:             BSD3
 author:              "Sandy Maguire"
diff --git a/polysemy-plugin/package.yaml b/polysemy-plugin/package.yaml
index 72c0661..2eb471f 100644
--- a/polysemy-plugin/package.yaml
+++ b/polysemy-plugin/package.yaml
@@ -39,7 +39,7 @@ tests:
     build-tools:
     - hspec-discover
     dependencies:
-    - polysemy >= 0.6.0.0
+    - polysemy >= 1.2.0.0
     - polysemy-plugin
     - hspec >= 2.6.0 && < 3
     - should-not-typecheck >= 2.1.0 && < 3
diff --git a/polysemy-plugin/polysemy-plugin.cabal b/polysemy-plugin/polysemy-plugin.cabal
index da020b5..2e77d6c 100644
--- a/polysemy-plugin/polysemy-plugin.cabal
+++ b/polysemy-plugin/polysemy-plugin.cabal
@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: b8d6dd19e90295689617adfecbd3bb83127b112840f4f304d956a4d5b33bf821
+-- hash: a3e70728f8ab4d2e3e7b2727e004b88a497852dd2b44df914418e070f5171e92
 
 name:           polysemy-plugin
 version:        0.2.2.0
@@ -76,7 +76,7 @@ test-suite polysemy-plugin-test
     , ghc-tcplugins-extra >=0.3 && <0.4
     , hspec >=2.6.0 && <3
     , inspection-testing >=0.4.2 && <0.5
-    , polysemy >=0.6.0.0
+    , polysemy >=1.2.0.0
     , polysemy-plugin
     , should-not-typecheck >=2.1.0 && <3
     , syb >=0.7 && <0.8
diff --git a/polysemy-plugin/test/ExampleSpec.hs b/polysemy-plugin/test/ExampleSpec.hs
index 5710f65..7903854 100644
--- a/polysemy-plugin/test/ExampleSpec.hs
+++ b/polysemy-plugin/test/ExampleSpec.hs
@@ -33,7 +33,13 @@ program = catch @CustomException work $ \e -> writeTTY ("Caught " ++ show e)
             _             -> writeTTY i >> writeTTY "no exceptions"
 
 foo :: IO (Either CustomException ())
-foo = (runM .@ lowerResource .@@ lowerError @CustomException) $ teletypeToIO program
+foo =
+    runFinal
+  . embedToFinal @IO
+  . resourceToIOFinal
+  . errorToIOFinal @CustomException
+  . teletypeToIO
+  $ program
 
 spec :: Spec
 spec = describe "example" $ do
diff --git a/polysemy.cabal b/polysemy.cabal
index 58f8dd0..1561f03 100644
--- a/polysemy.cabal
+++ b/polysemy.cabal
@@ -4,10 +4,10 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: ed739126c69520676b38ca047f46cbddc31813120ceb38b36fe7ac3c0012a606
+-- hash: a8b3a81d8983405247d7e8cb0010669caf9e8f62f85762990fadbeccdafc6094
 
 name:           polysemy
-version:        1.1.0.0
+version:        1.2.0.0
 synopsis:       Higher-order, low-boilerplate, zero-cost free monads.
 description:    Please see the README on GitHub at <https://github.com/isovector/polysemy#readme>
 category:       Language
@@ -47,6 +47,7 @@ library
       Polysemy.Error
       Polysemy.Fail
       Polysemy.Fail.Type
+      Polysemy.Final
       Polysemy.Fixpoint
       Polysemy.Input
       Polysemy.Internal
@@ -57,10 +58,12 @@ library
       Polysemy.Internal.Forklift
       Polysemy.Internal.Kind
       Polysemy.Internal.NonDet
+      Polysemy.Internal.Strategy
       Polysemy.Internal.Tactics
       Polysemy.Internal.TH.Common
       Polysemy.Internal.TH.Effect
       Polysemy.Internal.Union
+      Polysemy.Internal.Writer
       Polysemy.IO
       Polysemy.NonDet
       Polysemy.Output
@@ -118,6 +121,7 @@ test-suite polysemy-test
       BracketSpec
       DoctestSpec
       FailSpec
+      FinalSpec
       FixpointSpec
       FusionSpec
       HigherOrderSpec
diff --git a/src/Polysemy.hs b/src/Polysemy.hs
index 8405da2..9d7aa35 100644
--- a/src/Polysemy.hs
+++ b/src/Polysemy.hs
@@ -7,10 +7,18 @@ module Polysemy
   -- * Running Sem
   , run
   , runM
+  , runFinal
 
   -- * Interoperating With Other Monads
+  -- ** Embed
   , Embed (..)
   , embed
+  , embedToFinal
+  -- ** Final
+  -- | For advanced uses of 'Final', including creating your own interpreters
+  -- that make use of it, see "Polysemy.Final"
+  , Final
+  , embedFinal
 
     -- * Lifting
   , raise
@@ -130,4 +138,5 @@ import Polysemy.Internal.Forklift
 import Polysemy.Internal.Kind
 import Polysemy.Internal.TH.Effect
 import Polysemy.Internal.Tactics
+import Polysemy.Final
 
diff --git a/src/Polysemy/Async.hs b/src/Polysemy/Async.hs
index adaa960..86377e4 100644
--- a/src/Polysemy/Async.hs
+++ b/src/Polysemy/Async.hs
@@ -10,11 +10,13 @@ module Polysemy.Async
 
     -- * Interpretations
   , asyncToIO
+  , asyncToIOFinal
   , lowerAsync
   ) where
 
 import qualified Control.Concurrent.Async as A
 import           Polysemy
+import           Polysemy.Final
 
 
 
@@ -32,13 +34,23 @@ data Async m a where
 makeSem ''Async
 
 ------------------------------------------------------------------------------
--- | A more flexible --- though less performant ---  version of 'lowerAsync'.
+-- | A more flexible --- though less performant ---
+-- version of 'asyncToIOFinal'.
 --
 -- This function is capable of running 'Async' effects anywhere within an
--- effect stack, without relying on an explicit function to lower it into 'IO'.
+-- effect stack, without relying on 'Final' to lower it into 'IO'.
 -- Notably, this means that 'Polysemy.State.State' effects will be consistent
 -- in the presence of 'Async'.
 --
+-- 'asyncToIO' is __unsafe__ if you're using 'await' inside higher-order actions
+-- of other effects interpreted after 'Async'.
+-- See <https://github.com/polysemy-research/polysemy/issues/205 Issue #205>.
+--
+-- Prefer 'asyncToIOFinal' unless you need to run pure, stateful interpreters
+-- after the interpreter for 'Async'.
+-- (Pure interpreters are interpreters that aren't expressed in terms of
+-- another effect or monad; for example, 'Polysemy.State.runState'.)
+--
 -- @since 1.0.0.0
 asyncToIO
     :: Member (Embed IO) r
@@ -57,9 +69,37 @@ asyncToIO m = withLowerToIO $ \lower _ -> lower $
     )  m
 {-# INLINE asyncToIO #-}
 
+------------------------------------------------------------------------------
+-- | Run an 'Async' effect in terms of 'A.async' through final 'IO'.
+--
+-- /Beware/: Effects that aren't interpreted in terms of 'IO'
+-- will have local state semantics in regards to 'Async' effects
+-- interpreted this way. See 'Final'.
+--
+-- Notably, unlike 'asyncToIO', this is not consistent with
+-- 'Polysemy.State.State' unless 'Polysemy.State.runStateIORef' is used.
+-- State that seems like it should be threaded globally throughout 'Async'
+-- /will not be./
+--
+-- Use 'asyncToIO' instead if you need to run
+-- pure, stateful interpreters after the interpreter for 'Async'.
+-- (Pure interpreters are interpreters that aren't expressed in terms of
+-- another effect or monad; for example, 'Polysemy.State.runState'.)
+--
+-- @since 1.2.0.0
+asyncToIOFinal :: Member (Final IO) r
+               => Sem (Async ': r) a
+               -> Sem r a
+asyncToIOFinal = interpretFinal $ \case
+  Async m -> do
+    ins <- getInspectorS
+    m'  <- runS m
+    liftS $ A.async (inspect ins <$> m')
+  Await a -> liftS (A.wait a)
+{-# INLINE asyncToIOFinal #-}
 
 ------------------------------------------------------------------------------
--- | Run an 'Async' effect via in terms of 'A.async'.
+-- | Run an 'Async' effect in terms of 'A.async'.
 --
 -- @since 1.0.0.0
 lowerAsync
@@ -80,4 +120,4 @@ lowerAsync lower m = interpretH
         Await a -> pureT =<< embed (A.wait a)
     )  m
 {-# INLINE lowerAsync #-}
-
+{-# DEPRECATED lowerAsync "Use 'asyncToIOFinal' instead" #-}
diff --git a/src/Polysemy/Error.hs b/src/Polysemy/Error.hs
index 9541309..14e5db1 100644
--- a/src/Polysemy/Error.hs
+++ b/src/Polysemy/Error.hs
@@ -13,6 +13,7 @@ module Polysemy.Error
     -- * Interpretations
   , runError
   , mapError
+  , errorToIOFinal
   , lowerError
   ) where
 
@@ -22,6 +23,7 @@ import qualified Control.Monad.Trans.Except as E
 import           Data.Bifunctor (first)
 import           Data.Typeable
 import           Polysemy
+import           Polysemy.Final
 import           Polysemy.Internal
 import           Polysemy.Internal.Union
 
@@ -130,6 +132,48 @@ instance Typeable e => Show (WrappedExc e) where
 instance (Typeable e) => X.Exception (WrappedExc e)
 
 
+------------------------------------------------------------------------------
+-- | Run an 'Error' effect as an 'IO' 'X.Exception' through final 'IO'. This
+-- interpretation is significantly faster than 'runError'.
+--
+-- /Beware/: Effects that aren't interpreted in terms of 'IO'
+-- will have local state semantics in regards to 'Error' effects
+-- interpreted this way. See 'Final'.
+--
+-- @since 1.2.0.0
+errorToIOFinal
+    :: ( Typeable e
+       , Member (Final IO) r
+       )
+    => Sem (Error e ': r) a
+    -> Sem r (Either e a)
+errorToIOFinal sem = withStrategicToFinal @IO $ do
+  m' <- runS (runErrorAsExcFinal sem)
+  s  <- getInitialStateS
+  pure $
+    either
+      ((<$ s) . Left . unwrapExc)
+      (fmap Right)
+    <$> X.try m'
+{-# INLINE errorToIOFinal #-}
+
+runErrorAsExcFinal
+    :: forall e r a
+    .  ( Typeable e
+       , Member (Final IO) r
+       )
+    => Sem (Error e ': r) a
+    -> Sem r a
+runErrorAsExcFinal = interpretFinal $ \case
+  Throw e   -> pure $ X.throwIO $ WrappedExc e
+  Catch m h -> do
+    m' <- runS m
+    h' <- bindS h
+    s  <- getInitialStateS
+    pure $ X.catch m' $ \(se :: WrappedExc e) ->
+      h' (unwrapExc se <$ s)
+{-# INLINE runErrorAsExcFinal #-}
+
 ------------------------------------------------------------------------------
 -- | Run an 'Error' effect as an 'IO' 'X.Exception'. This interpretation is
 -- significantly faster than 'runError', at the cost of being less flexible.
@@ -151,6 +195,7 @@ lowerError lower
     . X.try
     . (lower .@ runErrorAsExc)
 {-# INLINE lowerError #-}
+{-# DEPRECATED lowerError "Use 'errorToIOFinal' instead" #-}
 
 
 -- TODO(sandy): Can we use the new withLowerToIO machinery for this?
@@ -171,4 +216,3 @@ runErrorAsExc lower = interpretH $ \case
     embed $ X.catch (runIt t) $ \(se :: WrappedExc e) ->
       runIt $ h $ unwrapExc se <$ is
 {-# INLINE runErrorAsExc #-}
-
diff --git a/src/Polysemy/Fail.hs b/src/Polysemy/Fail.hs
index a80ef20..af5bd00 100644
--- a/src/Polysemy/Fail.hs
+++ b/src/Polysemy/Fail.hs
@@ -47,7 +47,7 @@ failToNonDet = interpret $ \(Fail _) -> empty
 
 ------------------------------------------------------------------------------
 -- | Run a 'Fail' effect in terms of an underlying 'MonadFail' instance.
-failToEmbed :: forall m a r
+failToEmbed :: forall m r a
              . (Member (Embed m) r, MonadFail m)
             => Sem (Fail ': r) a
             -> Sem r a
diff --git a/src/Polysemy/Final.hs b/src/Polysemy/Final.hs
new file mode 100644
index 0000000..027ab35
--- /dev/null
+++ b/src/Polysemy/Final.hs
@@ -0,0 +1,242 @@
+{-# LANGUAGE TemplateHaskell #-}
+module Polysemy.Final
+  (
+    -- * Effect
+    Final(..)
+  , ThroughWeavingToFinal
+
+    -- * Actions
+  , withWeavingToFinal
+  , withStrategicToFinal
+  , embedFinal
+
+    -- * Combinators for Interpreting to the Final Monad
+  , interpretFinal
+
+    -- * Strategy
+    -- | Strategy is a domain-specific language very similar to @Tactics@
+    -- (see 'Polysemy.Tactical'), and is used to describe how higher-order
+    -- effects are threaded down to the final monad.
+    --
+    -- Much like @Tactics@, computations can be run and threaded
+    -- through the use of 'runS' and 'bindS', and first-order constructors
+    -- may use 'pureS'. In addition, 'liftS' may be used to
+    -- lift actions of the final monad.
+    --
+    -- Unlike @Tactics@, the final return value within a 'Strategic'
+    -- must be a monadic value of the target monad
+    -- with the functorial state wrapped inside of it.
+  , Strategic
+  , WithStrategy
+  , pureS
+  , liftS
+  , runS
+  , bindS
+  , getInspectorS
+  , getInitialStateS
+
+    -- * Interpretations
+  , runFinal
+  , finalToFinal
+
+  -- * Interpretations for Other Effects
+  , embedToFinal
+  ) where
+
+import Polysemy.Internal
+import Polysemy.Internal.Combinators
+import Polysemy.Internal.Union
+import Polysemy.Internal.Strategy
+import Polysemy.Internal.TH.Effect
+
+-----------------------------------------------------------------------------
+-- | This represents a function which produces
+-- an action of the final monad @m@ given:
+--
+--   * The initial effectful state at the moment the action
+--     is to be executed.
+--
+--   * A way to convert @z@ (which is typically @'Sem' r@) to @m@ by
+--     threading the effectful state through.
+--
+--   * An inspector that is able to view some value within the
+--     effectful state if the effectful state contains any values.
+--
+-- A @'Polysemy.Internal.Union.Weaving'@ provides these components,
+-- hence the name 'ThroughWeavingToFinal'.
+type ThroughWeavingToFinal m z a =
+     forall f
+   . Functor f
+  => f ()
+  -> (forall x. f (z x) -> m (f x))
+  -> (forall x. f x -> Maybe x)
+  -> m (f a)
+
+-----------------------------------------------------------------------------
+-- | An effect for embedding higher-order actions in the final target monad
+-- of the effect stack.
+--
+-- This is very useful for writing interpreters that interpret higher-order
+-- effects in terms of the final monad.
+--
+-- 'Final' is more powerful than 'Embed', but is also less flexible
+-- to interpret (compare 'Polysemy.Embed.runEmbedded' with 'finalToFinal').
+-- If you only need the power of 'embed', then you should use 'Embed' instead.
+--
+-- /Beware/: 'Final' actions are interpreted as actions of the final monad,
+-- and the effectful state visible to
+-- 'withWeavingToFinal' \/ 'withStrategicToFinal'
+-- \/ 'interpretFinal'
+-- is that of /all interpreters run in order to produce the final monad/.
+--
+-- This means that any interpreter built using 'Final' will /not/
+-- respect local/global state semantics based on the order of
+-- interpreters run. You should signal interpreters that make use of
+-- 'Final' by adding a @-'Final'@ suffix to the names of these.
+--
+-- State semantics of effects that are /not/
+-- interpreted in terms of the final monad will always
+-- appear local to effects that are interpreted in terms of the final monad.
+--
+-- 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.
+newtype Final m z a where
+  WithWeavingToFinal
+    :: ThroughWeavingToFinal m z a
+    -> Final m z a
+
+makeSem_ ''Final
+
+-----------------------------------------------------------------------------
+-- | Allows for embedding higher-order actions of the final monad
+-- by providing the means of explicitly threading effects through @'Sem' r@
+-- to the final monad.
+--
+-- Consider using 'withStrategicToFinal' instead,
+-- which provides a more user-friendly interface, but is also slightly weaker.
+--
+-- You are discouraged from using 'withWeavingToFinal' directly
+-- in application code, as it ties your application code directly to
+-- the final monad.
+withWeavingToFinal
+  :: forall m a r
+   . Member (Final m) r
+  => ThroughWeavingToFinal m (Sem r) a
+  -> Sem r a
+
+
+-----------------------------------------------------------------------------
+-- | 'withWeavingToFinal' admits an implementation of 'embed'.
+--
+-- Just like 'embed', you are discouraged from using this in application code.
+embedFinal :: (Member (Final m) r, Functor m) => m a -> Sem r a
+embedFinal m = withWeavingToFinal $ \s _ _ -> (<$ s) <$> m
+{-# INLINE embedFinal #-}
+
+-----------------------------------------------------------------------------
+-- | Allows for embedding higher-order actions of the final monad
+-- by providing the means of explicitly threading effects through @'Sem' r@
+-- to the final monad. This is done through the use of the 'Strategic'
+-- environment, which provides 'runS' and 'bindS'.
+--
+-- You are discouraged from using 'withStrategicToFinal' in application code,
+-- as it ties your application code directly to the final monad.
+withStrategicToFinal :: Member (Final m) r
+                     => Strategic m (Sem r) a
+                     -> Sem r a
+withStrategicToFinal strat = withWeavingToFinal (runStrategy strat)
+{-# INLINE withStrategicToFinal #-}
+
+------------------------------------------------------------------------------
+-- | Like 'interpretH', but may be used to
+-- interpret higher-order effects in terms of the final monad.
+--
+-- 'interpretFinal' requires less boilerplate than using 'interpretH'
+-- together with 'withStrategicToFinal' \/ 'withWeavingToFinal',
+-- but is also less powerful.
+-- 'interpretFinal' does not provide any means of executing actions
+-- of @'Sem' r@ as you interpret each action, and the provided interpreter
+-- is automatically recursively used to process higher-order occurences of
+-- @'Sem' (e ': r)@ to @'Sem' r@.
+--
+-- If you need greater control of how the effect is interpreted,
+-- use 'interpretH' together with 'withStrategicToFinal' \/
+-- 'withWeavingToFinal' instead.
+--
+-- /Beware/: Effects that aren't interpreted in terms of the final
+-- monad will have local state semantics in regards to effects
+-- interpreted using 'interpretFinal'. See 'Final'.
+interpretFinal
+    :: forall m e r a
+     . Member (Final m) r
+    => (forall x n. e n x -> Strategic m n x)
+       -- ^ A natural transformation from the handled effect to the final monad.
+    -> Sem (e ': r) a
+    -> Sem r a
+interpretFinal n =
+  let
+    go :: Sem (e ': r) x -> Sem r x
+    go = hoistSem $ \u -> case decomp u of
+      Right (Weaving e s wv ex ins) ->
+        injWeaving $
+          Weaving
+            (WithWeavingToFinal (runStrategy (n e)))
+            s
+            (go . wv)
+            ex
+            ins
+      Left g -> hoist go g
+    {-# INLINE go #-}
+  in
+    go
+{-# INLINE interpretFinal #-}
+
+------------------------------------------------------------------------------
+-- | Lower a 'Sem' containing only a single lifted, final 'Monad' into that
+-- monad.
+--
+-- If you also need to process an @'Embed' m@ effect, use this together with
+-- 'embedToFinal'.
+runFinal :: Monad m => Sem '[Final m] a -> m a
+runFinal = usingSem $ \u -> case extract u of
+  Weaving (WithWeavingToFinal wav) s wv ex ins ->
+    ex <$> wav s (runFinal . wv) ins
+{-# INLINE runFinal #-}
+
+------------------------------------------------------------------------------
+-- | 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)
+             => (forall x. m1 x -> m2 x)
+             -> (forall x. m2 x -> m1 x)
+             -> Sem (Final m1 ': r) a
+             -> Sem r a
+finalToFinal to from =
+  let
+    go :: Sem (Final m1 ': r) x -> Sem r x
+    go = hoistSem $ \u -> case decomp u of
+      Right (Weaving (WithWeavingToFinal wav) s wv ex ins) ->
+        injWeaving $
+          Weaving
+            (WithWeavingToFinal $ \s' wv' ins' ->
+              to $ wav s' (from . wv') ins'
+            )
+            s
+            (go . wv)
+            ex
+            ins
+      Left g -> hoist go g
+    {-# INLINE go #-}
+  in
+    go
+{-# INLINE finalToFinal #-}
+
+------------------------------------------------------------------------------
+-- | Transform an @'Embed' m@ effect into a @'Final' m@ effect
+embedToFinal :: (Member (Final m) r, Functor m)
+             => Sem (Embed m ': r) a
+             -> Sem r a
+embedToFinal = interpret $ \(Embed m) -> embedFinal m
+{-# INLINE embedToFinal #-}
diff --git a/src/Polysemy/Fixpoint.hs b/src/Polysemy/Fixpoint.hs
index 70a19b4..a48dbc7 100644
--- a/src/Polysemy/Fixpoint.hs
+++ b/src/Polysemy/Fixpoint.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE AllowAmbiguousTypes, TemplateHaskell #-}
 
 module Polysemy.Fixpoint
   ( -- * Effect
@@ -12,10 +12,14 @@ import Control.Monad.Fix
 import Data.Maybe
 
 import Polysemy
+import Polysemy.Final
 import Polysemy.Internal.Fixpoint
 
-------------------------------------------------------------------------------
--- | Run a 'Fixpoint' effect purely.
+-----------------------------------------------------------------------------
+-- | Run a 'Fixpoint' effect in terms of a final 'MonadFix' instance.
+--
+-- If you need to run a 'Fixpoint' effect purely, use this together with
+-- @'Final' 'Data.Functor.Identity.Identity'@.
 --
 -- __Note__: This is subject to the same traps as 'MonadFix' instances for
 -- monads with failure: this will throw an exception if you try to recursively use
@@ -28,9 +32,10 @@ import Polysemy.Internal.Fixpoint
 -- @
 -- bad :: (Int, Either () Int)
 -- bad =
---    'run'
---  . 'runFixpoint' 'run'
---  . 'Polysemy.State.runLazyState' @Int 1
+--    'Data.Functor.Identity.runIdentity'
+--  . 'runFinal'
+--  . 'fixpointToFinal' \@'Data.Functor.Identity.Identity'
+--  . 'Polysemy.State.runLazyState' \@Int 1
 --  . 'Polysemy.Error.runError'
 --  $ mdo
 --   'Polysemy.State.put' a
@@ -38,16 +43,38 @@ import Polysemy.Internal.Fixpoint
 --   return a
 -- @
 --
--- 'runFixpoint' also operates under the assumption that any effectful
+-- 'fixpointToFinal' also operates under the assumption that any effectful
 -- state which can't be inspected using 'Polysemy.Inspector' can't contain any
--- values. This is true for all interpreters featured in this package,
+-- values. For example, the effectful state for 'Polysemy.Error.runError' is
+-- @'Either' e a@. The inspector for this effectful state only fails if the
+-- effectful state is a @'Left'@ value, which therefore doesn't contain any
+-- values of @a@.
+--
+-- This assumption holds true for all interpreters featured in this package,
 -- and is presumably always true for any properly implemented interpreter.
--- 'runFixpoint' may throw an exception if it is used together with an
+-- 'fixpointToFinal' may throw an exception if it is used together with an
 -- interpreter that uses 'Polysemy.Internal.Union.weave' improperly.
 --
--- If 'runFixpoint' throws an exception for you, and it can't
+-- 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.
+fixpointToFinal :: forall m r a
+                 . (Member (Final m) r, MonadFix m)
+                => Sem (Fixpoint ': r) a
+                -> Sem r a
+fixpointToFinal = interpretFinal @m $
+  \(Fixpoint f) -> do
+    f'  <- bindS f
+    s   <- getInitialStateS
+    ins <- getInspectorS
+    pure $ mfix $ \fa -> f' $
+      fromMaybe (bomb "fixpointToFinal") (inspect ins fa) <$ s
+{-# INLINE fixpointToFinal #-}
+
+------------------------------------------------------------------------------
+-- | Run a 'Fixpoint' effect purely.
+--
+-- __Note__: 'runFixpoint' is subject to the same caveats as 'fixpointToFinal'.
 runFixpoint
     :: (∀ x. Sem r x -> x)
     -> Sem (Fixpoint ': r) a
@@ -61,11 +88,14 @@ runFixpoint lower = interpretH $ \case
       lower . runFixpoint lower . c $
         fromMaybe (bomb "runFixpoint") (inspect ins fa) <$ s
 {-# INLINE runFixpoint #-}
+{-# DEPRECATED runFixpoint "Use 'fixpointToFinal' together with \
+                           \'Data.Functor.Identity.Identity' instead" #-}
+
 
 ------------------------------------------------------------------------------
 -- | Run a 'Fixpoint' effect in terms of an underlying 'MonadFix' instance.
 --
--- __Note__: 'runFixpointM' is subject to the same caveats as 'runFixpoint'.
+-- __Note__: 'runFixpointM' is subject to the same caveats as 'fixpointToFinal'.
 runFixpointM
     :: ( MonadFix m
        , Member (Embed m) r
@@ -82,3 +112,4 @@ runFixpointM lower = interpretH $ \case
       lower . runFixpointM lower . c $
         fromMaybe (bomb "runFixpointM") (inspect ins fa) <$ s
 {-# INLINE runFixpointM #-}
+{-# DEPRECATED runFixpointM "Use 'fixpointToFinal' instead" #-}
diff --git a/src/Polysemy/Internal.hs b/src/Polysemy/Internal.hs
index 73089e8..f8f32ce 100644
--- a/src/Polysemy/Internal.hs
+++ b/src/Polysemy/Internal.hs
@@ -61,15 +61,19 @@ import Polysemy.Internal.Union
 -- interpretations (and others that you might add) may be used interchangably
 -- without needing to write any newtypes or 'Monad' instances. The only
 -- change needed to swap interpretations is to change a call from
--- 'Polysemy.Error.runError' to 'Polysemy.Error.lowerError'.
+-- 'Polysemy.Error.runError' to 'Polysemy.Error.errorToIOFinal'.
 --
 -- The effect stack @r@ can contain arbitrary other monads inside of it. These
 -- monads are lifted into effects via the 'Embed' effect. Monadic values can be
 -- lifted into a 'Sem' via 'embed'.
 --
+-- Higher-order actions of another monad can be lifted into higher-order actions
+-- of 'Sem' via the 'Polysemy.Final' effect, which is more powerful
+-- than 'Embed', but also less flexible to interpret.
+--
 -- A 'Sem' can be interpreted as a pure value (via 'run') or as any
--- traditional 'Monad' (via 'runM'). Each effect @E@ comes equipped with some
--- interpreters of the form:
+-- traditional 'Monad' (via 'runM' or 'Polysemy.runFinal').
+-- Each effect @E@ comes equipped with some interpreters of the form:
 --
 -- @
 -- runE :: 'Sem' (E ': r) a -> 'Sem' r a
@@ -127,8 +131,9 @@ import Polysemy.Internal.Union
 -- behaviour over other effects later in the chain.
 --
 -- After all of your effects are handled, you'll be left with either
--- a @'Sem' '[] a@ or a @'Sem' '[ 'Embed' m ] a@ value, which can be
--- consumed respectively by 'run' and 'runM'.
+-- a @'Sem' '[] a@, a @'Sem' '[ 'Embed' m ] a@, or a @'Sem' '[ 'Polysemy.Final' m ] a@
+-- value, which can be consumed respectively by 'run', 'runM', and
+-- 'Polysemy.runFinal'.
 --
 -- ==== Examples
 --
@@ -452,6 +457,11 @@ runM (Sem m) = m $ \z ->
 -- just for initialization. This can result in rather surprising behavior. For
 -- a version of '.@' that won't duplicate work, see the @.\@!@ operator in
 -- <http://hackage.haskell.org/package/polysemy-zoo/docs/Polysemy-IdempotentLowering.html polysemy-zoo>.
+--
+-- Interpreters using 'Polysemy.Final' may be composed normally, and
+-- avoid the work duplication issue. For that reason, you're encouraged to use
+-- @-'Polysemy.Final'@ interpreters instead of @lower-@ interpreters whenever
+-- possible.
 (.@)
     :: Monad m
     => (∀ x. Sem r x -> m x)
diff --git a/src/Polysemy/Internal/Fixpoint.hs b/src/Polysemy/Internal/Fixpoint.hs
index 1129ce0..23daf12 100644
--- a/src/Polysemy/Internal/Fixpoint.hs
+++ b/src/Polysemy/Internal/Fixpoint.hs
@@ -4,13 +4,14 @@ module Polysemy.Internal.Fixpoint where
 
 ------------------------------------------------------------------------------
 -- | An effect for providing 'Control.Monad.Fix.mfix'.
-data Fixpoint m a where
+newtype Fixpoint m a where
   Fixpoint :: (a -> m a) -> Fixpoint m a
 
 
 ------------------------------------------------------------------------------
--- | The error used in 'Polysemy.Fixpoint.runFixpoint' and
--- 'Polysemy.Fixpoint.runFixpointM' when the result of a failed computation
+-- | The error used in 'Polysemy.Fixpoint.fixpointToFinal',
+-- 'Polysemy.Fixpoint.runFixpoint' and 'Polysemy.Fixpoint.runFixpointM'
+-- when the result of a failed computation
 -- is recursively used and somehow visible. You may use this for your own
 -- 'Fixpoint' interpreters. The argument should be the name of the interpreter.
 bomb :: String -> a
diff --git a/src/Polysemy/Internal/Forklift.hs b/src/Polysemy/Internal/Forklift.hs
index 60d26b1..51c943a 100644
--- a/src/Polysemy/Internal/Forklift.hs
+++ b/src/Polysemy/Internal/Forklift.hs
@@ -9,6 +9,7 @@ module Polysemy.Internal.Forklift where
 import qualified Control.Concurrent.Async as A
 import           Control.Concurrent.Chan.Unagi
 import           Control.Concurrent.MVar
+import           Control.Exception
 import           Polysemy.Internal
 import           Polysemy.Internal.Union
 
@@ -66,7 +67,7 @@ withLowerToIO action = do
   res <- embed $ A.async $ do
     a <- action (runViaForklift inchan)
                 (putMVar signal ())
-    putMVar signal ()
+          `finally` (putMVar signal ())
     pure a
 
   let me = do
diff --git a/src/Polysemy/Internal/Strategy.hs b/src/Polysemy/Internal/Strategy.hs
new file mode 100644
index 0000000..a156ddc
--- /dev/null
+++ b/src/Polysemy/Internal/Strategy.hs
@@ -0,0 +1,101 @@
+{-# OPTIONS_HADDOCK not-home #-}
+module Polysemy.Internal.Strategy where
+
+import Polysemy.Internal
+import Polysemy.Internal.Combinators
+import Polysemy.Internal.Tactics (Inspector(..))
+
+
+data Strategy m f n z a where
+  GetInitialState     :: Strategy m f n z (f ())
+  HoistInterpretation :: (a -> n b) -> Strategy m f n z (f a -> m (f b))
+  GetInspector        :: Strategy m f n z (Inspector f)
+
+------------------------------------------------------------------------------
+-- | 'Strategic' is an environment in which you're capable of explicitly
+-- threading higher-order effect states to the final monad.
+-- This is a variant of @Tactics@ (see 'Polysemy.Tactical'), and usage
+-- is extremely similar.
+type Strategic m n a = forall f. Functor f => Sem (WithStrategy m f n) (m (f a))
+
+type WithStrategy m f n = '[Strategy m f n]
+
+------------------------------------------------------------------------------
+-- | Internal function to process Strategies in terms of
+-- 'Polysemy.Final.withWeavingToFinal'.
+runStrategy :: Functor f
+            => Sem '[Strategy m f n] a
+            -> f ()
+            -> (forall x. f (n x) -> m (f x))
+            -> (forall x. f x -> Maybe x)
+            -> a
+runStrategy sem = \s wv ins -> run $ interpret
+  (\case
+    GetInitialState       -> pure s
+    HoistInterpretation f -> pure $ \fa -> wv (f <$> fa)
+    GetInspector          -> pure (Inspector ins)
+  ) sem
+{-# INLINE runStrategy #-}
+
+------------------------------------------------------------------------------
+-- | Get a natural transformation capable of potentially inspecting values
+-- inside of @f@. Binding the result of 'getInspectorS' produces a function that
+-- can sometimes peek inside values returned by 'bindS'.
+--
+-- This is often useful for running callback functions that are not managed by
+-- polysemy code.
+--
+-- See also 'Polysemy.getInspectorT'
+getInspectorS :: forall m f n. Sem (WithStrategy m f n) (Inspector f)
+getInspectorS = send (GetInspector @m @f @n)
+{-# INLINE getInspectorS #-}
+
+------------------------------------------------------------------------------
+-- | Get the stateful environment of the world at the moment the
+-- @Strategy@ is to be run.
+--
+-- Prefer 'pureS', 'liftS', 'runS', or 'bindS' instead of using this function
+-- directly.
+getInitialStateS :: forall m f n. Sem (WithStrategy m f n) (f ())
+getInitialStateS = send (GetInitialState @m @f @n)
+{-# INLINE getInitialStateS #-}
+
+------------------------------------------------------------------------------
+-- | Embed a value into 'Strategic'.
+pureS :: Applicative m => a -> Strategic m n a
+pureS a = pure . (a <$) <$> getInitialStateS
+{-# INLINE pureS #-}
+
+------------------------------------------------------------------------------
+-- | Lifts an action of the final monad into 'Strategic'.
+--
+-- /Note/: you don't need to use this function if you already have a monadic
+-- action with the functorial state threaded into it, by the use of
+-- 'runS' or 'bindS'.
+-- In these cases, you need only use 'pure' to embed the action into the
+-- 'Strategic' environment.
+liftS :: Functor m => m a -> Strategic m n a
+liftS m = do
+  s <- getInitialStateS
+  pure $ fmap (<$ s) m
+{-# INLINE liftS #-}
+
+------------------------------------------------------------------------------
+-- | Lifts a monadic action into the stateful environment, in terms
+-- of the final monad.
+-- The stateful environment will be the same as the one that the @Strategy@
+-- is initially run in.
+--
+-- Use 'bindS'  if you'd prefer to explicitly manage your stateful environment.
+runS :: n a -> Sem (WithStrategy m f n) (m (f a))
+runS na = bindS (const na) <*> getInitialStateS
+{-# INLINE runS #-}
+
+------------------------------------------------------------------------------
+-- | Embed a kleisli action into the stateful environment, in terms of the final
+-- monad. You can use 'bindS' to get an effect parameter of the form @a -> n b@
+-- into something that can be used after calling 'runS' on an effect parameter
+-- @n a@.
+bindS :: (a -> n b) -> Sem (WithStrategy m f n) (f a -> m (f b))
+bindS = send . HoistInterpretation
+{-# INLINE bindS #-}
diff --git a/src/Polysemy/Internal/Union.hs b/src/Polysemy/Internal/Union.hs
index d095453..79512b8 100644
--- a/src/Polysemy/Internal/Union.hs
+++ b/src/Polysemy/Internal/Union.hs
@@ -237,7 +237,7 @@ inj e = injWeaving $
 {-# INLINE inj #-}
 
 ------------------------------------------------------------------------------
--- | Lift a @Weaving e@ into a 'Union' capable of holding it.
+-- | Lift a @'Weaving' e@ into a 'Union' capable of holding it.
 injWeaving :: forall e r m a. Member e r => Weaving e m a -> Union r m a
 injWeaving = Union (finder @_ @r @e)
 {-# INLINE injWeaving #-}
diff --git a/src/Polysemy/Internal/Writer.hs b/src/Polysemy/Internal/Writer.hs
new file mode 100644
index 0000000..181671c
--- /dev/null
+++ b/src/Polysemy/Internal/Writer.hs
@@ -0,0 +1,156 @@
+{-# LANGUAGE BangPatterns, TemplateHaskell, TupleSections #-}
+{-# OPTIONS_HADDOCK not-home #-}
+module Polysemy.Internal.Writer where
+
+import Control.Concurrent.STM
+import Control.Exception
+import Control.Monad
+
+import Data.Semigroup
+
+import Polysemy
+import Polysemy.Final
+
+
+------------------------------------------------------------------------------
+-- | An effect capable of emitting and intercepting messages.
+data Writer o m a where
+  Tell   :: o -> Writer o m ()
+  Listen :: ∀ o m a. m a -> Writer o m (o, a)
+  Pass   :: m (o -> o, a) -> Writer o m a
+
+makeSem ''Writer
+
+-- TODO(KingoftheHomeless): Research if this is more or less efficient than
+-- using 'reinterpretH' + 'subsume'
+
+-----------------------------------------------------------------------------
+-- | Transform a @'Writer' o@ effect into a  @'Writer' ('Endo' o)@ effect,
+-- right-associating all uses of '<>' for @o@.
+--
+-- This can be used together with 'raiseUnder' in order to create
+-- @-AssocR@ variants out of regular 'Writer' interpreters.
+writerToEndoWriter
+    :: (Monoid o, Member (Writer (Endo o)) r)
+    => Sem (Writer o ': r) a
+    -> Sem r a
+writerToEndoWriter = interpretH $ \case
+      Tell o   -> tell (Endo (o <>)) >>= pureT
+      Listen m -> do
+        m' <- writerToEndoWriter <$> runT m
+        raise $ do
+          (o, fa) <- listen m'
+          return $ (,) (appEndo o mempty) <$> fa
+      Pass m -> do
+        ins <- getInspectorT
+        m'  <- writerToEndoWriter <$> runT m
+        raise $ pass $ do
+          t <- m'
+          let
+            f' =
+              maybe
+                id
+                (\(f, _) (Endo oo) -> let !o' = f (oo mempty) in Endo (o' <>))
+                (inspect ins t)
+          return (f', fmap snd t)
+{-# INLINE writerToEndoWriter #-}
+
+
+-- TODO(KingoftheHomeless): Make this mess more palatable
+--
+-- 'interpretFinal' is too weak for our purposes, so we
+-- use 'interpretH' + 'withWeavingToFinal'.
+
+------------------------------------------------------------------------------
+-- | A variant of 'Polysemy.Writer.runWriterTVar' where an 'STM' action is
+-- used instead of a 'TVar' to commit 'tell's.
+runWriterSTMAction :: forall o r a
+                          . (Member (Final IO) r, Monoid o)
+                         => (o -> STM ())
+                         -> Sem (Writer o ': r) a
+                         -> Sem r a
+runWriterSTMAction write = interpretH $ \case
+  Tell o -> do
+    t <- embedFinal $ atomically (write o)
+    pureT t
+  Listen m -> do
+    m' <- runT m
+    -- Using 'withWeavingToFinal' instead of 'withStrategicToFinal'
+    -- here allows us to avoid using two additional 'embedFinal's in
+    -- order to create the TVars.
+    raise $ withWeavingToFinal $ \s wv _ -> mask $ \restore -> do
+      -- See below to understand how this works
+      tvar   <- newTVarIO mempty
+      switch <- newTVarIO False
+      fa     <-
+        restore (wv (runWriterSTMAction (write' tvar switch) m' <$ s))
+          `onException` commit tvar switch id
+      o      <- commit tvar switch id
+      return $ (fmap . fmap) (o, ) fa
+  Pass m -> do
+    m'  <- runT m
+    ins <- getInspectorT
+    raise $ withWeavingToFinal $ \s wv ins' -> mask $ \restore -> do
+      tvar   <- newTVarIO mempty
+      switch <- newTVarIO False
+      t      <-
+        restore (wv (runWriterSTMAction (write' tvar switch) m' <$ s))
+          `onException` commit tvar switch id
+      _      <- commit tvar switch
+        (maybe id fst $ ins' t >>= inspect ins)
+      return $ (fmap . fmap) snd t
+
+  where
+    {- KingoftheHomeless:
+      'write'' is used by the argument computation to a 'listen' or 'pass'
+      in order to 'tell', rather than directly using the 'write'.
+      This is because we need to temporarily store its
+      'tell's seperately in order for the 'listen'/'pass' to work
+      properly. Once the 'listen'/'pass' completes, we 'commit' the
+      changes done to the local tvar globally through 'write'.
+
+      'commit' is protected by 'mask'+'onException'. Combine this
+      with the fact that the 'withWeavingToFinal' can't be interrupted
+      by pure errors emitted by effects (since these will be
+      represented as part of the functorial state), and we
+      guarantee that no writes will be lost if the argument computation
+      fails for whatever reason.
+
+      The argument computation to a 'listen'/'pass' may also spawn
+      asynchronous computations which do 'tell's of their own.
+      In order to make sure these 'tell's won't be lost once a
+      'listen'/'pass' completes, a switch is used to
+      control which tvar 'write'' writes to. The switch is flipped
+      atomically together with commiting the writes of the local tvar
+      as part of 'commit'. Once the switch is flipped,
+      any asynchrounous computations spawned by the argument
+      computation will write to the global tvar instead of the local
+      tvar (which is no longer relevant), and thus no writes will be
+      lost.
+    -}
+    write' :: TVar o
+           -> TVar Bool
+           -> o
+           -> STM ()
+    write' tvar switch = \o -> do
+      useGlobal <- readTVar switch
+      if useGlobal then
+        write o
+      else do
+        s <- readTVar tvar
+        writeTVar tvar $! s <> o
+
+    commit :: TVar o
+           -> TVar Bool
+           -> (o -> o)
+           -> IO o
+    commit tvar switch f = atomically $ do
+      o <- readTVar tvar
+      let !o' = f o
+      -- Likely redundant, but doesn't hurt.
+      alreadyCommited <- readTVar switch
+      unless alreadyCommited $
+        write o'
+      writeTVar switch True
+      return o'
+{-# INLINE runWriterSTMAction #-}
diff --git a/src/Polysemy/Output.hs b/src/Polysemy/Output.hs
index a27ff67..7c5ddb1 100644
--- a/src/Polysemy/Output.hs
+++ b/src/Polysemy/Output.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE BangPatterns, TemplateHaskell #-}
 
 module Polysemy.Output
   ( -- * Effect
@@ -13,6 +13,8 @@ module Polysemy.Output
   , runOutputMonoidAssocR
   , runOutputMonoidIORef
   , runOutputMonoidTVar
+  , outputToIOMonoid
+  , outputToIOMonoidAssocR
   , ignoreOutput
   , runOutputBatched
   , runOutputSem
@@ -83,7 +85,7 @@ runOutputMonoidAssocR
     -> Sem r (m, a)
 runOutputMonoidAssocR f =
     fmap (first (`appEndo` mempty))
-  . runOutputMonoid (\a -> Endo (f a <>))
+  . runOutputMonoid (\o -> let !o' = f o in Endo (o' <>))
 {-# INLINE runOutputMonoidAssocR #-}
 
 ------------------------------------------------------------------------------
@@ -97,7 +99,7 @@ runOutputMonoidIORef
     -> Sem (Output o ': r) a
     -> Sem r a
 runOutputMonoidIORef ref f = interpret $ \case
-  Output o -> embed $ atomicModifyIORef' ref (\s -> (s <> f o, ()))
+  Output o -> embed $ atomicModifyIORef' ref (\s -> let !o' = f o in (s <> o', ()))
 {-# INLINE runOutputMonoidIORef #-}
 
 ------------------------------------------------------------------------------
@@ -116,6 +118,60 @@ runOutputMonoidTVar tvar f = interpret $ \case
     writeTVar tvar $! s <> f o
 {-# INLINE runOutputMonoidTVar #-}
 
+
+--------------------------------------------------------------------
+-- | Run an 'Output' effect in terms of atomic operations
+-- in 'IO'.
+--
+-- Internally, this simply creates a new 'IORef', passes it to
+-- 'runOutputMonoidIORef', 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 'Output' effects
+-- interpreted this way.
+-- For example, 'Polysemy.Error.throw' and 'Polysemy.Error.catch' will
+-- never revert 'output's, even if 'Polysemy.Error.runError' is used
+-- after 'outputToIOMonoid'.
+outputToIOMonoid
+  :: forall o m r a
+   . (Monoid m, Member (Embed IO) r)
+  => (o -> m)
+  -> Sem (Output o ': r) a
+  -> Sem r (m, a)
+outputToIOMonoid f sem = do
+  ref <- embed $ newIORef mempty
+  res <- runOutputMonoidIORef ref f sem
+  end <- embed $ readIORef ref
+  return (end, res)
+
+------------------------------------------------------------------------------
+-- | Like 'outputToIOMonoid', but right-associates uses of '<>'.
+--
+-- This asymptotically improves performance if the time complexity of '<>' for
+-- the 'Monoid' depends only on the size of the first argument.
+--
+-- You should always use this instead of 'outputToIOMonoid' if the monoid
+-- is a list, such as 'String'.
+--
+-- /Beware/: As this uses an 'IORef' internally,
+-- all other effects will have local
+-- state semantics in regards to 'Output' effects
+-- interpreted this way.
+-- For example, 'Polysemy.Error.throw' and 'Polysemy.Error.catch' will
+-- never revert 'output's, even if 'Polysemy.Error.runError' is used
+-- after 'outputToIOMonoidAssocR'.
+outputToIOMonoidAssocR
+  :: forall o m r a
+   . (Monoid m, Member (Embed IO) r)
+  => (o -> m)
+  -> Sem (Output o ': r) a
+  -> Sem r (m, a)
+outputToIOMonoidAssocR f =
+    (fmap . first) (`appEndo` mempty)
+  . outputToIOMonoid (\o -> let !o' = f o in Endo (o' <>))
+
 ------------------------------------------------------------------------------
 -- | Run an 'Output' effect by ignoring it.
 --
diff --git a/src/Polysemy/Resource.hs b/src/Polysemy/Resource.hs
index 883638d..b2b21f2 100644
--- a/src/Polysemy/Resource.hs
+++ b/src/Polysemy/Resource.hs
@@ -12,12 +12,14 @@ module Polysemy.Resource
 
     -- * Interpretations
   , runResource
-  , lowerResource
+  , resourceToIOFinal
   , resourceToIO
+  , lowerResource
   ) where
 
 import qualified Control.Exception as X
 import           Polysemy
+import           Polysemy.Final
 
 
 ------------------------------------------------------------------------------
@@ -72,9 +74,44 @@ onException
     -> Sem r a
 onException act end = bracketOnError (pure ()) (const end) (const act)
 
+------------------------------------------------------------------------------
+-- | Run a 'Resource' effect in terms of 'X.bracket' through final 'IO'
+--
+-- /Beware/: Effects that aren't interpreted in terms of 'IO'
+-- will have local state semantics in regards to 'Resource' effects
+-- interpreted this way. See 'Final'.
+--
+-- Notably, unlike 'resourceToIO', this is not consistent with
+-- 'Polysemy.State.State' unless 'Polysemy.State.runStateInIORef' is used.
+-- State that seems like it should be threaded globally throughout 'bracket's
+-- /will not be./
+--
+-- Use 'resourceToIO' instead if you need to run
+-- pure, stateful interpreters after the interpreter for 'Resource'.
+-- (Pure interpreters are interpreters that aren't expressed in terms of
+-- another effect or monad; for example, 'Polysemy.State.runState'.)
+--
+-- @since 1.2.0.0
+resourceToIOFinal :: Member (Final IO) r
+                  => Sem (Resource ': r) a
+                  -> Sem r a
+resourceToIOFinal = interpretFinal $ \case
+  Bracket alloc dealloc use -> do
+    a <- runS  alloc
+    d <- bindS dealloc
+    u <- bindS use
+    pure $ X.bracket a d u
+
+  BracketOnError alloc dealloc use -> do
+    a <- runS  alloc
+    d <- bindS dealloc
+    u <- bindS use
+    pure $ X.bracketOnError a d u
+{-# INLINE resourceToIOFinal #-}
+
 
 ------------------------------------------------------------------------------
--- | Run a 'Resource' effect via in terms of 'X.bracket'.
+-- | Run a 'Resource' effect in terms of 'X.bracket'.
 --
 -- @since 1.0.0.0
 lowerResource
@@ -106,6 +143,7 @@ lowerResource finish = interpretH $ \case
 
     embed $ X.bracketOnError (run_it a) (run_it . d) (run_it . u)
 {-# INLINE lowerResource #-}
+{-# DEPRECATED lowerResource "Use 'resourceToIOFinal' instead" #-}
 
 
 ------------------------------------------------------------------------------
@@ -148,7 +186,7 @@ runResource = interpretH $ \case
 
 
 ------------------------------------------------------------------------------
--- | A more flexible --- though less safe ---  version of 'lowerResource'.
+-- | A more flexible --- though less safe ---  version of 'resourceToIOFinal'
 --
 -- This function is capable of running 'Resource' effects anywhere within an
 -- effect stack, without relying on an explicit function to lower it into 'IO'.
@@ -159,7 +197,7 @@ runResource = interpretH $ \case
 -- by effects _already handled_ in your effect stack, or in 'IO' code run
 -- directly inside of 'bracket'. It is not safe against exceptions thrown
 -- explicitly at the main thread. If this is not safe enough for your use-case,
--- use 'lowerResource' instead.
+-- use 'resourceToIOFinal' instead.
 --
 -- This function creates a thread, and so should be compiled with @-threaded@.
 --
diff --git a/src/Polysemy/Writer.hs b/src/Polysemy/Writer.hs
index 15ca2b4..3a0d5d3 100644
--- a/src/Polysemy/Writer.hs
+++ b/src/Polysemy/Writer.hs
@@ -1,5 +1,4 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TupleSections   #-}
+{-# LANGUAGE TupleSections #-}
 
 module Polysemy.Writer
   ( -- * Effect
@@ -14,26 +13,27 @@ module Polysemy.Writer
     -- * Interpretations
   , runWriter
   , runWriterAssocR
+  , runWriterTVar
+  , writerToIOFinal
+  , writerToIOAssocRFinal
+  , writerToEndoWriter
 
     -- * Interpretations for Other Effects
   , outputToWriter
   ) where
 
+import Control.Concurrent.STM
+
 import Data.Bifunctor (first)
+import Data.Semigroup
 
 import Polysemy
 import Polysemy.Output
 import Polysemy.State
 
+import Polysemy.Internal.Writer
 
-------------------------------------------------------------------------------
--- | An effect capable of emitting and intercepting messages.
-data Writer o m a where
-  Tell   :: o -> Writer o m ()
-  Listen :: ∀ o m a. m a -> Writer o m (o, a)
-  Pass   :: m (o -> o, a) -> Writer o m a
 
-makeSem ''Writer
 
 ------------------------------------------------------------------------------
 -- | @since 0.7.0.0
@@ -94,31 +94,64 @@ runWriterAssocR
     => Sem (Writer o ': r) a
     -> Sem r (o, a)
 runWriterAssocR =
-  let
-    go :: forall o r a
-        . Monoid o
-       => Sem (Writer o ': r) a
-       -> Sem r (o -> o, a)
-    go =
-        runState id
-      . reinterpretH
-      (\case
-          Tell o -> do
-            modify' @(o -> o) (. (o <>)) >>= pureT
-          Listen m -> do
-            mm <- runT m
-            -- TODO(sandy): this is stupid
-            (oo, fa) <- raise $ go mm
-            modify' @(o -> o) (. oo)
-            pure $ fmap (oo mempty, ) fa
-          Pass m -> do
-            mm <- runT m
-            (o, t) <- raise $ runWriterAssocR mm
-            ins <- getInspectorT
-            let f = maybe id fst (inspect ins t)
-            modify' @(o -> o) (. (f o <>))
-            pure (fmap snd t)
-      )
-    {-# INLINE go #-}
-  in fmap (first ($ mempty)) . go
+    (fmap . first) (`appEndo` mempty)
+  . runWriter
+  . writerToEndoWriter
+  . raiseUnder
 {-# INLINE runWriterAssocR #-}
+
+--------------------------------------------------------------------
+-- | Transform a 'Writer' effect into atomic operations
+-- over a 'TVar' through final 'IO'.
+runWriterTVar :: (Monoid o, Member (Final IO) r)
+              => TVar o
+              -> Sem (Writer o ': r) a
+              -> Sem r a
+runWriterTVar tvar = runWriterSTMAction $ \o -> do
+  s <- readTVar tvar
+  writeTVar tvar $! s <> o
+{-# INLINE runWriterTVar #-}
+
+
+--------------------------------------------------------------------
+-- | Run a 'Writer' effect by transforming it into atomic operations
+-- through final 'IO'.
+--
+-- Internally, this simply creates a new 'TVar', passes it to
+-- 'runWriterTVar', and then returns the result and the final value
+-- of the 'TVar'.
+--
+-- /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'.
+writerToIOFinal :: (Monoid o, Member (Final IO) r)
+                => Sem (Writer o ': r) a
+                -> Sem r (o, a)
+writerToIOFinal sem = do
+  tvar <- embedFinal $ newTVarIO mempty
+  res  <- runWriterTVar tvar sem
+  end  <- embedFinal $ readTVarIO tvar
+  return (end, res)
+{-# INLINE writerToIOFinal #-}
+
+--------------------------------------------------------------------
+-- | Like 'writerToIOFinal'. but right-associates uses of '<>'.
+--
+-- This asymptotically improves performance if the time complexity of '<>'
+-- for the 'Monoid' depends only on the size of the first argument.
+--
+-- You should always use this instead of 'writerToIOFinal' if the monoid
+-- is a list, such as 'String'.
+--
+-- /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'.
+writerToIOAssocRFinal :: (Monoid o, Member (Final IO) r)
+                      => Sem (Writer o ': r) a
+                      -> Sem r (o, a)
+writerToIOAssocRFinal =
+    (fmap . first) (`appEndo` mempty)
+  . writerToIOFinal
+  . writerToEndoWriter
+  . raiseUnder
+{-# INLINE writerToIOAssocRFinal #-}
diff --git a/stack.yaml b/stack.yaml
index 35c3f89..b015e34 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -16,4 +16,4 @@ extra-deps:
 - th-abstraction-0.3.1.0
 - unagi-chan-0.4.1.0
 - type-errors-0.2.0.0
-- type-errors-pretty-0.0.0.0
+- type-errors-pretty-0.0.0.0
\ No newline at end of file
diff --git a/test/AsyncSpec.hs b/test/AsyncSpec.hs
index 0b4d356..a70dd2e 100644
--- a/test/AsyncSpec.hs
+++ b/test/AsyncSpec.hs
@@ -2,7 +2,6 @@
 
 module AsyncSpec where
 
-import Control.Concurrent
 import Control.Concurrent.MVar
 import Control.Monad
 import Polysemy
diff --git a/test/FinalSpec.hs b/test/FinalSpec.hs
new file mode 100644
index 0000000..2249685
--- /dev/null
+++ b/test/FinalSpec.hs
@@ -0,0 +1,96 @@
+{-# LANGUAGE RecursiveDo #-}
+module FinalSpec where
+
+import Test.Hspec
+
+import Data.Either
+import Data.IORef
+
+import Polysemy
+import Polysemy.Async
+import Polysemy.Error
+import Polysemy.Fixpoint
+import Polysemy.Trace
+import Polysemy.State
+
+
+data Node a = Node a (IORef (Node a))
+
+mkNode :: (Member (Embed IO) r, Member Fixpoint r)
+       => a
+       -> Sem r (Node a)
+mkNode a = mdo
+  let nd = Node a p
+  p <- embed $ newIORef nd
+  return nd
+
+linkNode :: Member (Embed IO) r
+         => Node a
+         -> Node a
+         -> Sem r ()
+linkNode (Node _ r) b =
+  embed $ writeIORef r b
+
+readNode :: Node a -> a
+readNode (Node a _) = a
+
+follow :: Member (Embed IO) r
+       => Node a
+       -> Sem r (Node a)
+follow (Node _ ref) = embed $ readIORef ref
+
+test1 :: IO (Either Int (String, Int, Maybe Int))
+test1 = do
+  ref <- newIORef "abra"
+  runFinal
+    . embedToFinal @IO
+    . runStateIORef ref -- Order of these interpreters don't matter
+    . errorToIOFinal
+    . fixpointToFinal @IO
+    . asyncToIOFinal
+     $ do
+     n1 <- mkNode 1
+     n2 <- mkNode 2
+     linkNode n2 n1
+     aw <- async $ do
+       linkNode n1 n2
+       modify (++"hadabra")
+       n2' <- follow n2
+       throw (readNode n2')
+     m <- await aw `catch` (\s -> return $ Just s)
+     n1' <- follow n1
+     s <- get
+     return (s, readNode n1', m)
+
+test2 :: IO ([String], Either () ())
+test2 =
+    runFinal
+  . runTraceList
+  . errorToIOFinal
+  . asyncToIOFinal
+  $ do
+  fut <- async $ do
+    trace "Global state semantics?"
+  catch @() (trace "What's that?" *> throw ()) (\_ -> return ())
+  _ <- await fut
+  trace "Nothing at all."
+
+
+
+spec :: Spec
+spec = do
+  describe "Final on IO" $ do
+    it "should terminate successfully, with no exceptions,\
+        \ and have global state semantics on State." $ do
+      res1 <- test1
+      res1 `shouldSatisfy` isRight
+      case res1 of
+        Right (s, i, j) -> do
+          i `shouldBe` 2
+          j `shouldBe` Just 1
+          s `shouldBe` "abrahadabra"
+        _ -> pure ()
+
+    it "should treat trace with local state semantics" $ do
+      res2 <- test2
+      res2 `shouldBe` (["Nothing at all."], Right ())
diff --git a/test/FixpointSpec.hs b/test/FixpointSpec.hs
index 745d7ee..e4d12cb 100644
--- a/test/FixpointSpec.hs
+++ b/test/FixpointSpec.hs
@@ -2,7 +2,8 @@
 {-# LANGUAGE RecursiveDo #-}
 module FixpointSpec where
 
-import Control.Exception (try, evaluate)
+import Data.Functor.Identity
+import Control.Exception (evaluate)
 import Control.Monad.Fix
 
 import Polysemy
@@ -29,8 +30,9 @@ runFinalState s sm = mfix $ \ ~(s', _) ->
 
 test1 :: (String, (Int, ()))
 test1 =
-    run
-  . runFixpoint run
+    runIdentity
+  . runFinal
+  . fixpointToFinal @Identity
   . runOutputMonoid (show @Int)
   . runFinalState 1
   $ do
@@ -42,8 +44,9 @@ test1 =
 
 test2 :: Either [Int] [Int]
 test2 =
-    run
-  . runFixpoint run
+    runIdentity
+  . runFinal
+  . fixpointToFinal @Identity
   . runError
   $ mdo
   a <- throw (2 : a) `catch` (\e -> return (1 : e))
@@ -51,8 +54,9 @@ test2 =
 
 test3 :: Either () (Int, Int)
 test3 =
-    run
-  . runFixpoint run
+    runIdentity
+  . runFinal
+  . fixpointToFinal @Identity
   . runError
   . runLazyState @Int 1
   $ mdo
@@ -62,8 +66,9 @@ test3 =
 
 test4 :: (Int, Either () Int)
 test4 =
-    run
-  . runFixpoint run
+    runIdentity
+  . runFinal
+  . fixpointToFinal @Identity
   . runLazyState @Int 1
   . runError
   $ mdo
@@ -73,7 +78,7 @@ test4 =
 
 
 spec :: Spec
-spec = parallel $ describe "runFixpoint" $ do
+spec = parallel $ describe "fixpointToFinal on Identity" $ do
   it "should work with runState" $ do
     test1 `shouldBe` ("12",  (2, ()))
   it "should work with runError" $ do
@@ -88,10 +93,10 @@ spec = parallel $ describe "runFixpoint" $ do
 
 bombMessage :: String
 bombMessage =
-  "runFixpoint: Internal computation failed.\
-              \ This is likely because you have tried to recursively use\
-              \ the result of a failed computation in an action\
-              \ whose effect may be observed even though the computation failed.\
-              \ It's also possible that you're using an interpreter\
-              \ that uses 'weave' improperly.\
-              \ See documentation for more information."
+  "fixpointToFinal: Internal computation failed.\
+                  \ This is likely because you have tried to recursively use\
+                  \ the result of a failed computation in an action\
+                  \ whose effect may be observed even though the computation failed.\
+                  \ It's also possible that you're using an interpreter\
+                  \ that uses 'weave' improperly.\
+                  \ See documentation for more information."
diff --git a/test/OutputSpec.hs b/test/OutputSpec.hs
index 36b0032..0ac72fb 100644
--- a/test/OutputSpec.hs
+++ b/test/OutputSpec.hs
@@ -9,6 +9,7 @@ import Data.Foldable
 import Polysemy
 import Polysemy.Async
 import Polysemy.Output
+import Polysemy.Final
 
 import Test.Hspec
 
@@ -47,8 +48,11 @@ spec = parallel $ do
     it "should commit writes of asynced computations" $
       let io = do
             ref <- newIORef ""
-            (runM .@ lowerAsync) . runOutputMonoidIORef ref (show @Int) $
-              test1
+            runFinal
+              . embedToFinal @IO
+              . asyncToIOFinal
+              . runOutputMonoidIORef ref (show @Int)
+              $ test1
             readIORef ref
       in do
         res <- io
@@ -58,8 +62,11 @@ spec = parallel $ do
     it "should commit writes of asynced computations" $
       let io = do
             ref <- newTVarIO ""
-            (runM .@ lowerAsync) . runOutputMonoidTVar ref (show @Int) $
-              test1
+            runFinal
+              . embedToFinal @IO
+              . asyncToIOFinal
+              . runOutputMonoidTVar ref (show @Int)
+              $ test1
             readTVarIO ref
       in do
         res <- io
diff --git a/test/WriterSpec.hs b/test/WriterSpec.hs
index 150fe2b..16445a4 100644
--- a/test/WriterSpec.hs
+++ b/test/WriterSpec.hs
@@ -8,8 +8,6 @@ import Control.Concurrent.MVar
 import Control.Concurrent.STM
 import Control.Exception (evaluate)
 
-import Data.IORef
-
 import Polysemy
 import Polysemy.Async
 import Polysemy.Error
@@ -55,6 +53,56 @@ test2 =
 test3 :: (String, (String, ()))
 test3 = run . runWriter $ listen (tell "and hear")
 
+test4 :: IO (String, String)
+test4 = do
+  tvar <- newTVarIO ""
+  (listened, _) <- runFinal . asyncToIOFinal . runWriterTVar tvar $ do
+    tell "message "
+    listen $ do
+      tell "has been"
+      a <- async $ tell " received"
+      await a
+  end <- readTVarIO tvar
+  return (end, listened)
+
+test5 :: IO (String, String)
+test5 = do
+  tvar <- newTVarIO ""
+  lock <- newEmptyMVar
+  (listened, a) <- runFinal . asyncToIOFinal . runWriterTVar tvar $ do
+    tell "message "
+    listen $ do
+      tell "has been"
+      a <- async $ do
+        embedFinal $ takeMVar lock
+        tell " received"
+      return a
+  putMVar lock ()
+  _ <- A.wait a
+  end <- readTVarIO tvar
+  return (end, listened)
+
+test6 :: Sem '[Error (A.Async (Maybe ())), Final IO] String
+test6 = do
+  tvar <- embedFinal $ newTVarIO ""
+  lock <- embedFinal $ newEmptyMVar
+  let
+      inner = do
+        tell "message "
+        fmap snd $ listen @String $ do
+          tell "has been"
+          a <- async $ do
+            embedFinal $ takeMVar lock
+            tell " received"
+          throw a
+  asyncToIOFinal (runWriterTVar tvar inner) `catch` \a ->
+    embedFinal $ do
+      putMVar lock ()
+      (_ :: Maybe ()) <- A.wait a
+      readTVarIO tvar
+
+
+
 spec :: Spec
 spec = do
   describe "writer" $ do
@@ -87,3 +135,24 @@ spec = do
         evaluate (run t2) `shouldThrow` errorCall "strict"
         runM t3           `shouldThrow` errorCall "strict"
         evaluate (run t3) `shouldThrow` errorCall "strict"
+
+  describe "runWriterTVar" $ do
+    it "should listen and commit asyncs spawned and awaited upon in a listen \
+       \block" $ do
+      (end, listened) <- test4
+      end `shouldBe` "message has been received"
+      listened `shouldBe` "has been received"
+
+    it "should commit writes of asyncs spawned inside a listen block even if \
+       \the block has finished." $ do
+      (end, listened) <- test5
+      end `shouldBe` "message has been received"
+      listened `shouldBe` "has been"
+
+
+    it "should commit writes of asyncs spawned inside a listen block even if \
+       \the block failed for any reason." $ do
+      Right end1 <- runFinal . errorToIOFinal $ test6
+      Right end2 <- runFinal . runError $ test6
+      end1 `shouldBe` "message has been received"
+      end2 `shouldBe` "message has been received"