module Effectful.Provider
(
Provider
, Provider_
, runProvider
, runProvider_
, provide
, provide_
, provideWith
, provideWith_
) where
import Control.Monad
import Data.Coerce
import Data.Functor.Identity
import Data.Kind (Type)
import Data.Primitive.PrimArray
import Effectful
import Effectful.Dispatch.Static
import Effectful.Dispatch.Static.Primitive
import Effectful.Internal.Env (Env(..))
import Effectful.Internal.Utils
data Provider (e :: Effect) (input :: Type) (f :: Type -> Type) :: Effect
type Provider_ e input = Provider e input Identity
type instance DispatchOf (Provider e input f) = Static NoSideEffects
data instance StaticRep (Provider e input f) where
Provider :: !(Env handlerEs)
-> !(forall r. input -> Eff (e : handlerEs) r -> Eff handlerEs (f r))
-> StaticRep (Provider e input f)
runProvider
:: (forall r. input -> Eff (e : es) r -> Eff es (f r))
-> Eff (Provider e input f : es) a
-> Eff es a
runProvider :: forall input (e :: Effect) (es :: [Effect]) (f :: Type -> Type) a.
(forall r. input -> Eff (e : es) r -> Eff es (f r))
-> Eff (Provider e input f : es) a -> Eff es a
runProvider forall r. input -> Eff (e : es) r -> Eff es (f r)
run Eff (Provider e input f : es) a
m = forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff forall a b. (a -> b) -> a -> b
$ \Env es
es0 -> do
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
inlineBracket
(forall (e :: Effect) (es :: [Effect]).
EffectRep (DispatchOf e) e
-> Relinker (EffectRep (DispatchOf e)) e
-> Env es
-> IO (Env (e : es))
consEnv (forall (handlerEs :: [Effect]) input (e :: Effect)
(f :: Type -> Type).
Env handlerEs
-> (forall r.
input -> Eff (e : handlerEs) r -> Eff handlerEs (f r))
-> StaticRep (Provider e input f)
Provider Env es
es0 forall r. input -> Eff (e : es) r -> Eff es (f r)
run) forall (e :: Effect) input (f :: Type -> Type).
Relinker StaticRep (Provider e input f)
relinkProvider Env es
es0)
forall (e :: Effect) (es :: [Effect]). Env (e : es) -> IO ()
unconsEnv
(\Env (Provider e input f : es)
es -> forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff Eff (Provider e input f : es) a
m Env (Provider e input f : es)
es)
runProvider_
:: (forall r. input -> Eff (e : es) r -> Eff es r)
-> Eff (Provider_ e input : es) a
-> Eff es a
runProvider_ :: forall input (e :: Effect) (es :: [Effect]) a.
(forall r. input -> Eff (e : es) r -> Eff es r)
-> Eff (Provider_ e input : es) a -> Eff es a
runProvider_ forall r. input -> Eff (e : es) r -> Eff es r
run = forall input (e :: Effect) (es :: [Effect]) (f :: Type -> Type) a.
(forall r. input -> Eff (e : es) r -> Eff es (f r))
-> Eff (Provider e input f : es) a -> Eff es a
runProvider forall a b. (a -> b) -> a -> b
$ \input
input -> coerce :: forall a b. Coercible a b => a -> b
coerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. input -> Eff (e : es) r -> Eff es r
run input
input
provide :: Provider e () f :> es => Eff (e : es) a -> Eff es (f a)
provide :: forall (e :: Effect) (f :: Type -> Type) (es :: [Effect]) a.
(Provider e () f :> es) =>
Eff (e : es) a -> Eff es (f a)
provide = forall (e :: Effect) input (f :: Type -> Type) (es :: [Effect]) a.
(Provider e input f :> es) =>
input -> Eff (e : es) a -> Eff es (f a)
provideWith ()
provide_ :: Provider_ e () :> es => Eff (e : es) a -> Eff es a
provide_ :: forall (e :: Effect) (es :: [Effect]) a.
(Provider_ e () :> es) =>
Eff (e : es) a -> Eff es a
provide_ = forall (e :: Effect) input (es :: [Effect]) a.
(Provider_ e input :> es) =>
input -> Eff (e : es) a -> Eff es a
provideWith_ ()
provideWith
:: Provider e input f :> es
=> input
-> Eff (e : es) a
-> Eff es (f a)
provideWith :: forall (e :: Effect) input (f :: Type -> Type) (es :: [Effect]) a.
(Provider e input f :> es) =>
input -> Eff (e : es) a -> Eff es (f a)
provideWith input
input Eff (e : es) a
action = forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff forall a b. (a -> b) -> a -> b
$ \Env es
es -> do
Provider Env handlerEs
handlerEs forall r. input -> Eff (e : handlerEs) r -> Eff handlerEs (f r)
run <- forall (e :: Effect) (es :: [Effect]).
(e :> es) =>
Env es -> IO (EffectRep (DispatchOf e) e)
getEnv Env es
es
(forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
`unEff` Env handlerEs
handlerEs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. input -> Eff (e : handlerEs) r -> Eff handlerEs (f r)
run input
input forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
unsafeEff forall a b. (a -> b) -> a -> b
$ \Env (e : handlerEs)
eHandlerEs -> do
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff Eff (e : es) a
action forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (e :: Effect) (handlerEs :: [Effect]) (es :: [Effect]).
Env (e : handlerEs) -> Env es -> IO (Env (e : es))
copyRef Env (e : handlerEs)
eHandlerEs Env es
es
provideWith_
:: Provider_ e input :> es
=> input
-> Eff (e : es) a
-> Eff es a
provideWith_ :: forall (e :: Effect) input (es :: [Effect]) a.
(Provider_ e input :> es) =>
input -> Eff (e : es) a -> Eff es a
provideWith_ input
input = forall (es :: [Effect]) a. Eff es (Identity a) -> Eff es a
adapt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (e :: Effect) input (f :: Type -> Type) (es :: [Effect]) a.
(Provider e input f :> es) =>
input -> Eff (e : es) a -> Eff es (f a)
provideWith input
input
where
adapt :: Eff es (Identity a) -> Eff es a
adapt :: forall (es :: [Effect]) a. Eff es (Identity a) -> Eff es a
adapt = coerce :: forall a b. Coercible a b => a -> b
coerce
relinkProvider :: Relinker StaticRep (Provider e input f)
relinkProvider :: forall (e :: Effect) input (f :: Type -> Type).
Relinker StaticRep (Provider e input f)
relinkProvider = forall (rep :: Effect -> Type) (e :: Effect).
((forall (es :: [Effect]). Env es -> IO (Env es))
-> rep e -> IO (rep e))
-> Relinker rep e
Relinker forall a b. (a -> b) -> a -> b
$ \forall (es :: [Effect]). Env es -> IO (Env es)
relink (Provider Env handlerEs
handlerEs forall r. input -> Eff (e : handlerEs) r -> Eff handlerEs (f r)
run) -> do
Env handlerEs
newHandlerEs <- forall (es :: [Effect]). Env es -> IO (Env es)
relink Env handlerEs
handlerEs
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (handlerEs :: [Effect]) input (e :: Effect)
(f :: Type -> Type).
Env handlerEs
-> (forall r.
input -> Eff (e : handlerEs) r -> Eff handlerEs (f r))
-> StaticRep (Provider e input f)
Provider Env handlerEs
newHandlerEs forall r. input -> Eff (e : handlerEs) r -> Eff handlerEs (f r)
run
copyRef :: Env (e : handlerEs) -> Env es -> IO (Env (e : es))
copyRef :: forall (e :: Effect) (handlerEs :: [Effect]) (es :: [Effect]).
Env (e : handlerEs) -> Env es -> IO (Env (e : es))
copyRef (Env Int
hoffset PrimArray Int
hrefs IORef' Storage
hstorage) (Env Int
offset PrimArray Int
refs0 IORef' Storage
storage) = do
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (IORef' Storage
hstorage forall a. Eq a => a -> a -> Bool
/= IORef' Storage
storage) forall a b. (a -> b) -> a -> b
$ do
forall a. HasCallStack => [Char] -> a
error [Char]
"storages do not match"
let size :: Int
size = forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Int
refs0 forall a. Num a => a -> a -> a
- Int
offset
MutablePrimArray RealWorld Int
mrefs <- forall (m :: Type -> Type) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray (Int
size forall a. Num a => a -> a -> a
+ Int
2)
forall (m :: Type -> Type) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> PrimArray a -> Int -> Int -> m ()
copyPrimArray MutablePrimArray RealWorld Int
mrefs Int
2 PrimArray Int
refs0 Int
offset Int
size
forall a (m :: Type -> Type).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Int
mrefs Int
0 forall a b. (a -> b) -> a -> b
$ forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray Int
hrefs Int
hoffset
forall a (m :: Type -> Type).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray RealWorld Int
mrefs Int
1 forall a b. (a -> b) -> a -> b
$ forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray Int
hrefs (Int
hoffset forall a. Num a => a -> a -> a
+ Int
1)
PrimArray Int
refs <- forall (m :: Type -> Type) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray RealWorld Int
mrefs
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (es :: [Effect]).
Int -> PrimArray Int -> IORef' Storage -> Env es
Env Int
0 PrimArray Int
refs IORef' Storage
storage