
31 Dec
2008
31 Dec
'08
3:48 p.m.
As someone suggested me, I can read the logs from Writer and WriterT as computation goes by, if the monoid for the Writer is lazy readable. This has been true until I tried to put the IO inside WriterT
{-# LANGUAGE FlexibleContexts #-} import Control.Monad.Writer
k :: (MonadWriter [Int] m) => m [Int] k = let f x = tell [x] >> f (x + 1) in f 0
works :: [Int] works = snd $ runWriter k
hangs :: IO [Int] hangs = snd `liftM` runWriterT k
main = take 20 `liftM` hangs >>= print
The main hangs both interpreted and compiled on ghc 6.10.1. The issue is not exposing with IO alone as main = print "test" >> main is a working program. Thanks for explanations. paolino