Писатель, реализованный с операционной Monad, не работает лениво

Я написал монаду с функциональностью Writer, используя подход Operational Monad. Тогда я заметил, что это не работает лениво.

В приведенном ниже коде есть rogueWriter, который выполняет бесконечное число операторов, каждый из которых пишет строку. Программа не заканчивается, хотя требуется только некоторые символы бесконечного вывода.

После моего анализа я заметил, что писатель-изгоев на самом деле довольно дружелюбный (ха-ха), потому что, когда я перехожу от runMyWriter rogueWriter до runWriter rogueWriter, все идет хорошо.

Вопросы:

• Как лучше всего объяснить поведение?
• Как мне изменить свой код, чтобы он работал?
• Какие монадные трансформаторы SomeMonadT возникают одна и та же проблема в
  SomeMonadT Writer w соответственно. WriterT w SomeMonad (возможно, некоторые примеры?)

Изменить: Возможно ли, что я пытаюсь изменить бесконечную строку здесь? Яркое различие между решением Сьордда Висшера и мином -

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

код:

{-# 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)