-- | This module defines the 'M' wrapper monad and the 'Eff' phantom constraint. All safe functionalities in this -- module are reexported in the "Avail" module, so you wouldn't need to import this module most of the times. {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE CPP #-} {-# OPTIONS_HADDOCK not-home #-} module Avail.Internal where import Control.Monad.Fix (MonadFix) import Control.Monad.Zip (MonadZip) import Data.Kind (Constraint, Type) import Data.Proxy (Proxy (Proxy)) import Unsafe.Coerce (unsafeCoerce) #ifdef AVAIL_semigroupoids import Data.Functor.Apply (Apply) import Data.Functor.Bind (Bind (join, (>>-))) #endif -- | The 'M' monad transformer acts as a /barrier of effects/. For example, for a monad type @App@ and any -- effect typeclass @MonadOvO@ that @App@ has an instance of, the constraint @Eff MonadOvO@ is required to perform -- the methods of @MonadOvO@ in the monad @'M' App@ as defined for the @App@ monad. -- -- In particular, 'M' is expected to be used on a __concrete__ monad instead of a /polymorphic/ one. This is -- particularly good in terms of program performance, and generally means instead of writing this: -- -- @ -- f :: 'Control.Monad.State.MonadState' 'Int' m => m () -- @ -- -- You should write -- -- @ -- f :: 'Eff' ('Control.Monad.State.MonadState' 'Int') => 'M' App () -- @ -- -- where @App@ is a monad stack of your choice that has support of @'Control.Monad.State.MonadState' 'Int'@. This also -- means there is no 'Control.Monad.Trans.Class.MonadTrans' instance for 'M'. -- -- Note: __you should not define instances of 'M' for effect typeclasses directly by hand__ as that is error-prone -- and may create holes in effect management. For defining instances of effect typeclasses for 'M', check out -- the "Avail.Derive" module and specifically the 'Avail.Derive.avail' and 'Avail.Derive.avail'' TH functions. -- -- Also keep in mind that typeclasses inside @mtl@, @exceptions@, @unliftio@, @monad-control@ and @capability@ work -- with 'M' out-of-the-box so no instance for them is needed to be defined on 'M' /by you/. newtype M m a = UnsafeLift (m a) -- ^ Unsafely lift an @m@ action into @'M' m@. This completely sidesteps the -- effect management mechanism; __You should not use this.__ deriving newtype (a -> M m b -> M m a (a -> b) -> M m a -> M m b (forall a b. (a -> b) -> M m a -> M m b) -> (forall a b. a -> M m b -> M m a) -> Functor (M m) forall a b. a -> M m b -> M m a forall a b. (a -> b) -> M m a -> M m b forall (m :: * -> *) a b. Functor m => a -> M m b -> M m a forall (m :: * -> *) a b. Functor m => (a -> b) -> M m a -> M m b forall (f :: * -> *). (forall a b. (a -> b) -> f a -> f b) -> (forall a b. a -> f b -> f a) -> Functor f <$ :: a -> M m b -> M m a $c<$ :: forall (m :: * -> *) a b. Functor m => a -> M m b -> M m a fmap :: (a -> b) -> M m a -> M m b $cfmap :: forall (m :: * -> *) a b. Functor m => (a -> b) -> M m a -> M m b Functor, Functor (M m) a -> M m a Functor (M m) -> (forall a. a -> M m a) -> (forall a b. M m (a -> b) -> M m a -> M m b) -> (forall a b c. (a -> b -> c) -> M m a -> M m b -> M m c) -> (forall a b. M m a -> M m b -> M m b) -> (forall a b. M m a -> M m b -> M m a) -> Applicative (M m) M m a -> M m b -> M m b M m a -> M m b -> M m a M m (a -> b) -> M m a -> M m b (a -> b -> c) -> M m a -> M m b -> M m c forall a. a -> M m a forall a b. M m a -> M m b -> M m a forall a b. M m a -> M m b -> M m b forall a b. M m (a -> b) -> M m a -> M m b forall a b c. (a -> b -> c) -> M m a -> M m b -> M m c forall (f :: * -> *). Functor f -> (forall a. a -> f a) -> (forall a b. f (a -> b) -> f a -> f b) -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c) -> (forall a b. f a -> f b -> f b) -> (forall a b. f a -> f b -> f a) -> Applicative f forall (m :: * -> *). Applicative m => Functor (M m) forall (m :: * -> *) a. Applicative m => a -> M m a forall (m :: * -> *) a b. Applicative m => M m a -> M m b -> M m a forall (m :: * -> *) a b. Applicative m => M m a -> M m b -> M m b forall (m :: * -> *) a b. Applicative m => M m (a -> b) -> M m a -> M m b forall (m :: * -> *) a b c. Applicative m => (a -> b -> c) -> M m a -> M m b -> M m c <* :: M m a -> M m b -> M m a $c<* :: forall (m :: * -> *) a b. Applicative m => M m a -> M m b -> M m a *> :: M m a -> M m b -> M m b $c*> :: forall (m :: * -> *) a b. Applicative m => M m a -> M m b -> M m b liftA2 :: (a -> b -> c) -> M m a -> M m b -> M m c $cliftA2 :: forall (m :: * -> *) a b c. Applicative m => (a -> b -> c) -> M m a -> M m b -> M m c <*> :: M m (a -> b) -> M m a -> M m b $c<*> :: forall (m :: * -> *) a b. Applicative m => M m (a -> b) -> M m a -> M m b pure :: a -> M m a $cpure :: forall (m :: * -> *) a. Applicative m => a -> M m a $cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (M m) Applicative, Applicative (M m) a -> M m a Applicative (M m) -> (forall a b. M m a -> (a -> M m b) -> M m b) -> (forall a b. M m a -> M m b -> M m b) -> (forall a. a -> M m a) -> Monad (M m) M m a -> (a -> M m b) -> M m b M m a -> M m b -> M m b forall a. a -> M m a forall a b. M m a -> M m b -> M m b forall a b. M m a -> (a -> M m b) -> M m b forall (m :: * -> *). Monad m => Applicative (M m) forall (m :: * -> *) a. Monad m => a -> M m a forall (m :: * -> *) a b. Monad m => M m a -> M m b -> M m b forall (m :: * -> *) a b. Monad m => M m a -> (a -> M m b) -> M m b forall (m :: * -> *). Applicative m -> (forall a b. m a -> (a -> m b) -> m b) -> (forall a b. m a -> m b -> m b) -> (forall a. a -> m a) -> Monad m return :: a -> M m a $creturn :: forall (m :: * -> *) a. Monad m => a -> M m a >> :: M m a -> M m b -> M m b $c>> :: forall (m :: * -> *) a b. Monad m => M m a -> M m b -> M m b >>= :: M m a -> (a -> M m b) -> M m b $c>>= :: forall (m :: * -> *) a b. Monad m => M m a -> (a -> M m b) -> M m b $cp1Monad :: forall (m :: * -> *). Monad m => Applicative (M m) Monad, Monad (M m) Monad (M m) -> (forall a. (a -> M m a) -> M m a) -> MonadFix (M m) (a -> M m a) -> M m a forall a. (a -> M m a) -> M m a forall (m :: * -> *). Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m forall (m :: * -> *). MonadFix m => Monad (M m) forall (m :: * -> *) a. MonadFix m => (a -> M m a) -> M m a mfix :: (a -> M m a) -> M m a $cmfix :: forall (m :: * -> *) a. MonadFix m => (a -> M m a) -> M m a $cp1MonadFix :: forall (m :: * -> *). MonadFix m => Monad (M m) MonadFix, Monad (M m) Monad (M m) -> (forall a b. M m a -> M m b -> M m (a, b)) -> (forall a b c. (a -> b -> c) -> M m a -> M m b -> M m c) -> (forall a b. M m (a, b) -> (M m a, M m b)) -> MonadZip (M m) M m a -> M m b -> M m (a, b) M m (a, b) -> (M m a, M m b) (a -> b -> c) -> M m a -> M m b -> M m c forall a b. M m a -> M m b -> M m (a, b) forall a b. M m (a, b) -> (M m a, M m b) forall a b c. (a -> b -> c) -> M m a -> M m b -> M m c forall (m :: * -> *). Monad m -> (forall a b. m a -> m b -> m (a, b)) -> (forall a b c. (a -> b -> c) -> m a -> m b -> m c) -> (forall a b. m (a, b) -> (m a, m b)) -> MonadZip m forall (m :: * -> *). MonadZip m => Monad (M m) forall (m :: * -> *) a b. MonadZip m => M m a -> M m b -> M m (a, b) forall (m :: * -> *) a b. MonadZip m => M m (a, b) -> (M m a, M m b) forall (m :: * -> *) a b c. MonadZip m => (a -> b -> c) -> M m a -> M m b -> M m c munzip :: M m (a, b) -> (M m a, M m b) $cmunzip :: forall (m :: * -> *) a b. MonadZip m => M m (a, b) -> (M m a, M m b) mzipWith :: (a -> b -> c) -> M m a -> M m b -> M m c $cmzipWith :: forall (m :: * -> *) a b c. MonadZip m => (a -> b -> c) -> M m a -> M m b -> M m c mzip :: M m a -> M m b -> M m (a, b) $cmzip :: forall (m :: * -> *) a b. MonadZip m => M m a -> M m b -> M m (a, b) $cp1MonadZip :: forall (m :: * -> *). MonadZip m => Monad (M m) MonadZip) #ifdef AVAIL_semigroupoids deriving newtype instance Apply m => Apply (M m) instance Bind m => Bind (M m) where UnsafeLift m >>- f = UnsafeLift $ m >>- (unM . f) join (UnsafeLift m) = UnsafeLift $ join $ unM <$> m #endif -- | The kind of /effect typeclasses/, i.e. those that define a set of operations on a monad. Examples include -- 'Control.Monad.IO.Class.MonadIO' and 'Control.Monad.Reader.MonadReader'. -- -- This type is the same as the 'Capability.Constraints.Capability' type in @capability@. type Effect = (Type -> Type) -> Constraint -- | Any 'Effect' being used with @avail@ should have an instance of this class. Specifically, this class stores -- the /superclasses/ of effect typeclasses. For example, 'Control.Monad.IO.Unlift.MonadUnliftIO' has a superclass -- 'Control.Monad.IO.Class.MonadIO'. -- -- You won't need to define instances of this by hand; instead, use the 'Avail.Derive.avail'' Template Haskell function. class KnownList (Superclasses e) => IsEff (e :: Effect) where -- | The superclasses of this typeclass. type Superclasses e :: [Effect] -- | The /primitive/ phantom effect constraint that does not take superclasses into account. You should not use this -- directly; use 'Eff' or 'Effs' instead. Additionally, you definitely shouldn't define instances for this class. class Eff' (e :: Effect) where -- | The dummy method of the phantom typeclass, to be instantiated via the reflection trick in 'rip''. instEffect :: Proxy e instEffect = [Char] -> Proxy e forall a. HasCallStack => [Char] -> a error [Char] "unimplemented" -- | The constraint that indicates an effect is available for use, i.e. you can perform methods defined by instances -- of the effect typeclass @e@ in a 'M' monad. type Eff (e :: Effect) = (Eff' e, Effs (Superclasses e)) -- | Convenient alias for @('Eff' e1, 'Eff' e2, ..., 'Eff' en)@. type family Effs (es :: [Effect]) :: Constraint where Effs '[] = () Effs (e ': es) = (Eff e, Effs es) -- | The newtype wrapper used to circumvent the impredicative problem of GHC and perform the reflection trick in -- 'rip''. You have no reason to use this directly. newtype InstEff e a = InstEff (Eff' e => a) -- | Brutally rip off an 'Eff'' constraint, a la -- [the reflection trick](https://hackage.haskell.org/package/base-4.16.0.0/docs/Unsafe-Coerce.html#v:unsafeCoerce). -- __This is highly unsafe__ in terms of effect management. rip' :: forall e a. (Eff' e => a) -> a rip' :: (Eff' e => a) -> a rip' Eff' e => a x = InstEff e a -> Proxy Any -> a forall a b. a -> b unsafeCoerce ((Eff' e => a) -> InstEff e a forall (e :: Effect) a. (Eff' e => a) -> InstEff e a InstEff @e Eff' e => a x) Proxy Any forall k (t :: k). Proxy t Proxy -- | Brutally rip off an 'Eff' constraint. This means 'rip''ing off the 'Eff'' constraint of the current 'Effect' -- and then 'rips' off constraints of all 'Superclasses' recursively. __This is highly unsafe__ in terms of effect -- management. rip :: forall e a. IsEff e => (Eff e => a) -> a rip :: (Eff e => a) -> a rip Eff e => a x = forall a. KnownList (Superclasses e) => (Effs (Superclasses e) => a) -> a forall (es :: [Effect]) a. KnownList es => (Effs es => a) -> a rips @(Superclasses e) ((Effs (Superclasses e) => a) -> a) -> (Effs (Superclasses e) => a) -> a forall a b. (a -> b) -> a -> b $ (Eff' e => a) -> a forall (e :: Effect) a. (Eff' e => a) -> a rip' @e Eff e => a Eff' e => a x -- | The list of effect typeclasses @es@ is known at compile time. This is required for functions like 'runM'. class KnownList (es :: [Effect]) where -- | Brutally rip off many 'Eff' constraints. __This is highly unsafe__ in terms of effect management. rips :: (Effs es => a) -> a rips Effs es => a _ = [Char] -> a forall a. HasCallStack => [Char] -> a error [Char] "unimplemented" instance KnownList '[] where rips :: (Effs '[] => a) -> a rips Effs '[] => a x = a Effs '[] => a x instance (IsEff e, KnownList es) => KnownList (e ': es) where rips :: (Effs (e : es) => a) -> a rips Effs (e : es) => a x = forall a. KnownList es => (Effs es => a) -> a forall (es :: [Effect]) a. KnownList es => (Effs es => a) -> a rips @es ((Effs es => a) -> a) -> (Effs es => a) -> a forall a b. (a -> b) -> a -> b $ (Eff e => a) -> a forall (e :: Effect) a. IsEff e => (Eff e => a) -> a rip @e Eff e => a Effs (e : es) => a x -- | Unwrap the 'M' monad into the underlying concrete monad. This is rarely needed as most of the time you would also -- want to eliminate 'Eff' constraints at the same time; for that see 'runM'. unM :: M m a -> m a unM :: M m a -> m a unM (UnsafeLift m a m) = m a m -- | Unwrap the 'M' monad into the underlying concrete monad and also eliminating 'Eff' constraints. You need -- @TypeApplications@ in order to specify the list of 'Effect's you want to eliminate 'Eff' constraints for: -- -- @ -- 'runM' @'[MonadReader Env, MonadState Store, MonadError MyErr] app -- @ -- -- Note that functions like '(Data.Function.&)' generally does not work with this function; either apply directly or -- use '($)' only. runM :: forall es m a. KnownList es => (Effs es => M m a) -> m a runM :: (Effs es => M m a) -> m a runM Effs es => M m a m = forall a. KnownList es => (Effs es => a) -> a forall (es :: [Effect]) a. KnownList es => (Effs es => a) -> a rips @es ((Effs es => m a) -> m a) -> (Effs es => m a) -> m a forall a b. (a -> b) -> a -> b $ M m a -> m a forall k (m :: k -> *) (a :: k). M m a -> m a unM M m a Effs es => M m a m