mirror of
https://github.com/haskell-effectful/effectful.git
synced 2024-11-27 11:44:45 +03:00
Add Effectful.Provider.List (#194)
This commit is contained in:
parent
87955a807e
commit
02ce340d05
@ -1,5 +1,6 @@
|
||||
# effectful-core-2.3.0.2 (2023-??-??)
|
||||
# effectful-core-2.3.1.0 (????-??-??)
|
||||
* Remove inaccurate information from the `Show` instance of `ErrorWrapper`.
|
||||
* Add `Effectful.Provider.List`, generalization of `Effectful.Provider`.
|
||||
|
||||
# effectful-core-2.3.0.1 (2023-11-13)
|
||||
* Prevent internal functions from appending call stack frames to handlers.
|
||||
|
@ -1,7 +1,7 @@
|
||||
cabal-version: 2.4
|
||||
build-type: Simple
|
||||
name: effectful-core
|
||||
version: 2.3.0.2
|
||||
version: 2.3.1.0
|
||||
license: BSD-3-Clause
|
||||
license-file: LICENSE
|
||||
category: Control
|
||||
@ -90,6 +90,7 @@ library
|
||||
Effectful.NonDet
|
||||
Effectful.Prim
|
||||
Effectful.Provider
|
||||
Effectful.Provider.List
|
||||
Effectful.Reader.Dynamic
|
||||
Effectful.Reader.Static
|
||||
Effectful.State.Dynamic
|
||||
|
@ -12,6 +12,8 @@ module Effectful.Internal.Effect
|
||||
, Subset(..)
|
||||
, KnownPrefix(..)
|
||||
, IsUnknownSuffixOf
|
||||
, type (++)
|
||||
, KnownEffects(..)
|
||||
|
||||
-- * Re-exports
|
||||
, Type
|
||||
@ -116,3 +118,22 @@ instance {-# INCOHERENT #-} KnownPrefix es where
|
||||
class (xs :: [Effect]) `IsUnknownSuffixOf` (es :: [Effect])
|
||||
instance {-# INCOHERENT #-} xs ~ es => xs `IsUnknownSuffixOf` es
|
||||
instance xs `IsUnknownSuffixOf` es => xs `IsUnknownSuffixOf` (e : es)
|
||||
|
||||
----
|
||||
|
||||
-- | Append two type-level lists together.
|
||||
type family (xs :: [Effect]) ++ (ys :: [Effect]) :: [Effect] where
|
||||
'[] ++ ys = ys
|
||||
(x : xs) ++ ys = x : xs ++ ys
|
||||
|
||||
infixr 5 ++
|
||||
|
||||
-- | Calculate length of a list of known effects.
|
||||
class KnownEffects (es :: [Effect]) where
|
||||
knownEffectsLength :: Int
|
||||
|
||||
instance KnownEffects es => KnownEffects (e : es) where
|
||||
knownEffectsLength = 1 + knownEffectsLength @es
|
||||
|
||||
instance KnownEffects '[] where
|
||||
knownEffectsLength = 0
|
||||
|
@ -192,8 +192,7 @@ copyRef (Env hoffset hrefs hstorage) (Env offset refs0 storage) = do
|
||||
error "storages do not match"
|
||||
let size = sizeofPrimArray refs0 - offset
|
||||
mrefs <- newPrimArray (size + 2)
|
||||
copyPrimArray mrefs 0 hrefs hoffset 2
|
||||
copyPrimArray mrefs 2 refs0 offset size
|
||||
writePrimArray mrefs 0 $ indexPrimArray hrefs hoffset
|
||||
writePrimArray mrefs 1 $ indexPrimArray hrefs (hoffset + 1)
|
||||
refs <- unsafeFreezePrimArray mrefs
|
||||
pure $ Env 0 refs storage
|
||||
|
144
effectful-core/src/Effectful/Provider/List.hs
Normal file
144
effectful-core/src/Effectful/Provider/List.hs
Normal file
@ -0,0 +1,144 @@
|
||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||
-- | Turn a handler of multiple effects into an effectful operation.
|
||||
--
|
||||
-- Generalization of "Effectful.Provider".
|
||||
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 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 @effects@ 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 (effects :: [Effect]) (input :: Type) (f :: Type -> Type) :: Effect
|
||||
|
||||
-- | A restricted variant of 'ProviderList' with unchanged return type of the
|
||||
-- handler.
|
||||
type ProviderList_ effs input = ProviderList effs input Identity
|
||||
|
||||
type instance DispatchOf (ProviderList effs input f) = Static NoSideEffects
|
||||
|
||||
data instance StaticRep (ProviderList effs input f) where
|
||||
ProviderList
|
||||
:: KnownEffects effs
|
||||
=> !(Env handlerEs)
|
||||
-> !(forall r. input -> Eff (effs ++ handlerEs) r -> Eff handlerEs (f r))
|
||||
-> StaticRep (ProviderList effs input f)
|
||||
|
||||
-- | Run the 'ProviderList' effect with a given handler.
|
||||
runProviderList
|
||||
:: KnownEffects effs
|
||||
=> (forall r. input -> Eff (effs ++ es) r -> Eff es (f r))
|
||||
-- ^ The handler.
|
||||
-> Eff (ProviderList effs input f : es) a
|
||||
-> Eff es a
|
||||
runProviderList run m = unsafeEff $ \es0 -> do
|
||||
inlineBracket
|
||||
(consEnv (ProviderList es0 run) relinkProviderList es0)
|
||||
unconsEnv
|
||||
(\es -> unEff m es)
|
||||
|
||||
-- | Run the 'Provider' effect with a given handler that doesn't change its
|
||||
-- return type.
|
||||
runProviderList_
|
||||
:: KnownEffects effs
|
||||
=> (forall r. input -> Eff (effs ++ es) r -> Eff es r)
|
||||
-- ^ The handler.
|
||||
-> Eff (ProviderList_ effs input : es) a
|
||||
-> Eff es a
|
||||
runProviderList_ run = runProviderList $ \input -> coerce . run input
|
||||
|
||||
-- | Run the handler.
|
||||
provideList
|
||||
:: forall effs f es a
|
||||
. ProviderList effs () f :> es
|
||||
=> Eff (effs ++ es) a
|
||||
-> Eff es (f a)
|
||||
provideList = provideListWith @effs ()
|
||||
|
||||
-- | Run the handler with unchanged return type.
|
||||
provideList_
|
||||
:: forall effs es a
|
||||
. ProviderList_ effs () :> es
|
||||
=> Eff (effs ++ es) a
|
||||
-> Eff es a
|
||||
provideList_ = provideListWith_ @effs ()
|
||||
|
||||
-- | Run the handler with a given input.
|
||||
provideListWith
|
||||
:: forall effs input f es a
|
||||
. ProviderList effs input f :> es
|
||||
=> input
|
||||
-- ^ The input to the handler.
|
||||
-> Eff (effs ++ es) a
|
||||
-> Eff es (f a)
|
||||
provideListWith input action = unsafeEff $ \es -> do
|
||||
ProviderList (handlerEs :: Env handlerEs) run <- getEnv @(ProviderList effs input f) es
|
||||
(`unEff` handlerEs) . run input . unsafeEff $ \eHandlerEs -> do
|
||||
unEff action =<< copyRefs @effs @handlerEs eHandlerEs es
|
||||
|
||||
-- | Run the handler that doesn't change its return type with a given input.
|
||||
provideListWith_
|
||||
:: forall effs input es a
|
||||
. ProviderList_ effs input :> es
|
||||
=> input
|
||||
-- ^ The input to the handler.
|
||||
-> Eff (effs ++ es) a
|
||||
-> Eff es a
|
||||
provideListWith_ input = adapt . provideListWith @effs input
|
||||
where
|
||||
adapt :: Eff es (Identity a) -> Eff es a
|
||||
adapt = coerce
|
||||
|
||||
----------------------------------------
|
||||
-- Helpers
|
||||
|
||||
relinkProviderList :: Relinker StaticRep (ProviderList e input f)
|
||||
relinkProviderList = Relinker $ \relink (ProviderList handlerEs run) -> do
|
||||
newHandlerEs <- relink handlerEs
|
||||
pure $ ProviderList newHandlerEs run
|
||||
|
||||
copyRefs
|
||||
:: forall effs handlerEs es
|
||||
. KnownEffects effs
|
||||
=> Env (effs ++ handlerEs)
|
||||
-> Env es
|
||||
-> IO (Env (effs ++ es))
|
||||
copyRefs (Env hoffset hrefs hstorage) (Env offset refs0 storage) = do
|
||||
when (hstorage /= storage) $ do
|
||||
error "storages do not match"
|
||||
let size = sizeofPrimArray refs0 - offset
|
||||
effsSize = 2 * knownEffectsLength @effs
|
||||
mrefs <- newPrimArray (size + effsSize)
|
||||
copyPrimArray mrefs 0 hrefs hoffset effsSize
|
||||
copyPrimArray mrefs effsSize refs0 offset size
|
||||
refs <- unsafeFreezePrimArray mrefs
|
||||
pure $ Env 0 refs storage
|
@ -1,3 +1,7 @@
|
||||
# effectful-2.3.1.0 (????-??-??)
|
||||
* Remove inaccurate information from the `Show` instance of `ErrorWrapper`.
|
||||
* Add `Effectful.Provider.List`, generalization of `Effectful.Provider`.
|
||||
|
||||
# effectful-2.3.0.0 (2023-09-13)
|
||||
* Deprecate `withConcEffToIO`.
|
||||
* Make `withEffToIO` take an explicit unlifting strategy for the sake of
|
||||
|
@ -1,7 +1,7 @@
|
||||
cabal-version: 2.4
|
||||
build-type: Simple
|
||||
name: effectful
|
||||
version: 2.3.0.0
|
||||
version: 2.3.1.0
|
||||
license: BSD-3-Clause
|
||||
license-file: LICENSE
|
||||
category: Control
|
||||
@ -68,7 +68,7 @@ library
|
||||
, async >= 2.2.2
|
||||
, bytestring >= 0.10
|
||||
, directory >= 1.3.2
|
||||
, effectful-core >= 2.3.0.0 && < 2.3.1.0
|
||||
, effectful-core >= 2.3.1.0 && < 2.3.2.0
|
||||
, process >= 1.6.9
|
||||
|
||||
, time >= 1.9.2
|
||||
@ -112,6 +112,7 @@ library
|
||||
, Effectful.NonDet
|
||||
, Effectful.Prim
|
||||
, Effectful.Provider
|
||||
, Effectful.Provider.List
|
||||
, Effectful.Reader.Dynamic
|
||||
, Effectful.Reader.Static
|
||||
, Effectful.State.Dynamic
|
||||
|
Loading…
Reference in New Issue
Block a user