-- | 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