{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
-- | Right monad 'Module' type-class.
--
-- Most possible instances are omitted.
-- The primary use-case for 'Module' is to power 'Bound.ScopeH.ScopeH'.
module Control.Monad.Module where

import Bound                     (Scope (..), (>>>=))
import Control.Monad.Trans.Class (MonadTrans (..))
import Data.Functor.Compose      (Compose (..))
import Data.Functor.Identity     (Identity (..))

-- | @f@ is right @m@-module. (according to https://ncatlab.org/nlab/show/module+over+a+monad#modules definitions).
-- We have @'Compose' f m ~> f@ natural transformation.
--
-- === Laws
--
-- @
-- fma '>>==' return    = fma
-- fma '>>==' (f 'Control.Monad.>=>' g) = (fma '>>==' f) '>>==' g
-- @
--
-- === Properties
--
-- For all @'Monad' m@ we can write associated @instance 'Module' m m where ('>>==') = ('>>=')@.
--
-- 'mjoin' and '>>==' are equivalent in power:
--
-- @
-- fa '>>==' amb = 'mjoin' ('fmap' amb fa)
-- @
class (Functor f, Monad m) => Module f m where

    -- | Called 'action'.
    (>>==) :: f a -> (a -> m b) -> f b

infixl 1 >>==

-- | 'Module''s 'join' variant.
mjoin :: Module f m => f (m a) -> f a
mjoin :: f (m a) -> f a
mjoin f (m a)
fma = f (m a)
fma f (m a) -> (m a -> m a) -> f a
forall (f :: * -> *) (m :: * -> *) a b.
Module f m =>
f a -> (a -> m b) -> f b
>>== m a -> m a
forall a. a -> a
id

-- | @'Module' m (t m)@ action's implementation.
transAction :: (MonadTrans t, Monad m, Monad (t m)) => t m a -> (a -> m b) -> t m b
transAction :: t m a -> (a -> m b) -> t m b
transAction t m a
tma a -> m b
amb = t m a
tma t m a -> (a -> t m b) -> t m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m b -> t m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m b -> t m b) -> (a -> m b) -> a -> t m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
amb

-- | @'Module' m ('Compose' f m)@ action's implementation.
composeAction :: (Functor f, Monad m) => Compose f m a -> (a -> m b) -> Compose f m b
composeAction :: Compose f m a -> (a -> m b) -> Compose f m b
composeAction (Compose f (m a)
fma) a -> m b
amb = f (m b) -> Compose f m b
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose ((m a -> m b) -> f (m a) -> f (m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m b
amb) f (m a)
fma)

instance Functor f => Module f Identity where
    f a
fa >>== :: f a -> (a -> Identity b) -> f b
>>== a -> Identity b
k = (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Identity b -> b
forall a. Identity a -> a
runIdentity (Identity b -> b) -> (a -> Identity b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Identity b
k) f a
fa

instance Monad m => Module (Scope b m) m where
    >>== :: Scope b m a -> (a -> m b) -> Scope b m b
(>>==) = Scope b m a -> (a -> m b) -> Scope b m b
forall (t :: (* -> *) -> * -> *) (f :: * -> *) a c.
(Bound t, Monad f) =>
t f a -> (a -> f c) -> t f c
(>>>=)

-- | An extension of 'Module' allowing to lift @m a@ info @f a@.
-- As we have @'Monad' m@, this allows to have a pseudo-return for @f@:
-- @point . return :: a -> f a@
--
-- /Note:/ for @f = t m@ for some @'MonadTrans' t@ @'mlift' = 'lift'@.
--
-- @since 0.0.2
class Module f m => LiftedModule f m where
    mlift :: m a -> f a