Writer implemented with Operational Monad does not work lazily

Question

I wrote a monad with Writer functionality, using the Operational Monad approach. Then I noticed it does not work lazily.

In the code below, there is a rogueWriter that performs infinitely many statements that each write a string. The program does not terminate althaugh only some characters of the infinite output are required.

After my analysis I noticed the rogue writer is actually quite friendly (haha) because when I change from runMyWriter rogueWriter to runWriter rogueWriter, everything goes well.

Questions:

1. How can the behaviour best be explained?
2. How should I change my code to make it work?
3. What monad transformers SomeMonadT arise the same problem in
   SomeMonadT Writer w resp. WriterT w SomeMonad (perhaps some examples?)

Edit: Is it possible that I'm trying to reverse an infinite string here? A striking difference between Sjoerd Visscher's solution and mine is

w `mappend` ws  resp.  ws `mappend` w

Code:

{-# LANGUAGE GADTs, FlexibleContexts, TypeSynonymInstances,
                    FlexibleInstances, MultiParamTypeClasses #-}

module Writer where

import Control.Monad.Identity
import Control.Monad.Operational
import Control.Monad.Writer
import Data.Monoid

data MyWriterI w a where
    Tell :: w -> MyWriterI w ()

type MyWriterT w = ProgramT (MyWriterI w)

type MyWriter w = (MyWriterT w) Identity

runMyWriterT :: (Monad m, Monoid w) => MyWriterT w m a -> m (a, w)
runMyWriterT prog = run prog mempty
  where
    run prog ws = viewT prog >>= flip eval ws
    eval (Return a)       ws = return (a, ws)
    eval (Tell w :>>= is) ws = run (is ()) (ws `mappend` w)

runMyWriter :: (Monoid w) => MyWriter w a -> (a, w)
runMyWriter prog = runIdentity (runMyWriterT prog)

instance (Monad m, Monoid w) => MonadWriter w (MyWriterT w m) where
    tell   = singleton . Tell
    listen = undefined
    pass   = undefined

-- Demonstration of the problem:

rogueWriter :: MonadWriter String m => m ()
rogueWriter = mapM_ (tell . show) [1..]

main = let (_, infiniteOutput) = runMyWriter rogueWriter
       in putStrLn (take 20 infiniteOutput)

Answer 1

I don't know exactly why your program fails, but this is how I would write it:

runMyWriterT prog = run prog
  where
    run prog = viewT prog >>= eval
    eval (Return a)       = return (a, mempty)
    eval (Tell w :>>= is) = do
      ~(r, ws) <- run (is ())
      return (r, w `mappend` ws)