constrained-monads-0.5.0.0: Typeclasses and instances for monads with constraints.

Safe HaskellNone
LanguageHaskell2010

Control.Monad.Constrained.Writer

Description

This module duplicates the Control.Monad.Writer module from the mtl, for constrained monads. It also provides a non-leaky writer monad.

Synopsis

Documentation

class (Monoid w, Monad m) => MonadWriter w m | m -> w where Source #

A class for monads with logging ability.

Minimal complete definition

writer, tell, listenC, passC

Associated Types

type WriterSuitable m a :: Constraint Source #

Methods

writer :: WriterSuitable m a => (a, w) -> m a Source #

Embed a simple writer action.

tell :: WriterSuitable m () => w -> m () Source #

Log some output.

listenC :: WriterSuitable m b => (a -> w -> b) -> m a -> m b Source #

This is equivalent to the listen function, except it is church encoded, to make the constraints a little easier to manage.

passC :: WriterSuitable m a => (a -> w -> w) -> m a -> m a Source #

This is equivalent to the pass function, except it is church encoded, to make the constraints a little easier to manage.

Instances

(MonadWriter w m, Monad (Unconstrained m)) => MonadWriter w (MaybeT m) Source # 

Associated Types

type WriterSuitable (MaybeT m :: * -> *) a :: Constraint Source #

Methods

writer :: WriterSuitable (MaybeT m) a => (a, w) -> MaybeT m a Source #

tell :: w -> MaybeT m () Source #

listenC :: WriterSuitable (MaybeT m) b => (a -> w -> b) -> MaybeT m a -> MaybeT m b Source #

passC :: WriterSuitable (MaybeT m) a => (a -> w -> w) -> MaybeT m a -> MaybeT m a Source #

(Monoid s, Monad m, Monad (Unconstrained m)) => MonadWriter s (WriterT s m) Source # 

Associated Types

type WriterSuitable (WriterT s m :: * -> *) a :: Constraint Source #

Methods

writer :: WriterSuitable (WriterT s m) a => (a, s) -> WriterT s m a Source #

tell :: s -> WriterT s m () Source #

listenC :: WriterSuitable (WriterT s m) b => (a -> s -> b) -> WriterT s m a -> WriterT s m b Source #

passC :: WriterSuitable (WriterT s m) a => (a -> s -> s) -> WriterT s m a -> WriterT s m a Source #

MonadWriter w m => MonadWriter w (IdentityT * m) Source # 

Associated Types

type WriterSuitable (IdentityT * m :: * -> *) a :: Constraint Source #

Methods

writer :: WriterSuitable (IdentityT * m) a => (a, w) -> IdentityT * m a Source #

tell :: w -> IdentityT * m () Source #

listenC :: WriterSuitable (IdentityT * m) b => (a -> w -> b) -> IdentityT * m a -> IdentityT * m b Source #

passC :: WriterSuitable (IdentityT * m) a => (a -> w -> w) -> IdentityT * m a -> IdentityT * m a Source #

(MonadWriter w m, Monad (Unconstrained m)) => MonadWriter w (StateT s m) Source # 

Associated Types

type WriterSuitable (StateT s m :: * -> *) a :: Constraint Source #

Methods

writer :: WriterSuitable (StateT s m) a => (a, w) -> StateT s m a Source #

tell :: w -> StateT s m () Source #

listenC :: WriterSuitable (StateT s m) b => (a -> w -> b) -> StateT s m a -> StateT s m b Source #

passC :: WriterSuitable (StateT s m) a => (a -> w -> w) -> StateT s m a -> StateT s m a Source #

(MonadWriter w m, Monad (Unconstrained m)) => MonadWriter w (StateT s m) Source # 

Associated Types

type WriterSuitable (StateT s m :: * -> *) a :: Constraint Source #

Methods

writer :: WriterSuitable (StateT s m) a => (a, w) -> StateT s m a Source #

tell :: w -> StateT s m () Source #

