{-# LANGUAGE CPP #-}#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Safe #-}#endif
#if __GLASGOW_HASKELL__ >= 710
{-# LANGUAGE AutoDeriveTypeable #-}#endif
------------------------------------------------------------------------------- |-- Module : Control.Monad.Trans.Writer.Strict-- Copyright : (c) Andy Gill 2001,-- (c) Oregon Graduate Institute of Science and Technology, 2001-- License : BSD-style (see the file LICENSE)---- Maintainer : R.Paterson@city.ac.uk-- Stability : experimental-- Portability : portable---- The strict 'WriterT' monad transformer, which adds collection of-- outputs (such as a count or string output) to a given monad.---- This monad transformer provides only limited access to the output-- during the computation. For more general access, use-- "Control.Monad.Trans.State" instead.---- This version builds its output strictly; for a lazy version with-- the same interface, see "Control.Monad.Trans.Writer.Lazy".-- Although the output is built strictly, it is not possible to-- achieve constant space behaviour with this transformer: for that,-- use "Control.Monad.Trans.State.Strict" instead.-----------------------------------------------------------------------------moduleControl.Monad.Trans.Writer.Strict(-- * The Writer monadWriter ,writer ,runWriter ,execWriter ,mapWriter ,-- * The WriterT monad transformerWriterT (..),execWriterT ,mapWriterT ,-- * Writer operationstell ,listen ,listens ,pass ,censor ,-- * Lifting other operationsliftCallCC ,liftCatch ,)whereimportControl.Monad.IO.ClassimportControl.Monad.Trans.Class importData.Functor.ClassesimportData.Functor.IdentityimportControl.ApplicativeimportControl.Monad#if MIN_VERSION_base(4,9,0)
importqualifiedControl.Monad.FailasFail#endif
importControl.Monad.FiximportControl.Monad.Signatures #if MIN_VERSION_base(4,4,0)
importControl.Monad.Zip(MonadZip(mzipWith))#endif
importData.FoldableimportData.MonoidimportData.Traversable(Traversable(traverse))importPreludehiding(null,length)-- ----------------------------------------------------------------------------- | A writer monad parameterized by the type @w@ of output to accumulate.---- The 'return' function produces the output 'mempty', while @>>=@-- combines the outputs of the subcomputations using 'mappend'.typeWriter w =WriterT w Identity-- | Construct a writer computation from a (result, output) pair.-- (The inverse of 'runWriter'.)writer::(Monadm )=>(a ,w )->WriterT w m a writer =WriterT .return{-# INLINEwriter#-}-- | Unwrap a writer computation as a (result, output) pair.-- (The inverse of 'writer'.)runWriter::Writer w a ->(a ,w )runWriter =runIdentity.runWriterT{-# INLINErunWriter#-}-- | Extract the output from a writer computation.---- * @'execWriter' m = 'snd' ('runWriter' m)@execWriter::Writer w a ->w execWriter m =snd(runWriter m ){-# INLINEexecWriter#-}-- | Map both the return value and output of a computation using-- the given function.---- * @'runWriter' ('mapWriter' f m) = f ('runWriter' m)@mapWriter::((a ,w )->(b ,w' ))->Writer w a ->Writer w' b mapWriter f =mapWriterT (Identity.f .runIdentity){-# INLINEmapWriter#-}-- ----------------------------------------------------------------------------- | A writer monad parameterized by:---- * @w@ - the output to accumulate.---- * @m@ - The inner monad.---- The 'return' function produces the output 'mempty', while @>>=@-- combines the outputs of the subcomputations using 'mappend'.newtypeWriterT w m a =WriterT {runWriterT ::m (a ,w )}instance(Eqw ,Eq1m )=>Eq1(WriterT w m )whereliftEq eq (WriterT m1 )(WriterT m2 )=liftEq(liftEq2eq (==))m1 m2 {-# INLINEliftEq#-}instance(Ordw ,Ord1m )=>Ord1(WriterT w m )whereliftCompare comp (WriterT m1 )(WriterT m2 )=liftCompare(liftCompare2comp compare)m1 m2 {-# INLINEliftCompare#-}instance(Readw ,Read1m )=>Read1(WriterT w m )whereliftReadsPrec rp rl =readsData$readsUnaryWith(liftReadsPrecrp' rl' )"WriterT"WriterT whererp' =liftReadsPrec2rp rl readsPrecreadListrl' =liftReadList2rp rl readsPrecreadListinstance(Showw ,Show1m )=>Show1(WriterT w m )whereliftShowsPrec sp sl d (WriterT m )=showsUnaryWith(liftShowsPrecsp' sl' )"WriterT"d m wheresp' =liftShowsPrec2sp sl showsPrecshowListsl' =liftShowList2sp sl showsPrecshowListinstance(Eqw ,Eq1m ,Eqa )=>Eq(WriterT w m a )where(== )=eq1instance(Ordw ,Ord1m ,Orda )=>Ord(WriterT w m a )wherecompare =compare1instance(Readw ,Read1m ,Reada )=>Read(WriterT w m a )wherereadsPrec =readsPrec1instance(Showw ,Show1m ,Showa )=>Show(WriterT w m a )whereshowsPrec =showsPrec1-- | Extract the output from a writer computation.---- * @'execWriterT' m = 'liftM' 'snd' ('runWriterT' m)@execWriterT::(Monadm )=>WriterT w m a ->m w execWriterT m =do(_,w )<-runWriterTm returnw {-# INLINEexecWriterT#-}-- | Map both the return value and output of a computation using-- the given function.---- * @'runWriterT' ('mapWriterT' f m) = f ('runWriterT' m)@mapWriterT::(m (a ,w )->n (b ,w' ))->WriterT w m a ->WriterT w' n b mapWriterT f m =WriterT $f (runWriterTm ){-# INLINEmapWriterT#-}instance(Functorm )=>Functor(WriterT w m )wherefmap f =mapWriterT $fmap$\(a ,w )->(f a ,w ){-# INLINEfmap#-}instance(Foldablef )=>Foldable(WriterT w f )wherefoldMap f =foldMap(f .fst).runWriterT{-# INLINEfoldMap#-}#if MIN_VERSION_base(4,8,0)
null (WriterT t )=nullt length (WriterT t )=lengtht #endif
instance(Traversablef )=>Traversable(WriterT w f )wheretraverse f =fmapWriterT .traversef' .runWriterTwheref' (a ,b )=fmap(\c ->(c ,b ))(f a ){-# INLINEtraverse#-}instance(Monoidw ,Applicativem )=>Applicative(WriterT w m )wherepure a =WriterT $pure(a ,mempty){-# INLINEpure#-}f <*> v =WriterT $liftA2k (runWriterTf )(runWriterTv )wherek (a ,w )(b ,w' )=(a b ,w `mappend`w' ){-# INLINE(<*>)#-}instance(Monoidw ,Alternativem )=>Alternative(WriterT w m )whereempty =WriterT empty{-# INLINEempty#-}m <|> n =WriterT $runWriterTm <|>runWriterTn {-# INLINE(<|>)#-}instance(Monoidw ,Monadm )=>Monad(WriterT w m )where#if !(MIN_VERSION_base(4,8,0))
returna=writer(a,mempty){-# INLINEreturn#-}#endif
m >>= k =WriterT $do(a ,w )<-runWriterTm (b ,w' )<-runWriterT(k a )return(b ,w `mappend`w' ){-# INLINE(>>=)#-}fail msg =WriterT $failmsg {-# INLINEfail#-}#if MIN_VERSION_base(4,9,0)
instance(Monoidw ,Fail.MonadFailm )=>Fail.MonadFail(WriterT w m )wherefail msg =WriterT $Fail.failmsg {-# INLINEfail#-}#endif
instance(Monoidw ,MonadPlusm )=>MonadPlus(WriterT w m )wheremzero =WriterT mzero{-# INLINEmzero#-}m `mplus `n =WriterT $runWriterTm `mplus`runWriterTn {-# INLINEmplus#-}instance(Monoidw ,MonadFixm )=>MonadFix(WriterT w m )wheremfix m =WriterT $mfix$\~(a ,_)->runWriterT(m a ){-# INLINEmfix#-}instance(Monoidw )=>MonadTrans (WriterT w )wherelift m =WriterT $doa <-m return(a ,mempty){-# INLINElift#-}instance(Monoidw ,MonadIOm )=>MonadIO(WriterT w m )whereliftIO =lift .liftIO{-# INLINEliftIO#-}#if MIN_VERSION_base(4,4,0)
instance(Monoidw ,MonadZipm )=>MonadZip(WriterT w m )wheremzipWith f (WriterT x )(WriterT y )=WriterT $mzipWith(\(a ,w )(b ,w' )->(f a b ,w `mappend`w' ))x y {-# INLINEmzipWith#-}#endif
-- | @'tell' w@ is an action that produces the output @w@.tell::(Monadm )=>w ->WriterT w m ()tell w =writer ((),w ){-# INLINEtell#-}-- | @'listen' m@ is an action that executes the action @m@ and adds its-- output to the value of the computation.---- * @'runWriterT' ('listen' m) = 'liftM' (\\ (a, w) -> ((a, w), w)) ('runWriterT' m)@listen::(Monadm )=>WriterT w m a ->WriterT w m (a ,w )listen m =WriterT $do(a ,w )<-runWriterTm return((a ,w ),w ){-# INLINElisten#-}-- | @'listens' f m@ is an action that executes the action @m@ and adds-- the result of applying @f@ to the output to the value of the computation.---- * @'listens' f m = 'liftM' (id *** f) ('listen' m)@---- * @'runWriterT' ('listens' f m) = 'liftM' (\\ (a, w) -> ((a, f w), w)) ('runWriterT' m)@listens::(Monadm )=>(w ->b )->WriterT w m a ->WriterT w m (a ,b )listens f m =WriterT $do(a ,w )<-runWriterTm return((a ,f w ),w ){-# INLINElistens#-}-- | @'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.---- * @'runWriterT' ('pass' m) = 'liftM' (\\ ((a, f), w) -> (a, f w)) ('runWriterT' m)@pass::(Monadm )=>WriterT w m (a ,w ->w )->WriterT w m a pass m =WriterT $do((a ,f ),w )<-runWriterTm return(a ,f w ){-# INLINEpass#-}-- | @'censor' f m@ is an action that executes the action @m@ and-- applies the function @f@ to its output, leaving the return value-- unchanged.---- * @'censor' f m = 'pass' ('liftM' (\\ x -> (x,f)) m)@---- * @'runWriterT' ('censor' f m) = 'liftM' (\\ (a, w) -> (a, f w)) ('runWriterT' m)@censor::(Monadm )=>(w ->w )->WriterT w m a ->WriterT w m a censor f m =WriterT $do(a ,w )<-runWriterTm return(a ,f w ){-# INLINEcensor#-}-- | Lift a @callCC@ operation to the new monad.liftCallCC::(Monoidw )=>CallCC m (a ,w )(b ,w )->CallCC (WriterT w m )a b liftCallCC callCC f =WriterT $callCC $\c ->runWriterT(f (\a ->WriterT $c (a ,mempty))){-# INLINEliftCallCC#-}-- | Lift a @catchE@ operation to the new monad.liftCatch::Catch e m (a ,w )->Catch e (WriterT w m )a liftCatch catchE m h =WriterT $runWriterTm `catchE `\e ->runWriterT(h e ){-# INLINEliftCatch#-}