{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-dodgy-imports #-}

-- |
-- Module      :  Control.Monad.Trans.Identity.Tagged
-- Copyright   :  © 2016–present Mark Karpov
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- The library provides a monad transformer that works just like
-- 'IdentityT', but can be tagged at the type level. This allows us to work
-- with monad stacks as usual, except we can make two identical monad stacks
-- to have different types. The main application for this is, of course, the
-- ability to have different instances for otherwise identical stacks
-- without having to do @newtype@ wrapping.
module Control.Monad.Trans.Identity.Tagged
  ( -- * The tagged identity monad transformer
    TaggedT (..),
    mapTaggedT,

    -- * Lifting other operations
    liftCallCC,
    liftCatch,
  )
where

import Control.Applicative
import Control.Monad (MonadPlus (..))
import Control.Monad.Cont.Class hiding (liftCallCC)
import Control.Monad.Error.Class
import Control.Monad.Fail qualified as Fail
import Control.Monad.Fix (MonadFix (..))
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.RWS.Class
import Control.Monad.Signatures
import Control.Monad.Trans.Class (MonadTrans (..))
import Control.Monad.Zip (MonadZip (..))
import Data.Functor.Classes

-- | Identity monad transformer with a type-level tag.
newtype TaggedT tag f a = TaggedT {forall {k} {k} (tag :: k) (f :: k -> *) (a :: k).
TaggedT tag f a -> f a
runTaggedT :: f a}

----------------------------------------------------------------------------
-- Standard instances

instance (Eq1 f) => Eq1 (TaggedT tag f) where
  liftEq :: forall a b.
(a -> b -> Bool) -> TaggedT tag f a -> TaggedT tag f b -> Bool
liftEq a -> b -> Bool
eq (TaggedT f a
x) (TaggedT f b
y) = (a -> b -> Bool) -> f a -> f b -> Bool
forall a b. (a -> b -> Bool) -> f a -> f b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq f a
x f b
y
  {-# INLINE liftEq #-}

instance (Ord1 f) => Ord1 (TaggedT tag f) where
  liftCompare :: forall a b.
(a -> b -> Ordering)
-> TaggedT tag f a -> TaggedT tag f b -> Ordering
liftCompare a -> b -> Ordering
comp (TaggedT f a
x) (TaggedT f b
y) = (a -> b -> Ordering) -> f a -> f b -> Ordering
forall a b. (a -> b -> Ordering) -> f a -> f b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
comp f a
x f b
y
  {-# INLINE liftCompare #-}

instance (Read1 f) => Read1 (TaggedT tag f) where
  liftReadsPrec :: forall a.
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (TaggedT tag f a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl =
    (String -> ReadS (TaggedT tag f a))
-> Int -> ReadS (TaggedT tag f a)
forall a. (String -> ReadS a) -> Int -> ReadS a
readsData ((String -> ReadS (TaggedT tag f a))
 -> Int -> ReadS (TaggedT tag f a))
-> (String -> ReadS (TaggedT tag f a))
-> Int
-> ReadS (TaggedT tag f a)
forall a b. (a -> b) -> a -> b
$
      (Int -> ReadS (f a))
-> String
-> (f a -> TaggedT tag f a)
-> String
-> ReadS (TaggedT tag f a)
forall a t.
(Int -> ReadS a) -> String -> (a -> t) -> String -> ReadS t
readsUnaryWith ((Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl) String
"TaggedT" f a -> TaggedT tag f a
forall {k} {k} (tag :: k) (f :: k -> *) (a :: k).
f a -> TaggedT tag f a
TaggedT

instance (Show1 f) => Show1 (TaggedT tag f) where
  liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> TaggedT tag f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
d (TaggedT f a
m) =
    (Int -> f a -> ShowS) -> String -> Int -> f a -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith ((Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl) String
"TaggedT" Int
d f a
m

instance (Eq1 f, Eq a) => Eq (TaggedT tag f a) where
  == :: TaggedT tag f a -> TaggedT tag f a -> Bool
(==) = TaggedT tag f a -> TaggedT tag f a -> Bool
forall (f :: * -> *) a. (Eq1 f, Eq a) => f a -> f a -> Bool
eq1

instance (Ord1 f, Ord a) => Ord (TaggedT tag f a) where
  compare :: TaggedT tag f a -> TaggedT tag f a -> Ordering
compare = TaggedT tag f a -> TaggedT tag f a -> Ordering
forall (f :: * -> *) a. (Ord1 f, Ord a) => f a -> f a -> Ordering
compare1

instance (Read1 f, Read a) => Read (TaggedT tag f a) where
  readsPrec :: Int -> ReadS (TaggedT tag f a)
readsPrec = Int -> ReadS (TaggedT tag f a)
forall (f :: * -> *) a. (Read1 f, Read a) => Int -> ReadS (f a)
readsPrec1

instance (Show1 f, Show a) => Show (TaggedT tag f a) where
  showsPrec :: Int -> TaggedT tag f a -> ShowS
showsPrec = Int -> TaggedT tag f a -> ShowS
forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1

instance (Functor m) => Functor (TaggedT tag m) where
  fmap :: forall a b. (a -> b) -> TaggedT tag m a -> TaggedT tag m b
fmap a -> b
f = (m a -> m b) -> TaggedT tag m a -> TaggedT tag m b
forall {k} {k} {k} (m :: k -> *) (a :: k) (n :: k -> *) (b :: k)
       (tag :: k).
(m a -> n b) -> TaggedT tag m a -> TaggedT tag n b
mapTaggedT ((a -> b) -> m a -> m b
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)
  {-# INLINE fmap #-}

instance (Foldable f) => Foldable (TaggedT tag f) where
  foldMap :: forall m a. Monoid m => (a -> m) -> TaggedT tag f a -> m
foldMap a -> m
f (TaggedT f a
a) = (a -> m) -> f a -> m
forall m a. Monoid m => (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f f a
a
  {-# INLINE foldMap #-}

instance (Traversable f) => Traversable (TaggedT tag f) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TaggedT tag f a -> f (TaggedT tag f b)
traverse a -> f b
f (TaggedT f a
a) = f b -> TaggedT tag f b
forall {k} {k} (tag :: k) (f :: k -> *) (a :: k).
f a -> TaggedT tag f a
TaggedT (f b -> TaggedT tag f b) -> f (f b) -> f (TaggedT tag f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> f a -> f (f b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> f a -> f (f b)
traverse a -> f b
f f a
a
  {-# INLINE traverse #-}

instance (Applicative m) => Applicative (TaggedT tag m) where
  pure :: forall a. a -> TaggedT tag m a
pure a
x = m a -> TaggedT tag m a
forall {k} {k} (tag :: k) (f :: k -> *) (a :: k).
f a -> TaggedT tag f a
TaggedT (a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
  {-# INLINE pure #-}
  <*> :: forall a b.
TaggedT tag m (a -> b) -> TaggedT tag m a -> TaggedT tag m b
(<*>) = (m (a -> b) -> m a -> m b)
-> TaggedT tag m (a -> b) -> TaggedT tag m a -> TaggedT tag m b
forall {k} {k} {k} {k} (m :: k -> *) (a :: k) (n :: k -> *)
       (b :: k) (p :: k -> *) (c :: k) (tag :: k).
(m a -> n b -> p c)
-> TaggedT tag m a -> TaggedT tag n b -> TaggedT tag p c
lift2TaggedT m (a -> b) -> m a -> m b
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
  {-# INLINE (<*>) #-}
  *> :: forall a b. TaggedT tag m a -> TaggedT tag m b -> TaggedT tag m b
(*>) = (m a -> m b -> m b)
-> TaggedT tag m a -> TaggedT tag m b -> TaggedT tag m b
forall {k} {k} {k} {k} (m :: k -> *) (a :: k) (n :: k -> *)
       (b :: k) (p :: k -> *) (c :: k) (tag :: k).
(m a -> n b -> p c)
-> TaggedT tag m a -> TaggedT tag n b -> TaggedT tag p c
lift2TaggedT m a -> m b -> m b
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
  {-# INLINE (*>) #-}

instance (Alternative m) => Alternative (TaggedT tag m) where
  empty :: forall a. TaggedT tag m a
empty = m a -> TaggedT tag m a
forall {k} {k} (tag :: k) (f :: k -> *) (a :: k).
f a -> TaggedT tag f a
TaggedT m a
forall a. m a
forall (f :: * -> *) a. Alternative f => f a
empty
  {-# INLINE empty #-}
  <|> :: forall a. TaggedT tag m a -> TaggedT tag m a -> TaggedT tag m a
(<|>) = (m a -> m a -> m a)
-> TaggedT tag m a -> TaggedT tag m a -> TaggedT tag m a
forall {k} {k} {k} {k} (m :: k -> *) (a :: k) (n :: k -> *)
       (b :: k) (p :: k -> *) (c :: k) (tag :: k).
(m a -> n b -> p c)
-> TaggedT tag m a -> TaggedT tag n b -> TaggedT tag p c
lift2TaggedT m a -> m a -> m a
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
  {-# INLINE (<|>) #-}

instance (Monad m) => Monad (TaggedT tag m) where
  TaggedT tag m a
m >>= :: forall a b.
TaggedT tag m a -> (a -> TaggedT tag m b) -> TaggedT tag m b
>>= a -> TaggedT tag m b
k = m b -> TaggedT tag m b
forall {k} {k} (tag :: k) (f :: k -> *) (a :: k).
f a -> TaggedT tag f a
TaggedT (m b -> TaggedT tag m b) -> m b -> TaggedT tag m b
forall a b. (a -> b) -> a -> b
$ TaggedT tag m b -> m b
forall {k} {k} (tag :: k) (f :: k -> *) (a :: k).
TaggedT tag f a -> f a
runTaggedT (TaggedT tag m b -> m b) -> (a -> TaggedT tag m b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> TaggedT tag m b
k (a -> m b) -> m a -> m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TaggedT tag m a -> m a
forall {k} {k} (tag :: k) (f :: k -> *) (a :: k).
TaggedT tag f a -> f a
runTaggedT TaggedT tag m a
m
  {-# INLINE (>>=) #-}

instance (Fail.MonadFail m) => Fail.MonadFail (TaggedT tag m) where
  fail :: forall a. String -> TaggedT tag m a
fail String
msg = m a -> TaggedT tag m a
forall {k} {k} (tag :: k) (f :: k -> *) (a :: k).
f a -> TaggedT tag f a
TaggedT (m a -> TaggedT tag m a) -> m a -> TaggedT tag m a
forall a b. (a -> b) -> a -> b
$ String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail String
msg
  {-# INLINE fail #-}

instance (MonadPlus m) => MonadPlus (TaggedT tag m) where
  mzero :: forall a. TaggedT tag m a
mzero = m a -> TaggedT tag m a
forall {k} {k} (tag :: k) (f :: k -> *) (a :: k).
f a -> TaggedT tag f a
TaggedT m a
forall a. m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  {-# INLINE mzero #-}
  mplus :: forall a. TaggedT tag m a -> TaggedT tag m a -> TaggedT tag m a
mplus = (m a -> m a -> m a)
-> TaggedT tag m a -> TaggedT tag m a -> TaggedT tag m a
forall {k} {k} {k} {k} (m :: k -> *) (a :: k) (n :: k -> *)
       (b :: k) (p :: k -> *) (c :: k) (tag :: k).
(m a -> n b -> p c)
-> TaggedT tag m a -> TaggedT tag n b -> TaggedT tag p c
lift2TaggedT m a -> m a -> m a
forall a. m a -> m a -> m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus
  {-# INLINE mplus #-}

instance (MonadFix m) => MonadFix (TaggedT tag m) where
  mfix :: forall a. (a -> TaggedT tag m a) -> TaggedT tag m a
mfix a -> TaggedT tag m a
f = m a -> TaggedT tag m a
forall {k} {k} (tag :: k) (f :: k -> *) (a :: k).
f a -> TaggedT tag f a
TaggedT ((a -> m a) -> m a
forall a. (a -> m a) -> m a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (TaggedT tag m a -> m a
forall {k} {k} (tag :: k) (f :: k -> *) (a :: k).
TaggedT tag f a -> f a
runTaggedT (TaggedT tag m a -> m a) -> (a -> TaggedT tag m a) -> a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> TaggedT tag m a
f))
  {-# INLINE mfix #-}

instance (MonadIO m) => MonadIO (TaggedT tag m) where
  liftIO :: forall a. IO a -> TaggedT tag m a
liftIO = m a -> TaggedT tag m a
forall {k} {k} (tag :: k) (f :: k -> *) (a :: k).
f a -> TaggedT tag f a
TaggedT (m a -> TaggedT tag m a)
-> (IO a -> m a) -> IO a -> TaggedT tag m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
  {-# INLINE liftIO #-}

instance (MonadZip m) => MonadZip (TaggedT tag m) where
  mzipWith :: forall a b c.
(a -> b -> c)
-> TaggedT tag m a -> TaggedT tag m b -> TaggedT tag m c
mzipWith a -> b -> c
f = (m a -> m b -> m c)
-> TaggedT tag m a -> TaggedT tag m b -> TaggedT tag m c
forall {k} {k} {k} {k} (m :: k -> *) (a :: k) (n :: k -> *)
       (b :: k) (p :: k -> *) (c :: k) (tag :: k).
(m a -> n b -> p c)
-> TaggedT tag m a -> TaggedT tag n b -> TaggedT tag p c
lift2TaggedT ((a -> b -> c) -> m a -> m b -> m c
forall a b c. (a -> b -> c) -> m a -> m b -> m c
forall (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c) -> m a -> m b -> m c
mzipWith a -> b -> c
f)
  {-# INLINE mzipWith #-}

instance MonadTrans (TaggedT tag) where
  lift :: forall (m :: * -> *) a. Monad m => m a -> TaggedT tag m a
lift = m a -> TaggedT tag m a
forall {k} {k} (tag :: k) (f :: k -> *) (a :: k).
f a -> TaggedT tag f a
TaggedT
  {-# INLINE lift #-}

-- | Lift a unary operation to the new monad.
mapTaggedT :: (m a -> n b) -> TaggedT tag m a -> TaggedT tag n b
mapTaggedT :: forall {k} {k} {k} (m :: k -> *) (a :: k) (n :: k -> *) (b :: k)
       (tag :: k).
(m a -> n b) -> TaggedT tag m a -> TaggedT tag n b
mapTaggedT m a -> n b
f = n b -> TaggedT tag n b
forall {k} {k} (tag :: k) (f :: k -> *) (a :: k).
f a -> TaggedT tag f a
TaggedT (n b -> TaggedT tag n b)
-> (TaggedT tag m a -> n b) -> TaggedT tag m a -> TaggedT tag n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> n b
f (m a -> n b) -> (TaggedT tag m a -> m a) -> TaggedT tag m a -> n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TaggedT tag m a -> m a
forall {k} {k} (tag :: k) (f :: k -> *) (a :: k).
TaggedT tag f a -> f a
runTaggedT
{-# INLINE mapTaggedT #-}

-- | Lift a binary operation to the new monad.
lift2TaggedT :: (m a -> n b -> p c) -> TaggedT tag m a -> TaggedT tag n b -> TaggedT tag p c
lift2TaggedT :: forall {k} {k} {k} {k} (m :: k -> *) (a :: k) (n :: k -> *)
       (b :: k) (p :: k -> *) (c :: k) (tag :: k).
(m a -> n b -> p c)
-> TaggedT tag m a -> TaggedT tag n b -> TaggedT tag p c
lift2TaggedT m a -> n b -> p c
f TaggedT tag m a
a TaggedT tag n b
b = p c -> TaggedT tag p c
forall {k} {k} (tag :: k) (f :: k -> *) (a :: k).
f a -> TaggedT tag f a
TaggedT (m a -> n b -> p c
f (TaggedT tag m a -> m a
forall {k} {k} (tag :: k) (f :: k -> *) (a :: k).
TaggedT tag f a -> f a
runTaggedT TaggedT tag m a
a) (TaggedT tag n b -> n b
forall {k} {k} (tag :: k) (f :: k -> *) (a :: k).
TaggedT tag f a -> f a
runTaggedT TaggedT tag n b
b))
{-# INLINE lift2TaggedT #-}

-- | Lift a @callCC@ operation to the new monad.
liftCallCC :: CallCC m a b -> CallCC (TaggedT tag m) a b
liftCallCC :: forall {k} (m :: * -> *) a b (tag :: k).
CallCC m a b -> CallCC (TaggedT tag m) a b
liftCallCC CallCC m a b
callCC' (a -> TaggedT tag m b) -> TaggedT tag m a
f =
  m a -> TaggedT tag m a
forall {k} {k} (tag :: k) (f :: k -> *) (a :: k).
f a -> TaggedT tag f a
TaggedT (m a -> TaggedT tag m a) -> m a -> TaggedT tag m a
forall a b. (a -> b) -> a -> b
$ CallCC m a b
callCC' CallCC m a b -> CallCC m a b
forall a b. (a -> b) -> a -> b
$ \a -> m b
c -> TaggedT tag m a -> m a
forall {k} {k} (tag :: k) (f :: k -> *) (a :: k).
TaggedT tag f a -> f a
runTaggedT ((a -> TaggedT tag m b) -> TaggedT tag m a
f (m b -> TaggedT tag m b
forall {k} {k} (tag :: k) (f :: k -> *) (a :: k).
f a -> TaggedT tag f a
TaggedT (m b -> TaggedT tag m b) -> (a -> m b) -> a -> TaggedT tag m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
c))
{-# INLINE liftCallCC #-}

-- | Lift a @catchE@ operation to the new monad.
liftCatch :: Catch e m a -> Catch e (TaggedT tag m) a
liftCatch :: forall {k} {k} e (m :: k -> *) (a :: k) (tag :: k).
Catch e m a -> Catch e (TaggedT tag m) a
liftCatch Catch e m a
f TaggedT tag m a
m e -> TaggedT tag m a
h = m a -> TaggedT tag m a
forall {k} {k} (tag :: k) (f :: k -> *) (a :: k).
f a -> TaggedT tag f a
TaggedT (m a -> TaggedT tag m a) -> m a -> TaggedT tag m a
forall a b. (a -> b) -> a -> b
$ Catch e m a
f (TaggedT tag m a -> m a
forall {k} {k} (tag :: k) (f :: k -> *) (a :: k).
TaggedT tag f a -> f a
runTaggedT TaggedT tag m a
m) (TaggedT tag m a -> m a
forall {k} {k} (tag :: k) (f :: k -> *) (a :: k).
TaggedT tag f a -> f a
runTaggedT (TaggedT tag m a -> m a) -> (e -> TaggedT tag m a) -> e -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> TaggedT tag m a
h)
{-# INLINE liftCatch #-}

----------------------------------------------------------------------------
-- MTL instances

instance (MonadCont m) => MonadCont (TaggedT tag m) where
  callCC :: forall a b.
((a -> TaggedT tag m b) -> TaggedT tag m a) -> TaggedT tag m a
callCC = CallCC m a b -> CallCC (TaggedT tag m) a b
forall {k} (m :: * -> *) a b (tag :: k).
CallCC m a b -> CallCC (TaggedT tag m) a b
liftCallCC CallCC m a b
forall a b. ((a -> m b) -> m a) -> m a
forall (m :: * -> *) a b. MonadCont m => ((a -> m b) -> m a) -> m a
callCC

instance (MonadError e m) => MonadError e (TaggedT tag m) where
  throwError :: forall a. e -> TaggedT tag m a
throwError = m a -> TaggedT tag m a
forall (m :: * -> *) a. Monad m => m a -> TaggedT tag m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> TaggedT tag m a) -> (e -> m a) -> e -> TaggedT tag m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall a. e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
  catchError :: forall a.
TaggedT tag m a -> (e -> TaggedT tag m a) -> TaggedT tag m a
catchError = Catch e m a -> Catch e (TaggedT tag m) a
forall {k} {k} e (m :: k -> *) (a :: k) (tag :: k).
Catch e m a -> Catch e (TaggedT tag m) a
liftCatch Catch e m a
forall a. m a -> (e -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError

instance (MonadRWS r w s m) => MonadRWS r w s (TaggedT tag m)

instance (MonadReader r m) => MonadReader r (TaggedT tag m) where
  ask :: TaggedT tag m r
ask = m r -> TaggedT tag m r
forall (m :: * -> *) a. Monad m => m a -> TaggedT tag m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
  local :: forall a. (r -> r) -> TaggedT tag m a -> TaggedT tag m a
local = (m a -> m a) -> TaggedT tag m a -> TaggedT tag m a
forall {k} {k} {k} (m :: k -> *) (a :: k) (n :: k -> *) (b :: k)
       (tag :: k).
(m a -> n b) -> TaggedT tag m a -> TaggedT tag n b
mapTaggedT ((m a -> m a) -> TaggedT tag m a -> TaggedT tag m a)
-> ((r -> r) -> m a -> m a)
-> (r -> r)
-> TaggedT tag m a
-> TaggedT tag m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> r) -> m a -> m a
forall a. (r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local
  reader :: forall a. (r -> a) -> TaggedT tag m a
reader = m a -> TaggedT tag m a
forall (m :: * -> *) a. Monad m => m a -> TaggedT tag m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> TaggedT tag m a)
-> ((r -> a) -> m a) -> (r -> a) -> TaggedT tag m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> a) -> m a
forall a. (r -> a) -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader

instance (MonadState s m) => MonadState s (TaggedT tag m) where
  get :: TaggedT tag m s
get = m s -> TaggedT tag m s
forall (m :: * -> *) a. Monad m => m a -> TaggedT tag m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m s
forall s (m :: * -> *). MonadState s m => m s
get
  put :: s -> TaggedT tag m ()
put = m () -> TaggedT tag m ()
forall (m :: * -> *) a. Monad m => m a -> TaggedT tag m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> TaggedT tag m ()) -> (s -> m ()) -> s -> TaggedT tag m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put
  state :: forall a. (s -> (a, s)) -> TaggedT tag m a
state = m a -> TaggedT tag m a
forall (m :: * -> *) a. Monad m => m a -> TaggedT tag m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> TaggedT tag m a)
-> ((s -> (a, s)) -> m a) -> (s -> (a, s)) -> TaggedT tag m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> (a, s)) -> m a
forall a. (s -> (a, s)) -> m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state

instance (MonadWriter w m) => MonadWriter w (TaggedT tag m) where
  writer :: forall a. (a, w) -> TaggedT tag m a
writer = m a -> TaggedT tag m a
forall (m :: * -> *) a. Monad m => m a -> TaggedT tag m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> TaggedT tag m a)
-> ((a, w) -> m a) -> (a, w) -> TaggedT tag m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, w) -> m a
forall a. (a, w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer
  tell :: w -> TaggedT tag m ()
tell = m () -> TaggedT tag m ()
forall (m :: * -> *) a. Monad m => m a -> TaggedT tag m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> TaggedT tag m ()) -> (w -> m ()) -> w -> TaggedT tag m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
  listen :: forall a. TaggedT tag m a -> TaggedT tag m (a, w)
listen = (m a -> m (a, w)) -> TaggedT tag m a -> TaggedT tag m (a, w)
forall {k} {k} {k} (m :: k -> *) (a :: k) (n :: k -> *) (b :: k)
       (tag :: k).
(m a -> n b) -> TaggedT tag m a -> TaggedT tag n b
mapTaggedT m a -> m (a, w)
forall a. m a -> m (a, w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen
  pass :: forall a. TaggedT tag m (a, w -> w) -> TaggedT tag m a
pass = (m (a, w -> w) -> m a)
-> TaggedT tag m (a, w -> w) -> TaggedT tag m a
forall {k} {k} {k} (m :: k -> *) (a :: k) (n :: k -> *) (b :: k)
       (tag :: k).
(m a -> n b) -> TaggedT tag m a -> TaggedT tag n b
mapTaggedT m (a, w -> w) -> m a
forall a. m (a, w -> w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass