-- | Turn an effect handler into an effectful operation.
--
-- @since 2.3.0.0
module Effectful.Provider
  ( -- * Example
    -- $example

    -- * Effect
    Provider(..)
  , Provider_

    -- ** Handlers
  , runProvider
  , runProvider_

    -- ** Operations
  , provide
  , provide_
  , provideWith
  , provideWith_
  ) where

import Data.Coerce
import Data.Functor.Identity
import Data.Kind (Type)
import GHC.Stack

import Effectful
import Effectful.Dispatch.Dynamic

-- $example
--
-- >>> import Control.Monad.IO.Class
-- >>> import Data.Map.Strict qualified as M
-- >>> import Effectful.Dispatch.Dynamic
-- >>> import Effectful.State.Static.Local
--
-- Given an effect:
--
-- >>> :{
--   data Write :: Effect where
--     Write :: String -> Write m ()
--   type instance DispatchOf Write = Dynamic
-- :}
--
-- >>> :{
--   write :: Write :> es => String -> Eff es ()
--   write = send . Write
-- :}
--
-- its handler can be turned into an effectful operation with the 'Provider'
-- effect:
--
-- >>> :{
--   action :: Provider_ Write FilePath :> es => Eff es ()
--   action = do
--     provideWith_ @Write "in.txt" $ do
--       write "hi"
--       write "there"
--     provideWith_ @Write "out.txt" $ do
--       write "good"
--       write "bye"
-- :}
--
-- Then, given multiple interpreters:
--
-- >>> :{
--   runWriteIO
--     :: IOE :> es
--     => FilePath
--     -> Eff (Write : es) a
--     -> Eff es a
--   runWriteIO fp = interpret_ $ \case
--     Write msg -> liftIO . putStrLn $ fp ++ ": " ++ msg
-- :}
--
-- >>> :{
--   runWritePure
--     :: State (M.Map FilePath [String]) :> es
--     => FilePath
--     -> Eff (Write : es) a
--     -> Eff es a
--   runWritePure fp = interpret_ $ \case
--     Write msg -> modify $ M.insertWith (++) fp [msg]
-- :}
--
-- @action@ can be supplied with either of them for the appropriate behavior:
--
-- >>> :{
--   runEff
--     . runProvider_ runWriteIO
--     $ action
-- :}
-- in.txt: hi
-- in.txt: there
-- out.txt: good
-- out.txt: bye
--
-- >>> :{
--   runPureEff
--     . fmap (fmap reverse)
--     . execState @(M.Map FilePath [String]) M.empty
--     . runProvider_ runWritePure
--     $ action
-- :}
-- fromList [("in.txt",["hi","there"]),("out.txt",["good","bye"])]
--
-- Moreover, operations of the 'Provider' effect can be intercepted with
-- 'interpose', e.g. to adjust the input of the effect handler:
--
-- >>> :{
--   adjustPaths
--     :: Provider_ Write FilePath :> es
--     => Eff es a
--     -> Eff es a
--   adjustPaths = interpose @(Provider_ Write FilePath) $ \env -> \case
--     ProvideWith fp action -> do
--       passthrough env $ ProvideWith ("logs/" ++ fp) action
-- :}
--
-- >>> :{
--   runEff
--     . runProvider_ runWriteIO
--     . adjustPaths
--     $ action
-- :}
-- logs/in.txt: hi
-- logs/in.txt: there
-- logs/out.txt: good
-- logs/out.txt: bye

-- | Provide a way to run a handler of @e@ with a given @input@.
--
-- /Note:/ @f@ can be used to alter the return type of the effect handler. If
-- that's unnecessary, use 'Provider_'.
data Provider (e :: Effect) (input :: Type) (f :: Type -> Type) :: Effect where
  -- | Run the effect handler with a given input.
  --
  -- @since 2.7.0.0
  ProvideWith :: input -> Eff (e : es) a -> Provider e input f (Eff es) (f a)

-- | A restricted variant of 'Provider' with unchanged return type of the effect
-- handler.
type Provider_ e input = Provider e input Identity

type instance DispatchOf (Provider e input f) = Dynamic

