
I have been experimenting with compositions of monads carrying associated monoids (i.e. Writer-style) and discovered the following pattern: ---------------------------------------------------------------------- {-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable, GeneralizedNewtypeDeriving #-} import Control.Monad import Control.Monad.Writer hiding ((<>)) import Data.Semigroup import Data.Foldable (Foldable) import Data.Traversable (Traversable) import qualified Data.Traversable as Traversable newtype Foo m a = Foo (Writer m a) deriving (Monad, MonadWriter m, Functor, Foldable, Traversable) newtype Bar m a = Bar { getBar :: [Foo m a] } deriving (Semigroup, Functor, Foldable, Traversable) instance Monoid m => Monad (Bar m) where return = Bar . return . return Bar ns >>= f = Bar $ ns >>= joinedSeq . fmap (getBar . f) where joinedSeq = fmap join . Traversable.sequence runFoo (Foo x) = runWriter x runBar (Bar xs) = fmap runFoo xs ---------------------------------------------------------------------- That is, given a type that is Monadic and Traversable, we can define a list of the same type as a monad, whose binding action "glues together" the nested Monoid values. A trivial example: ---------------------------------------------------------------------- -- annotate all elements in bar tells :: String -> Bar String a -> Bar String a tells a (Bar xs) = Bar $ fmap (tell a >>) xs -- a bar with no annotations x :: Bar String Int x = return 0 -- annotations compose with >>= y :: Bar String Int y = x <> tells "a" x >>= (tells "b" . return) -- and with join z :: Bar String Int z = join $ tells "d" $ return (tells "c" (return 0) <> return 1) -- runBar y ==> [(0,"b"),(0,"ab")] -- runBar z ==> [(0,"dc"),(1,"d")] ---------------------------------------------------------------------- However, I am concerned about the (Monad Bar) instance which seems ad-hoc to me, especially the use of sequence. Is there a more general pattern which uses a class other than Traversable? Any pointers would be much appreciated. Regards, Hans