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

-- |

-- Module      :  Control.Effect.Machinery.Via

-- Copyright   :  (c) Michael Szvetits, 2020

-- License     :  BSD3 (see the file LICENSE)

-- Maintainer  :  typedbyte@qualified.name

-- Stability   :  stable

-- Portability :  portable

--

-- This module defines the type 'Via' which indicates that a specific effect

-- is handled by a specific monad transformer (also known as effect handler

-- or effect interpreter).

--

-- It also defines the 'G' type, which is the global tag that is used for

-- untagged effects.

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

module Control.Effect.Machinery.Via
  ( Via(..)
  , G
  ) where

-- base

import Control.Monad.IO.Class (MonadIO)

-- monad-control

import Control.Monad.Trans.Control (ComposeSt, MonadBaseControl,
                                    MonadTransControl, StM, defaultLiftBaseWith,
                                    defaultRestoreM,liftBaseWith, restoreM)

-- transformers

import Control.Monad.Trans.Class (MonadTrans)

-- transformers-base

import Control.Monad.Base (MonadBase, liftBase, liftBaseDefault)

import Control.Effect.Machinery.Kind (Effect, Transformer)

-- | This type indicates that an effect (i.e., a type class) @eff@ is handled by

-- a specific monad transformer @t@. The type is a simple wrapper around the

-- monad transformer itself. The whole purpose of this type is to guide the type

-- system to pick the instance of type class @eff@ given by the type @t@, and

-- to delegate all other effects that are not @eff@ to their handlers which are

-- located somewhere further down the monad transformer stack.

