<div dir="ltr"><div>Firstly, a direct answer to your question: use mconcat.</div><div><br></div><div>    main :: IO ()<br>    main = do<br>    let l = [1,2,3,4]<br>        w = writer ((), 0) :: WriterT (Sum Int) IO ()<br>    z <- sequence<br>        (map (A.async . runWriterT . runIt w) l)<br>        >>= mapM A.wait<br>    print $ snd $ mconcat z<br></div><div><br></div><div>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.</div><div><br></div><div>You're not actually using the return value from the `runIt` call, just the writer value. There's a function called `execWriter` for this:</div><div><br></div><div>    z <- sequence<br>        (map (A.async . execWriterT . runIt w) l)<br>        >>= mapM A.wait<br>    print $ mconcat z<br></div><div><br></div><div>Next, the combination of map and sequence can be written as traverse:</div><div><br></div><div>    z <- traverse (A.async . execWriterT . runIt w) l<br>        >>= mapM A.wait<br></div><div><br></div><div>But the async library is cool enough that it provides a function called mapConcurrently that deals with the async/wait dance for you:</div><div><br></div><div>    main :: IO ()<br>    main = do<br>      let l = [1,2,3,4]<br>          w = writer ((), 0) :: WriterT (Sum Int) IO ()<br>      z <- A.mapConcurrently (execWriterT . runIt w) l<br>      print $ mconcat z<br></div><div><br></div><div>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:</div><div><br></div><div>2<br>3<br>41</div><div><br></div><div>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):</div><div><br></div><div>    module Main where<br><br>    import qualified Control.Concurrent.Async as A<br>    import Control.Monad.Trans.Writer<br>    import Data.Monoid<br>    import Say<br><br>    runIt :: (Show a, Num a)<br>          => WriterT (Sum a) IO ()<br>          -> a<br>          -> WriterT (Sum a) IO ()<br>    runIt w x = do<br>      censor (+1) w -- emulates conditional count of something<br>      sayShow x<br><br>    main :: IO ()<br>    main = do<br>      let l = [1,2,3,4]<br>          w = writer ((), 0) :: WriterT (Sum Int) IO ()<br>      z <- A.mapConcurrently (execWriterT . runIt w) l<br>      sayShow $ mconcat z<br><br></div></div><div class="gmail_extra"><br><div class="gmail_quote">On Tue, Jul 25, 2017 at 11:36 AM, Baa <span dir="ltr"><<a href="mailto:aquagnu@gmail.com" target="_blank">aquagnu@gmail.com</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">Hello, Dear List!<br>
<br>
There is package `async`<br>
(<a href="https://hackage.haskell.org/package/async-2.1.1.1/docs/Control-Concurrent-Async.html" rel="noreferrer" target="_blank">https://hackage.haskell.org/<wbr>package/async-2.1.1.1/docs/<wbr>Control-Concurrent-Async.html</a>)<wbr>.<br>
<br>
Before, I had:<br>
<br>
    import qualified Control.Concurent.Async as A<br>
    ...<br>
    runIt :: ... -> IO ()<br>
    ...<br>
      sequence [A.async $ runIt ...] >>= mapM_ A.wait<br>
<br>
But now I want to count something inside `runIt`. I will use<br>
`Writer` monad for it (sure, it can be `State` also, not in<br>
principle to me). To do it synchronously, I done:<br>
<br>
    module Main where<br>
<br>
    import Control.Monad.Trans.Writer<br>
    import Control.Monad.IO.Class<br>
    import Data.Monoid<br>
<br>
    runIt :: (Show a, Num a) => WriterT (Sum a) IO () -> a -> WriterT (Sum a) IO ()<br>
    runIt w x = do<br>
      censor (+1) w -- emulates conditional count of something<br>
      liftIO $ print x<br>
<br>
    main = do<br>
      let l = [1,2,3,4]<br>
          w = writer ((), 0) :: WriterT (Sum Int) IO ()<br>
      z <- runWriterT $ sequence [runIt w i | i <- l]<br>
      print $ snd z<br>
<br>
but now my `runIt` changes it's signature:<br>
<br>
    runIt :: Num a => WriterT (Sum a) IO () -> ... -> WriterT (Sum a) IO ()<br>
    ...<br>
      sequence [A.async $ runIt ...] >>= mapM_ A.wait<br>
                ^^^^^^^^^^^<br>
                     ` ERROR is here!<br>
<br>
I get the error because `async`::IO () -> IO (A.Async ()) but I'm<br>
trying to pass it `WriterT (Sum a) IO ()`!<br>
<br>
To fix it I added `runWriterT` there:<br>
<br>
    res <- sequence [A.async $ runWriterT (runIt ...) ...] >>= mapM A.wait<br>
<br>
but now I will get list of counters, not one (res::[((), Sum Int)])!<br>
<br>
How to solve this problem: to run several actions asyncronously and to count something<br>
inside the action with `Writer` monad?<br>
<br>
<br>
===<br>
Best regards, Paul<br>
______________________________<wbr>_________________<br>
Beginners mailing list<br>
<a href="mailto:Beginners@haskell.org">Beginners@haskell.org</a><br>
<a href="http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners" rel="noreferrer" target="_blank">http://mail.haskell.org/cgi-<wbr>bin/mailman/listinfo/beginners</a><br>
</blockquote></div><br></div>