{-|
  This package contains MonadLoc instance declarations for the monad
  transformer type constructors in the @transformers@ package.
-}

module Control.Monad.Loc.Transformers where

import Control.Monad.Loc

import Control.Monad.Trans.Error
import Control.Monad.Trans.List
import Control.Monad.Trans.Reader
import Control.Monad.Trans.State.Lazy     as Lazy
import Control.Monad.Trans.State.Strict   as Strict
import Control.Monad.Trans.Writer.Lazy    as Lazy
import Control.Monad.Trans.Writer.Strict  as Strict
import Control.Monad.Trans.RWS.Lazy       as Lazy
import Control.Monad.Trans.RWS.Strict     as Strict
import Data.Monoid

instance MonadLoc m => MonadLoc (ListT m) where
  withLoc :: String -> ListT m a -> ListT m a
withLoc String
l = m [a] -> ListT m a
forall (m :: * -> *) a. m [a] -> ListT m a
ListT (m [a] -> ListT m a)
-> (ListT m a -> m [a]) -> ListT m a -> ListT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m [a] -> m [a]
forall (m :: * -> *) a. MonadLoc m => String -> m a -> m a
withLoc String
l (m [a] -> m [a]) -> (ListT m a -> m [a]) -> ListT m a -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListT m a -> m [a]
forall (m :: * -> *) a. ListT m a -> m [a]
runListT

instance (Error e, MonadLoc m) => MonadLoc (ErrorT e m) where
  withLoc :: String -> ErrorT e m a -> ErrorT e m a
withLoc String
l = m (Either e a) -> ErrorT e m a
forall e (m :: * -> *) a. m (Either e a) -> ErrorT e m a
ErrorT (m (Either e a) -> ErrorT e m a)
-> (ErrorT e m a -> m (Either e a)) -> ErrorT e m a -> ErrorT e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m (Either e a) -> m (Either e a)
forall (m :: * -> *) a. MonadLoc m => String -> m a -> m a
withLoc String
l (m (Either e a) -> m (Either e a))
-> (ErrorT e m a -> m (Either e a))
-> ErrorT e m a
-> m (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorT e m a -> m (Either e a)
forall e (m :: * -> *) a. ErrorT e m a -> m (Either e a)
runErrorT

instance MonadLoc m => MonadLoc (ReaderT r m) where
  withLoc :: String -> ReaderT r m a -> ReaderT r m a
withLoc String
l ReaderT r m a
m = (r -> m a) -> ReaderT r m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m a) -> ReaderT r m a) -> (r -> m a) -> ReaderT r m a
forall a b. (a -> b) -> a -> b
$ \r
r -> String -> m a -> m a
forall (m :: * -> *) a. MonadLoc m => String -> m a -> m a
withLoc String
l (m a -> m a) -> m a -> m a
forall a b. (a -> b) -> a -> b
$ ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT r m a
m r
r

instance (Monoid w, MonadLoc m) => MonadLoc (Lazy.WriterT w  m) where
  withLoc :: String -> WriterT w m a -> WriterT w m a
withLoc String
l = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT (m (a, w) -> WriterT w m a)
-> (WriterT w m a -> m (a, w)) -> WriterT w m a -> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m (a, w) -> m (a, w)
forall (m :: * -> *) a. MonadLoc m => String -> m a -> m a
withLoc String
l (m (a, w) -> m (a, w))
-> (WriterT w m a -> m (a, w)) -> WriterT w m a -> m (a, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT w m a -> m (a, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Lazy.runWriterT

instance MonadLoc m => MonadLoc (Lazy.StateT s m) where
  withLoc :: String -> StateT s m a -> StateT s m a
withLoc String
l StateT s m a
m = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \s
s -> String -> m (a, s) -> m (a, s)
forall (m :: * -> *) a. MonadLoc m => String -> m a -> m a
withLoc String
l (m (a, s) -> m (a, s)) -> m (a, s) -> m (a, s)
forall a b. (a -> b) -> a -> b
$ StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Lazy.runStateT StateT s m a
m s
s

instance (Monoid w, MonadLoc m) => MonadLoc (Lazy.RWST r w s m) where
  withLoc :: String -> RWST r w s m a -> RWST r w s m a
withLoc String
l RWST r w s m a
m = (r -> s -> m (a, s, w)) -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (r -> s -> m (a, s, w)) -> RWST r w s m a
forall a b. (a -> b) -> a -> b
$ \r
r s
s -> String -> m (a, s, w) -> m (a, s, w)
forall (m :: * -> *) a. MonadLoc m => String -> m a -> m a
withLoc String
l (m (a, s, w) -> m (a, s, w)) -> m (a, s, w) -> m (a, s, w)
forall a b. (a -> b) -> a -> b
$ RWST r w s m a -> r -> s -> m (a, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Lazy.runRWST RWST r w s m a
m r
r s
s

instance (Monoid w, MonadLoc m) => MonadLoc (Strict.WriterT w  m) where
  withLoc :: String -> WriterT w m a -> WriterT w m a
withLoc String
l = m (a, w) -> WriterT w m a
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT (m (a, w) -> WriterT w m a)
-> (WriterT w m a -> m (a, w)) -> WriterT w m a -> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m (a, w) -> m (a, w)
forall (m :: * -> *) a. MonadLoc m => String -> m a -> m a
withLoc String
l (m (a, w) -> m (a, w))
-> (WriterT w m a -> m (a, w)) -> WriterT w m a -> m (a, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT w m a -> m (a, w)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
Strict.runWriterT

instance MonadLoc m => MonadLoc (Strict.StateT s m) where
  withLoc :: String -> StateT s m a -> StateT s m a
withLoc String
l StateT s m a
m = (s -> m (a, s)) -> StateT s m a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT ((s -> m (a, s)) -> StateT s m a)
-> (s -> m (a, s)) -> StateT s m a
forall a b. (a -> b) -> a -> b
$ \s
s -> String -> m (a, s) -> m (a, s)
forall (m :: * -> *) a. MonadLoc m => String -> m a -> m a
withLoc String
l (m (a, s) -> m (a, s)) -> m (a, s) -> m (a, s)
forall a b. (a -> b) -> a -> b
$ StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
Strict.runStateT StateT s m a
m s
s

instance (Monoid w, MonadLoc m) => MonadLoc (Strict.RWST r w s m) where
  withLoc :: String -> RWST r w s m a -> RWST r w s m a
withLoc String
l RWST r w s m a
m = (r -> s -> m (a, s, w)) -> RWST r w s m a
forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST ((r -> s -> m (a, s, w)) -> RWST r w s m a)
-> (r -> s -> m (a, s, w)) -> RWST r w s m a
forall a b. (a -> b) -> a -> b
$ \r
r s
s -> String -> m (a, s, w) -> m (a, s, w)
forall (m :: * -> *) a. MonadLoc m => String -> m a -> m a
withLoc String
l (m (a, s, w) -> m (a, s, w)) -> m (a, s, w) -> m (a, s, w)
forall a b. (a -> b) -> a -> b
$ RWST r w s m a -> r -> s -> m (a, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
Strict.runRWST RWST r w s m a
m r
r s
s