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

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

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

collect :: (Monad m, Monoid w) => WriterT w m a -> WriterT w m (a, w)
collect :: forall (m :: Type -> Type) w a.
(Monad m, Monoid w) =>
WriterT w m a -> WriterT w m (a, w)
collect WriterT w m a
wmr = (w -> w) -> WriterT w m (a, w) -> WriterT w m (a, w)
forall (m :: Type -> Type) w a.
Monad m =>
(w -> w) -> WriterT w m a -> WriterT w m a
censor (\w
_ -> w
forall a. Monoid a => a
mempty) (WriterT w m (a, w) -> WriterT w m (a, w))
-> WriterT w m (a, w) -> WriterT w m (a, w)
forall a b. (a -> b) -> a -> b
$ WriterT w m a -> WriterT w m (a, w)
forall (m :: Type -> Type) w a.
Monad m =>
WriterT w m a -> WriterT w m (a, w)
listen WriterT w m a
wmr

evalWriterT :: Monad m => WriterT w m a -> m a
evalWriterT :: forall (m :: Type -> Type) w a. Monad m => WriterT w m a -> m a
evalWriterT WriterT w m a
wma = ((a, w) -> a) -> m (a, w) -> m a
forall a b. (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, w) -> a
forall a b. (a, b) -> a
fst (m (a, w) -> m a) -> m (a, w) -> m a
forall a b. (a -> b) -> a -> b
$ WriterT w m a -> m (a, w)
forall w (m :: Type -> Type) a. WriterT w m a -> m (a, w)
runWriterT WriterT w m a
wma

instance TransConstraint Functor (WriterT w) where
    hasTransConstraint :: forall (m :: Type -> Type).
Functor m =>
Dict (Functor (WriterT w m))
hasTransConstraint = Dict (Functor (WriterT w m))
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 = Dict (Applicative (WriterT w m))
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 = Dict (Monad (WriterT w m))
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 = Dict (MonadIO (WriterT w m))
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 = Dict (MonadFail (WriterT w m))
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 = Dict (MonadFix (WriterT w m))
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 = Dict (MonadPlus (WriterT w m))
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) = (a, w) -> a
forall a b. (a, b) -> a
fst ((a, w) -> a) -> (a, w) -> a
forall a b. (a -> b) -> a -> b
$ m (a, w) -> (a, w)
Extract m
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 = Dict (MonadExtract (WriterT w m))
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) = ((a, w) -> a)
-> Result (Exc (WriterT w m)) (a, w)
-> Result (Exc (WriterT w m)) a
forall a b.
(a -> b)
-> Result (Exc (WriterT w m)) a -> Result (Exc (WriterT w m)) b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, w) -> a
forall a b. (a, b) -> a
fst (Result (Exc (WriterT w m)) (a, w) -> Result (Exc (WriterT w m)) a)
-> Result (Exc (WriterT w m)) (a, w)
-> Result (Exc (WriterT w m)) a
forall a b. (a -> b) -> a -> b
$ m (a, w) -> Result (Exc m) (a, w)
forall a. m a -> Result (Exc m) a
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 = Dict (MonadInner (WriterT w m))
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 = Dict (Coercible (WriterT w m1) (WriterT w m2))
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 = m a -> WriterT w m a
forall (m :: Type -> Type) a. Monad m => m a -> WriterT w m a
forall (t :: TransKind) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WriterT w m a) -> m a -> WriterT w m a
forall a b. (a -> b) -> a -> b
$ Exc m -> m a
forall a. Exc m -> m a
forall (m :: Type -> Type) a. MonadException m => Exc m -> m a
throwExc Exc m
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 (m1 :: Type -> Type) a.
  Monad m1 =>
  WriterT w m1 a -> m1 (Tunnel (WriterT w) a))
 -> m (Tunnel (WriterT w) a))
-> WriterT w m a
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
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 (m1 :: Type -> Type) a.
   Monad m1 =>
   WriterT w m1 a -> m1 (Tunnel (WriterT w) a))
  -> m (Tunnel (WriterT w) a))
 -> WriterT w m a)
