{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ImplicitParams #-}
-- | Turn a handler of multiple effects into an effectful operation.
--
-- Generalizes "Effectful.Provider".
--
-- @since 2.3.1.0
module Effectful.Provider.List
  ( -- * Effect
    ProviderList
  , ProviderList_

    -- ** Handlers
  , runProviderList
  , runProviderList_

    -- ** Operations
  , provideList
  , provideList_
  , provideListWith
  , provideListWith_

    -- * Misc
  , type (++)
  , KnownEffects
  ) where

import Control.Monad
import Data.Coerce
import Data.Functor.Identity
import Data.Primitive.PrimArray
import GHC.Stack

import Effectful
import Effectful.Dispatch.Static
import Effectful.Dispatch.Static.Primitive
import Effectful.Internal.Effect
import Effectful.Internal.Env (Env(..))
import Effectful.Internal.Utils

-- | Provide a way to run a handler of multiple @providedEs@ with a given
-- @input@.
--
-- /Note:/ @f@ can be used to alter the return type of the handler. If that's
-- unnecessary, use 'ProviderList_'.
data ProviderList (providedEs :: [Effect]) (input :: Type) (f :: Type -> Type) :: Effect

-- | A restricted variant of 'ProviderList' with unchanged return type of the
-- handler.
type ProviderList_ providedEs input = ProviderList providedEs input Identity

type instance DispatchOf (ProviderList providedEs input f) = Static NoSideEffects

data instance StaticRep (ProviderList providedEs input f) where
  ProviderList
    :: KnownEffects providedEs
    => !(Env handlerEs)
    -> !(forall r. HasCallStack => input -> Eff (providedEs ++ handlerEs) r -> Eff handlerEs (f r))
    -> StaticRep (ProviderList providedEs input f)

-- | Run the 'ProviderList' effect with a given handler.
runProviderList
  :: (HasCallStack, KnownEffects providedEs)
  => (forall r. HasCallStack => input -> Eff (providedEs ++ es) r -> Eff es (f r))
  -- ^ The handler.
  -> Eff (ProviderList providedEs input f : es) a
  -> Eff es a
runProviderList :: forall (providedEs :: [Effect]) input (es :: [Effect])
       (f :: Type -> Type) a.
(HasCallStack, KnownEffects providedEs) =>
(forall r.
 HasCallStack =>
 input -> Eff (providedEs ++ es) r -> Eff es (f r))
-> Eff (ProviderList providedEs input f : es) a -> Eff es a
runProviderList forall r.
HasCallStack =>
input -> Eff (providedEs ++ es) r -> Eff es (f r)
providerList Eff (ProviderList providedEs input f : es) a
m = (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
es0 -> do
  IO (Env (ProviderList providedEs input f : es))
-> (Env (ProviderList providedEs input f : es) -> IO ())
-> (Env (ProviderList providedEs input f : es) -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
inlineBracket
    (EffectRep
  (DispatchOf (ProviderList providedEs input f))
  (ProviderList providedEs input f)
-> Relinker
     (EffectRep (DispatchOf (ProviderList providedEs input f)))
     (ProviderList providedEs input f)
-> Env es
-> IO (Env (ProviderList providedEs input f : 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 -> StaticRep (ProviderList providedEs input f)
mkProviderList Env es
es0) Relinker
  (EffectRep (DispatchOf (ProviderList providedEs input f)))
  (ProviderList providedEs input f)
Relinker StaticRep (ProviderList providedEs input f)
forall (e :: [Effect]) input (f :: Type -> Type).
Relinker StaticRep (ProviderList e input f)
relinkProviderList Env es
es0)
    Env (ProviderList providedEs input f : es) -> IO ()
forall (e :: Effect) (es :: [Effect]).
HasCallStack =>
Env (e : es) -> IO ()
unconsEnv
    (\Env (ProviderList providedEs input f : es)
es -> Eff (ProviderList providedEs input f : es) a
-> Env (ProviderList providedEs input f : es) -> IO a
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff Eff (ProviderList providedEs input f : es) a
m Env (ProviderList providedEs input f : es)
es)
  where
    -- Corresponds to withFrozenCallStack in provideListWith.
    mkProviderList :: Env es -> StaticRep (ProviderList providedEs input f)
mkProviderList Env es
es =
      Env es
-> (forall r.
    HasCallStack =>
    input -> Eff (providedEs ++ es) r -> Eff es (f r))
-> StaticRep (ProviderList providedEs input f)
forall (providedEs :: [Effect]) (handlerEs :: [Effect]) input
       (f :: Type -> Type).
KnownEffects providedEs =>
Env handlerEs
-> (forall r.
    HasCallStack =>
    input -> Eff (providedEs ++ handlerEs) r -> Eff handlerEs (f r))
-> StaticRep (ProviderList providedEs input f)
ProviderList Env es
es (let ?callStack = CallStack -> CallStack
thawCallStack HasCallStack
CallStack
?callStack in input -> Eff (providedEs ++ es) r -> Eff es (f r)
forall r.
HasCallStack =>
input -> Eff (providedEs ++ es) r -> Eff es (f r)
providerList)

-- | Run the 'Provider' effect with a given handler that doesn't change its
-- return type.
runProviderList_
  :: (HasCallStack, KnownEffects providedEs)
  => (forall r. HasCallStack => input -> Eff (providedEs ++ es) r -> Eff es r)
  -- ^ The handler.
  -> Eff (ProviderList_ providedEs input : es) a
  -> Eff es a
runProviderList_ :: forall (providedEs :: [Effect]) input (es :: [Effect]) a.
(HasCallStack, KnownEffects providedEs) =>
(forall r.
 HasCallStack =>
 input -> Eff (providedEs ++ es) r -> Eff es r)
-> Eff (ProviderList_ providedEs input : es) a -> Eff es a
runProviderList_ forall r.
HasCallStack =>
input -> Eff (providedEs ++ es) r -> Eff es r
providerList = (forall r.
 HasCallStack =>
 input -> Eff (providedEs ++ es) r -> Eff es (Identity r))
-> Eff (ProviderList providedEs input Identity : es) a -> Eff es a
forall (providedEs :: [Effect]) input (es :: [Effect])
       (f :: Type -> Type) a.
(HasCallStack, KnownEffects providedEs) =>
(forall r.
 HasCallStack =>
 input -> Eff (providedEs ++ es) r -> Eff es (f r))
-> Eff (ProviderList providedEs input f : es) a -> Eff es a
runProviderList ((forall r.
  HasCallStack =>
  input -> Eff (providedEs ++ es) r -> Eff es (Identity r))
 -> Eff (ProviderList providedEs input Identity : es) a -> Eff es a)
-> (forall r.
    HasCallStack =>
    input -> Eff (providedEs ++ es) r -> Eff es (Identity r))
-> Eff (ProviderList providedEs input Identity : es) a
-> Eff es a
forall a b. (a -> b) -> a -> b
$ \input
input -> Eff es r -> Eff es (Identity r)
forall a b. Coercible a b => a -> b
coerce (Eff es r -> Eff es (Identity r))
-> (Eff (providedEs ++ es) r -> Eff es r)
-> Eff (providedEs ++ es) r
-> Eff es (Identity r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. input -> Eff (providedEs ++ es) r -> Eff es r
forall r.
HasCallStack =>
input -> Eff (providedEs ++ es) r -> Eff es r
providerList input
input

-- | Run the handler.
provideList
  :: forall providedEs f es a
   . (HasCallStack, ProviderList providedEs () f :> es)
  => Eff (providedEs ++ es) a
  -> Eff es (f a)
provideList :: forall (providedEs :: [Effect]) (f :: Type -> Type)
       (es :: [Effect]) a.
(HasCallStack, ProviderList providedEs () f :> es) =>
Eff (providedEs ++ es) a -> Eff es (f a)
provideList = forall (providedEs :: [Effect]) input (f :: Type -> Type)
       (es :: [Effect]) a.
(HasCallStack, ProviderList providedEs input f :> es) =>
input -> Eff (providedEs ++ es) a -> Eff es (f a)
provideListWith @providedEs ()

-- | Run the handler with unchanged return type.
provideList_
  :: forall providedEs es a
   . (HasCallStack, ProviderList_ providedEs () :> es)
  => Eff (providedEs ++ es) a
  -> Eff es a
provideList_ :: forall (providedEs :: [Effect]) (es :: [Effect]) a.
(HasCallStack, ProviderList_ providedEs () :> es) =>
Eff (providedEs ++ es) a -> Eff es a
provideList_ = forall (providedEs :: [Effect]) input (es :: [Effect]) a.
(HasCallStack, ProviderList_ providedEs input :> es) =>
input -> Eff (providedEs ++ es) a -> Eff es a
provideListWith_ @providedEs ()

-- | Run the handler with a given input.
provideListWith
  :: forall providedEs input f es a
   . (HasCallStack, ProviderList providedEs input f :> es)
  => input
  -- ^ The input to the handler.
  -> Eff (providedEs ++ es) a
  -> Eff es (f a)
provideListWith :: forall (providedEs :: [Effect]) input (f :: Type -> Type)
       (es :: [Effect]) a.
(HasCallStack, ProviderList providedEs input f :> es) =>
input -> Eff (providedEs ++ es) a -> Eff es (f a)
provideListWith input
input Eff (providedEs ++ es) a
action = (Env es -> IO (f a)) -> Eff es (f a)
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env es -> IO (f a)) -> Eff es (f a))
-> (Env es -> IO (f a)) -> Eff es (f a)
forall a b. (a -> b) -> a -> b
$ \Env es
es -> do
  ProviderList (Env handlerEs
handlerEs :: Env handlerEs) forall r.
HasCallStack =>
input -> Eff (providedEs ++ handlerEs) r -> Eff handlerEs (f r)
providerList <- do
    forall (e :: Effect) (es :: [Effect]).
(HasCallStack, e :> es) =>
Env es -> IO (EffectRep (DispatchOf e) e)
getEnv @(ProviderList providedEs input f) Env es
es
  (Eff handlerEs (f a) -> Env handlerEs -> IO (f a)
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
`unEff` Env handlerEs
handlerEs)
    -- Corresponds to a thawCallStack in runProviderList.
    (Eff handlerEs (f a) -> IO (f a))
-> ((Env (providedEs ++ handlerEs) -> IO a) -> Eff handlerEs (f a))
-> (Env (providedEs ++ handlerEs) -> IO a)
-> IO (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HasCallStack =>
 input -> Eff (providedEs ++ handlerEs) a -> Eff handlerEs (f a))
-> input -> Eff (providedEs ++ handlerEs) a -> Eff handlerEs (f a)
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack input -> Eff (providedEs ++ handlerEs) a -> Eff handlerEs (f a)
HasCallStack =>
input -> Eff (providedEs ++ handlerEs) a -> Eff handlerEs (f a)
forall r.
HasCallStack =>
input -> Eff (providedEs ++ handlerEs) r -> Eff handlerEs (f r)
providerList input
input
    (Eff (providedEs ++ handlerEs) a -> Eff handlerEs (f a))
-> ((Env (providedEs ++ handlerEs) -> IO a)
    -> Eff (providedEs ++ handlerEs) a)
-> (Env (providedEs ++ handlerEs) -> IO a)
-> Eff handlerEs (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Env (providedEs ++ handlerEs) -> IO a)
-> Eff (providedEs ++ handlerEs) a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff ((Env (providedEs ++ handlerEs) -> IO a) -> IO (f a))
-> (Env (providedEs ++ handlerEs) -> IO a) -> IO (f a)
forall a b. (a -> b) -> a -> b
$ \Env (providedEs ++ handlerEs)
eHandlerEs -> do
    Eff (providedEs ++ es) a -> Env (providedEs ++ es) -> IO a
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff Eff (providedEs ++ es) a
action (Env (providedEs ++ es) -> IO a)
-> IO (Env (providedEs ++ es)) -> IO a
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (providedEs :: [Effect]) (handlerEs :: [Effect])
       (es :: [Effect]).
(HasCallStack, KnownEffects providedEs) =>
Env (providedEs ++ handlerEs)
-> Env es -> IO (Env (providedEs ++ es))
copyRefs @providedEs @handlerEs Env (providedEs ++ handlerEs)
eHandlerEs Env es
es

-- | Run the handler that doesn't change its return type with a given input.
provideListWith_
  :: forall providedEs input es a
   . (HasCallStack, ProviderList_ providedEs input :> es)
  => input
  -- ^ The input to the handler.
  -> Eff (providedEs ++ es) a
  -> Eff es a
provideListWith_ :: forall (providedEs :: [Effect]) input (es :: [Effect]) a.
(HasCallStack, ProviderList_ providedEs input :> es) =>
input -> Eff (providedEs ++ es) a -> Eff es a
provideListWith_ input
input = Eff es (Identity a) -> Eff es a
adapt (Eff es (Identity a) -> Eff es a)
-> (Eff (providedEs ++ es) a -> Eff es (Identity a))
-> Eff (providedEs ++ es) a
-> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (providedEs :: [Effect]) input (f :: Type -> Type)
       (es :: [Effect]) a.
(HasCallStack, ProviderList providedEs input f :> es) =>
input -> Eff (providedEs ++ es) a -> Eff es (f a)
provideListWith @providedEs input
input
  where
    adapt :: Eff es (Identity a) -> Eff es a
    adapt :: Eff es (Identity a) -> Eff es a
adapt = Eff es (Identity a) -> Eff es a
forall a b. Coercible a b => a -> b
coerce

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

relinkProviderList :: Relinker StaticRep (ProviderList e input f)
relinkProviderList :: forall (e :: [Effect]) input (f :: Type -> Type).
Relinker StaticRep (ProviderList e input f)
relinkProviderList = (HasCallStack =>
 (forall (es :: [Effect]). Env es -> IO (Env es))
 -> StaticRep (ProviderList e input f)
 -> IO (StaticRep (ProviderList e input f)))
-> Relinker StaticRep (ProviderList e input f)
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 (ProviderList e input f)
  -> IO (StaticRep (ProviderList e input f)))
 -> Relinker StaticRep (ProviderList e input f))
-> (HasCallStack =>
    (forall (es :: [Effect]). Env es -> IO (Env es))
    -> StaticRep (ProviderList e input f)
    -> IO (StaticRep (ProviderList e input f)))
-> Relinker StaticRep (ProviderList e input f)
forall a b. (a -> b) -> a -> b
$ \forall (es :: [Effect]). Env es -> IO (Env es)
relink (ProviderList Env handlerEs
handlerEs forall r.
HasCallStack =>
input -> Eff (e ++ handlerEs) r -> Eff handlerEs (f r)
run) -> do
  Env handlerEs
newHandlerEs <- Env handlerEs -> IO (Env handlerEs)
forall (es :: [Effect]). Env es -> IO (Env es)
relink Env handlerEs
handlerEs
  StaticRep (ProviderList e input f)
-> IO (StaticRep (ProviderList e input f))
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (StaticRep (ProviderList e input f)
 -> IO (StaticRep (ProviderList e input f)))
-> StaticRep (ProviderList e input f)
-> IO (StaticRep (ProviderList e input f))
forall a b. (a -> b) -> a -> b
$ Env handlerEs
-> (forall r.
    HasCallStack =>
    input -> Eff (e ++ handlerEs) r -> Eff handlerEs (f r))
-> StaticRep (ProviderList e input f)
forall (providedEs :: [Effect]) (handlerEs :: [Effect]) input
       (f :: Type -> Type).
KnownEffects providedEs =>
Env handlerEs
-> (forall r.
    HasCallStack =>
    input -> Eff (providedEs ++ handlerEs) r -> Eff handlerEs (f r))
-> StaticRep (ProviderList providedEs input f)
ProviderList Env handlerEs
newHandlerEs input -> Eff (e ++ handlerEs) r -> Eff handlerEs (f r)
forall r.
HasCallStack =>
input -> Eff (e ++ handlerEs) r -> Eff handlerEs (f r)
run

copyRefs
  :: forall providedEs handlerEs es
   . (HasCallStack, KnownEffects providedEs)
  => Env (providedEs ++ handlerEs)
  -> Env es
  -> IO (Env (providedEs ++ es))
copyRefs :: forall (providedEs :: [Effect]) (handlerEs :: [Effect])
       (es :: [Effect]).
(HasCallStack, KnownEffects providedEs) =>
Env (providedEs ++ handlerEs)
-> Env es -> IO (Env (providedEs ++ es))
copyRefs (Env Int
hoffset PrimArray Ref
hrefs IORef' Storage
hstorage) (Env Int
offset PrimArray Ref
refs0 IORef' Storage
storage) = do
  Bool -> IO () -> IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (IORef' Storage
hstorage IORef' Storage -> IORef' Storage -> Bool
forall a. Eq a => a -> a -> Bool
/= IORef' Storage
storage) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error [Char]
"storages do not match"
  let providedEsSize :: Int
providedEsSize = forall (es :: [Effect]). KnownEffects es => Int
knownEffectsLength @providedEs
      esSize :: Int
esSize = PrimArray Ref -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Ref
refs0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset
  MutablePrimArray RealWorld Ref
mrefs <- Int -> IO (MutablePrimArray (PrimState IO) Ref)
forall (m :: Type -> Type) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray (Int
providedEsSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
esSize)
  MutablePrimArray (PrimState IO) Ref
-> Int -> PrimArray Ref -> Int -> Int -> IO ()
forall (m :: Type -> Type) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray RealWorld Ref
MutablePrimArray (PrimState IO) Ref
mrefs Int
0 PrimArray Ref
hrefs Int
hoffset Int
providedEsSize
  MutablePrimArray (PrimState IO) Ref
-> Int -> PrimArray Ref -> Int -> Int -> IO ()
forall (m :: Type -> Type) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray RealWorld Ref
MutablePrimArray (PrimState IO) Ref
mrefs Int
providedEsSize PrimArray Ref
refs0 Int
offset Int
esSize
  PrimArray Ref
refs <- MutablePrimArray (PrimState IO) Ref -> IO (PrimArray Ref)
forall (m :: Type -> Type) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld Ref
MutablePrimArray (PrimState IO) Ref
mrefs
  Env (providedEs ++ es) -> IO (Env (providedEs ++ es))
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Env (providedEs ++ es) -> IO (Env (providedEs ++ es)))
-> Env (providedEs ++ es) -> IO (Env (providedEs ++ es))
forall a b. (a -> b) -> a -> b
$ Int -> PrimArray Ref -> IORef' Storage -> Env (providedEs ++ es)
forall (es :: [Effect]).
Int -> PrimArray Ref -> IORef' Storage -> Env es
Env Int
0 PrimArray Ref
refs IORef' Storage
storage