newtype Via (eff :: Effect) (t :: Transformer) m a =
  Via { Via eff t m a -> t m a
runVia :: t m a }
    deriving (Functor (Via eff t m)
a -> Via eff t m a
Functor (Via eff t m) =>
(forall a. a -> Via eff t m a)
-> (forall a b.
    Via eff t m (a -> b) -> Via eff t m a -> Via eff t m b)
-> (forall a b c.
    (a -> b -> c) -> Via eff t m a -> Via eff t m b -> Via eff t m c)
-> (forall a b. Via eff t m a -> Via eff t m b -> Via eff t m b)
-> (forall a b. Via eff t m a -> Via eff t m b -> Via eff t m a)
-> Applicative (Via eff t m)
Via eff t m a -> Via eff t m b -> Via eff t m b
Via eff t m a -> Via eff t m b -> Via eff t m a
Via eff t m (a -> b) -> Via eff t m a -> Via eff t m b
(a -> b -> c) -> Via eff t m a -> Via eff t m b -> Via eff t m c
forall a. a -> Via eff t m a
forall a b. Via eff t m a -> Via eff t m b -> Via eff t m a
forall a b. Via eff t m a -> Via eff t m b -> Via eff t m b
forall a b. Via eff t m (a -> b) -> Via eff t m a -> Via eff t m b
forall a b c.
(a -> b -> c) -> Via eff t m a -> Via eff t m b -> Via eff 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
forall (eff :: Effect) (t :: Transformer) (m :: * -> *).
Applicative (t m) =>
Functor (Via eff t m)
forall (eff :: Effect) (t :: Transformer) (m :: * -> *) a.
Applicative (t m) =>
a -> Via eff t m a
forall (eff :: Effect) (t :: Transformer) (m :: * -> *) a b.
Applicative (t m) =>
Via eff t m a -> Via eff t m b -> Via eff t m a
forall (eff :: Effect) (t :: Transformer) (m :: * -> *) a b.
Applicative (t m) =>
Via eff t m a -> Via eff t m b -> Via eff t m b
forall (eff :: Effect) (t :: Transformer) (m :: * -> *) a b.
Applicative (t m) =>
Via eff t m (a -> b) -> Via eff t m a -> Via eff t m b
forall (eff :: Effect) (t :: Transformer) (m :: * -> *) a b c.
Applicative (t m) =>
(a -> b -> c) -> Via eff t m a -> Via eff t m b -> Via eff t m c
<* :: Via eff t m a -> Via eff t m b -> Via eff t m a
$c<* :: forall (eff :: Effect) (t :: Transformer) (m :: * -> *) a b.
Applicative (t m) =>
Via eff t m a -> Via eff t m b -> Via eff t m a
*> :: Via eff t m a -> Via eff t m b -> Via eff t m b
$c*> :: forall (eff :: Effect) (t :: Transformer) (m :: * -> *) a b.
Applicative (t m) =>
Via eff t m a -> Via eff t m b -> Via eff t m b
liftA2 :: (a -> b -> c) -> Via eff t m a -> Via eff t m b -> Via eff t m c
$cliftA2 :: forall (eff :: Effect) (t :: Transformer) (m :: * -> *) a b c.
Applicative (t m) =>
(a -> b -> c) -> Via eff t m a -> Via eff t m b -> Via eff t m c
<*> :: Via eff t m (a -> b) -> Via eff t m a -> Via eff t m b
$c<*> :: forall (eff :: Effect) (t :: Transformer) (m :: * -> *) a b.
Applicative (t m) =>
Via eff t m (a -> b) -> Via eff t m a -> Via eff t m b
pure :: a -> Via eff t m a
$cpure :: forall (eff :: Effect) (t :: Transformer) (m :: * -> *) a.
Applicative (t m) =>
a -> Via eff t m a
$cp1Applicative :: forall (eff :: Effect) (t :: Transformer) (m :: * -> *).
Applicative (t m) =>
Functor (Via eff t m)
Applicative, a -> Via eff t m b -> Via eff t m a
(a -> b) -> Via eff t m a -> Via eff t m b
(forall a b. (a -> b) -> Via eff t m a -> Via eff t m b)
-> (forall a b. a -> Via eff t m b -> Via eff t m a)
-> Functor (Via eff t m)
forall a b. a -> Via eff t m b -> Via eff t m a
forall a b. (a -> b) -> Via eff t m a -> Via eff t m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (eff :: Effect) (t :: Transformer) (m :: * -> *) a b.
Functor (t m) =>
a -> Via eff t m b -> Via eff t m a
forall (eff :: Effect) (t :: Transformer) (m :: * -> *) a b.
Functor (t m) =>
(a -> b) -> Via eff t m a -> Via eff t m b
<$ :: a -> Via eff t m b -> Via eff t m a
$c<$ :: forall (eff :: Effect) (t :: Transformer) (m :: * -> *) a b.
Functor (t m) =>
a -> Via eff t m b -> Via eff t m a
fmap :: (a -> b) -> Via eff t m a -> Via eff t m b
$cfmap :: forall (eff :: Effect) (t :: Transformer) (m :: * -> *) a b.
Functor (t m) =>
(a -> b) -> Via eff t m a -> Via eff t m b
Functor, Applicative (Via eff t m)
a -> Via eff t m a
Applicative (Via eff t m) =>
(forall a b.
 Via eff t m a -> (a -> Via eff t m b) -> Via eff t m b)
-> (forall a b. Via eff t m a -> Via eff t m b -> Via eff t m b)
-> (forall a. a -> Via eff t m a)
-> Monad (Via eff t m)
Via eff t m a -> (a -> Via eff t m b) -> Via eff t m b
Via eff t m a -> Via eff t m b -> Via eff t m b
forall a. a -> Via eff t m a
forall a b. Via eff t m a -> Via eff t m b -> Via eff t m b
forall a b. Via eff t m a -> (a -> Via eff t m b) -> Via eff 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
forall (eff :: Effect) (t :: Transformer) (m :: * -> *).
Monad (t m) =>
Applicative (Via eff t m)
forall (eff :: Effect) (t :: Transformer) (m :: * -> *) a.
Monad (t m) =>
a -> Via eff t m a
forall (eff :: Effect) (t :: Transformer) (m :: * -> *) a b.
Monad (t m) =>
Via eff t m a -> Via eff t m b -> Via eff t m b
forall (eff :: Effect) (t :: Transformer) (m :: * -> *) a b.
Monad (t m) =>
Via eff t m a -> (a -> Via eff t m b) -> Via eff t m b
return :: a -> Via eff t m a
$creturn :: forall (eff :: Effect) (t :: Transformer) (m :: * -> *) a.
Monad (t m) =>
a -> Via eff t m a
>> :: Via eff t m a -> Via eff t m b -> Via eff t m b
$c>> :: forall (eff :: Effect) (t :: Transformer) (m :: * -> *) a b.
Monad (t m) =>
Via eff t m a -> Via eff t m b -> Via eff t m b
>>= :: Via eff t m a -> (a -> Via eff t m b) -> Via eff t m b
$c>>= :: forall (eff :: Effect) (t :: Transformer) (m :: * -> *) a b.
Monad (t m) =>
Via eff t m a -> (a -> Via eff t m b) -> Via eff t m b
$cp1Monad :: forall (eff :: Effect) (t :: Transformer) (m :: * -> *).
Monad (t m) =>
Applicative (Via eff t m)
Monad, Monad (Via eff t m)
Monad (Via eff t m) =>
(forall a. IO a -> Via eff t m a) -> MonadIO (Via eff t m)
IO a -> Via eff t m a
forall a. IO a -> Via eff t m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (eff :: Effect) (t :: Transformer) (m :: * -> *).
MonadIO (t m) =>
Monad (Via eff t m)
forall (eff :: Effect) (t :: Transformer) (m :: * -> *) a.
MonadIO (t m) =>
IO a -> Via eff t m a
liftIO :: IO a -> Via eff t m a
$cliftIO :: forall (eff :: Effect) (t :: Transformer) (m :: * -> *) a.
MonadIO (t m) =>
IO a -> Via eff t m a
$cp1MonadIO :: forall (eff :: Effect) (t :: Transformer) (m :: * -> *).
MonadIO (t m) =>
Monad (Via eff t m)
MonadIO)
    deriving (m a -> Via eff t m a
(forall (m :: * -> *) a. Monad m => m a -> Via eff t m a)
-> MonadTrans (Via eff t)
forall (m :: * -> *) a. Monad m => m a -> Via eff t m a
forall (eff :: Effect) (t :: Transformer) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> Via eff t m a
forall (t :: Transformer).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> Via eff t m a
$clift :: forall (eff :: Effect) (t :: Transformer) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> Via eff t m a
MonadTrans, MonadTrans (Via eff t)
m (StT (Via eff t) a) -> Via eff t m a
MonadTrans (Via eff t) =>
(forall (m :: * -> *) a.
 Monad m =>
 (Run (Via eff t) -> m a) -> Via eff t m a)
-> (forall (m :: * -> *) a.
    Monad m =>
    m (StT (Via eff t) a) -> Via eff t m a)
-> MonadTransControl (Via eff t)
(Run (Via eff t) -> m a) -> Via eff t m a
forall (m :: * -> *) a.
Monad m =>
m (StT (Via eff t) a) -> Via eff t m a
forall (m :: * -> *) a.
Monad m =>
(Run (Via eff t) -> m a) -> Via eff t m a
forall (eff :: Effect) (t :: Transformer).
MonadTransControl t =>
MonadTrans (Via eff t)
forall (eff :: Effect) (t :: Transformer) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT (Via eff t) a) -> Via eff t m a
forall (eff :: Effect) (t :: Transformer) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run (Via eff t) -> m a) -> Via eff 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 (Via eff t) a) -> Via eff t m a
$crestoreT :: forall (eff :: Effect) (t :: Transformer) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT (Via eff t) a) -> Via eff t m a
liftWith :: (Run (Via eff t) -> m a) -> Via eff t m a
$cliftWith :: forall (eff :: Effect) (t :: Transformer) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run (Via eff t) -> m a) -> Via eff t m a
$cp1MonadTransControl :: forall (eff :: Effect) (t :: Transformer).
MonadTransControl t =>
MonadTrans (Via eff t)
MonadTransControl)

