{-# OPTIONS -fno-warn-orphans #-}

module Control.Monad.Ology.Specific.WriterT
    ( module Control.Monad.Trans.Writer
    ) where

import Control.Monad.Ology.General
import Control.Monad.Trans.Writer hiding (liftCallCC, liftCatch)
import Import

instance Monoid w => TransConstraint Functor (WriterT w) where
    hasTransConstraint :: forall (m :: Type -> Type).
Functor m =>
Dict (Functor (WriterT w m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance Monoid w => TransConstraint Applicative (WriterT w) where
    hasTransConstraint :: forall (m :: Type -> Type).
Applicative m =>
Dict (Applicative (WriterT w m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance Monoid w => TransConstraint Monad (WriterT w) where
    hasTransConstraint :: forall (m :: Type -> Type). Monad m => Dict (Monad (WriterT w m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance Monoid w => TransConstraint MonadIO (WriterT w) where
    hasTransConstraint :: forall (m :: Type -> Type).
MonadIO m =>
Dict (MonadIO (WriterT w m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance Monoid w => TransConstraint MonadFail (WriterT w) where
    hasTransConstraint :: forall (m :: Type -> Type).
MonadFail m =>
Dict (MonadFail (WriterT w m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance Monoid w => TransConstraint MonadFix (WriterT w) where
    hasTransConstraint :: forall (m :: Type -> Type).
MonadFix m =>
Dict (MonadFix (WriterT w m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance Monoid w => TransConstraint MonadPlus (WriterT w) where
    hasTransConstraint :: forall (m :: Type -> Type).
MonadPlus m =>
Dict (MonadPlus (WriterT w m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance (MonadExtract m, Monoid w) => MonadExtract (WriterT w m) where
    mToValue :: Extract (WriterT w m)
mToValue (WriterT m (a, w)
maw) = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type). MonadExtract m => Extract m
mToValue m (a, w)
maw

instance Monoid w => TransConstraint MonadExtract (WriterT w) where
    hasTransConstraint :: forall (m :: Type -> Type).
MonadExtract m =>
Dict (MonadExtract (WriterT w m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance (MonadInner m, Monoid w) => MonadInner (WriterT w m) where
    retrieveInner :: forall a. WriterT w m a -> Result (Exc (WriterT w m)) a
retrieveInner (WriterT m (a, w)
maw) = forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) a.
MonadInner m =>
m a -> Result (Exc m) a
retrieveInner m (a, w)
maw

instance Monoid w => TransConstraint MonadInner (WriterT w) where
    hasTransConstraint :: forall (m :: Type -> Type).
MonadInner m =>
Dict (MonadInner (WriterT w m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance Monoid w => MonadTransCoerce (WriterT w) where
    transCoerce :: forall (m1 :: Type -> Type) (m2 :: Type -> Type).
Coercible m1 m2 =>
Dict (Coercible (WriterT w m1) (WriterT w m2))
transCoerce = forall (a :: Constraint). a => Dict a
Dict

instance (Monoid w, MonadException m) => MonadException (WriterT w m) where
    type Exc (WriterT w m) = Exc m
    throwExc :: forall a. Exc (WriterT w m) -> WriterT w m a
throwExc Exc (WriterT w m)
e = forall (t :: TransKind) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) a. MonadException m => Exc m -> m a
throwExc Exc (WriterT w m)
e
    catchExc :: forall a.
WriterT w m a
-> (Exc (WriterT w m) -> WriterT w m a) -> WriterT w m a
catchExc WriterT w m a
tma Exc (WriterT w m) -> WriterT w m a
handler = forall (t :: TransKind) (m :: Type -> Type) r.
(MonadTransTunnel t, Monad m) =>
((forall (m1 :: Type -> Type) a.
  Monad m1 =>
  t m1 a -> m1 (Tunnel t a))
 -> m (Tunnel t r))
-> t m r
tunnel forall a b. (a -> b) -> a -> b
$ \forall (m1 :: Type -> Type) a.
Monad m1 =>
WriterT w m1 a -> m1 (Tunnel (WriterT w) a)
unlift -> forall (m :: Type -> Type) a.
MonadException m =>
m a -> (Exc m -> m a) -> m a
catchExc (forall (m1 :: Type -> Type) a.
Monad m1 =>
WriterT w m1 a -> m1 (Tunnel (WriterT w) a)
unlift WriterT w m a
tma) forall a b. (a -> b) -> a -> b
$ \Exc m
e -> forall (m1 :: Type -> Type) a.
Monad m1 =>
WriterT w m1 a -> m1 (Tunnel (WriterT w) a)
unlift forall a b. (a -> b) -> a -> b
$ Exc (WriterT w m) -> WriterT w m a
handler Exc m
e

instance Monoid w => TransConstraint MonadException (WriterT w) where
    hasTransConstraint :: forall (m :: Type -> Type).
MonadException m =>
Dict (MonadException (WriterT w m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance (MonadThrow e m, Monoid w) => MonadThrow e (WriterT w m) where
    throw :: forall a. e -> WriterT w m a
throw e
e = forall (t :: TransKind) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall e (m :: Type -> Type) a. MonadThrow e m => e -> m a
throw e
e

instance Monoid w => TransConstraint (MonadThrow e) (WriterT w) where
    hasTransConstraint :: forall (m :: Type -> Type).
MonadThrow e m =>
Dict (MonadThrow e (WriterT w m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance (MonadCatch e m, Monoid w) => MonadCatch e (WriterT w m) where
    catch :: forall a. WriterT w m a -> (e -> WriterT w m a) -> WriterT w m a
catch WriterT w m a
ma e -> WriterT w m a
handler = forall (t :: TransKind) (m :: Type -> Type) r.
(MonadTransTunnel t, Monad m) =>
((forall (m1 :: Type -> Type) a.
  Monad m1 =>
  t m1 a -> m1 (Tunnel t a))
 -> m (Tunnel t r))
-> t m r
tunnel forall a b. (a -> b) -> a -> b
$ \forall (m1 :: Type -> Type) a.
Monad m1 =>
WriterT w m1 a -> m1 (Tunnel (WriterT w) a)
unlift -> forall e (m :: Type -> Type) a.
MonadCatch e m =>
m a -> (e -> m a) -> m a
catch (forall (m1 :: Type -> Type) a.
Monad m1 =>
WriterT w m1 a -> m1 (Tunnel (WriterT w) a)
unlift WriterT w m a
ma) forall a b. (a -> b) -> a -> b
$ \e
e -> forall (m1 :: Type -> Type) a.
Monad m1 =>
WriterT w m1 a -> m1 (Tunnel (WriterT w) a)
unlift forall a b. (a -> b) -> a -> b
$ e -> WriterT w m a
handler e
e

instance Monoid w => TransConstraint (MonadCatch e) (WriterT w) where
    hasTransConstraint :: forall (m :: Type -> Type).
MonadCatch e m =>
Dict (MonadCatch e (WriterT w m))
hasTransConstraint = forall (a :: Constraint). a => Dict a
Dict

instance Monoid w => MonadTransHoist (WriterT w) where
    hoist :: forall (m1 :: Type -> Type) (m2 :: Type -> Type).
(Monad m1, Monad m2) =>
(m1 --> m2) -> WriterT w m1 --> WriterT w m2
hoist = forall (t :: TransKind) (m1 :: Type -> Type) (m2 :: Type -> Type).
(MonadTransTunnel t, Monad m1, Monad m2) =>
(m1 --> m2) -> t m1 --> t m2
tunnelHoist

instance Monoid w => MonadTransTunnel (WriterT w) where
    type Tunnel (WriterT w) = (,) w
    tunnel :: forall (m :: Type -> Type) r.
Monad m =>
((forall (m1 :: Type -> Type) a.
  Monad m1 =>
  WriterT w m1 a -> m1 (Tunnel (WriterT w) a))
 -> m (Tunnel (WriterT w) r))
-> WriterT w m r
tunnel (forall (m1 :: Type -> Type) a.
 Monad m1 =>
 WriterT w m1 a -> m1 (Tunnel (WriterT w) a))
-> m (Tunnel (WriterT w) r)
call = forall w (m :: Type -> Type) a. m (a, w) -> WriterT w m a
WriterT forall a b. (a -> b) -> a -> b
$ forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> (b, a)
swap forall a b. (a -> b) -> a -> b
$ (forall (m1 :: Type -> Type) a.
 Monad m1 =>
 WriterT w m1 a -> m1 (Tunnel (WriterT w) a))
-> m (Tunnel (WriterT w) r)
call forall a b. (a -> b) -> a -> b
$ \(WriterT m1 (a, w)
mrs) -> forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> (b, a)
swap forall a b. (a -> b) -> a -> b
$ m1 (a, w)
mrs

instance Monoid w => MonadTransUnlift (WriterT w) where
    liftWithUnlift :: forall (m :: Type -> Type) r.
MonadIO m =>
(Unlift MonadTunnelIOInner (WriterT w) -> m r) -> WriterT w m r
liftWithUnlift Unlift MonadTunnelIOInner (WriterT w) -> m r
call = do
        MVar w
var <- forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (MVar a)
newMVar forall a. Monoid a => a
mempty
        r
r <-
            forall (t :: TransKind) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$
            Unlift MonadTunnelIOInner (WriterT w) -> m r
call forall a b. (a -> b) -> a -> b
$ \(WriterT m (a, w)
mrs) -> do
                (a
r, w
output) <- m (a, w)
mrs
                forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar w
var forall a b. (a -> b) -> a -> b
$ \w
oldoutput -> forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a -> a -> a
mappend w
oldoutput w
output
                forall (m :: Type -> Type) a. Monad m => a -> m a
return a
r
        w
totaloutput <- forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> IO a
takeMVar MVar w
var
        forall (m :: Type -> Type) w. Monad m => w -> WriterT w m ()
tell w
totaloutput
        forall (m :: Type -> Type) a. Monad m => a -> m a
return r
r