-> ((forall (m1 :: Type -> Type) a.
     Monad m1 =>
     WriterT w m1 a -> m1 (Tunnel (WriterT w) a))
    -> m (Tunnel (WriterT w) a))
-> WriterT w m a
forall a b. (a -> b) -> a -> b
$ \forall (m1 :: Type -> Type) a.
Monad m1 =>
WriterT w m1 a -> m1 (Tunnel (WriterT w) a)
unlift -> m (Tunnel (WriterT w) a)
-> (Exc m -> m (Tunnel (WriterT w) a)) -> m (Tunnel (WriterT w) a)
forall a. m a -> (Exc m -> m a) -> m a
forall (m :: Type -> Type) a.
MonadException m =>
m a -> (Exc m -> m a) -> m a
catchExc (WriterT w m a -> m (Tunnel (WriterT w) a)
forall (m1 :: Type -> Type) a.
Monad m1 =>
WriterT w m1 a -> m1 (Tunnel (WriterT w) a)
unlift WriterT w m a
tma) ((Exc m -> m (Tunnel (WriterT w) a)) -> m (Tunnel (WriterT w) a))
-> (Exc m -> m (Tunnel (WriterT w) a)) -> m (Tunnel (WriterT w) a)
forall a b. (a -> b) -> a -> b
$ \Exc m
e -> WriterT w m a -> m (Tunnel (WriterT w) a)
forall (m1 :: Type -> Type) a.
Monad m1 =>
WriterT w m1 a -> m1 (Tunnel (WriterT w) a)
unlift (WriterT w m a -> m (Tunnel (WriterT w) a))
-> WriterT w m a -> m (Tunnel (WriterT w) a)
forall a b. (a -> b) -> a -> b
$ Exc (WriterT w m) -> WriterT w m a
handler Exc m
Exc (WriterT w m)
e

instance Monoid w => TransConstraint MonadException (WriterT w) where
    hasTransConstraint :: forall (m :: Type -> Type).
MonadException m =>
Dict (MonadException (WriterT w m))
hasTransConstraint = Dict (MonadException (WriterT w m))
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 = m a -> WriterT w m a
forall (m :: Type -> Type) a. Monad m => m a -> WriterT w m a
forall (t :: TransKind) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WriterT w m a) -> m a -> WriterT w m a
forall a b. (a -> b) -> a -> b
$ e -> m a
forall a. e -> m a
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 = Dict (MonadThrow e (WriterT w m))
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 (m1 :: Type -> Type) a.
  Monad m1 =>
  WriterT w m1 a -> m1 (Tunnel (WriterT w) a))
 -> m (Tunnel (WriterT w) a))
-> WriterT w m a
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
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 (m1 :: Type -> Type) a.
   Monad m1 =>
   WriterT w m1 a -> m1 (Tunnel (WriterT w) a))
  -> m (Tunnel (WriterT w) a))
 -> WriterT w m a)
-> ((forall (m1 :: Type -> Type) a.
     Monad m1 =>
     WriterT w m1 a -> m1 (Tunnel (WriterT w) a))
    -> m (Tunnel (WriterT w) a))
