{-# LANGUAGE ImplicitParams #-}
-- | Support for access to values supplied by a monadic action.
--
-- @since 2.7.0.0
module Effectful.Input.Static.Action
  ( -- * Effect
    Input

    -- ** Handlers
  , runInput

    -- ** Operations
  , input
  , inputs
  ) where

import Data.Kind
import GHC.Stack

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

-- | Provide access to values of type @i@ supplied by a monadic action.
data Input (i :: Type) :: Effect

type instance DispatchOf (Input i) = Static NoSideEffects

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

data instance StaticRep (Input i) where
  Input
    :: !(Env inputEs)
    -> !(InputImpl i inputEs)
    -> StaticRep (Input i)

-- | Run the 'Input' effect with the given action that supplies values.
runInput
  :: forall i es a
   . HasCallStack
  => (HasCallStack => Eff es i)
  -- ^ The action for input generation.
  -> Eff (Input i : es) a
  -> Eff es a
runInput :: forall i (es :: [Effect]) a.
HasCallStack =>
(HasCallStack => Eff es i) -> Eff (Input i : es) a -> Eff es a
runInput HasCallStack => Eff es i
inputAction Eff (Input i : 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 (Input i : es))
-> (Env (Input i : es) -> IO ())
-> (Env (Input i : es) -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
inlineBracket
    (EffectRep (DispatchOf (Input i)) (Input i)
-> Relinker (EffectRep (DispatchOf (Input i))) (Input i)
-> Env es
-> IO (Env (Input i : 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 -> InputImpl i es -> StaticRep (Input i)
forall (inputEs :: [Effect]) i.
Env inputEs -> InputImpl i inputEs -> StaticRep (Input i)
Input Env es
es InputImpl i es
inputImpl) Relinker (EffectRep (DispatchOf (Input i))) (Input i)
Relinker StaticRep (Input i)
forall i. Relinker StaticRep (Input i)
relinkInput Env es
es)
    Env (Input i : es) -> IO ()
forall (e :: Effect) (es :: [Effect]).
HasCallStack =>
Env (e : es) -> IO ()
unconsEnv
    (Eff (Input i : es) a -> Env (Input i : es) -> IO a
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff Eff (Input i : es) a
action)
  where
    inputImpl :: InputImpl i es
inputImpl = (HasCallStack => Eff es i) -> InputImpl i es
forall (es :: [Effect]) i.
(HasCallStack => Eff es i) -> InputImpl i es
InputImpl ((HasCallStack => Eff es i) -> InputImpl i es)
-> (HasCallStack => Eff es i) -> InputImpl i es
forall a b. (a -> b) -> a -> b
$ let ?callStack = CallStack -> CallStack
thawCallStack HasCallStack
CallStack
?callStack in Eff es i
HasCallStack => Eff es i
inputAction

-- | Fetch the value.
input :: (HasCallStack, Input i :> es) => Eff es i
input :: forall i (es :: [Effect]).
(HasCallStack, Input i :> es) =>
Eff es i
input = (Env es -> IO i) -> Eff es i
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO i) -> Eff es i) -> (Env es -> IO i) -> Eff es i
forall a b. (a -> b) -> a -> b
$ \Env es
es -> do
  Input Env inputEs
inputEs (InputImpl HasCallStack => Eff inputEs i
inputAction) <- Env es -> IO (EffectRep (DispatchOf (Input i)) (Input i))
forall (e :: Effect) (es :: [Effect]).
(HasCallStack, e :> es) =>
Env es -> IO (EffectRep (DispatchOf e) e)
getEnv Env es
es
  -- Corresponds to thawCallStack in runInput.
  (Eff inputEs i -> Env inputEs -> IO i
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
`unEff` Env inputEs
inputEs) (Eff inputEs i -> IO i) -> Eff inputEs i -> IO i
forall a b. (a -> b) -> a -> b
$ (HasCallStack => Eff inputEs i) -> Eff inputEs i
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack Eff inputEs i
HasCallStack => Eff inputEs i
inputAction

-- | Fetch the result of applying a function to the value.
--
-- @'inputs' f ≡ f '<$>' 'input'@
inputs
  :: (HasCallStack, Input i :> es)
  => (i -> a) -- ^ The function to apply to the value.
  -> Eff es a
inputs :: forall i (es :: [Effect]) a.
(HasCallStack, Input i :> es) =>
(i -> a) -> Eff es a
inputs i -> a
f = i -> a
f (i -> a) -> Eff es i -> Eff es a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff es i
forall i (es :: [Effect]).
(HasCallStack, Input i :> es) =>
Eff es i
input

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

relinkInput :: Relinker StaticRep (Input i)
relinkInput :: forall i. Relinker StaticRep (Input i)
relinkInput = (HasCallStack =>
 (forall (es :: [Effect]). Env es -> IO (Env es))
 -> StaticRep (Input i) -> IO (StaticRep (Input i)))
-> Relinker StaticRep (Input i)
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 (Input i) -> IO (StaticRep (Input i)))
 -> Relinker StaticRep (Input i))
-> (HasCallStack =>
    (forall (es :: [Effect]). Env es -> IO (Env es))
    -> StaticRep (Input i) -> IO (StaticRep (Input i)))
-> Relinker StaticRep (Input i)
forall a b. (a -> b) -> a -> b
$ \forall (es :: [Effect]). Env es -> IO (Env es)
relink (Input Env inputEs
inputEs InputImpl i inputEs
inputAction) -> do
  Env inputEs
newActionEs <- Env inputEs -> IO (Env inputEs)
forall (es :: [Effect]). Env es -> IO (Env es)
relink Env inputEs
inputEs
  StaticRep (Input i) -> IO (StaticRep (Input i))
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (StaticRep (Input i) -> IO (StaticRep (Input i)))
-> StaticRep (Input i) -> IO (StaticRep (Input i))
forall a b. (a -> b) -> a -> b
$ Env inputEs -> InputImpl i inputEs -> StaticRep (Input i)
forall (inputEs :: [Effect]) i.
Env inputEs -> InputImpl i inputEs -> StaticRep (Input i)
Input Env inputEs
newActionEs InputImpl i inputEs
inputAction