-- | Run the 'Provider' effect with a given effect handler.
runProvider
  :: forall e input f es a
   . HasCallStack
  => (forall r. HasCallStack => input -> Eff (e : es) r -> Eff es (f r))
  -- ^ The effect handler.
  -> Eff (Provider e input f : es) a
  -> Eff es a
runProvider :: forall (e :: Effect) input (f :: Type -> Type) (es :: [Effect]) a.
HasCallStack =>
(forall r. HasCallStack => input -> Eff (e : es) r -> Eff es (f r))
-> Eff (Provider e input f : es) a -> Eff es a
runProvider forall r. HasCallStack => input -> Eff (e : es) r -> Eff es (f r)
provider = EffectHandler (Provider e input f) es
-> Eff (Provider e input f : es) a -> Eff es a
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
EffectHandler e es -> Eff (e : es) a -> Eff es a
interpret (EffectHandler (Provider e input f) es
 -> Eff (Provider e input f : es) a -> Eff es a)
-> EffectHandler (Provider e input f) es
-> Eff (Provider e input f : es) a
-> Eff es a
forall a b. (a -> b) -> a -> b
$ \LocalEnv localEs
env -> \case
  ProvideWith input
input Eff (e : es) a
action -> input -> Eff (e : es) a -> Eff es (f a)
forall r. HasCallStack => input -> Eff (e : es) r -> Eff es (f r)
provider input
input (Eff (e : es) a -> Eff es (f a)) -> Eff (e : es) a -> Eff es (f a)
forall a b. (a -> b) -> a -> b
$ do
    LocalEnv localEs
-> ((forall {r}. Eff localEs r -> Eff (e : es) r)
    -> Eff (e : es) a)
-> Eff (e : es) a
forall (localEs :: [Effect]) (es :: [Effect]) a.
HasCallStack =>
LocalEnv localEs
-> ((forall r. Eff localEs r -> Eff es r) -> Eff es a) -> Eff es a
localSeqUnlift LocalEnv localEs
env (((forall {r}. Eff localEs r -> Eff (e : es) r) -> Eff (e : es) a)
 -> Eff (e : es) a)
-> ((forall {r}. Eff localEs r -> Eff (e : es) r)
    -> Eff (e : es) a)
-> Eff (e : es) a
forall a b. (a -> b) -> a -> b
$ \forall {r}. Eff localEs r -> Eff (e : es) r
unlift -> do
      forall (lentEs :: [Effect]) (es :: [Effect]) (localEs :: [Effect])
       a.
(HasCallStack, KnownSubset lentEs es) =>
LocalEnv localEs
-> ((forall r. Eff (lentEs ++ localEs) r -> Eff localEs r)
    -> Eff es a)