-> WriterT w m a
forall a b. (a -> b) -> a -> b
$ \forall (m1 :: Type -> Type) a.
Monad m1 =>
WriterT w m1 a -> m1 (Tunnel (WriterT w) a)
unlift -> m (Tunnel (WriterT w) a)
-> (e -> m (Tunnel (WriterT w) a)) -> m (Tunnel (WriterT w) a)
forall a. m a -> (e -> m a) -> m a
forall e (m :: Type -> Type) a.
MonadCatch e m =>
m a -> (e -> m a) -> m a
catch (WriterT w m a -> m (Tunnel (WriterT w) a)
forall (m1 :: Type -> Type) a.
Monad m1 =>
WriterT w m1 a -> m1 (Tunnel (WriterT w) a)
unlift WriterT w m a
ma) ((e -> m (Tunnel (WriterT w) a)) -> m (Tunnel (WriterT w) a))
-> (e -> m (Tunnel (WriterT w) a)) -> m (Tunnel (WriterT w) a)
forall a b. (a -> b) -> a -> b
$ \e
e -> WriterT w m a -> m (Tunnel (WriterT w) a)
forall (m1 :: Type -> Type) a.
Monad m1 =>
WriterT w m1 a -> m1 (Tunnel (WriterT w) a)
unlift (WriterT w m a -> m (Tunnel (WriterT w) a))
-> WriterT w m a -> m (Tunnel (WriterT w) a)
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 = Dict (MonadCatch e (WriterT w m))
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 = (m1 --> m2) -> WriterT w m1 --> WriterT w m2
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 = m (r, w) -> WriterT w m r
forall w (m :: Type -> Type) a. m (a, w) -> WriterT w m a
WriterT (m (r, w) -> WriterT w m r) -> m (r, w) -> WriterT w m r
forall a b. (a -> b) -> a -> b
$ ((w, r) -> (r, w)) -> m (w, r) -> m (r, w)
forall a b. (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (w, r) -> (r, w)
forall a b. (a, b) -> (b, a)
swap (m (w, r) -> m (r, w)) -> m (w, r) -> m (r, w)
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 (m1 :: Type -> Type) a.
  Monad m1 =>
  WriterT w m1 a -> m1 (Tunnel (WriterT w) a))
 -> m (Tunnel (WriterT w) r))
-> (forall (m1 :: Type -> Type) a.
    Monad m1 =>
    WriterT w m1 a -> m1 (Tunnel (WriterT w) a))
-> m (Tunnel (WriterT w) r)
forall a b. (a -> b) -> a -> b
$ \(WriterT m1 (a, w)
mrs) -> ((a, w) -> Tunnel (WriterT w) a)
-> m1 (a, w) -> m1 (Tunnel (WriterT w) a)
forall a b. (a -> b) -> m1 a -> m1 b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, w) -> (w, a)
(a, w) -> Tunnel (WriterT w) a
forall a b. (a, b) -> (b, a)
swap (m1 (a, w) -> m1 (Tunnel (WriterT w) a))
-> m1 (a, w) -> m1 (Tunnel (WriterT w) a)
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 MonadTunnelIO (WriterT w) -> m r) -> WriterT w m r
liftWithUnlift Unlift MonadTunnelIO (WriterT w) -> m r
call = do
        MVar w
var <- IO (MVar w) -> WriterT w m (MVar w)
forall a. IO a -> WriterT w m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (MVar w) -> WriterT w m (MVar w))
-> IO (MVar w) -> WriterT w m (MVar w)
forall a b. (a -> b) -> a -> b
$ w -> IO (MVar w)
forall a. a -> IO (MVar a)
newMVar w
forall a. Monoid a => a
mempty
        r
r <-
            m r -> WriterT w m r
forall (m :: Type -> Type) a. Monad m => m a -> WriterT w m a
forall (t :: TransKind) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m r -> WriterT w m r) -> m r -> WriterT w m r
forall a b. (a -> b) -> a -> b
$
            Unlift MonadTunnelIO (WriterT w) -> m r
call (Unlift MonadTunnelIO (WriterT w) -> m r)
-> Unlift MonadTunnelIO (WriterT w) -> m r
forall a b. (a -> b) -> a -> b
$ \(WriterT m (a, w)
mrs) -> do
                (a
r, w
output) <- m (a, w)
mrs
                IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MVar w -> (w -> IO w) -> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar w
var ((w -> IO w) -> IO ()) -> (w -> IO w) -> IO ()
forall a b. (a -> b) -> a -> b
$ \w
oldoutput -> w -> IO w
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (w -> IO w) -> w -> IO w
forall a b. (a -> b) -> a -> b
$ w -> w -> w
forall a. Monoid a => a -> a -> a
mappend w
oldoutput w
output
                a -> m a
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return a
r
        w
totaloutput <- IO w -> WriterT w m w
forall a. IO a -> WriterT w m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO w -> WriterT w m w) -> IO w -> WriterT w m w
forall a b. (a -> b) -> a -> b
$ MVar w -> IO w
forall a. MVar a -> IO a
takeMVar MVar w
var
        w -> WriterT w m ()
forall (m :: Type -> Type) w. Monad m => w -> WriterT w m ()
tell w
totaloutput
        r -> WriterT w m r
forall a. a -> WriterT w m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return r
r