{-# OPTIONS_HADDOCK not-home #-}

-- | Description: The auxiliary effect 'Strategy' used for building interpreters
-- that embed 'Sem's in 'IO' callbacks
module Polysemy.Internal.Strategy where

import Polysemy.Internal
import Polysemy.Internal.Combinators
import Polysemy.Internal.Tactics (Inspector(..))


------------------------------------------------------------------------------
-- | See 'Strategic'.
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 :: 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 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 -> forall a. Sem '[] a -> a
run forall a b. (a -> b) -> a -> b
$ forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
FirstOrder e "interpret" =>
(forall (rInitial :: [(* -> *) -> * -> *]) 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       -> forall (f :: * -> *) a. Applicative f => a -> f a
pure f ()
s
    HoistInterpretation a -> n b
f -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ \f a
fa -> forall x. f (n x) -> m (f x)
wv (a -> n b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
fa)
    Strategy m f n (Sem rInitial) x
GetInspector          -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 :: forall (m :: * -> *) (f :: * -> *) (n :: * -> *).
Sem (WithStrategy m f n) (Inspector f)
getInspectorS = forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) 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)
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 :: forall (m :: * -> *) (f :: * -> *) (n :: * -> *).
Sem (WithStrategy m f n) (f ())
getInitialStateS = forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) 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 ())
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 :: forall (m :: * -> *) a (n :: * -> *).
Applicative m =>
a -> Strategic m n a
pureS a
a = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
a forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 :: forall (m :: * -> *) a (n :: * -> *).
Functor m =>
m a -> Strategic m n a
liftS m a
m = do
  f ()
s <- forall (m :: * -> *) (f :: * -> *) (n :: * -> *).
Sem (WithStrategy m f n) (f ())
getInitialStateS
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (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 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 :: forall (n :: * -> *) a (m :: * -> *) (f :: * -> *).
n a -> Sem (WithStrategy m f n) (m (f a))
runS n a
na = forall a (n :: * -> *) b (m :: * -> *) (f :: * -> *).
(a -> n b) -> Sem (WithStrategy m f n) (f a -> m (f b))
bindS (forall a b. a -> b -> a
const n a
na) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 :: forall a (n :: * -> *) b (m :: * -> *) (f :: * -> *).
(a -> n b) -> Sem (WithStrategy m f n) (f a -> m (f b))
bindS = forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
Member e r =>
e (Sem r) a -> Sem r a
send forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 #-}