-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Effect.Machinery.Tagger
-- Copyright   :  (c) Michael Szvetits, 2020
-- License     :  BSD3 (see the file LICENSE)
-- Maintainer  :  typedbyte@qualified.name
-- Stability   :  stable
-- Portability :  portable
--
-- This module defines an effect handler which handles tagging, retagging and
-- untagging of effects.
-----------------------------------------------------------------------------
module Control.Effect.Machinery.Tagger where

-- base
import Control.Monad.IO.Class (MonadIO)

-- monad-control
import Control.Monad.Trans.Control (MonadBaseControl, MonadTransControl)

-- transformers
import Control.Monad.Trans.Class    (MonadTrans)
import Control.Monad.Trans.Identity (IdentityT(IdentityT))

-- transformers-base
import Control.Monad.Base (MonadBase)

-- | This type provides instances for effect type classes in order to enable
-- tagging, retagging and untagging of effects. Whenever this type is used as
-- handler of an effect, the effect previously tagged with @tag@ will be
-- tagged with @new@ instead.
--
-- You usually don\'t interact with this type directly, since the type class
-- instances for this type are generated by the functions found in the module
-- "Control.Effect.Machinery.TH".
newtype Tagger tag new m a =
  Tagger { runTagger :: m a }
    deriving (Applicative, Functor, Monad, MonadIO)
    deriving (MonadTrans, MonadTransControl) via IdentityT
    deriving (MonadBase b, MonadBaseControl b)