-> Eff es a
localSeqLend @'[e] LocalEnv localEs
env (((forall r. Eff ('[e] ++ localEs) r -> Eff localEs r)
  -> Eff (e : es) a)
 -> Eff (e : es) a)
-> ((forall r. Eff ('[e] ++ localEs) r -> Eff localEs r)
    -> Eff (e : es) a)
-> Eff (e : es) a
forall a b. (a -> b) -> a -> b
$ \forall r. Eff ('[e] ++ localEs) r -> Eff localEs r
lend -> do
        Eff localEs a -> Eff (e : es) a
forall {r}. Eff localEs r -> Eff (e : es) r
unlift (Eff localEs a -> Eff (e : es) a)
-> (Eff (e : es) a -> Eff localEs a)
-> Eff (e : es) a
-> Eff (e : es) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (e : es) a -> Eff localEs a
Eff ('[e] ++ localEs) a -> Eff localEs a
forall r. Eff ('[e] ++ localEs) r -> Eff localEs r
lend (Eff (e : es) a -> Eff (e : es) a)
-> Eff (e : es) a -> Eff (e : es) a
forall a b. (a -> b) -> a -> b
$ Eff (e : es) a
action

-- | Run the 'Provider' effect with a given effect handler that doesn't change
-- its return type.
runProvider_
  :: forall e input es a
   . HasCallStack
  => (forall r. HasCallStack => input -> Eff (e : es) r -> Eff es r)
  -- ^ The effect handler.
  -> Eff (Provider_ e input : es) a
  -> Eff es a
runProvider_ :: forall (e :: Effect) input (es :: [Effect]) a.
HasCallStack =>
(forall r. HasCallStack => input -> Eff (e : es) r -> Eff es r)
-> Eff (Provider_ e input : es) a -> Eff es a
runProvider_ forall r. HasCallStack => input -> Eff (e : es) r -> Eff es r
provider = EffectHandler (Provider_ e input) es
-> Eff (Provider_ e input : es) a -> Eff es a
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
EffectHandler e es -> Eff (e : es) a -> Eff es a
interpret (EffectHandler (Provider_ e input) es
 -> Eff (Provider_ e input : es) a -> Eff es a)
-> EffectHandler (Provider_ e input) es
-> Eff (Provider_ e input : es) a
-> Eff es a
forall a b. (a -> b) -> a -> b
$ \LocalEnv localEs
env -> \case
  ProvideWith input
input Eff (e : es) a
action -> input -> Eff (e : es) a -> Eff es a
forall r. HasCallStack => input -> Eff (e : es) r -> Eff es r
provider input
input (Eff (e : es) a -> Eff es a) -> Eff (e : es) a -> Eff es a
forall a b. (a -> b) -> a -> b
$ do
    LocalEnv localEs
-> ((forall {r}. Eff localEs r -> Eff (e : es) r)
    -> Eff (e : es) a)
-> Eff (e : es) a
forall (localEs :: [Effect]) (es :: [Effect]) a.
HasCallStack =>
LocalEnv localEs
-> ((forall r. Eff localEs r -> Eff es r) -> Eff es a) -> Eff es a
localSeqUnlift LocalEnv localEs
env (((forall {r}. Eff localEs r -> Eff (e : es) r) -> Eff (e : es) a)
 -> Eff (e : es) a)
-> ((forall {r}. Eff localEs r -> Eff (e : es) r)
    -> Eff (e : es) a)
-> Eff (e : es) a
forall a b. (a -> b) -> a -> b
$ \forall {r}. Eff localEs r -> Eff (e : es) r
unlift -> do
      forall (lentEs :: [Effect]) (es :: [Effect]) (localEs :: [Effect])
       a.
(HasCallStack, KnownSubset lentEs es) =>
LocalEnv localEs
-> ((forall r. Eff (lentEs ++ localEs) r -> Eff localEs r)
    -> Eff es a)
-> Eff es a
localSeqLend @'[e] LocalEnv localEs
env (((forall r. Eff ('[e] ++ localEs) r -> Eff localEs r)
  -> Eff (e : es) a)
 -> Eff (e : es) a)
-> ((forall r. Eff ('[e] ++ localEs) r -> Eff localEs r)
    -> Eff (e : es) a)
-> Eff (e : es) a
forall a b. (a -> b) -> a -> b
$ \forall r. Eff ('[e] ++ localEs) r -> Eff localEs r
lend -> do
        Eff localEs a -> Eff (e : es) a
forall {r}. Eff localEs r -> Eff (e : es) r
unlift (Eff localEs a -> Eff (e : es) a)
-> (Eff (e : localEs) (Identity a) -> Eff localEs a)
-> Eff (e : localEs) (Identity a)
-> Eff (e : es) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (e : localEs) (Identity a) -> Eff localEs a
Eff ('[e] ++ localEs) a -> Eff localEs a
forall r. Eff ('[e] ++ localEs) r -> Eff localEs r
lend (Eff (e : localEs) (Identity a) -> Eff (e : es) a)
-> Eff (e : localEs) (Identity a) -> Eff (e : es) a
forall a b. (a -> b) -> a -> b
$ Eff (e : es) a -> Eff (e : localEs) (Identity a)
forall a b. Coercible a b => a -> b
coerce Eff (e : es) a
action

-- | Run the effect handler.
provide :: (HasCallStack, Provider e () f :> es) => Eff (e : es) a -> Eff es (f a)
provide :: forall (e :: Effect) (f :: Type -> Type) (es :: [Effect]) a.
(HasCallStack, Provider e () f :> es) =>
Eff (e : es) a -> Eff es (f a)
provide = Provider e () f (Eff es) (f a) -> Eff es (f a)
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Provider e () f (Eff es) (f a) -> Eff es (f a))
-> (Eff (e : es) a -> Provider e () f (Eff es) (f a))
-> Eff (e : es) a
-> Eff es (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Eff (e : es) a -> Provider e () f (Eff es) (f a)
forall input (e :: Effect) (es :: [Effect]) a (f :: Type -> Type).
input -> Eff (e : es) a -> Provider e input f (Eff es) (f a)
ProvideWith ()

-- | Run the effect handler with unchanged return type.
provide_ :: (HasCallStack, Provider_ e () :> es) => Eff (e : es) a -> Eff es a
provide_ :: forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, Provider_ e () :> es) =>
Eff (e : es) a -> Eff es a
provide_ = Eff es (Identity a) -> Eff es a
forall (es :: [Effect]) a. Eff es (Identity a) -> Eff es a
dropIdentity (Eff es (Identity a) -> Eff es a)
-> (Eff (e : es) a -> Eff es (Identity a))
-> Eff (e : es) a
-> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Provider e () Identity (Eff es) (Identity a) -> Eff es (Identity a)
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Provider e () Identity (Eff es) (Identity a)
 -> Eff es (Identity a))
-> (Eff (e : es) a -> Provider e () Identity (Eff es) (Identity a))
-> Eff (e : es) a
-> Eff es (Identity a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ()
-> Eff (e : es) a -> Provider e () Identity (Eff es) (Identity a)
forall input (e :: Effect) (es :: [Effect]) a (f :: Type -> Type).
input -> Eff (e : es) a -> Provider e input f (Eff es) (f a)
ProvideWith ()

-- | Run the effect handler with a given input.
provideWith
  :: (HasCallStack, Provider e input f :> es)
  => input
  -- ^ The input to the effect handler.
  -> Eff (e : es) a
  -> Eff es (f a)
provideWith :: forall (e :: Effect) input (f :: Type -> Type) (es :: [Effect]) a.
(HasCallStack, Provider e input f :> es) =>
input -> Eff (e : es) a -> Eff es (f a)
provideWith input
input = Provider e input f (Eff es) (f a) -> Eff es (f a)
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Provider e input f (Eff es) (f a) -> Eff es (f a))
-> (Eff (e : es) a -> Provider e input f (Eff es) (f a))
-> Eff (e : es) a
-> Eff es (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. input -> Eff (e : es) a -> Provider e input f (Eff es) (f a)
forall input (e :: Effect) (es :: [Effect]) a (f :: Type -> Type).
input -> Eff (e : es) a -> Provider e input f (Eff es) (f a)
ProvideWith input
input

-- | Run the effect handler that doesn't change its return type with a given
-- input.
provideWith_
  :: (HasCallStack, Provider_ e input :> es)
  => input
  -- ^ The input to the effect handler.
  -> Eff (e : es) a
  -> Eff es a
provideWith_ :: forall (e :: Effect) input (es :: [Effect]) a.
(HasCallStack, Provider_ e input :> es) =>
input -> Eff (e : es) a -> Eff es a
provideWith_ input
input = Eff es (Identity a) -> Eff es a
forall (es :: [Effect]) a. Eff es (Identity a) -> Eff es a
dropIdentity (Eff es (Identity a) -> Eff es a)
-> (Eff (e : es) a -> Eff es (Identity a))
-> Eff (e : es) a
-> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Provider e input Identity (Eff es) (Identity a)
-> Eff es (Identity a)
forall (e :: Effect) (es :: [Effect]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (Provider e input Identity (Eff es) (Identity a)
 -> Eff es (Identity a))
-> (Eff (e : es) a
    -> Provider e input Identity (Eff es) (Identity a))
-> Eff (e : es) a
-> Eff es (Identity a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. input
-> Eff (e : es) a
-> Provider e input Identity (Eff es) (Identity a)
forall input (e :: Effect) (es :: [Effect]) a (f :: Type -> Type).
input -> Eff (e : es) a -> Provider e input f (Eff es) (f a)
ProvideWith input
input

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

dropIdentity :: Eff es (Identity a) -> Eff es a
dropIdentity :: forall (es :: [Effect]) a. Eff es (Identity a) -> Eff es a
dropIdentity = Eff es (Identity a) -> Eff es a
forall a b. Coercible a b => a -> b
coerce