{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | The multi-valued version of mtl's Writer / WriterT
module Control.Monad.Trans.MultiWriter.Strict
  (
  -- * MultiWriterT
    MultiWriterT(..)
  , MultiWriterTNull
  , MultiWriter
  -- * MonadMultiWriter class
  , MonadMultiWriter(..)
  -- * run-functions
  , runMultiWriterT
  , runMultiWriterTAW
  , runMultiWriterTWA
  , runMultiWriterTW
  , runMultiWriterTNil
  , runMultiWriterTNil_
  -- * with-functions (single Writer)
  , withMultiWriter
  , withMultiWriterAW
  , withMultiWriterWA
  , withMultiWriterW
  -- * with-functions (multiple Writers)
  , withMultiWriters
  , withMultiWritersAW
  , withMultiWritersWA
  , withMultiWritersW
  -- * inflate-function (run WriterT in MultiWriterT)
  , inflateWriter
  -- * other functions
  , mapMultiWriterT
  , mGetRaw
  , mPutRaw
  )
where



import Data.HList.HList
import Data.HList.ContainsType

import Control.Monad.Trans.MultiWriter.Class ( MonadMultiWriter(..) )

import Control.Monad.State.Strict      ( StateT(..)
                                       , MonadState(..)
                                       , execStateT
                                       , evalStateT
                                       , mapStateT )
import Control.Monad.Writer.Strict     ( WriterT(..) )
import Control.Monad.Trans.Class       ( MonadTrans
                                       , lift )
import Control.Monad.Writer.Class      ( MonadWriter
                                       , listen
                                       , tell
                                       , writer
                                       , pass )

import Data.Functor.Identity           ( Identity )

import Control.Applicative             ( Applicative(..)
                                       , Alternative(..)
                                       )
import Control.Monad                   ( MonadPlus(..)
                                       , liftM
                                       , ap
                                       , void )
import Control.Monad.Base              ( MonadBase(..)
                                       , liftBaseDefault
                                       )
import Control.Monad.Trans.Control     ( MonadTransControl(..)
                                       , MonadBaseControl(..)
                                       , ComposeSt
                                       , defaultLiftBaseWith
                                       , defaultRestoreM
                                       )
import Control.Monad.Fix               ( MonadFix(..) )
import Control.Monad.IO.Class          ( MonadIO(..) )

import Data.Monoid



-- | A Writer transformer monad patameterized by:
--
-- * x - The list of types that can be written (Monoid instances).
-- * m - The inner monad.
--
-- 'MultiWriterT' corresponds to mtl's 'WriterT', but can contain
-- a heterogenous list of types.
--
-- This heterogenous list is represented using Types.Data.List, i.e:
--
--   * @'[]@ - The empty list,
--   * @a ': b@ - A list where @/a/@ is an arbitrary type
--     and @/b/@ is the rest list.
--
-- For example,
--
-- > MultiWriterT '[Int, Bool] :: (* -> *) -> (* -> *)
--
-- is a Writer transformer containing the types [Int, Bool].
newtype MultiWriterT x m a = MultiWriterT {
  MultiWriterT x m a -> StateT (HList x) m a
runMultiWriterTRaw :: StateT (HList x) m a
}

-- | A MultiWriter transformer carrying an empty state.
type MultiWriterTNull = MultiWriterT '[]

type MultiWriter x a = MultiWriterT x Identity a

instance (Functor f) => Functor (MultiWriterT x f) where
  fmap :: (a -> b) -> MultiWriterT x f a -> MultiWriterT x f b
fmap a -> b
f = StateT (HList x) f b -> MultiWriterT x f b
forall (x :: [*]) (m :: * -> *) a.
StateT (HList x) m a -> MultiWriterT x m a
MultiWriterT (StateT (HList x) f b -> MultiWriterT x f b)
-> (MultiWriterT x f a -> StateT (HList x) f b)
-> MultiWriterT x f a
-> MultiWriterT x f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> StateT (HList x) f a -> StateT (HList x) f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (StateT (HList x) f a -> StateT (HList x) f b)
-> (MultiWriterT x f a -> StateT (HList x) f a)
-> MultiWriterT x f a
-> StateT (HList x) f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiWriterT x f a -> StateT (HList x) f a
forall (x :: [*]) (m :: * -> *) a.
MultiWriterT x m a -> StateT (HList x) m a
runMultiWriterTRaw

instance (Applicative m, Monad m) => Applicative (MultiWriterT x m) where
  pure :: a -> MultiWriterT x m a
pure = StateT (HList x) m a -> MultiWriterT x m a
forall (x :: [*]) (m :: * -> *) a.
StateT (HList x) m a -> MultiWriterT x m a
MultiWriterT (StateT (HList x) m a -> MultiWriterT x m a)
-> (a -> StateT (HList x) m a) -> a -> MultiWriterT x m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> StateT (HList x) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  <*> :: MultiWriterT x m (a -> b)
-> MultiWriterT x m a -> MultiWriterT x m b
(<*>) = MultiWriterT x m (a -> b)
-> MultiWriterT x m a -> MultiWriterT x m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad m => Monad (MultiWriterT x m) where
  return :: a -> MultiWriterT x m a
return = a -> MultiWriterT x m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  MultiWriterT x m a
k >>= :: MultiWriterT x m a
-> (a -> MultiWriterT x m b) -> MultiWriterT x m b
>>= a -> MultiWriterT x m b
f = StateT (HList x) m b -> MultiWriterT x m b
forall (x :: [*]) (m :: * -> *) a.
StateT (HList x) m a -> MultiWriterT x m a
MultiWriterT (StateT (HList x) m b -> MultiWriterT x m b)
-> StateT (HList x) m b -> MultiWriterT x m b
forall a b. (a -> b) -> a -> b
$ MultiWriterT x m a -> StateT (HList x) m a
forall (x :: [*]) (m :: * -> *) a.
MultiWriterT x m a -> StateT (HList x) m a
runMultiWriterTRaw MultiWriterT x m a
k StateT (HList x) m a
-> (a -> StateT (HList x) m b) -> StateT (HList x) m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (MultiWriterT x m b -> StateT (HList x) m b
forall (x :: [*]) (m :: * -> *) a.
MultiWriterT x m a -> StateT (HList x) m a
runMultiWriterTRaw(MultiWriterT x m b -> StateT (HList x) m b)
-> (a -> MultiWriterT x m b) -> a -> StateT (HList x) m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> MultiWriterT x m b
f)

instance MonadTrans (MultiWriterT x) where
  lift :: m a -> MultiWriterT x m a
lift = StateT (HList x) m a -> MultiWriterT x m a
forall (x :: [*]) (m :: * -> *) a.
StateT (HList x) m a -> MultiWriterT x m a
MultiWriterT (StateT (HList x) m a -> MultiWriterT x m a)
-> (m a -> StateT (HList x) m a) -> m a -> MultiWriterT x m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> StateT (HList x) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

#if MIN_VERSION_base(4,8,0)
instance {-# OVERLAPPING #-} (Monad m, ContainsType a c, Monoid a)
#else
instance (Monad m, ContainsType a c, Monoid a)
#endif
      => MonadMultiWriter a (MultiWriterT c m) where
  mTell :: a -> MultiWriterT c m ()
mTell a
v = StateT (HList c) m () -> MultiWriterT c m ()
forall (x :: [*]) (m :: * -> *) a.
StateT (HList x) m a -> MultiWriterT x m a
MultiWriterT (StateT (HList c) m () -> MultiWriterT c m ())
-> StateT (HList c) m () -> MultiWriterT c m ()
forall a b. (a -> b) -> a -> b
$ do
    HList c
x <- StateT (HList c) m (HList c)
forall s (m :: * -> *). MonadState s m => m s
get
    HList c -> StateT (HList c) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (HList c -> StateT (HList c) m ())
-> HList c -> StateT (HList c) m ()
forall a b. (a -> b) -> a -> b
$ a -> HList c -> HList c
forall a (c :: [*]). ContainsType a c => a -> HList c -> HList c
setHListElem (HList c -> a
forall a (c :: [*]). ContainsType a c => HList c -> a
getHListElem HList c
x a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
v) HList c
x

instance MonadFix m => MonadFix (MultiWriterT w m) where
  mfix :: (a -> MultiWriterT w m a) -> MultiWriterT w m a
mfix a -> MultiWriterT w m a
f = StateT (HList w) m a -> MultiWriterT w m a
forall (x :: [*]) (m :: * -> *) a.
StateT (HList x) m a -> MultiWriterT x m a
MultiWriterT (StateT (HList w) m a -> MultiWriterT w m a)
-> StateT (HList w) m a -> MultiWriterT w m a
forall a b. (a -> b) -> a -> b
$ (a -> StateT (HList w) m a) -> StateT (HList w) m a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (MultiWriterT w m a -> StateT (HList w) m a
forall (x :: [*]) (m :: * -> *) a.
MultiWriterT x m a -> StateT (HList x) m a
runMultiWriterTRaw (MultiWriterT w m a -> StateT (HList w) m a)
-> (a -> MultiWriterT w m a) -> a -> StateT (HList w) m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> MultiWriterT w m a
f)

-- methods

-- | A raw extractor of the contained HList (i.e. the complete state).
mGetRaw :: Monad m => MultiWriterT a m (HList a)
mGetRaw :: MultiWriterT a m (HList a)
mGetRaw = StateT (HList a) m (HList a) -> MultiWriterT a m (HList a)
forall (x :: [*]) (m :: * -> *) a.
StateT (HList x) m a -> MultiWriterT x m a
MultiWriterT StateT (HList a) m (HList a)
forall s (m :: * -> *). MonadState s m => m s
get

mPutRaw :: Monad m => HList s -> MultiWriterT s m ()
mPutRaw :: HList s -> MultiWriterT s m ()
mPutRaw = StateT (HList s) m () -> MultiWriterT s m ()
forall (x :: [*]) (m :: * -> *) a.
StateT (HList x) m a -> MultiWriterT x m a
MultiWriterT (StateT (HList s) m () -> MultiWriterT s m ())
-> (HList s -> StateT (HList s) m ())
-> HList s
-> MultiWriterT s m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HList s -> StateT (HList s) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put

-- | Map both the return value and the state of a computation
-- using the given function.
mapMultiWriterT :: (m (a, HList w) -> m' (a', HList w))
               -> MultiWriterT w m  a
               -> MultiWriterT w m' a'
mapMultiWriterT :: (m (a, HList w) -> m' (a', HList w))
-> MultiWriterT w m a -> MultiWriterT w m' a'
mapMultiWriterT m (a, HList w) -> m' (a', HList w)
f = StateT (HList w) m' a' -> MultiWriterT w m' a'
forall (x :: [*]) (m :: * -> *) a.
StateT (HList x) m a -> MultiWriterT x m a
MultiWriterT (StateT (HList w) m' a' -> MultiWriterT w m' a')
-> (MultiWriterT w m a -> StateT (HList w) m' a')
-> MultiWriterT w m a
-> MultiWriterT w m' a'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (m (a, HList w) -> m' (a', HList w))
-> StateT (HList w) m a -> StateT (HList w) m' a'
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT m (a, HList w) -> m' (a', HList w)
f (StateT (HList w) m a -> StateT (HList w) m' a')
-> (MultiWriterT w m a -> StateT (HList w) m a)
-> MultiWriterT w m a
-> StateT (HList w) m' a'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiWriterT w m a -> StateT (HList w) m a
forall (x :: [*]) (m :: * -> *) a.
MultiWriterT x m a -> StateT (HList x) m a
runMultiWriterTRaw

