heftia-effects-0.7.0.0: higher-order algebraic effects done right
Copyright(c) 2024-2025 Sayo contributors
LicenseMPL-2.0 (see the LICENSE file)
Maintainerymdfield@outlook.jp
Safe HaskellNone
LanguageGHC2021

Control.Monad.Hefty.Unlift

Description

Realizes unliftio in the form of higher-order effects.

Documentation

runUnliftBase :: Monad m => Eff '[UnliftBase m, Emb m] a -> m a Source #

data UnliftBase (b :: Type -> Type) (f :: Type -> Type) a where #

Constructors

WithRunInBase :: forall (f :: Type -> Type) (b :: Type -> Type) a. ((forall x. f x -> b x) -> b a) -> UnliftBase b f a 

Instances

Instances details
HFunctor (UnliftBase b) 
Instance details

Defined in Data.Effect

Methods

hfmap :: (forall x. f x -> g x) -> UnliftBase b f a -> UnliftBase b g a #

type FormOf (UnliftBase b) 
Instance details

Defined in Data.Effect

type LabelOf (UnliftBase b) 
Instance details

Defined in Data.Effect

type OrderOf (UnliftBase b) 
Instance details

Defined in Data.Effect

pattern WithRunInIO :: ((f ~> IO) -> IO a) -> UnliftIO f a #

withRunInBase :: forall b a f (es :: [Effect]) (ff :: (Type -> Type) -> Type -> Type) (c :: (Type -> Type) -> Constraint). (Free c ff, f ~ Eff ff es, UnliftBase b :> es) => ((forall x. f x -> b x) -> b a) -> f a #

withRunInBase' :: forall {k} (key :: k) b a f (es :: [Effect]) (ff :: (Type -> Type) -> Type -> Type) (c :: (Type -> Type) -> Constraint). (Free c ff, f ~ Eff ff es, Has key (UnliftBase b) es) => ((forall x. f x -> b x) -> b a) -> f a #

withRunInBase'' :: forall {k} (tag :: k) b a f (es :: [Effect]) (ff :: (Type -> Type) -> Type -> Type) (c :: (Type -> Type) -> Constraint). (Free c ff, f ~ Eff ff es, Tagged tag (UnliftBase b) :> es) => ((forall x. f x -> b x) -> b a) -> f a #

withRunInBase'_ :: forall b a f (es :: [Effect]) (ff :: (Type -> Type) -> Type -> Type) (c :: (Type -> Type) -> Constraint). (Free c ff, f ~ Eff ff es, In (UnliftBase b) es) => ((forall x. f x -> b x) -> b a) -> f a #

withRunInIO :: forall (es :: [Effect]) (ff :: (Type -> Type) -> Type -> Type) a (c :: (Type -> Type) -> Constraint). (UnliftIO :> es, Free c ff) => ((Eff ff es ~> IO) -> IO a) -> Eff ff es a #