listenC :: WriterSuitable (StateT s m) b => (a -> w -> b) -> StateT s m a -> StateT s m b Source #

passC :: WriterSuitable (StateT s m) a => (a -> w -> w) -> StateT s m a -> StateT s m a Source #

(MonadWriter w m, Monad (Unconstrained m)) => MonadWriter w (ExceptT e m) Source # 

Associated Types

type WriterSuitable (ExceptT e m :: * -> *) a :: Constraint Source #

Methods

writer :: WriterSuitable (ExceptT e m) a => (a, w) -> ExceptT e m a Source #

tell :: w -> ExceptT e m () Source #

listenC :: WriterSuitable (ExceptT e m) b => (a -> w -> b) -> ExceptT e m a -> ExceptT e m b Source #

passC :: WriterSuitable (ExceptT e m) a => (a -> w -> w) -> ExceptT e m a -> ExceptT e m a Source #

MonadWriter w m => MonadWriter w (ReaderT * r m) Source # 

Associated Types

type WriterSuitable (ReaderT * r m :: * -> *) a :: Constraint Source #

Methods

writer :: WriterSuitable (ReaderT * r m) a => (a, w) -> ReaderT * r m a Source #

tell :: w -> ReaderT * r m () Source #

listenC :: WriterSuitable (ReaderT * r m) b => (a -> w -> b) -> ReaderT * r m a -> ReaderT * r m b Source #

passC :: WriterSuitable (ReaderT * r m) a => (a -> w -> w) -> ReaderT * r m a -> ReaderT * r m a Source #

data WriterT s m a Source #

A monad transformer similar to WriterT, except that it does not leak space. It is implemented using a state monad, so that mappend is tail recursive. See this email to the Haskell libraries committee for more information.

Wherever possible, coercions are used to eliminate any overhead from the newtype wrapper.

Instances

(MonadError e m, Monad (Unconstrained m)) => MonadError e (WriterT w m) Source # 

Associated Types

type SuitableError (WriterT w m :: * -> *) a :: Constraint Source #

Methods

throwError :: SuitableError (WriterT w m) a => e -> WriterT w m a Source #

catchError :: SuitableError (WriterT w m) a => WriterT w m a -> (e -> WriterT w m a) -> WriterT w m a Source #

(MonadReader r m, Monad (Unconstrained m)) => MonadReader r (WriterT w m) Source # 

Associated Types

type ReaderSuitable (WriterT w m :: * -> *) a :: Constraint Source #

Methods

ask :: WriterT w m r Source #

local :: (ReaderSuitable (WriterT w m) a, ReaderSuitable (WriterT w m) r) => (r -> r) -> WriterT w m a -> WriterT w m a Source #

reader :: (ReaderSuitable (WriterT w m) r, ReaderSuitable (WriterT w m) a) => (r -> a) -> WriterT w m a Source #

(MonadState s m, Monad (Unconstrained m)) => MonadState s (WriterT w m) Source # 

Associated Types

type StateSuitable (WriterT w m :: * -> *) a :: Constraint Source #

Methods

get :: WriterT w m s Source #

put :: s -> WriterT w m () Source #

state :: (StateSuitable (WriterT w m) a, StateSuitable (WriterT w m) s) => (s -> (a, s)) -> WriterT w m a Source #

(Monoid s, Monad m, Monad (Unconstrained m)) => MonadWriter s (WriterT s m) Source # 

Associated Types

type WriterSuitable (WriterT s m :: * -> *) a :: Constraint Source #

Methods

writer :: WriterSuitable (WriterT s m) a => (a, s) -> WriterT s m a Source #

tell :: s -> WriterT s m () Source #

listenC :: WriterSuitable (WriterT s m) b => (a -> s -> b) -> WriterT s m a -> WriterT s m b Source #

passC :: WriterSuitable (WriterT s m) a => (a -> s -> s) -> WriterT s m a -> WriterT s m a Source #

MonadTrans (WriterT w) Source # 

Associated Types

type SuitableLift (WriterT w :: (* -> *) -> * -> *) (m :: * -> *) a :: Constraint Source #

Methods

lift :: (Monad m, SuitableLift (WriterT w) m a) => m a -> WriterT w m a Source #

(Foldable m, Monoid w) => Foldable (WriterT w m) Source # 

Methods

fold :: Monoid m => WriterT w m m -> m #

foldMap :: Monoid m => (a -> m) -> WriterT w m a -> m #

foldr :: (a -> b -> b) -> b -> WriterT w m a -> b #

foldr' :: (a -> b -> b) -> b -> WriterT w m a -> b #

foldl :: (b -> a -> b) -> b -> WriterT w m a -> b #

foldl' :: (b -> a -> b) -> b -> WriterT w m a -> b #

foldr1 :: (a -> a -> a) -> WriterT w m a -> a #

foldl1 :: (a -> a -> a) -> WriterT w m a -> a #

toList :: WriterT w m a -> [a] #

null :: WriterT w m a -> Bool #

length :: WriterT w m a -> Int #

elem :: Eq a => a -> WriterT w m a -> Bool #

maximum :: Ord a => WriterT w m a -> a #

minimum :: Ord a => WriterT w m a -> a #

sum :: Num a => WriterT w m a -> a #

product :: Num a => WriterT w m a -> a #

(Eq1 m, Eq w, Monoid w) => Eq1 (WriterT w m) Source # 

Methods

liftEq :: (a -> b -> Bool) -> WriterT w m a -> WriterT w m b -> Bool #

(Ord1 m, Ord w, Monoid w) => Ord1 (WriterT w m) Source # 

Methods

liftCompare :: (a -> b -> Ordering) -> WriterT w m a -> WriterT w m b -> Ordering #

(Show w, Show1 m, Monoid w) => Show1 (WriterT w m) Source # 

Methods

liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> WriterT w m a -> ShowS #

liftShowList :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> [WriterT w m a] -> ShowS #

(Monad m, Monad (Unconstrained m)) => Monad (WriterT s m) Source # 

Methods

(>>=) :: Suitable (WriterT s m) b => WriterT s m a -> (a -> WriterT s m b) -> WriterT s m b Source #

(Monad m, Monad (Unconstrained m)) => Applicative (WriterT s m) Source # 

Associated Types

type Unconstrained (WriterT s m :: * -> *) :: * -> * Source #

Methods

reflect :: WriterT s m a -> Unconstrained (WriterT s m) a Source #

reify :: Suitable (WriterT s m) a => Unconstrained (WriterT s m) a -> WriterT s m a Source #

pure :: Suitable (WriterT s m) a => a -> WriterT s m a Source #

(<*>) :: Suitable (WriterT s m) b => WriterT s m (a -> b) -> WriterT s m a -> WriterT s m b Source #

(*>) :: Suitable (WriterT s m) b => WriterT s m a -> WriterT s m b -> WriterT s m b Source #

(<*) :: Suitable (WriterT s m) a => WriterT s m a -> WriterT s m b -> WriterT s m a Source #

liftA2 :: Suitable (WriterT s m) c => (a -> b -> c) -> WriterT s m a -> WriterT s m b -> WriterT s m c Source #

liftA3 :: Suitable (WriterT s m) d => (a -> b -> c -> d) -> WriterT s m a -> WriterT s m b -> WriterT s m c -> WriterT s m d Source #

Functor m => Functor (WriterT s m) Source # 

Associated Types

type Suitable (WriterT s m :: * -> *) a :: Constraint Source #

Methods

fmap :: Suitable (WriterT s m) b => (a -> b) -> WriterT s m a -> WriterT s m b Source #

(<$) :: Suitable (WriterT s m) a => a -> WriterT s m b -> WriterT s m a Source #