runMultiWriterT   :: (Monoid (HList w), Functor m) => MultiWriterT w m a -> m (a, HList w)
runMultiWriterTAW :: (Monoid (HList w), Functor m) => MultiWriterT w m a -> m (a, HList w)
runMultiWriterTWA :: (Monoid (HList w),   Monad m) => MultiWriterT w m a -> m (HList w, a)
runMultiWriterTW  :: (Monoid (HList w),   Monad m) => MultiWriterT w m a -> m (HList w)
runMultiWriterT :: MultiWriterT w m a -> m (a, HList w)
runMultiWriterT     = MultiWriterT w m a -> m (a, HList w)
forall (w :: [*]) (m :: * -> *) a.
(Monoid (HList w), Functor m) =>
MultiWriterT w m a -> m (a, HList w)
runMultiWriterTAW
runMultiWriterTAW :: MultiWriterT w m a -> m (a, HList w)
runMultiWriterTAW MultiWriterT w m a
k = StateT (HList w) m a -> HList w -> m (a, HList w)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (MultiWriterT w m a -> StateT (HList w) m a
forall (x :: [*]) (m :: * -> *) a.
MultiWriterT x m a -> StateT (HList x) m a
runMultiWriterTRaw MultiWriterT w m a
k) HList w
forall a. Monoid a => a
mempty
runMultiWriterTWA :: MultiWriterT w m a -> m (HList w, a)
runMultiWriterTWA MultiWriterT w m a
k = (\(a
a,HList w
b) -> (HList w
b,a
a)) ((a, HList w) -> (HList w, a)) -> m (a, HList w) -> m (HList w, a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` StateT (HList w) m a -> HList w -> m (a, HList w)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (MultiWriterT w m a -> StateT (HList w) m a
forall (x :: [*]) (m :: * -> *) a.
MultiWriterT x m a -> StateT (HList x) m a
runMultiWriterTRaw MultiWriterT w m a
k) HList w
forall a. Monoid a => a
mempty
runMultiWriterTW :: MultiWriterT w m a -> m (HList w)
runMultiWriterTW  MultiWriterT w m a
k = StateT (HList w) m a -> HList w -> m (HList w)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT (MultiWriterT w m a -> StateT (HList w) m a
forall (x :: [*]) (m :: * -> *) a.
MultiWriterT x m a -> StateT (HList x) m a
runMultiWriterTRaw MultiWriterT w m a
k) HList w
forall a. Monoid a => a
mempty

runMultiWriterTNil  ::   Monad m => MultiWriterT '[] m a -> m a
runMultiWriterTNil_ :: Functor m => MultiWriterT '[] m a -> m ()
runMultiWriterTNil :: MultiWriterT '[] m a -> m a
runMultiWriterTNil  MultiWriterT '[] m a
k = StateT (HList '[]) m a -> HList '[] -> m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (MultiWriterT '[] m a -> StateT (HList '[]) m a
forall (x :: [*]) (m :: * -> *) a.
MultiWriterT x m a -> StateT (HList x) m a
runMultiWriterTRaw MultiWriterT '[] m a
k) HList '[]
HNil
runMultiWriterTNil_ :: MultiWriterT '[] m a -> m ()
runMultiWriterTNil_ MultiWriterT '[] m a
k = m (a, HList '[]) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (a, HList '[]) -> m ()) -> m (a, HList '[]) -> m ()
forall a b. (a -> b) -> a -> b
$ StateT (HList '[]) m a -> HList '[] -> m (a, HList '[])
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (MultiWriterT '[] m a -> StateT (HList '[]) m a
forall (x :: [*]) (m :: * -> *) a.
MultiWriterT x m a -> StateT (HList x) m a
runMultiWriterTRaw MultiWriterT '[] m a
k) HList '[]
HNil

withMultiWriter   :: (Monoid w, Monad m) => MultiWriterT (w ': ws) m a -> MultiWriterT ws m (a, w)
withMultiWriterAW :: (Monoid w, Monad m) => MultiWriterT (w ': ws) m a -> MultiWriterT ws m (a, w)
withMultiWriterWA :: (Monoid w, Monad m) => MultiWriterT (w ': ws) m a -> MultiWriterT ws m (w, a)
withMultiWriterW  :: (Monoid w, Monad m) => MultiWriterT (w ': ws) m a -> MultiWriterT ws m w
withMultiWriter :: MultiWriterT (w : ws) m a -> MultiWriterT ws m (a, w)
withMultiWriter = MultiWriterT (w : ws) m a -> MultiWriterT ws m (a, w)
forall w (m :: * -> *) (ws :: [*]) a.
(Monoid w, Monad m) =>
MultiWriterT (w : ws) m a -> MultiWriterT ws m (a, w)
withMultiWriterAW
withMultiWriterAW :: MultiWriterT (w : ws) m a -> MultiWriterT ws m (a, w)
withMultiWriterAW MultiWriterT (w : ws) m a
k = StateT (HList ws) m (a, w) -> MultiWriterT ws m (a, w)
forall (x :: [*]) (m :: * -> *) a.
StateT (HList x) m a -> MultiWriterT x m a
MultiWriterT (StateT (HList ws) m (a, w) -> MultiWriterT ws m (a, w))
-> StateT (HList ws) m (a, w) -> MultiWriterT ws m (a, w)
forall a b. (a -> b) -> a -> b
$ do
  HList ws
w <- StateT (HList ws) m (HList ws)
forall s (m :: * -> *). MonadState s m => m s
get
  (a
a, HList (w : ws)
w') <- m (a, HList (w : ws)) -> StateT (HList ws) m (a, HList (w : ws))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (a, HList (w : ws)) -> StateT (HList ws) m (a, HList (w : ws)))
-> m (a, HList (w : ws)) -> StateT (HList ws) m (a, HList (w : ws))
forall a b. (a -> b) -> a -> b
$ StateT (HList (w : ws)) m a
-> HList (w : ws) -> m (a, HList (w : ws))
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (MultiWriterT (w : ws) m a -> StateT (HList (w : ws)) m a
forall (x :: [*]) (m :: * -> *) a.
MultiWriterT x m a -> StateT (HList x) m a
runMultiWriterTRaw MultiWriterT (w : ws) m a
k) (w
forall a. Monoid a => a
mempty w -> HList ws -> HList (w : ws)
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
:+: HList ws
w)
  case HList (w : ws)
w' of x
x' :+: HList xs
wr' -> do HList xs -> StateT (HList ws) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put HList xs
wr'; (a, x) -> StateT (HList ws) m (a, x)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, x
x')
withMultiWriterWA :: MultiWriterT (w : ws) m a -> MultiWriterT ws m (w, a)
withMultiWriterWA MultiWriterT (w : ws) m a
k = (\(a
a,w
b) -> (w
b,a
a)) ((a, w) -> (w, a))
-> MultiWriterT ws m (a, w) -> MultiWriterT ws m (w, a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MultiWriterT (w : ws) m a -> MultiWriterT ws m (a, w)
forall w (m :: * -> *) (ws :: [*]) a.
(Monoid w, Monad m) =>
MultiWriterT (w : ws) m a -> MultiWriterT ws m (a, w)
withMultiWriterAW MultiWriterT (w : ws) m a
k
withMultiWriterW :: MultiWriterT (w : ws) m a -> MultiWriterT ws m w
withMultiWriterW  MultiWriterT (w : ws) m a
k = (a, w) -> w
forall a b. (a, b) -> b
snd ((a, w) -> w) -> MultiWriterT ws m (a, w) -> MultiWriterT ws m w
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` MultiWriterT (w : ws) m a -> MultiWriterT ws m (a, w)
forall w (m :: * -> *) (ws :: [*]) a.
(Monoid w, Monad m) =>
MultiWriterT (w : ws) m a -> MultiWriterT ws m (a, w)
withMultiWriterAW MultiWriterT (w : ws) m a
k

withMultiWriters   :: forall w1 w2 m a
               . (Monoid (HList w1), Monad m, HInit w1)
              => MultiWriterT (Append w1 w2) m a
              -> MultiWriterT w2 m (a, HList w1)
withMultiWritersAW :: forall w1 w2 m a
               . (Monoid (HList w1), Monad m, HInit w1)
              => MultiWriterT (Append w1 w2) m a
              -> MultiWriterT w2 m (a, HList w1)
withMultiWritersWA :: forall w1 w2 m a
               . (Monoid (HList w1), Monad m, HInit w1)
              => MultiWriterT (Append w1 w2) m a
              -> MultiWriterT w2 m (HList w1, a)
-- withMultiWritersA would have too much ambiguity for what the ws are
-- (one could use a Proxy, but that does not seem to be worth the effort)
-- same reasoning for withMultiWriters_
withMultiWritersW  :: forall w1 w2 m a
               . (Monoid (HList w1), Monad m, HInit w1)
              => MultiWriterT (Append w1 w2) m a
              -> MultiWriterT w2 m (HList w1)
withMultiWriters :: MultiWriterT (Append w1 w2) m a -> MultiWriterT w2 m (a, HList w1)
withMultiWriters = MultiWriterT (Append w1 w2) m a -> MultiWriterT w2 m (a, HList w1)
forall (w1 :: [*]) (w2 :: [*]) (m :: * -> *) a.
(Monoid (HList w1), Monad m, HInit w1) =>
MultiWriterT (Append w1 w2) m a -> MultiWriterT w2 m (a, HList w1)
withMultiWritersAW
withMultiWritersAW :: MultiWriterT (Append w1 w2) m a -> MultiWriterT w2 m (a, HList w1)
withMultiWritersAW MultiWriterT (Append w1 w2) m a
k = StateT (HList w2) m (a, HList w1)
-> MultiWriterT w2 m (a, HList w1)
forall (x :: [*]) (m :: * -> *) a.
StateT (HList x) m a -> MultiWriterT x m a
MultiWriterT (StateT (HList w2) m (a, HList w1)
 -> MultiWriterT w2 m (a, HList w1))
-> StateT (HList w2) m (a, HList w1)
-> MultiWriterT w2 m (a, HList w1)
forall a b. (a -> b) -> a -> b
$ do
  HList w2
w <- StateT (HList w2) m (HList w2)
forall s (m :: * -> *). MonadState s m => m s
get
  (a
a, HList (Append w1 w2)
ws') <- m (a, HList (Append w1 w2))
-> StateT (HList w2) m (a, HList (Append w1 w2))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (a, HList (Append w1 w2))
 -> StateT (HList w2) m (a, HList (Append w1 w2)))
-> m (a, HList (Append w1 w2))
-> StateT (HList w2) m (a, HList (Append w1 w2))
forall a b. (a -> b) -> a -> b
$ StateT (HList (Append w1 w2)) m a
-> HList (Append w1 w2) -> m (a, HList (Append w1 w2))
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (MultiWriterT (Append w1 w2) m a
-> StateT (HList (Append w1 w2)) m a
forall (x :: [*]) (m :: * -> *) a.
MultiWriterT x m a -> StateT (HList x) m a
runMultiWriterTRaw MultiWriterT (Append w1 w2) m a
k) (HList w1 -> HList w2 -> HList (Append w1 w2)
forall (ts1 :: [*]) (ts2 :: [*]).
HList ts1 -> HList ts2 -> HList (Append ts1 ts2)
hAppend (HList w1
forall a. Monoid a => a
mempty :: HList w1) HList w2
w)
  let (HList w1
o, HList w2
w') = HList (Append w1 w2) -> (HList w1, HList w2)
forall (l1 :: [*]) (l2 :: [*]).
HInit l1 =>
HList (Append l1 l2) -> (HList l1, HList l2)
hSplit HList (Append w1 w2)
ws'
  HList w2 -> StateT (HList w2) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put HList w2
w'
  (a, HList w1) -> StateT (HList w2) m (a, HList w1)
forall (m :: * -> *) a. Monad m => a -> m a
return ((a, HList w1) -> StateT (HList w2) m (a, HList w1))
-> (a, HList w1) -> StateT (HList w2) m (a, HList w1)
forall a b. (a -> b) -> a -> b
$ (a
a, HList w1
o)
withMultiWritersWA :: MultiWriterT (Append w1 w2) m a -> MultiWriterT w2 m (HList w1, a)
withMultiWritersWA MultiWriterT (Append w1 w2) m a
k = StateT (HList w2) m (HList w1, a)
-> MultiWriterT w2 m (HList w1, a)
forall (x :: [*]) (m :: * -> *) a.
StateT (HList x) m a -> MultiWriterT x m a
MultiWriterT (StateT (HList w2) m (HList w1, a)
 -> MultiWriterT w2 m (HList w1, a))
-> StateT (HList w2) m (HList w1, a)
-> MultiWriterT w2 m (HList w1, a)
forall a b. (a -> b) -> a -> b
$ do
  HList w2
w <- StateT (HList w2) m (HList w2)
forall s (m :: * -> *). MonadState s m => m s
get
  (a
a, HList (Append w1 w2)
ws') <- m (a, HList (Append w1 w2))
-> StateT (HList w2) m (a, HList (Append w1 w2))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (a, HList (Append w1 w2))
 -> StateT (HList w2) m (a, HList (Append w1 w2)))
-> m (a, HList (Append w1 w2))
-> StateT (HList w2) m (a, HList (Append w1 w2))
forall a b. (a -> b) -> a -> b
$ StateT (HList (Append w1 w2)) m a
-> HList (Append w1 w2) -> m (a, HList (Append w1 w2))
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (MultiWriterT (Append w1 w2) m a
-> StateT (HList (Append w1 w2)) m a
forall (x :: [*]) (m :: * -> *) a.
MultiWriterT x m a -> StateT (HList x) m a
runMultiWriterTRaw MultiWriterT (Append w1 w2) m a
k) (HList w1 -> HList w2 -> HList (Append w1 w2)
forall (ts1 :: [*]) (ts2 :: [*]).
HList ts1 -> HList ts2 -> HList (Append ts1 ts2)
hAppend (HList w1
forall a. Monoid a => a
mempty :: HList w1) HList w2
w)
  let (HList w1
o, HList w2
w') = HList (Append w1 w2) -> (HList w1, HList w2)
forall (l1 :: [*]) (l2 :: [*]).
HInit l1 =>
HList (Append l1 l2) -> (HList l1, HList l2)
hSplit HList (Append w1 w2)
ws'
  HList w2 -> StateT (HList w2) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put HList w2
w'
  (HList w1, a) -> StateT (HList w2) m (HList w1, a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((HList w1, a) -> StateT (HList w2) m (HList w1, a))
-> (HList w1, a) -> StateT (HList w2) m (HList w1, a)
forall a b. (a -> b) -> a -> b
$ (HList w1
o, a
a)
withMultiWritersW :: MultiWriterT (Append w1 w2) m a -> MultiWriterT w2 m (HList w1)
withMultiWritersW MultiWriterT (Append w1 w2) m a
k  = StateT (HList w2) m (HList w1) -> MultiWriterT w2 m (HList w1)
forall (x :: [*]) (m :: * -> *) a.
StateT (HList x) m a -> MultiWriterT x m a
MultiWriterT (StateT (HList w2) m (HList w1) -> MultiWriterT w2 m (HList w1))
-> StateT (HList w2) m (HList w1) -> MultiWriterT w2 m (HList w1)
forall a b. (a -> b) -> a -> b
$ do
  HList w2
w <- StateT (HList w2) m (HList w2)
forall s (m :: * -> *). MonadState s m => m s
get
  HList (Append w1 w2)
ws' <- m (HList (Append w1 w2))
-> StateT (HList w2) m (HList (Append w1 w2))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (HList (Append w1 w2))
 -> StateT (HList w2) m (HList (Append w1 w2)))
-> m (HList (Append w1 w2))
-> StateT (HList w2) m (HList (Append w1 w2))
forall a b. (a -> b) -> a -> b
$ StateT (HList (Append w1 w2)) m a
-> HList (Append w1 w2) -> m (HList (Append w1 w2))
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT (MultiWriterT (Append w1 w2) m a
-> StateT (HList (Append w1 w2)) m a
forall (x :: [*]) (m :: * -> *) a.
MultiWriterT x m a -> StateT (HList x) m a
runMultiWriterTRaw MultiWriterT (Append w1 w2) m a
k) (HList w1 -> HList w2 -> HList (Append w1 w2)
forall (ts1 :: [*]) (ts2 :: [*]).
HList ts1 -> HList ts2 -> HList (Append ts1 ts2)
hAppend (HList w1
forall a. Monoid a => a
mempty :: HList w1) HList w2
w)
  let (HList w1
o, HList w2
w') = HList (Append w1 w2) -> (HList w1, HList w2)
forall (l1 :: [*]) (l2 :: [*]).
HInit l1 =>
HList (Append l1 l2) -> (HList l1, HList l2)
hSplit HList (Append w1 w2)
ws'
  HList w2 -> StateT (HList w2) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put HList w2
w'
  HList w1 -> StateT (HList w2) m (HList w1)
forall (m :: * -> *) a. Monad m => a -> m a
return (HList w1 -> StateT (HList w2) m (HList w1))
-> HList w1 -> StateT (HList w2) m (HList w1)
forall a b. (a -> b) -> a -> b
$ HList w1
o

inflateWriter :: (Monad m, Monoid w, ContainsType w ws)
              => WriterT w m a
              -> MultiWriterT ws m a
inflateWriter :: WriterT w m a -> MultiWriterT ws m a
inflateWriter WriterT w m a
k = do
  (a
x, w
w) <- m (a, w) -> MultiWriterT ws m (a, w)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (a, w) -> MultiWriterT ws m (a, w))
-> m (a, w) -> MultiWriterT ws m (a, w)
forall a b. (a -> b) -> a -> b
$ WriterT w m a -> m (a, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT WriterT w m a
k
  w -> MultiWriterT ws m ()
forall a (m :: * -> *). MonadMultiWriter a m => a -> m ()
mTell w
w
  a -> MultiWriterT ws m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

-- foreign lifting instances

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

instance (MonadWriter w m) => MonadWriter w (MultiWriterT c m) where
  writer :: (a, w) -> MultiWriterT c m a
writer = m a -> MultiWriterT c m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> MultiWriterT c m a)
-> ((a, w) -> m a) -> (a, w) -> MultiWriterT c m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, w) -> m a
forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer
  tell :: w -> MultiWriterT c m ()
tell   = m () -> MultiWriterT c m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> MultiWriterT c m ())
-> (w -> m ()) -> w -> MultiWriterT c m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
  listen :: MultiWriterT c m a -> MultiWriterT c m (a, w)
listen = StateT (HList c) m (a, w) -> MultiWriterT c m (a, w)
forall (x :: [*]) (m :: * -> *) a.
StateT (HList x) m a -> MultiWriterT x m a
MultiWriterT (StateT (HList c) m (a, w) -> MultiWriterT c m (a, w))
-> (MultiWriterT c m a -> StateT (HList c) m (a, w))
-> MultiWriterT c m a
-> MultiWriterT c m (a, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (m (a, HList c) -> m ((a, w), HList c))
-> StateT (HList c) m a -> StateT (HList c) m (a, w)
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT ((((a, HList c), w) -> ((a, w), HList c))
-> m ((a, HList c), w) -> m ((a, w), HList c)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\((a
a,HList c
w), w
w') -> ((a
a, w
w'), HList c
w)) (m ((a, HList c), w) -> m ((a, w), HList c))
-> (m (a, HList c) -> m ((a, HList c), w))
-> m (a, HList c)
-> m ((a, w), HList c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (a, HList c) -> m ((a, HList c), w)
forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen) (StateT (HList c) m a -> StateT (HList c) m (a, w))
-> (MultiWriterT c m a -> StateT (HList c) m a)
-> MultiWriterT c m a
-> StateT (HList c) m (a, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    MultiWriterT c m a -> StateT (HList c) m a
forall (x :: [*]) (m :: * -> *) a.
MultiWriterT x m a -> StateT (HList x) m a
runMultiWriterTRaw
  pass :: MultiWriterT c m (a, w -> w) -> MultiWriterT c m a
pass = StateT (HList c) m a -> MultiWriterT c m a
forall (x :: [*]) (m :: * -> *) a.
StateT (HList x) m a -> MultiWriterT x m a
MultiWriterT (StateT (HList c) m a -> MultiWriterT c m a)
-> (MultiWriterT c m (a, w -> w) -> StateT (HList c) m a)
-> MultiWriterT c m (a, w -> w)
-> MultiWriterT c m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (m ((a, w -> w), HList c) -> m (a, HList c))
-> StateT (HList c) m (a, w -> w) -> StateT (HList c) m a
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT (m ((a, HList c), w -> w) -> m (a, HList c)
forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass (m ((a, HList c), w -> w) -> m (a, HList c))
-> (m ((a, w -> w), HList c) -> m ((a, HList c), w -> w))
-> m ((a, w -> w), HList c)
-> m (a, HList c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((a, w -> w), HList c) -> ((a, HList c), w -> w))
-> m ((a, w -> w), HList c) -> m ((a, HList c), w -> w)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\((a
a, w -> w
f), HList c
w) -> ((a
a, HList c
w), w -> w
f))) (StateT (HList c) m (a, w -> w) -> StateT (HList c) m a)
-> (MultiWriterT c m (a, w -> w) -> StateT (HList c) m (a, w -> w))
-> MultiWriterT c m (a, w -> w)
-> StateT (HList c) m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    MultiWriterT c m (a, w -> w) -> StateT (HList c) m (a, w -> w)
forall (x :: [*]) (m :: * -> *) a.
MultiWriterT x m a -> StateT (HList x) m a
runMultiWriterTRaw

instance MonadIO m => MonadIO (MultiWriterT c m) where
  liftIO :: IO a -> MultiWriterT c m a
liftIO = m a -> MultiWriterT c m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> MultiWriterT c m a)
-> (IO a -> m a) -> IO a -> MultiWriterT c m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance (Functor m, Applicative m, MonadPlus m) => Alternative (MultiWriterT c m) where
  empty :: MultiWriterT c m a
empty = m a -> MultiWriterT c m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  MultiWriterT StateT (HList c) m a
m <|> :: MultiWriterT c m a -> MultiWriterT c m a -> MultiWriterT c m a
<|> MultiWriterT StateT (HList c) m a
n = StateT (HList c) m a -> MultiWriterT c m a
forall (x :: [*]) (m :: * -> *) a.
StateT (HList x) m a -> MultiWriterT x m a
MultiWriterT (StateT (HList c) m a -> MultiWriterT c m a)
-> StateT (HList c) m a -> MultiWriterT c m a
forall a b. (a -> b) -> a -> b
$ StateT (HList c) m a
m StateT (HList c) m a
-> StateT (HList c) m a -> StateT (HList c) m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT (HList c) m a
n

instance MonadPlus m => MonadPlus (MultiWriterT c m) where
  mzero :: MultiWriterT c m a
mzero = StateT (HList c) m a -> MultiWriterT c m a
forall (x :: [*]) (m :: * -> *) a.
StateT (HList x) m a -> MultiWriterT x m a
MultiWriterT (StateT (HList c) m a -> MultiWriterT c m a)
-> StateT (HList c) m a -> MultiWriterT c m a
forall a b. (a -> b) -> a -> b
$ StateT (HList c) m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  MultiWriterT StateT (HList c) m a
m mplus :: MultiWriterT c m a -> MultiWriterT c m a -> MultiWriterT c m a
`mplus` MultiWriterT StateT (HList c) m a
n = StateT (HList c) m a -> MultiWriterT c m a
forall (x :: [*]) (m :: * -> *) a.
StateT (HList x) m a -> MultiWriterT x m a
MultiWriterT (StateT (HList c) m a -> MultiWriterT c m a)
-> StateT (HList c) m a -> MultiWriterT c m a
forall a b. (a -> b) -> a -> b
$ StateT (HList c) m a
m StateT (HList c) m a
-> StateT (HList c) m a -> StateT (HList c) m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` StateT (HList c) m a
n

instance MonadBase b m => MonadBase b (MultiWriterT c m) where
  liftBase :: b α -> MultiWriterT c m α
liftBase = b α -> MultiWriterT c m α
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) α.
(MonadTrans t, MonadBase b m) =>
b α -> t m α
liftBaseDefault

instance MonadTransControl (MultiWriterT c) where
  type StT (MultiWriterT c) a = (a, HList c)
  liftWith :: (Run (MultiWriterT c) -> m a) -> MultiWriterT c m a
liftWith Run (MultiWriterT c) -> m a
f = StateT (HList c) m a -> MultiWriterT c m a
forall (x :: [*]) (m :: * -> *) a.
StateT (HList x) m a -> MultiWriterT x m a
MultiWriterT (StateT (HList c) m a -> MultiWriterT c m a)
-> StateT (HList c) m a -> MultiWriterT c m a
forall a b. (a -> b) -> a -> b
$ (Run (StateT (HList c)) -> m a) -> StateT (HList c) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith ((Run (StateT (HList c)) -> m a) -> StateT (HList c) m a)
-> (Run (StateT (HList c)) -> m a) -> StateT (HList c) m a
forall a b. (a -> b) -> a -> b
$ \Run (StateT (HList c))
s -> Run (MultiWriterT c) -> m a
f (Run (MultiWriterT c) -> m a) -> Run (MultiWriterT c) -> m a
forall a b. (a -> b) -> a -> b
$ \MultiWriterT c n b
r -> StateT (HList c) n b -> n (StT (StateT (HList c)) b)
Run (StateT (HList c))
s (StateT (HList c) n b -> n (StT (StateT (HList c)) b))
-> StateT (HList c) n b -> n (StT (StateT (HList c)) b)
forall a b. (a -> b) -> a -> b
$ MultiWriterT c n b -> StateT (HList c) n b
forall (x :: [*]) (m :: * -> *) a.
MultiWriterT x m a -> StateT (HList x) m a
runMultiWriterTRaw MultiWriterT c n b
r
  restoreT :: m (StT (MultiWriterT c) a) -> MultiWriterT c m a
restoreT = StateT (HList c) m a -> MultiWriterT c m a
forall (x :: [*]) (m :: * -> *) a.
StateT (HList x) m a -> MultiWriterT x m a
MultiWriterT (StateT (HList c) m a -> MultiWriterT c m a)
-> (m (a, HList c) -> StateT (HList c) m a)
-> m (a, HList c)
-> MultiWriterT c m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (a, HList c) -> StateT (HList c) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT

instance MonadBaseControl b m => MonadBaseControl b (MultiWriterT c m) where
  type StM (MultiWriterT c m) a = ComposeSt (MultiWriterT c) m a
  liftBaseWith :: (RunInBase (MultiWriterT c m) b -> b a) -> MultiWriterT c m a
liftBaseWith = (RunInBase (MultiWriterT c m) b -> b a) -> MultiWriterT c m a
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
(RunInBaseDefault t m b -> b a) -> t m a
defaultLiftBaseWith
  restoreM :: StM (MultiWriterT c m) a -> MultiWriterT c m a
restoreM = StM (MultiWriterT c m) a -> MultiWriterT c m a
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
ComposeSt t m a -> t m a
defaultRestoreM