{-# LANGUAGE TemplateHaskell #-}

-- | Description: The effect 'Final' that allows embedding higher-order actions in
-- the final target monad of the effect stack
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'.
--
-- @since 1.2.0.0
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.
--
-- @since 1.2.0.0
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.
--
-- @since 1.2.0.0
withWeavingToFinal
  :: forall m r a
   . 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.
--
-- @since 1.2.0.0
embedFinal :: (Member (Final m) r, Functor m) => m a -> Sem r a
embedFinal :: forall (m :: * -> *) (r :: EffectRow) a.
(Member (Final m) r, Functor m) =>
m a -> Sem r a
embedFinal m a
m = forall (m :: * -> *) (r :: EffectRow) a.
Member (Final m) r =>
ThroughWeavingToFinal m (Sem r) a -> Sem r a
withWeavingToFinal forall a b. (a -> b) -> a -> b
$ \f ()
s forall x. f (Sem r x) -> m (f x)
_ forall x. f x -> Maybe x
_ -> (forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
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.
--
-- @since 1.2.0.0
withStrategicToFinal :: Member (Final m) r
                     => Strategic m (Sem r) a
                     -> Sem r a
withStrategicToFinal :: forall (m :: * -> *) (r :: EffectRow) a.
Member (Final m) r =>
Strategic m (Sem r) a -> Sem r a
withStrategicToFinal Strategic m (Sem r) a
strat = forall (m :: * -> *) (r :: EffectRow) a.
Member (Final m) r =>
ThroughWeavingToFinal m (Sem r) a -> Sem r a
withWeavingToFinal (forall (f :: * -> *) (m :: * -> *) (n :: * -> *) a.
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 Strategic m (Sem r) a
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'.
--
-- @since 1.2.0.0
interpretFinal
    :: forall m e r a
     . Member (Final m) r
    => (forall x rInitial. e (Sem rInitial) x -> Strategic m (Sem rInitial) x)
       -- ^ A natural transformation from the handled effect to the final monad.
    -> Sem (e ': r) a
    -> Sem r a
interpretFinal :: forall (m :: * -> *) (e :: Effect) (r :: EffectRow) a.
Member (Final m) r =>
(forall x (rInitial :: EffectRow).
 e (Sem rInitial) x -> Strategic m (Sem rInitial) x)
-> Sem (e : r) a -> Sem r a
interpretFinal forall x (rInitial :: EffectRow).
e (Sem rInitial) x -> Strategic m (Sem rInitial) x
n =
  let
    go :: Sem (e ': r) x -> Sem r x
    go :: forall x. Sem (e : r) x -> Sem r x
go = forall (r :: EffectRow) (r' :: EffectRow) a.
(forall x. Union r (Sem r) x -> Union r' (Sem r') x)
-> Sem r a -> Sem r' a
hoistSem forall a b. (a -> b) -> a -> b
$ \Union (e : r) (Sem (e : r)) x
u -> case forall (e :: Effect) (r :: EffectRow) (m :: * -> *) a.
Union (e : r) m a -> Either (Union r m a) (Weaving e m a)
decomp Union (e : r) (Sem (e : r)) x
u of
      Right (Weaving e (Sem rInitial) a
e f ()
s forall x. f (Sem rInitial x) -> Sem (e : r) (f x)
wv f a -> x
ex forall x. f x -> Maybe x
ins) ->
        forall (e :: Effect) (r :: EffectRow) (m :: * -> *) a.
Member e r =>
Weaving e m a -> Union r m a
injWeaving forall a b. (a -> b) -> a -> b
$
          forall (f :: * -> *) (e :: Effect) (rInitial :: EffectRow) a
       resultType (mAfter :: * -> *).
Functor f =>
e (Sem rInitial) a
-> f ()
-> (forall x. f (Sem rInitial x) -> mAfter (f x))
-> (f a -> resultType)
-> (forall x. f x -> Maybe x)
-> Weaving e mAfter resultType
Weaving
            (forall (m :: * -> *) (z :: * -> *) a.
ThroughWeavingToFinal m z a -> Final m z a
WithWeavingToFinal (forall (f :: * -> *) (m :: * -> *) (n :: * -> *) a.
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 (forall x (rInitial :: EffectRow).
e (Sem rInitial) x -> Strategic m (Sem rInitial) x
n e (Sem rInitial) a
e)))
            f ()
s
            (forall x. Sem (e : r) x -> Sem r x
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. f (Sem rInitial x) -> Sem (e : r) (f x)
wv)
            f a -> x
ex
            forall x. f x -> Maybe x
ins
      Left Union r (Sem (e : r)) x
g -> forall (m :: * -> *) (n :: * -> *) (r :: EffectRow) a.
(forall x. m x -> n x) -> Union r m a -> Union r n a
hoist forall x. Sem (e : r) x -> Sem r x
go Union r (Sem (e : r)) x
g
    {-# INLINE go #-}
  in
    forall x. Sem (e : r) x -> Sem r x
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'.
--
-- @since 1.2.0.0
runFinal :: Monad m => Sem '[Final m] a -> m a
runFinal :: forall (m :: * -> *) a. Monad m => Sem '[Final m] a -> m a
runFinal = forall (m :: * -> *) (r :: EffectRow) a.
Monad m =>
(forall x. Union r (Sem r) x -> m x) -> Sem r a -> m a
usingSem forall a b. (a -> b) -> a -> b
$ \Union '[Final m] (Sem '[Final m]) x
u -> case forall (e :: Effect) (m :: * -> *) a.
Union '[e] m a -> Weaving e m a
extract Union '[Final m] (Sem '[Final m]) x
u of
  Weaving (WithWeavingToFinal ThroughWeavingToFinal m (Sem rInitial) a
wav) f ()
s forall x. f (Sem rInitial x) -> Sem '[Final m] (f x)
wv f a -> x
ex forall x. f x -> Maybe x
ins ->
    f a -> x
ex forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ThroughWeavingToFinal m (Sem rInitial) a
wav f ()
s (forall (m :: * -> *) a. Monad m => Sem '[Final m] a -> m a
runFinal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. f (Sem rInitial x) -> Sem '[Final m] (f x)
wv) forall x. f x -> Maybe x
ins
{-# INLINE runFinal #-}

------------------------------------------------------------------------------
-- | Given natural transformations between @m1@ and @m2@, run a @'Final' m1@
-- effect by transforming it into a @'Final' m2@ effect.
--
-- @since 1.2.0.0
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
             -> Sem r a
finalToFinal :: forall (m1 :: * -> *) (m2 :: * -> *) (r :: EffectRow) a.
Member (Final m2) r =>
(forall x. m1 x -> m2 x)
-> (forall x. m2 x -> m1 x) -> Sem (Final m1 : r) a -> Sem r a
finalToFinal forall x. m1 x -> m2 x
to forall x. m2 x -> m1 x
from =
  let
    go :: Sem (Final m1 ': r) x -> Sem r x
    go :: forall x. Sem (Final m1 : r) x -> Sem r x
go = forall (r :: EffectRow) (r' :: EffectRow) a.
(forall x. Union r (Sem r) x -> Union r' (Sem r') x)
-> Sem r a -> Sem r' a
hoistSem forall a b. (a -> b) -> a -> b
$ \Union (Final m1 : r) (Sem (Final m1 : r)) x
u -> case forall (e :: Effect) (r :: EffectRow) (m :: * -> *) a.
Union (e : r) m a -> Either (Union r m a) (Weaving e m a)
decomp Union (Final m1 : r) (Sem (Final m1 : r)) x
u of
      Right (Weaving (WithWeavingToFinal ThroughWeavingToFinal m1 (Sem rInitial) a
wav) f ()
s forall x. f (Sem rInitial x) -> Sem (Final m1 : r) (f x)
wv f a -> x
ex forall x. f x -> Maybe x
ins) ->
        forall (e :: Effect) (r :: EffectRow) (m :: * -> *) a.
Member e r =>
Weaving e m a -> Union r m a
injWeaving forall a b. (a -> b) -> a -> b
$
          forall (f :: * -> *) (e :: Effect) (rInitial :: EffectRow) a
       resultType (mAfter :: * -> *).
Functor f =>
e (Sem rInitial) a
-> f ()
-> (forall x. f (Sem rInitial x) -> mAfter (f x))
-> (f a -> resultType)
-> (forall x. f x -> Maybe x)
-> Weaving e mAfter resultType
Weaving
            (forall (m :: * -> *) (z :: * -> *) a.
ThroughWeavingToFinal m z a -> Final m z a
WithWeavingToFinal forall a b. (a -> b) -> a -> b
$ \f ()
s' forall x. f (Sem rInitial x) -> m2 (f x)
wv' forall x. f x -> Maybe x
ins' ->
              forall x. m1 x -> m2 x
to forall a b. (a -> b) -> a -> b
$ ThroughWeavingToFinal m1 (Sem rInitial) a
wav f ()
s' (forall x. m2 x -> m1 x
from forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. f (Sem rInitial x) -> m2 (f x)
wv') forall x. f x -> Maybe x
ins'
            )
            f ()
s
            (forall x. Sem (Final m1 : r) x -> Sem r x
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. f (Sem rInitial x) -> Sem (Final m1 : r) (f x)
wv)
            f a -> x
ex
            forall x. f x -> Maybe x
ins
      Left Union r (Sem (Final m1 : r)) x
g -> forall (m :: * -> *) (n :: * -> *) (r :: EffectRow) a.
(forall x. m x -> n x) -> Union r m a -> Union r n a
hoist forall x. Sem (Final m1 : r) x -> Sem r x
go Union r (Sem (Final m1 : r)) x
g
    {-# INLINE go #-}
  in
    forall x. Sem (Final m1 : r) x -> Sem r x
go
{-# INLINE finalToFinal #-}

------------------------------------------------------------------------------
-- | Transform an @'Embed' m@ effect into a @'Final' m@ effect
--
-- @since 1.2.0.0
embedToFinal :: (Member (Final m) r, Functor m)
             => Sem (Embed m ': r) a
             -> Sem r a
embedToFinal :: forall (m :: * -> *) (r :: EffectRow) a.
(Member (Final m) r, Functor m) =>
Sem (Embed m : r) a -> Sem r a
embedToFinal = forall (e :: Effect) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret forall a b. (a -> b) -> a -> b
$ \(Embed m x
m) -> forall (m :: * -> *) (r :: EffectRow) a.
(Member (Final m) r, Functor m) =>
m a -> Sem r a
embedFinal m x
m
{-# INLINE embedToFinal #-}