instance (Monad (t m), MonadBase b m, MonadTrans t) => MonadBase b (Via eff t m) where
  liftBase :: b α -> Via eff t m α
liftBase = b α -> Via eff t m α
forall (t :: Transformer) (b :: * -> *) (m :: * -> *) α.
(MonadTrans t, MonadBase b m) =>
b α -> t m α
liftBaseDefault
  {-# INLINE liftBase #-}

instance (Monad (t m), MonadBaseControl b m, MonadTransControl t) => MonadBaseControl b (Via eff t m) where
  type StM (Via eff t m) a = ComposeSt t m a
  liftBaseWith :: (RunInBase (Via eff t m) b -> b a) -> Via eff t m a
liftBaseWith = (RunInBase (Via eff t m) b -> b a) -> Via eff t m a
forall (t :: Transformer) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
(RunInBaseDefault t m b -> b a) -> t m a
defaultLiftBaseWith
  {-# INLINE liftBaseWith #-}
  restoreM :: StM (Via eff t m) a -> Via eff t m a
restoreM = StM (Via eff t m) a -> Via eff t m a
forall (t :: Transformer) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
ComposeSt t m a -> t m a
defaultRestoreM
  {-# INLINE restoreM #-}

-- | This type is used as tag for all untagged effects. In order words, every

-- effect is tagged, even untagged ones, but all the untagged ones simply have

-- the same tag @G@ (short for \"Global\", because you can view tags as some

-- kind of namespace mechanism, and all untagged effects live in the same

-- global namespace).

--

-- If you don\'t want to use tagged effects (i.e., you write effect type classes

-- without a tag type parameter), you can ignore this type completely.

data G