{-# LANGUAGE TemplateHaskell #-}
-----------------------------------------------------------------------------

-- |

-- Module      :  Control.Effect.Embed

-- Copyright   :  (c) Michael Szvetits, 2020

-- License     :  BSD3 (see the file LICENSE)

-- Maintainer  :  typedbyte@qualified.name

-- Stability   :  stable

-- Portability :  portable

--

-- The embed effect for integrating arbitrary monads into the effect system.

-----------------------------------------------------------------------------

module Control.Effect.Embed
  ( -- * Embed Effect

    Embed(..)
    -- * Interpretations

  , Transformation
  , runEmbed
  ) where

-- transformers

import Control.Monad.Trans.Reader (ReaderT(ReaderT), runReaderT)

import Control.Effect.Machinery hiding (embed)

-- | An effect that integrates a monad @n@ into the computation @m@.

class Monad m => Embed n m where
  -- | Monadic actions in @n@ can be lifted into @m@ via 'embed'.

  --

  -- 'embed' is like 'liftIO', but not limited to 'IO'. In fact, 'liftIO' can

  -- be realized using 'embed' by specializing @n@ to @IO@.

  embed :: n a -> m a

makeEffect ''Embed

instance Monad m => Embed m m where
  embed :: m a -> m a
embed = m a -> m a
forall a. a -> a
id
  {-# INLINE embed #-}

newtype F n t = F (forall b. n b -> t b)

-- | The transformation interpreter of the embed effect. This type implements the

-- 'Embed' type class by transforming the integrated monad @n@ into another

-- integrated monad @t@ via natural transformation.

--

-- When interpreting the effect, you usually don\'t interact with this type directly,

-- but instead use one of its corresponding interpretation functions.

newtype Transformation n t m a =
  Transformation { Transformation n t m a -> ReaderT (F n t) m a
runTransformation :: ReaderT (F n t) m a }
    deriving (Functor (Transformation n t m)
a -> Transformation n t m a
Functor (Transformation n t m) =>
(forall a. a -> Transformation n t m a)
-> (forall a b.
    Transformation n t m (a -> b)
    -> Transformation n t m a -> Transformation n t m b)
-> (forall a b c.
    (a -> b -> c)
    -> Transformation n t m a
    -> Transformation n t m b
    -> Transformation n t m c)
-> (forall a b.
    Transformation n t m a
    -> Transformation n t m b -> Transformation n t m b)
-> (forall a b.
    Transformation n t m a
    -> Transformation n t m b -> Transformation n t m a)
-> Applicative (Transformation n t m)
Transformation n t m a
-> Transformation n t m b -> Transformation n t m b
Transformation n t m a
-> Transformation n t m b -> Transformation n t m a
Transformation n t m (a -> b)
-> Transformation n t m a -> Transformation n t m b
(a -> b -> c)
-> Transformation n t m a
-> Transformation n t m b
-> Transformation n t m c
forall a. a -> Transformation n t m a
forall a b.
Transformation n t m a
-> Transformation n t m b -> Transformation n t m a
forall a b.
Transformation n t m a
-> Transformation n t m b -> Transformation n t m b
forall a b.
Transformation n t m (a -> b)
-> Transformation n t m a -> Transformation n t m b
forall a b c.
(a -> b -> c)
-> Transformation n t m a
-> Transformation n t m b
-> Transformation n t m c
forall k (n :: k -> *) (t :: k -> *) (m :: * -> *).
Applicative m =>
Functor (Transformation n t m)
forall k (n :: k -> *) (t :: k -> *) (m :: * -> *) a.
Applicative m =>
a -> Transformation n t m a
forall k (n :: k -> *) (t :: k -> *) (m :: * -> *) a b.
Applicative m =>
Transformation n t m a
-> Transformation n t m b -> Transformation n t m a
forall k (n :: k -> *) (t :: k -> *) (m :: * -> *) a b.
Applicative m =>
Transformation n t m a
-> Transformation n t m b -> Transformation n t m b
forall k (n :: k -> *) (t :: k -> *) (m :: * -> *) a b.
Applicative m =>
Transformation n t m (a -> b)
-> Transformation n t m a -> Transformation n t m b
forall k (n :: k -> *) (t :: k -> *) (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> Transformation n t m a
-> Transformation n t m b
-> Transformation n t 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
<* :: Transformation n t m a
-> Transformation n t m b -> Transformation n t m a
$c<* :: forall k (n :: k -> *) (t :: k -> *) (m :: * -> *) a b.
Applicative m =>
Transformation n t m a
-> Transformation n t m b -> Transformation n t m a
*> :: Transformation n t m a
-> Transformation n t m b -> Transformation n t m b
$c*> :: forall k (n :: k -> *) (t :: k -> *) (m :: * -> *) a b.
Applicative m =>
Transformation n t m a
-> Transformation n t m b -> Transformation n t m b
liftA2 :: (a -> b -> c)
-> Transformation n t m a
-> Transformation n t m b
-> Transformation n t m c
$cliftA2 :: forall k (n :: k -> *) (t :: k -> *) (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> Transformation n t m a
-> Transformation n t m b
-> Transformation n t m c
<*> :: Transformation n t m (a -> b)
-> Transformation n t m a -> Transformation n t m b
$c<*> :: forall k (n :: k -> *) (t :: k -> *) (m :: * -> *) a b.
Applicative m =>
Transformation n t m (a -> b)
-> Transformation n t m a -> Transformation n t m b
pure :: a -> Transformation n t m a
$cpure :: forall k (n :: k -> *) (t :: k -> *) (m :: * -> *) a.
Applicative m =>
a -> Transformation n t m a
$cp1Applicative :: forall k (n :: k -> *) (t :: k -> *) (m :: * -> *).
Applicative m =>
Functor (Transformation n t m)
Applicative, a -> Transformation n t m b -> Transformation n t m a
(a -> b) -> Transformation n t m a -> Transformation n t m b
(forall a b.
 (a -> b) -> Transformation n t m a -> Transformation n t m b)
-> (forall a b.
    a -> Transformation n t m b -> Transformation n t m a)
-> Functor (Transformation n t m)
forall a b. a -> Transformation n t m b -> Transformation n t m a
forall a b.
(a -> b) -> Transformation n t m a -> Transformation n t m b
forall k (n :: k -> *) (t :: k -> *) (m :: * -> *) a b.
Functor m =>
a -> Transformation n t m b -> Transformation n t m a
forall k (n :: k -> *) (t :: k -> *) (m :: * -> *) a b.
Functor m =>
(a -> b) -> Transformation n t m a -> Transformation n t m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Transformation n t m b -> Transformation n t m a
$c<$ :: forall k (n :: k -> *) (t :: k -> *) (m :: * -> *) a b.
Functor m =>
a -> Transformation n t m b -> Transformation n t m a
fmap :: (a -> b) -> Transformation n t m a -> Transformation n t m b
$cfmap :: forall k (n :: k -> *) (t :: k -> *) (m :: * -> *) a b.
Functor m =>
(a -> b) -> Transformation n t m a -> Transformation n t m b
Functor, Applicative (Transformation n t m)
a -> Transformation n t m a
Applicative (Transformation n t m) =>
(forall a b.
 Transformation n t m a
 -> (a -> Transformation n t m b) -> Transformation n t m b)
-> (forall a b.
    Transformation n t m a
    -> Transformation n t m b -> Transformation n t m b)
-> (forall a. a -> Transformation n t m a)
-> Monad (Transformation n t m)
Transformation n t m a
-> (a -> Transformation n t m b) -> Transformation n t m b
Transformation n t m a
-> Transformation n t m b -> Transformation n t m b
forall a. a -> Transformation n t m a
forall a b.
Transformation n t m a
-> Transformation n t m b -> Transformation n t m b
forall a b.
Transformation n t m a
-> (a -> Transformation n t m b) -> Transformation n t m b
forall k (n :: k -> *) (t :: k -> *) (m :: * -> *).
Monad m =>
Applicative (Transformation n t m)
forall k (n :: k -> *) (t :: k -> *) (m :: * -> *) a.
Monad m =>
a -> Transformation n t m a
forall k (n :: k -> *) (t :: k -> *) (m :: * -> *) a b.
Monad m =>
Transformation n t m a
-> Transformation n t m b -> Transformation n t m b
forall k (n :: k -> *) (t :: k -> *) (m :: * -> *) a b.
Monad m =>
Transformation n t m a
-> (a -> Transformation n t m b) -> Transformation n t 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 -> Transformation n t m a
$creturn :: forall k (n :: k -> *) (t :: k -> *) (m :: * -> *) a.
Monad m =>
a -> Transformation n t m a
>> :: Transformation n t m a
-> Transformation n t m b -> Transformation n t m b
$c>> :: forall k (n :: k -> *) (t :: k -> *) (m :: * -> *) a b.
Monad m =>
Transformation n t m a
-> Transformation n t m b -> Transformation n t m b
>>= :: Transformation n t m a
-> (a -> Transformation n t m b) -> Transformation n t m b
$c>>= :: forall k (n :: k -> *) (t :: k -> *) (m :: * -> *) a b.
Monad m =>
Transformation n t m a
-> (a -> Transformation n t m b) -> Transformation n t m b
$cp1Monad :: forall k (n :: k -> *) (t :: k -> *) (m :: * -> *).
Monad m =>
Applicative (Transformation n t m)
Monad, Monad (Transformation n t m)
Monad (Transformation n t m) =>
(forall a. IO a -> Transformation n t m a)
-> MonadIO (Transformation n t m)
IO a -> Transformation n t m a
forall a. IO a -> Transformation n t m a
forall k (n :: k -> *) (t :: k -> *) (m :: * -> *).
MonadIO m =>
Monad (Transformation n t m)
forall k (n :: k -> *) (t :: k -> *) (m :: * -> *) a.
MonadIO m =>
IO a -> Transformation n t m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> Transformation n t m a
$cliftIO :: forall k (n :: k -> *) (t :: k -> *) (m :: * -> *) a.
MonadIO m =>
IO a -> Transformation n t m a
$cp1MonadIO :: forall k (n :: k -> *) (t :: k -> *) (m :: * -> *).
MonadIO m =>
Monad (Transformation n t m)
MonadIO)
    deriving (m a -> Transformation n t m a
(forall (m :: * -> *) a. Monad m => m a -> Transformation n t m a)
-> MonadTrans (Transformation n t)
forall k (n :: k -> *) (t :: k -> *) (m :: * -> *) a.
Monad m =>
m a -> Transformation n t m a
forall (m :: * -> *) a. Monad m => m a -> Transformation n t m a
forall (t :: Transformer).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> Transformation n t m a
$clift :: forall k (n :: k -> *) (t :: k -> *) (m :: * -> *) a.
Monad m =>
m a -> Transformation n t m a
MonadTrans, MonadTrans (Transformation n t)
m (StT (Transformation n t) a) -> Transformation n t m a
MonadTrans (Transformation n t) =>
(forall (m :: * -> *) a.
 Monad m =>
 (Run (Transformation n t) -> m a) -> Transformation n t m a)
-> (forall (m :: * -> *) a.
    Monad m =>
    m (StT (Transformation n t) a) -> Transformation n t m a)
-> MonadTransControl (Transformation n t)
(Run (Transformation n t) -> m a) -> Transformation n t m a
forall k (n :: k -> *) (t :: k -> *).
MonadTrans (Transformation n t)
forall k (n :: k -> *) (t :: k -> *) (m :: * -> *) a.
Monad m =>
m (StT (Transformation n t) a) -> Transformation n t m a
forall k (n :: k -> *) (t :: k -> *) (m :: * -> *) a.
Monad m =>
(Run (Transformation n t) -> m a) -> Transformation n t m a
forall (m :: * -> *) a.
Monad m =>
m (StT (Transformation n t) a) -> Transformation n t m a
forall (m :: * -> *) a.
Monad m =>
(Run (Transformation n t) -> m a) -> Transformation n t m a
forall (t :: Transformer).
MonadTrans t =>
(forall (m :: * -> *) a. Monad m => (Run t -> m a) -> t m a)
-> (forall (m :: * -> *) a. Monad m => m (StT t a) -> t m a)
-> MonadTransControl t
restoreT :: m (StT (Transformation n t) a) -> Transformation n t m a
$crestoreT :: forall k (n :: k -> *) (t :: k -> *) (m :: * -> *) a.
Monad m =>
m (StT (Transformation n t) a) -> Transformation n t m a
liftWith :: (Run (Transformation n t) -> m a) -> Transformation n t m a
$cliftWith :: forall k (n :: k -> *) (t :: k -> *) (m :: * -> *) a.
Monad m =>
(Run (Transformation n t) -> m a) -> Transformation n t m a
$cp1MonadTransControl :: forall k (n :: k -> *) (t :: k -> *).
MonadTrans (Transformation n t)
MonadTransControl)
    deriving (MonadBase b, MonadBaseControl b)

instance Embed t m => Embed n (Transformation n t m) where
  embed :: n a -> Transformation n t m a
embed na :: n a
na = ReaderT (F n t) m a -> Transformation n t m a
forall k (n :: k -> *) (t :: k -> *) (m :: * -> *) a.
ReaderT (F n t) m a -> Transformation n t m a
Transformation (ReaderT (F n t) m a -> Transformation n t m a)
-> ((F n t -> m a) -> ReaderT (F n t) m a)
-> (F n t -> m a)
-> Transformation n t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (F n t -> m a) -> ReaderT (F n t) m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((F n t -> m a) -> Transformation n t m a)
-> (F n t -> m a) -> Transformation n t m a
forall a b. (a -> b) -> a -> b
$
    \(F f :: forall b. n b -> t b
f) -> t a -> m a
forall (n :: * -> *) (m :: * -> *) a. Embed n m => n a -> m a
embed (n a -> t a
forall b. n b -> t b
f n a
na)
  {-# INLINE embed #-}

-- | Runs the embed effect by transforming the integrated monad @n@ into another

-- integrated monad @t@.

runEmbed :: (forall b. n b -> t b)                 -- ^ The natural transformation from monad @n@ to monad @t@.

         -> (Embed n `Via` Transformation n t) m a -- ^ The program whose embed effect should be handled.

         -> m a                                    -- ^ The program with its embed effect handled.

runEmbed :: (forall b. n b -> t b)
-> Via (Embed n) (Transformation n t) m a -> m a
runEmbed f :: forall b. n b -> t b
f = (ReaderT (F n t) m a -> F n t -> m a)
-> F n t -> ReaderT (F n t) m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT (F n t) m a -> F n t -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ((forall b. n b -> t b) -> F n t
forall k (n :: k -> *) (t :: k -> *).
(forall (b :: k). n b -> t b) -> F n t
F forall b. n b -> t b
f) (ReaderT (F n t) m a -> m a)
-> (Via (Embed n) (Transformation n t) m a -> ReaderT (F n t) m a)
-> Via (Embed n) (Transformation n t) m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transformation n t m a -> ReaderT (F n t) m a
forall k (n :: k -> *) (t :: k -> *) (m :: * -> *) a.
Transformation n t m a -> ReaderT (F n t) m a
runTransformation (Transformation n t m a -> ReaderT (F n t) m a)
-> (Via (Embed n) (Transformation n t) m a
    -> Transformation n t m a)
-> Via (Embed n) (Transformation n t) m a
-> ReaderT (F n t) m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Via (Embed n) (Transformation n t) m a -> Transformation n t m a
forall (eff :: Effect) (t :: Transformer) (m :: * -> *) a.
Via eff t m a -> t m a
runVia
{-# INLINE runEmbed #-}