{-# 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.
--
-- @since 1.2.0.0
type Strategic m n a = forall f. Functor f => Sem (WithStrategy m f n) (m (f a))


------------------------------------------------------------------------------
-- | @since 1.2.0.0
type WithStrategy m f n = '[Strategy m f n]


------------------------------------------------------------------------------
-- | Internal function to process Strategies in terms of
-- 'Polysemy.Final.withWeavingToFinal'.
--
-- @since 1.2.0.0
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 '[Strategy m f n] a
-> f ()
-> (forall x. f (n x) -> m (f x))
-> (forall x. f x -> Maybe x)
-> a
runStrategy Sem '[Strategy m f n] a
sem = \f ()
s forall x. f (n x) -> m (f x)
wv forall x. f x -> Maybe x
ins -> Sem '[] a -> a
forall a. Sem '[] a -> a
run (Sem '[] a -> a) -> Sem '[] a -> a
forall a b. (a -> b) -> a -> b
$ (forall (rInitial :: EffectRow) x.
 Strategy m f n (Sem rInitial) x -> Sem '[] x)
-> Sem '[Strategy m f n] a -> Sem '[] a
forall (e :: (* -> *) -> * -> *) (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
  (\case
    Strategy m f n (Sem rInitial) x
GetInitialState       -> f () -> Sem '[] (f ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure f ()
s
    HoistInterpretation f -> (f a -> m (f b)) -> Sem '[] (f a -> m (f b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((f a -> m (f b)) -> Sem '[] (f a -> m (f b)))
-> (f a -> m (f b)) -> Sem '[] (f a -> m (f b))
forall a b. (a -> b) -> a -> b
$ \f a
fa -> f (n b) -> m (f b)
forall x. f (n x) -> m (f x)
wv (a -> n b
f (a -> n b) -> f a -> f (n b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
fa)
    Strategy m f n (Sem rInitial) x
GetInspector          -> Inspector f -> Sem '[] (Inspector f)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((forall x. f x -> Maybe x) -> Inspector f
forall (f :: * -> *). (forall x. f x -> Maybe x) -> Inspector f
Inspector forall x. f x -> Maybe x
ins)
  ) Sem '[Strategy m f n] a
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'
--
-- @since 1.2.0.0
getInspectorS :: forall m f n. Sem (WithStrategy m f n) (Inspector f)
getInspectorS :: Sem (WithStrategy m f n) (Inspector f)
getInspectorS = Strategy m f n (Sem (WithStrategy m f n)) (Inspector f)
-> Sem (WithStrategy m f n) (Inspector f)
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member e r =>
e (Sem r) a -> Sem r a
send (forall k (m :: * -> *) (f :: * -> *) (n :: * -> *) (z :: k).
Strategy m f n z (Inspector f)
forall (z :: * -> *). Strategy m f n z (Inspector f)
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.
--
-- @since 1.2.0.0
getInitialStateS :: forall m f n. Sem (WithStrategy m f n) (f ())
getInitialStateS :: Sem (WithStrategy m f n) (f ())
getInitialStateS = Strategy m f n (Sem (WithStrategy m f n)) (f ())
-> Sem (WithStrategy m f n) (f ())
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member e r =>
e (Sem r) a -> Sem r a
send (forall k (m :: * -> *) (f :: * -> *) (n :: * -> *) (z :: k).
Strategy m f n z (f ())
forall (z :: * -> *). Strategy m f n z (f ())
GetInitialState @m @f @n)
{-# INLINE getInitialStateS #-}


------------------------------------------------------------------------------
-- | Embed a value into 'Strategic'.
--
-- @since 1.2.0.0
pureS :: Applicative m => a -> Strategic m n a
pureS :: a -> Strategic m n a
pureS a
a = f a -> m (f a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (f a -> m (f a)) -> (f () -> f a) -> f () -> m (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
a a -> f () -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (f () -> m (f a))
-> Sem (WithStrategy m f n) (f ())
-> Sem (WithStrategy m f n) (m (f a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem (WithStrategy m f n) (f ())
forall (m :: * -> *) (f :: * -> *) (n :: * -> *).
Sem (WithStrategy m f n) (f ())
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.
--
-- @since 1.2.0.0
liftS :: Functor m => m a -> Strategic m n a
liftS :: m a -> Strategic m n a
liftS m a
m = do
  f ()
s <- Sem (WithStrategy m f n) (f ())
forall (m :: * -> *) (f :: * -> *) (n :: * -> *).
Sem (WithStrategy m f n) (f ())
getInitialStateS
  m (f a) -> Sem (WithStrategy m f n) (m (f a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (m (f a) -> Sem (WithStrategy m f n) (m (f a)))
-> m (f a) -> Sem (WithStrategy m f n) (m (f a))
forall a b. (a -> b) -> a -> b
$ (a -> f () -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f ()
s) (a -> f a) -> m a -> m (f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
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.
--
-- @since 1.2.0.0
runS :: n a -> Sem (WithStrategy m f n) (m (f a))
runS :: n a -> Sem (WithStrategy m f n) (m (f a))
runS n a
na = (() -> n a) -> Sem (WithStrategy m f n) (f () -> m (f a))
forall a (n :: * -> *) b (m :: * -> *) (f :: * -> *).
(a -> n b) -> Sem (WithStrategy m f n) (f a -> m (f b))
bindS (n a -> () -> n a
forall a b. a -> b -> a
const n a
na) Sem (WithStrategy m f n) (f () -> m (f a))
-> Sem (WithStrategy m f n) (f ())
-> Sem (WithStrategy m f n) (m (f a))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Sem (WithStrategy m f n) (f ())
forall (m :: * -> *) (f :: * -> *) (n :: * -> *).
Sem (WithStrategy m f n) (f ())
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@.
--
-- @since 1.2.0.0
bindS :: (a -> n b) -> Sem (WithStrategy m f n) (f a -> m (f b))
bindS :: (a -> n b) -> Sem (WithStrategy m f n) (f a -> m (f b))
bindS = Strategy m f n (Sem (WithStrategy m f n)) (f a -> m (f b))
-> Sem (WithStrategy m f n) (f a -> m (f b))
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
Member e r =>
e (Sem r) a -> Sem r a
send (Strategy m f n (Sem (WithStrategy m f n)) (f a -> m (f b))
 -> Sem (WithStrategy m f n) (f a -> m (f b)))
-> ((a -> n b)
    -> Strategy m f n (Sem (WithStrategy m f n)) (f a -> m (f b)))
-> (a -> n b)
-> Sem (WithStrategy m f n) (f a -> m (f b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> n b)
-> Strategy m f n (Sem (WithStrategy m f n)) (f a -> m (f b))
forall k a (n :: * -> *) b (m :: * -> *) (f :: * -> *) (z :: k).
(a -> n b) -> Strategy m f n z (f a -> m (f b))
HoistInterpretation
{-# INLINE bindS #-}