{-# OPTIONS_HADDOCK not-home #-}
-- |
-- Copyright: (c) 2021 Xy Ren
-- License: BSD3
-- Maintainer: xy.r@outlook.com
-- Stability: unstable
-- Portability: non-portable (GHC only)
--
-- This module contains the definition of the 'Eff' monad, as well as reexports of some shared utilities in the
-- internal modules. Most of the times, you won't need to use this module directly; user-facing functionalities are all
-- exported via the "Cleff" module.
--
-- __This is an /internal/ module and its API may change even between minor versions.__ Therefore you should be
-- extra careful if you're to depend on this module.
module Cleff.Internal.Monad
  ( -- * The 'Eff' monad
    Eff (Eff, unEff)
  , Effect
  , Env (Env)
  , HandlerPtr (HandlerPtr, unHandlerPtr)
    -- * Constraints
  , (:>)
  , (:>>)
  , KnownList
  , Subset
    -- * Misc types
  , type (++)
  , type (~>)
  ) where

import           Cleff.Internal.Stack (Effect, HandlerPtr (HandlerPtr, unHandlerPtr), KnownList, Stack, Subset,
                                       type (++), type (:>), type (:>>))
import           Control.Applicative  (Applicative (liftA2))
import           Control.Monad.Fix    (MonadFix (mfix))
import           Control.Monad.Zip    (MonadZip (munzip, mzipWith))
import           Data.Any             (Any)
import           Data.Monoid          (Ap (Ap))
import           Data.RadixVec        (RadixVec)
import           Data.String          (IsString (fromString))

-- * The 'Eff' monad

-- | The extensible effects monad. The monad @'Eff' es@ is capable of performing any effect in the /effect stack/ @es@,
-- which is a type-level list that holds all effects available.
--
-- The best practice is to always use a polymorphic type variable for the effect stack @es@, and then use the type
-- operator '(:>)' in constraints to indicate what effects are available in the stack. For example,
--
-- @
-- ('Cleff.Reader.Reader' 'String' ':>' es, 'Cleff.State.State' 'Bool' ':>' es) => 'Eff' es 'Integer'
-- @
--
-- means you can perform operations of the @'Cleff.Reader.Reader' 'String'@ effect and the @'Cleff.State.State' 'Bool'@
-- effect in a computation returning an 'Integer'. A convenient shorthand, '(:>>)', can also be used to indicate
-- multiple effects being in a stack:
--
-- @
-- '['Cleff.Reader.Reader' 'String', 'Cleff.State.State' 'Bool'] ':>>' es => 'Eff' es 'Integer'
-- @
--
-- The reason why you should always use a polymorphic effect stack as opposed to a concrete list of effects are that:
--
-- * it can contain other effects that are used by computations other than the current one, and
-- * it does not require you to run the effects in any particular order.
type role Eff nominal representational
newtype Eff es a = Eff { Eff es a -> Env es -> IO a
unEff :: Env es -> IO a }
  -- ^ The effect monad receives an effect environment 'Env' that contains all effect handlers and produces an 'IO'
  -- action.

-- | The /effect environment/ that corresponds effects in the stack to their respective handlers. This
-- structure simulates memory: handlers are retrieved via pointers ('HandlerPtr's), and for each effect in the stack
-- we can either change what pointer it uses or change the handler the pointer points to. The former is used for global
-- effect interpretation ('Cleff.reinterpretN') and the latter for local interpretation ('Cleff.toEffWith') in order to
-- retain correct HO semantics. For more details on this see https://github.com/re-xyr/cleff/issues/5.
type role Env nominal
data Env (es :: [Effect]) = Env
  {-# UNPACK #-} !(Stack es) -- ^ The effect stack storing pointers to handlers.
  {-# UNPACK #-} !(RadixVec Any) -- ^ The storage that corresponds pointers to handlers.

instance Functor (Eff es) where
  fmap :: (a -> b) -> Eff es a -> Eff es b
fmap a -> b
f (Eff Env es -> IO a
x) = (Env es -> IO b) -> Eff es b
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
Eff ((a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (IO a -> IO b) -> (Env es -> IO a) -> Env es -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env es -> IO a
x)
  a
x <$ :: a -> Eff es b -> Eff es a
<$ Eff Env es -> IO b
y = (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
Eff \Env es
es -> a
x a -> IO b -> IO a
forall (f :: Type -> Type) a b. Functor f => a -> f b -> f a
<$ Env es -> IO b
y Env es
es

instance Applicative (Eff es) where
  pure :: a -> Eff es a
pure = (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
Eff ((Env es -> IO a) -> Eff es a)
-> (a -> Env es -> IO a) -> a -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> Env es -> IO a
forall a b. a -> b -> a
const (IO a -> Env es -> IO a) -> (a -> IO a) -> a -> Env es -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
  Eff Env es -> IO (a -> b)
f <*> :: Eff es (a -> b) -> Eff es a -> Eff es b
<*> Eff Env es -> IO a
x = (Env es -> IO b) -> Eff es b
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
Eff \Env es
es -> Env es -> IO (a -> b)
f Env es
es IO (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Env es -> IO a
x Env es
es
  Eff Env es -> IO a
x <* :: Eff es a -> Eff es b -> Eff es a
<*  Eff Env es -> IO b
y = (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
Eff \Env es
es -> Env es -> IO a
x Env es
es IO a -> IO b -> IO a
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<*  Env es -> IO b
y Env es
es
  Eff Env es -> IO a
x  *> :: Eff es a -> Eff es b -> Eff es b
*> Eff Env es -> IO b
y = (Env es -> IO b) -> Eff es b
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
Eff \Env es
es -> Env es -> IO a
x Env es
es  IO a -> IO b -> IO b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> Env es -> IO b
y Env es
es
  liftA2 :: (a -> b -> c) -> Eff es a -> Eff es b -> Eff es c
liftA2 a -> b -> c
f (Eff Env es -> IO a
x) (Eff Env es -> IO b
y) = (Env es -> IO c) -> Eff es c
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
Eff \Env es
es -> (a -> b -> c) -> IO a -> IO b -> IO c
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f (Env es -> IO a
x Env es
es) (Env es -> IO b
y Env es
es)

instance Monad (Eff es) where
  -- no 'return', because the default impl is correct and it is going to be deprecated anyway
  Eff Env es -> IO a
x >>= :: Eff es a -> (a -> Eff es b) -> Eff es b
>>= a -> Eff es b
f = (Env es -> IO b) -> Eff es b
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
Eff \Env es
es -> Env es -> IO a
x Env es
es IO a -> (a -> IO b) -> IO b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x' -> Eff es b -> Env es -> IO b
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff (a -> Eff es b
f a
x') Env es
es
  >> :: Eff es a -> Eff es b -> Eff es b
(>>) = Eff es a -> Eff es b -> Eff es b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
(*>) -- More efficient, since the default is @x >> y = x >>= const y@

instance MonadFix (Eff es) where
  mfix :: (a -> Eff es a) -> Eff es a
mfix a -> Eff es a
f = (Env es -> IO a) -> Eff es a
forall (es :: [Effect]) a. (Env es -> IO a) -> Eff es a
Eff \Env es
es -> (a -> IO a) -> IO a
forall (m :: Type -> Type) a. MonadFix m => (a -> m a) -> m a
mfix \a
x -> Eff es a -> Env es -> IO a
forall (es :: [Effect]) a. Eff es a -> Env es -> IO a
unEff (a -> Eff es a
f a
x) Env es
es

-- | @since 0.2.1.0
deriving via (Ap (Eff es) a) instance Bounded a => Bounded (Eff es a)

-- | @since 0.2.1.0
instance Num a => Num (Eff es a) where
  + :: Eff es a -> Eff es a -> Eff es a
(+) = (a -> a -> a) -> Eff es a -> Eff es a -> Eff es a
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Num a => a -> a -> a
(+)
  (-) = (a -> a -> a) -> Eff es a -> Eff es a -> Eff es a
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (-)
  * :: Eff es a -> Eff es a -> Eff es a
(*) = (a -> a -> a) -> Eff es a -> Eff es a -> Eff es a
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Num a => a -> a -> a
(*)
  negate :: Eff es a -> Eff es a
negate = (a -> a) -> Eff es a -> Eff es a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
negate
  abs :: Eff es a -> Eff es a
abs = (a -> a) -> Eff es a -> Eff es a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
abs
  signum :: Eff es a -> Eff es a
signum = (a -> a) -> Eff es a -> Eff es a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
signum
  fromInteger :: Integer -> Eff es a
fromInteger = a -> Eff es a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (a -> Eff es a) -> (Integer -> a) -> Integer -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. Num a => Integer -> a
fromInteger

-- | @since 0.2.1.0
instance Fractional a => Fractional (Eff es a) where
  / :: Eff es a -> Eff es a -> Eff es a
(/) = (a -> a -> a) -> Eff es a -> Eff es a -> Eff es a
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Fractional a => a -> a -> a
(/)
  recip :: Eff es a -> Eff es a
recip = (a -> a) -> Eff es a -> Eff es a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Fractional a => a -> a
recip
  fromRational :: Rational -> Eff es a
fromRational = a -> Eff es a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (a -> Eff es a) -> (Rational -> a) -> Rational -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> a
forall a. Fractional a => Rational -> a
fromRational

-- | @since 0.2.1.0
instance Floating a => Floating (Eff es a) where
  pi :: Eff es a
pi = a -> Eff es a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
forall a. Floating a => a
pi
  exp :: Eff es a -> Eff es a
exp = (a -> a) -> Eff es a -> Eff es a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
exp
  log :: Eff es a -> Eff es a
log = (a -> a) -> Eff es a -> Eff es a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
log
  sqrt :: Eff es a -> Eff es a
sqrt = (a -> a) -> Eff es a -> Eff es a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
sqrt
  ** :: Eff es a -> Eff es a -> Eff es a
(**) = (a -> a -> a) -> Eff es a -> Eff es a -> Eff es a
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Floating a => a -> a -> a
(**)
  logBase :: Eff es a -> Eff es a -> Eff es a
logBase = (a -> a -> a) -> Eff es a -> Eff es a -> Eff es a
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Floating a => a -> a -> a
logBase
  sin :: Eff es a -> Eff es a
sin = (a -> a) -> Eff es a -> Eff es a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
sin
  cos :: Eff es a -> Eff es a
cos = (a -> a) -> Eff es a -> Eff es a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
cos
  tan :: Eff es a -> Eff es a
tan = (a -> a) -> Eff es a -> Eff es a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
tan
  asin :: Eff es a -> Eff es a
asin = (a -> a) -> Eff es a -> Eff es a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
asin
  acos :: Eff es a -> Eff es a
acos = (a -> a) -> Eff es a -> Eff es a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
acos
  atan :: Eff es a -> Eff es a
atan = (a -> a) -> Eff es a -> Eff es a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
atan
  sinh :: Eff es a -> Eff es a
sinh = (a -> a) -> Eff es a -> Eff es a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
sinh
  cosh :: Eff es a -> Eff es a
cosh = (a -> a) -> Eff es a -> Eff es a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
cosh
  tanh :: Eff es a -> Eff es a
tanh = (a -> a) -> Eff es a -> Eff es a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
tanh
  asinh :: Eff es a -> Eff es a
asinh = (a -> a) -> Eff es a -> Eff es a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
asinh
  acosh :: Eff es a -> Eff es a
acosh = (a -> a) -> Eff es a -> Eff es a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
acosh
  atanh :: Eff es a -> Eff es a
atanh = (a -> a) -> Eff es a -> Eff es a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
atanh

-- | @since 0.2.1.0
deriving newtype instance Semigroup a => Semigroup (Eff es a)

-- | @since 0.2.1.0
deriving newtype instance Monoid a => Monoid (Eff es a)

-- | @since 0.2.1.0
instance IsString a => IsString (Eff es a) where
  fromString :: String -> Eff es a
fromString = a -> Eff es a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (a -> Eff es a) -> (String -> a) -> String -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a
forall a. IsString a => String -> a
fromString

-- | Compatibility instance for @MonadComprehensions@.
--
-- @since 0.2.1.0
instance MonadZip (Eff es) where
  mzipWith :: (a -> b -> c) -> Eff es a -> Eff es b -> Eff es c
mzipWith = (a -> b -> c) -> Eff es a -> Eff es b -> Eff es c
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
  munzip :: Eff es (a, b) -> (Eff es a, Eff es b)
munzip Eff es (a, b)
x = ((a, b) -> a
forall a b. (a, b) -> a
fst ((a, b) -> a) -> Eff es (a, b) -> Eff es a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff es (a, b)
x, (a, b) -> b
forall a b. (a, b) -> b
snd ((a, b) -> b) -> Eff es (a, b) -> Eff es b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff es (a, b)
x)

-- * Misc types

-- | A natural transformation from @f@ to @g@. With this, instead of writing
--
-- @
-- runSomeEffect :: 'Cleff.Eff' (SomeEffect : es) a -> 'Cleff.Eff' es a
-- @
--
-- you can write:
--
-- @
-- runSomeEffect :: 'Cleff.Eff' (SomeEffect : es) ~> 'Cleff.Eff' es
-- @
type f ~> g = ∀ a. f a -> g a