{-# LANGUAGE ImplicitParams #-}
-- | Support for feeding values of a particular type to a monadic action.
--
-- @since 2.7.0.0
module Effectful.Output.Static.Action
  ( -- * Effect
    Output

    -- ** Handlers
  , runOutput

    -- ** Operations
  , output
  ) where

import Data.Kind
import GHC.Stack

import Effectful
import Effectful.Dispatch.Static
import Effectful.Dispatch.Static.Primitive
import Effectful.Internal.Utils

-- | Provide the ability to feed values of type @o@ to a monadic action.
data Output (o :: Type) :: Effect

type instance DispatchOf (Output o) = Static NoSideEffects

-- | Wrapper to prevent a space leak on reconstruction of 'Output' in
-- 'relinkOutput' (see https://gitlab.haskell.org/ghc/ghc/-/issues/25520).
newtype OutputImpl o es where
  OutputImpl :: (HasCallStack => o -> Eff es ()) -> OutputImpl o es

data instance StaticRep (Output o) where
  Output
    :: !(Env actionEs)
    -> !(OutputImpl o actionEs)
    -> StaticRep (Output o)

-- | Run the 'Output' effect with the given action for receiving values.
runOutput
  :: forall o es a
   . HasCallStack
  => (HasCallStack => o -> Eff es ())
  -- ^ The action for receiving values.
  -> Eff (Output o : es) a
  -> Eff es a
runOutput :: forall o (es :: [Effect]) a.
HasCallStack =>
(HasCallStack => o -> Eff es ())
-> Eff (Output o : es) a -> Eff es a
runOutput HasCallStack => o -> Eff es ()
outputAction Eff (Output o : es) a
action = (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO a) -> Eff es a) -> (Env es -> IO a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Env es
es -> do
  IO (Env (Output o : es))
-> (Env (Output o : es) -> IO ())
-> (Env (Output o : es) -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
inlineBracket
    (EffectRep (DispatchOf (Output o)) (Output o)
-> Relinker (EffectRep (DispatchOf (Output o))) (Output o)
-> Env es
-> IO (Env (Output o : es))
forall (e :: Effect) (es :: [Effect]).
HasCallStack =>
EffectRep (DispatchOf e) e
-> Relinker (EffectRep (DispatchOf e)) e
-> Env es
-> IO (Env (e : es))
consEnv (Env es -> OutputImpl o es -> StaticRep (Output o)
forall (actionEs :: [Effect]) o.
Env actionEs -> OutputImpl o actionEs -> StaticRep (Output o)
Output Env es
es OutputImpl o es
outputImpl) Relinker (EffectRep (DispatchOf (Output o))) (Output o)
Relinker StaticRep (Output o)
forall o. Relinker StaticRep (Output o)
relinkOutput Env es
es)
    Env (Output o : es) -> IO ()
forall (e :: Effect) (es :: [Effect]).
HasCallStack =>
Env (e : es) -> IO ()
unconsEnv
    (Eff (Output o : es) a -> Env (Output o : es) -> IO a
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff Eff (Output o : es) a
action)
  where
    outputImpl :: OutputImpl o es
outputImpl = (HasCallStack => o -> Eff es ()) -> OutputImpl o es
forall o (es :: [Effect]).
(HasCallStack => o -> Eff es ()) -> OutputImpl o es
OutputImpl ((HasCallStack => o -> Eff es ()) -> OutputImpl o es)
-> (HasCallStack => o -> Eff es ()) -> OutputImpl o es
forall a b. (a -> b) -> a -> b
$ let ?callStack = CallStack -> CallStack
thawCallStack HasCallStack
CallStack
?callStack in o -> Eff es ()
HasCallStack => o -> Eff es ()
outputAction

-- | Feed the value to the underlying monadic action.
output
  :: (HasCallStack, Output o :> es)
  => o -- ^ The value.
  -> Eff es ()
output :: forall o (es :: [Effect]).
(HasCallStack, Output o :> es) =>
o -> Eff es ()
output !o
o = (Env es -> IO ()) -> Eff es ()
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO ()) -> Eff es ()) -> (Env es -> IO ()) -> Eff es ()
forall a b. (a -> b) -> a -> b
$ \Env es
es -> do
  Output Env actionEs
actionEs (OutputImpl HasCallStack => o -> Eff actionEs ()
outputAction) <- Env es -> IO (EffectRep (DispatchOf (Output o)) (Output o))
forall (e :: Effect) (es :: [Effect]).
(HasCallStack, e :> es) =>
Env es -> IO (EffectRep (DispatchOf e) e)
getEnv Env es
es
  -- Corresponds to thawCallStack in runOutput.
  (Eff actionEs () -> Env actionEs -> IO ()
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
`unEff` Env actionEs
actionEs) (Eff actionEs () -> IO ()) -> Eff actionEs () -> IO ()
forall a b. (a -> b) -> a -> b
$ (HasCallStack => o -> Eff actionEs ()) -> o -> Eff actionEs ()
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack o -> Eff actionEs ()
HasCallStack => o -> Eff actionEs ()
outputAction o
o

----------------------------------------
-- Helpers

relinkOutput :: Relinker StaticRep (Output o)
relinkOutput :: forall o. Relinker StaticRep (Output o)
relinkOutput = (HasCallStack =>
 (forall (es :: [Effect]). Env es -> IO (Env es))
 -> StaticRep (Output o) -> IO (StaticRep (Output o)))
-> Relinker StaticRep (Output o)
forall (a :: Effect -> Type) (b :: Effect).
(HasCallStack =>
 (forall (es :: [Effect]). Env es -> IO (Env es))
 -> a b -> IO (a b))
-> Relinker a b
Relinker ((HasCallStack =>
  (forall (es :: [Effect]). Env es -> IO (Env es))
  -> StaticRep (Output o) -> IO (StaticRep (Output o)))
 -> Relinker StaticRep (Output o))
-> (HasCallStack =>
    (forall (es :: [Effect]). Env es -> IO (Env es))
    -> StaticRep (Output o) -> IO (StaticRep (Output o)))
-> Relinker StaticRep (Output o)
forall a b. (a -> b) -> a -> b
$ \forall (es :: [Effect]). Env es -> IO (Env es)
relink (Output Env actionEs
actionEs OutputImpl o actionEs
outputAction) -> do
  Env actionEs
newActionEs <- Env actionEs -> IO (Env actionEs)
forall (es :: [Effect]). Env es -> IO (Env es)
relink Env actionEs
actionEs
  StaticRep (Output o) -> IO (StaticRep (Output o))
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (StaticRep (Output o) -> IO (StaticRep (Output o)))
-> StaticRep (Output o) -> IO (StaticRep (Output o))
forall a b. (a -> b) -> a -> b
$ Env actionEs -> OutputImpl o actionEs -> StaticRep (Output o)
forall (actionEs :: [Effect]) o.
Env actionEs -> OutputImpl o actionEs -> StaticRep (Output o)
Output Env actionEs
newActionEs OutputImpl o actionEs
outputAction