{-# 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 { 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 f (Eff x) = Eff (fmap f . x)
  x <$ Eff y = Eff \es -> x <$ y es

instance Applicative (Eff es) where
  pure = Eff . const . pure
  Eff f <*> Eff x = Eff \es -> f es <*> x es
  Eff x <*  Eff y = Eff \es -> x es <*  y es
  Eff x  *> Eff y = Eff \es -> x es  *> y es
  liftA2 f (Eff x) (Eff y) = Eff \es -> liftA2 f (x es) (y es)

instance Monad (Eff es) where
  -- no 'return', because the default impl is correct and it is going to be deprecated anyway
  Eff x >>= f = Eff \es -> x es >>= \x' -> unEff (f x') es
  (>>) = (*>) -- More efficient, since the default is @x >> y = x >>= const y@

instance MonadFix (Eff es) where
  mfix f = Eff \es -> mfix \x -> unEff (f x) 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
  (+) = liftA2 (+)
  (-) = liftA2 (-)
  (*) = liftA2 (*)
  negate = fmap negate
  abs = fmap abs
  signum = fmap signum
  fromInteger = pure . fromInteger

-- | @since 0.2.1.0
instance Fractional a => Fractional (Eff es a) where
  (/) = liftA2 (/)
  recip = fmap recip
  fromRational = pure . fromRational

-- | @since 0.2.1.0
instance Floating a => Floating (Eff es a) where
  pi = pure pi
  exp = fmap exp
  log = fmap log
  sqrt = fmap sqrt
  (**) = liftA2 (**)
  logBase = liftA2 logBase
  sin = fmap sin
  cos = fmap cos
  tan = fmap tan
  asin = fmap asin
  acos = fmap acos
  atan = fmap atan
  sinh = fmap sinh
  cosh = fmap cosh
  tanh = fmap tanh
  asinh = fmap asinh
  acosh = fmap acosh
  atanh = fmap 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 = pure . fromString

-- | Compatibility instance for @MonadComprehensions@.
--
-- @since 0.2.1.0
instance MonadZip (Eff es) where
  mzipWith = liftA2
  munzip x = (fst <$> x, snd <$> 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