Firstly, a direct answer to your question: use mconcat.
main :: IO ()
main = do
let l = [1,2,3,4]
w = writer ((), 0) :: WriterT (Sum Int) IO ()
z <- sequence
(map (A.async . runWriterT . runIt w) l)
>>= mapM A.wait
print $ snd $ mconcat z
Under the surface, WriterT is using mappend to combine the `Sum` values anyway, so it's natural is `mconcat` (the version of mappend that applies to list) to get the same result. Now some possible improvements.
You're not actually using the return value from the `runIt` call, just the writer value. There's a function called `execWriter` for this:
z <- sequence
(map (A.async . execWriterT . runIt w) l)
>>= mapM A.wait
print $ mconcat z
Next, the combination of map and sequence can be written as traverse:
z <- traverse (A.async . execWriterT . runIt w) l
>>= mapM A.wait
But the async library is cool enough that it provides a function called mapConcurrently that deals with the async/wait dance for you:
main :: IO ()
main = do
let l = [1,2,3,4]
w = writer ((), 0) :: WriterT (Sum Int) IO ()
z <- A.mapConcurrently (execWriterT . runIt w) l
print $ mconcat z
One final note: usage of `print` like this in a concurrent context can run into interleaved output if you have the wrong buffer mode turned out, leading to output like this:
2
3
41
This is especially common when using runghc or ghci. You can either change the buffering mode or use a different output function like sayShow (from the say package, which I wrote):
module Main where
import qualified Control.Concurrent.Async as A
import Control.Monad.Trans.Writer
import Data.Monoid
import Say
runIt :: (Show a, Num a)
=> WriterT (Sum a) IO ()
-> a
-> WriterT (Sum a) IO ()
runIt w x = do
censor (+1) w -- emulates conditional count of something
sayShow x
main :: IO ()
main = do
let l = [1,2,3,4]
w = writer ((), 0) :: WriterT (Sum Int) IO ()
z <- A.mapConcurrently (execWriterT . runIt w) l
sayShow $ mconcat z