module Algebra.Monad.Writer (
MonadWriter(..),
mute,intercept,
WriterT,Writer,
_writerT,_writer
) where
import Algebra.Monad.Base
import Algebra.Monad.RWS
instance Monoid w => MonadWriter w ((,) w) where
tell w = (w,())
listen m@(w,_) = (w,m)
censor ~(w,~(a,f)) = (f w,a)
mute :: (MonadWriter w m,Monoid w) => m a -> m a
mute m = censor (m<&>(,const zero))
intercept :: (MonadWriter w m,Monoid w) => m a -> m (w,a)
intercept = listen >>> mute
newtype WriterT w m a = WriterT (RWST Void w Void m a)
deriving (Unit,Functor,Applicative,Monad,MonadFix
,Foldable,Traversable
,MonadTrans,MonadInternal
,MonadWriter w,MonadCont,MonadList)
type Writer w a = WriterT w Id a
instance (Monoid w,MonadReader r m) => MonadReader r (WriterT w m) where
ask = ask_ ; local = local_
instance (Monoid w,MonadState r m) => MonadState r (WriterT w m) where
get = get_ ; put = put_ ; modify = modify_
deriving instance Semigroup (m (a,Void,w)) => Semigroup (WriterT w m a)
deriving instance Monoid (m (a,Void,w)) => Monoid (WriterT w m a)
deriving instance Ring (m (a,Void,w)) => Ring (WriterT w m a)
_writerT :: (Functor m,Functor m') => Iso (WriterT w m a) (WriterT w' m' b) (m (w,a)) (m' (w',b))
_writerT = iso writerT runWriterT
where writerT mw = WriterT (RWST (pure (mw <&> \ ~(w,a) -> (a,zero,w) )))
runWriterT (WriterT (RWST m)) = m (zero,zero) <&> \ ~(a,_,w) -> (w,a)
_writer :: Iso (Writer w a) (Writer w' b) (w,a) (w',b)
_writer = _Id._writerT