(Eq w, Eq1 m, Eq a, Monoid w) => Eq (WriterT w m a) Source # 

Methods

(==) :: WriterT w m a -> WriterT w m a -> Bool #

(/=) :: WriterT w m a -> WriterT w m a -> Bool #

(Ord w, Ord1 m, Ord a, Monoid w) => Ord (WriterT w m a) Source # 

Methods

compare :: WriterT w m a -> WriterT w m a -> Ordering #

(<) :: WriterT w m a -> WriterT w m a -> Bool #

(<=) :: WriterT w m a -> WriterT w m a -> Bool #

(>) :: WriterT w m a -> WriterT w m a -> Bool #

(>=) :: WriterT w m a -> WriterT w m a -> Bool #

max :: WriterT w m a -> WriterT w m a -> WriterT w m a #

min :: WriterT w m a -> WriterT w m a -> WriterT w m a #

(Show w, Show1 m, Show a, Monoid w) => Show (WriterT w m a) Source # 

Methods

showsPrec :: Int -> WriterT w m a -> ShowS #

show :: WriterT w m a -> String #

showList :: [WriterT w m a] -> ShowS #

type SuitableLift (WriterT w) m a Source # 
type SuitableLift (WriterT w) m a = Suitable m (a, w)
type Unconstrained (WriterT s m) Source # 
type Unconstrained (WriterT s m) = Ap (WriterT s m)
type Suitable (WriterT s m) a Source # 
type Suitable (WriterT s m) a = Suitable m (a, s)
type SuitableError (WriterT w m) a Source # 
type SuitableError (WriterT w m) a = SuitableError m (a, w)
type ReaderSuitable (WriterT w m) a Source # 
type ReaderSuitable (WriterT w m) a = (ReaderSuitable m a, Suitable m (a, w), ReaderSuitable m (a, w))
type StateSuitable (WriterT w m) a Source # 
type StateSuitable (WriterT w m) a = (StateSuitable m a, Suitable m (a, w))
type WriterSuitable (WriterT s m) a Source # 
type WriterSuitable (WriterT s m) a = Suitable m (a, s)

pattern WriterT :: forall m s a. (Functor m, Monoid s, Suitable m (a, s)) => m (a, s) -> WriterT s m a Source #

This pattern gives the newtype wrapper around StateT the same interface as WriterT. Unfortunately, GHC currently warns that a function is incomplete wherever this pattern is used. This issue should be solved in a future version of GHC, when the COMPLETE pragma is implemented.

type Writer s = WriterT s Identity Source #

A type synonym for the plain (non-transformer) version of WriterT. This can be used as if it were defined as:

newtype Writer w a = Writer { runWriter :: (a, w) }

runWriterT :: Monoid s => WriterT s m a -> m (a, s) Source #

Run a writer computation in the underlying monad.

execWriterT :: (Monad m, Monoid s, Suitable m s) => WriterT s m a -> m s Source #

Run a writer computation in the underlying monad, and collect its output.

execWriter :: Monoid s => Writer s a -> s Source #

Run a writer computation, and collect its output.

runWriter :: Monoid s => Writer s a -> (a, s) Source #

Run a writer computation.

>>> runWriter $ traverse (\x -> writer (show x, [x])) [1..5]
(["1","2","3","4","5"],[1,2,3,4,5])

listen :: (MonadWriter w m, WriterSuitable m (a, w)) => m a -> m (a, w) Source #

listen m is an action that executes the action m and adds its output to the value of the computation.

pass :: (MonadWriter w m, Suitable m a, WriterSuitable m (a, w -> w)) => m (a, w -> w) -> m a Source #

pass m is an action that executes the action m, which returns a value and a function, and returns the value, applying the function to the output.

evalWriterT :: (Monad m, Monoid s, Suitable m a) => WriterT s m a -> m a Source #

Run a writer computation in the underlying monad, and return its result.

evalWriter :: Monoid s => Writer s a -> a Source #

Run a writer computation, and return its result.