How do I define the initial state in the State Monad? - haskell

I found this partially on http://www.haskell.org/haskellwiki/State_Monad
but it is not clear to me how I would define the initial state of c and f.
It works with IORefs though but I do not need global mutable data.
increment :: StateT Integer IO Integer
increment = do
n <- get
put (n+1)
return n
plusOne :: Integer -> IO Integer
plusOne n = execStateT increment n
printTChan mtch = do
forever $ do
m <- atomically $ readTChan mtch
case m of
"ping" -> plusOne c
_ -> plusOne f
print (c)


When working with StateT, you can think of run/eval/execStateT as marking the scope of the state, so what you have there is just a fancy way of writing this:
plusOne n = return (n+1)
Since you're ignoring the result of these actions, this has no effect whatsoever.
If you want to carry the state across your entire computation, you need to structure your code so that the whole thing runs in StateT:
printTChan mtch = flip evalStateT (c0, f0) $ do
forever $ do
m <- liftIO . atomically $ readTChan mtch
case m of
"ping" -> modify incrementC
_ -> modify incrementF
(c, f) <- get
liftIO $ print c
incrementC (c, f) = (c+1, f)
incrementF (c, f) = (f, c+1)
Now, you can fill in the initial state values in place of (c0, f0).

Related

Factorial using imperative-style programming

I have the following code:
while :: IO Bool -> IO () -> IO ()
while test body =
do b <- test
if b
then do {body ; while test body} -- same-line syntax for do
else return ()
I need to implement the factorial function using imperative-style programming. what I have to do is to create and initialize variables using newIORef, modify their values using a while loop with readIORef and writeIORef, then have the IO action return a pair consisting of the input n and the final result.
This is what I have done so far:
fact :: Integer -> IO (Integer, Integer)
fact n = do r <- newIORef n --initialize variable
while
(do {v <- readIORef n; n})
(do {v <- readIORef r; writeIORef (...)) --modify the value (?)
readIORef r
This is my attempt to write the factorial function. This is obviously does not work. Any help would be appreciated.

I think maybe it's time to give you some working version:
fact :: Integer -> IO (Integer, Integer)
fact n = do
i <- newIORef 1
acc <- newIORef 1
while (lessOrEqualN i) (step i acc)
acc' <- readIORef acc
return $ (n, acc')
where
lessOrEqualN iRef = do
i' <- readIORef iRef
return $ i' <= n
step iRef accRef = do
i' <- readIORef iRef
acc' <- readIORef accRef
writeIORef accRef (acc' * i')
writeIORef iRef (i'+1)
as you can see I used an loop reference i and an accumulator reference acc always reading, writing the changing values.
To make this (hopefully) a bit more readable I extracted the test and the body of the while into lessOrEqualN and step.
Of course there are easier ways to do this (modifyIORef) but I guess you have to use those.
PS: you play with it a bit - maybe you want to handle negative values differently or whatever
this might be a bit cleaner (putting both mutables into the same ref):
fact :: Integer -> IO (Integer, Integer)
fact n = do
ref <- newIORef (1,1)
while (lessOrEqualN ref) (step ref)
(_,acc) <- readIORef ref
return $ (n, acc)
where
lessOrEqualN ref = do
(i,_) <- readIORef ref
return $ i <= n
step ref = do
(i,acc) <- readIORef ref
writeIORef ref (i+1, acc * i)

I think Carsten's answer can be made a bit cleaner like this:
{-# LANGUAGE TupleSections #-}
import Control.Monad
import Data.IORef
fact :: Integer -> IO (Integer, Integer)
fact n = do
counter <- newIORef 1
result <- newIORef 1
while (fmap (<=n) (readIORef counter)) $ do
i <- postIncrement counter
modifyIORef result (*i)
fmap (n,) (readIORef result)
while :: IO Bool -> IO () -> IO ()
while test body =
do b <- test
if b
then do {body ; while test body} -- same-line syntax for do
else return ()
postIncrement :: Enum a => IORef a -> IO a
postIncrement ref = do
result <- readIORef ref
modifyIORef ref succ
return result
What I'm doing here is:
Using modifyIORef to cut down on the number of paired readIORef/writeIORef calls.
Using fmap to reduce the need for auxiliary functions to test the contents of an IORef.
Write a generic, reusable postIncrement function and use that to shorten fact further.
But frankly, I think your instructor's insistence that you use this while function is a bit silly. It doesn't make for clean code. If I was told to write an imperative factorial with IORef I'd first write this, just using the forM_ loop from the library:
factorial :: Integer -> IO (Integer, Integer)
factorial n = do
result <- newIORef 1
forM_ [2..n] $ \i -> do
modifyIORef result (*i)
fmap (n,) (readIORef result)
And that's because I was too dumb to remember replicateM_ :: Monad m => Int -> m a -> m () right away...

A monad for building test data

OK, so I'm trying to write a monad for building test data, but I can't quite get it to work how I want it. It looks something like this:
runBuildM :: [i] -> BuildM i o x -> [o]
-- Given a list of i, build a list of o.
source :: BuildM i o i
-- Fetch unique i.
yield :: o -> BuildM i o ()
-- Return a new o to the caller.
gather :: BuildM i o x -> BuildM i o o
-- Fetch every possible o from sub-computation.
local :: BuildM i o x -> BuildM i o x
-- Isolate any source invocations from the rest of the code.
In other words, it's a supply monad, writer monad and list monad. The idea is that I can write something like this:
build_tests depth = do
local $ do
v <- source
yield v
yield (map toLower v)
yield "[]"
yield "()"
when (depth > 2) $ do
t1 <- gather $ build_tests (depth-1)
yield $ "(" ++ t1 ++ ")"
yield $ "[" ++ t1 ++ "]"
t2 <- gather $ build_tests (depth-1)
yield $ "(" ++ t1 ++ "," ++ t2 ++ ")"
The idea is to generate all possible combinations of data. You can do that just using list comprehensions, but the result ends up syntactically awful. This is much more readable. Unfortunately, it doesn't actually work...
The problem seems to boil down to the local function not behaving correctly. The intention is for any source calls in the sub-computation to have no effect outside of it. (I.e., subsequent calls to source from outside the local block get the first token again.) However, what my implementation of local actually does is reset the next token for everything (i.e., including the contents of the sub-computation). This is clearly incorrect, but I cannot for the life of me bend my mind around how to make it work correctly.
The fact that I'm having this much trouble getting the code to work as required probably means the actual internal representation of my monad is just wrong. Can anybody take a stab at implementing this correctly?
EDIT: I should perhaps have realised this, but I didn't actually specify the expected result I'm trying to get. The above code is supposed to produce this:
["A", "a", "[]", "()", "(A)", "(a)", "[A]", "[a]", "(A, B)", "(A, b)", "(a, B)", "(a, b)"]
It's not super-critical that the results appear in exactly this order. I'd like the single cases to appear before the compound ones, but I'm not too fussed exactly what order the compounds appear. The rule is that the same variable never appears twice in any individual expression.
If we allow the depth to be a bit deeper, we additionally get terms such as
"((A))", "([A])", "[(A)]", "((A, B), C)", "(A, (B, C))"
and so on.
It's clearly broken, but here's what I have so far:
newtype BuildM i o x = BuildM ([i] -> SEQ.Seq ([i], SEQ.Seq o, x))
instance Functor (BuildM i o) where
fmap uf (BuildM sf) =
BuildM $ \ is0 -> do
(is1, os, x) <- sf is0
return (is1, os, uf x)
instance Applicative (BuildM i o) where
pure x = BuildM $ \ is0 -> return (is0, SEQ.empty, x)
BuildM sf1 <*> BuildM sf2 =
BuildM $ \ is1 -> do
(is2, os2, f) <- sf1 is1
(is3, os3, x) <- sf2 is2
return (is3, os2 >< os3, f x)
instance Monad (BuildM i o) where
return = pure
BuildM sf1 >>= uf =
BuildM $ \ is1 -> do
(is2, os2, x) <- sf1 is1
let BuildM sf2 = uf x
(is3, os3, y) <- sf2 is2
return (is3, os2 >< os3, y)
runBuildM :: [i] -> BuildM i o x -> [o]
runBuildM is0 (BuildM sf) =
toList $ do
(is, os, x) <- sf is0
os
source :: BuildM i o i
source =
BuildM $ \ is ->
if null is
then error "AHC.Tests.TestBuilder.source: end of input"
else return (tail is, SEQ.empty, head is)
yield :: o -> BuildM i o ()
yield o = BuildM $ \ is -> return (is, SEQ.singleton o, () )
gather :: BuildM i o x -> BuildM i o' o
gather (BuildM sf1) =
BuildM $ \ is1 -> do
(is2, os2, _) <- sf1 is1
o <- os2
return (is2, SEQ.empty, o)
local :: BuildM i o x -> BuildM i o ()
local (BuildM sf1) =
BuildM $ \ is1 ->
let os = do (is2, os2, x) <- sf1 is1; os2
in return (is1, os, () )

You are trying to reinvent pipes. Your source and yield are pipes await and yield. The other two concerns you are trying to handle are a ReaderT and a WriterT respectively. If you put the entire list of inputs in the environment of the ReaderT you can run local sub computations that start over at the beginning of the list. You can collect all of the results from a sub-computation by adding a WriterT layer to collect the output.
For the nice syntax with gather you are trying to recreate ListT.
Pipes, Readers, and Writers
We're going to use all of the following in very short order.
import Data.Functor.Identity
import Data.Foldable
import Control.Monad
import Control.Monad.Morph
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Monad.Trans.Reader hiding (local)
import Control.Monad.Trans.Writer.Strict
import Pipes.Core
import Pipes ((>->))
import qualified Pipes as P
import qualified Pipes.Prelude as P
import Pipes.Lift (runWriterP, runReaderP)
Your builder is a Pipe i o over a Reader [i] which allows you to reset at the beginning of the input. We will define two versions of it, BuildT which is a monad transformer, and BuildM which is a monad. BuildM is jsut the transformer applied to Identity.
type BuildT e i o m r = Pipe i o (ReaderT e m) r
type BuildM e i o r = BuildT e i o Identity r
local runs a builder feeding it the entire input read from the environment. We might want to give this a different name to avoid conflicting with local defined for ReaderT
local :: (Monad m, Foldable f) => BuildT (f i) i o m () -> Proxy a' a () o (ReaderT (f i) m) ()
local subDef = do
e <- lift ask
hoist lift $ runReaderP e $
P.each e >->
subDef
To collect the results of the sub computations, we take advantage of the fact that pipes are so pure that you can swap out the underlying monad provided you have a natural transformation forall x. m x -> n x. The proxies from pipes have an MFunctor instance that provides a function hoist :: (forall x. m x -> n x) -> Proxy a' a b' b m r -> Proxy a' a b' b n r; it lets us lift all of the underlying monad operations under a pipe to use the pipe over another transformer, in this case WriterT.
collect :: (Monad m) => Proxy a' a () b m r -> Proxy a' a c' c m ([b], r)
collect subDef = do
(r, w) <- runWriterP $
hoist lift subDef //> \x -> lift $ tell (++[x])
return (w [], r)
To run a builder we feed it all of the input from the environment, provide the initial environment, collect the results, and run the entire pipe.
runBuildT :: (Monad m) => [i] -> BuildT [i] i o m () -> m [o]
runBuildT e = runEffect . fmap fst . collect . runReaderP e . local
Running the monad instead of the transformer is just
runBuildM :: [i] -> BuildM [i] i o () -> [o]
runBuildM e = runIdentity . runBuildT e
ListT
This section lets us use do-notation when generating all combinations of things. It's equivalent to using pipes' for in place of each >>= and yield in place of each return.
The syntax that gathers all of the results from a sub computation is reinventing ListT. a ListT m a holds a Producer a m () that only returns data downstream. Pipes that get data from upstream and return data downstream don't fit into the Producer b m (). This will take a bit of conversion.
We can convert a Proxy that has both an upstream and a downstream interface into one with only a downstream interface wrapped around another proxy with the upstream interface. To do so, we hoist the underlying monad into our new inner upstream proxy, then replace all of the requests in the outer downstream proxy with requests lifted from the inner upstream proxy.
floatRespond :: (Monad m) => Proxy a' a b' b m r -> Proxy c' c b' b (Proxy a' a d' d m) r
floatRespond = (lift . request >\\) . hoist lift
These can be converted into a ListT. We'll discard any returned data to get a more polymorphic type.
gather :: (Monad m) => Proxy a' a () b m r -> P.ListT (Proxy a' a c' c m) b
gather = P.Select . floatRespond . (>>= return . const ())
Using ListT is a bit cumbersome to use; you need an mplus between returns to get both outputs. It's frequently convenient to shove a proxy into a ListT so you can lift . yield instead of returning. We are going to discard all our ListT results an rely on the output coming from lift . yield.enumeratejust runs aListT` wrapped around anything, discarding all the results
enumerate = P.runListT
Example
We're now equipped to write and run your example. I thing you mean for source to get one value from the source and for yield to return one value. If you don't need to be able to get values one at a time your question is over-specified and this answer is overkill.
source = P.await
yield = P.yield
In the example, where we use gather to build lists, we run that portion of the code with enumerate and yield results with lift . yield.
import Data.Char
build_tests :: Monad m => Int -> BuildT [String] String String m ()
build_tests depth = do
local $ do
v <- source
yield $ v
yield $ (map toLower v)
yield "[]"
yield "()"
when (depth > 2) $ enumerate $ do
t1 <- gather $ build_tests (depth-1)
lift . yield $ "(" ++ t1 ++ ")"
lift . yield $ "[" ++ t1 ++ "]"
t2 <- gather $ build_tests (depth-1)
lift . yield $ "(" ++ t1 ++ "," ++ t2 ++ ")"
If we run this example with the input ["A", "B"] the "B" input is never used because source is only ever used once inside each local.
main = do
putStrLn "Depth 2"
print =<< runBuildT ["A", "B"] (build_tests 2)
putStrLn "Depth 3"
print =<< runBuildT ["A", "B"] (build_tests 3)
The output for depths less than 4 is small enough to repeat here.
["A","a","[]","()"]
Depth 3
["A","a","[]","()","(A)","[A]","(A,A)","(A,a)","(A,[])","(A,())","(a)","[a]","(a,A)","(a,a)","(a,[])","(a,())","([])","[[]]","([],A)","([],a)","([],[])","([],())","(())","[()]","((),A)","((),a)","((),[])","((),())"]
This might be overkill
I suspect that you might have meant for source to get everything from the source.
source = gather P.cat
yield = P.yield
If we use this for the example instead of getting a single item from the source we'll enumerate the first local block and yield results by returning in ListT.
build_tests :: Monad m => Int -> BuildT [String] String String m ()
build_tests depth = do
local $ enumerate $ do
v <- source
lift . yield $ v
lift . yield $ (map toLower v)
yield "[]"
yield "()"
when (depth > 2) $ enumerate $ do
t1 <- gather $ build_tests (depth-1)
lift . yield $ "(" ++ t1 ++ ")"
lift . yield $ "[" ++ t1 ++ "]"
t2 <- gather $ build_tests (depth-1)
lift . yield $ "(" ++ t1 ++ "," ++ t2 ++ ")"
This uses both source values when we run the example with two sources.
Depth 2
["A","a","B","b","[]","()"]
Depth 3
["A","a","B","b","[]","()","(A)","[A]","(A,A)","(A,a)","(A,B)","(A,b)","(A,[])","(A,())","(a)","[a]","(a,A)","(a,a)","(a,B)","(a,b)","(a,[])","(a,())","(B)","[B]","(B,A)","(B,a)","(B,B)","(B,b)","(B,[])","(B,())","(b)","[b]","(b,A)","(b,a)","(b,B)","(b,b)","(b,[])","(b,())","([])","[[]]","([],A)","([],a)","([],B)","([],b)","([],[])","([],())","(())","[()]","((),A)","((),a)","((),B)","((),b)","((),[])","((),())"]
If you never get a single value from the source you could just use ListT (ReaderT [i] m) o instead. You might still want a proxy to avoid messing around with mplus.

You are trying to reinvent pipes and some nice syntax for building lists. The problem is much simpler than how you characterize it. The source of strings can be completely separated from building the structures.
You want to generate structures that draw symbols from some source. Without worrying about the source, let's build the structures. Each structure is a Pipe that will draw from some source and yield strings to concatenate together to build the expression.
import Data.Char
import Data.Functor.Identity
import Pipes.Core
import Pipes ((>->))
import qualified Pipes as P
import qualified Pipes.Prelude as P
build_structures :: Int -> [Pipe String String Identity ()]
build_structures depth = gather $ do
yield $ P.take 1
yield $ P.map (map toLower) >-> P.take 1
when (depth > 2) $ do
t1 <- lift $ build_structures (depth - 1)
yield $ P.yield "(" >> t1 >> P.yield ")"
yield $ P.yield "[" >> t1 >> P.yield "]"
t2 <- lift $ build_structures (depth - 1)
yield $ P.yield "(" >> t1 >> P.yield "," >> t2 >> P.yield ")"
This code uses the ContT yield trick from the continuation answer.
We run one of these structures by feeding it the symbols and concatenating the results.
run :: Pipe String String Identity () -> String
run p = concat . P.toList $ P.each symbols >-> p
-- an infinite source of unique symbols
symbols :: [String]
symbols = drop 1 symbols'
where
symbols' = [""] ++ do
tail <- symbols'
first <- ['A'..'Z']
return (first : tail)
The examples produce the desired strings. I'll leave producing the two special cases "[]" and "()", which do not appear in recursive terms, as an exercise.
import Data.Functor
main = do
putStrLn "Depth 2"
print $ run <$> build_structures 2
putStrLn "Depth 3"
print $ run <$> build_structures 3
putStrLn "Depth 4"
print $ run <$> build_structures 4
This results in
Depth 2
["A","a"]
Depth 3
["A","a","(A)","[A]","(A,B)","(A,b)","(a)","[a]","(a,B)","(a,b)"]
Depth 4
["A","a","(A)","[A]","(A,B)","(A,b)","(A,(B))","(A,[B])","(A,(B,C))","(A,(B,c))","(A,(b))","(A,[b])","(A,(b,C))","(A,(b,c))","(a)","[a]","(a,B)","(a,b)","(a,(B))","(a,[B])","(a,(B,C))","(a,(B,c))","(a,(b))","(a,[b])",...

If my other answer is overkill, the continuation monad transformer provides a convenient way to construct any MonadPlus values.
The continuation monad lets us easily capture the idea of doing something mplus the as yet unknown remainder.
import Control.Monad
import Control.Monad.Trans.Cont
once :: MonadPlus m => m a -> ContT a m ()
once m = ContT $ \k -> m `mplus` k ()
Yielding a result is just returning it once.
yield :: MonadPlus m => a -> ContT a m ()
yield = once . return
We can gather up all the results by sticking mzero at the end.
gather :: MonadPlus m => ContT a m r -> m a
gather m = runContT m (const mzero)
Your example is written in terms of yield, gather, once, and lift.
import Data.Char
import Control.Monad.Trans.Class
build_tests :: MonadPlus m => m String -> Int -> ContT String m ()
build_tests source = go
where
go depth = do
once . gather $ do
v <- lift source
yield v
yield (map toLower v)
yield "[]"
yield "()"
when (depth > 2) $ do
t1 <- lift . gather $ go (depth-1)
yield $ "(" ++ t1 ++ ")"
yield $ "[" ++ t1 ++ "]"
t2 <- lift . gather $ go (depth-1)
yield $ "(" ++ t1 ++ "," ++ t2 ++ ")"
main = print . gather $ build_tests ["A", "B"] 3
This outputs the following:
Depth 2
["A","a","B","b","[]","()"]
Depth 3
["A","a","B","b","[]","()","(A)","[A]","(A,A)","(A,a)","(A,B)","(A,b)","(A,[])","(A,())","(a)","[a]","(a,A)","(a,a)","(a,B)","(a,b)","(a,[])","(a,())","(B)","[B]","(B,A)","(B,a)","(B,B)","(B,b)","(B,[])","(B,())","(b)","[b]","(b,A)","(b,a)","(b,B)","(b,b)","(b,[])","(b,())","([])","[[]]","([],A)","([],a)","([],B)","([],b)","([],[])","([],())","(())","[()]","((),A)","((),a)","((),B)","((),b)","((),[])","((),())"]
I've taken the liberty of getting rid of the requirement to read the original source from the environment for simplicity. You can add a ReaderT to the transformer stack to get it back. I also haven't chosen a list transfomer for you, the example is running using the ordinary list monad. Since it's written in terms of MonadPlus it will work for any (MonadTrans t, MonadPlus (t m)) => t m as well.

Why does this haskell code not terminate

import Control.Monad.State.Lazy
type Queue a = [a]
push :: a -> State (Queue a) ()
push x = state (\xs -> ((),xs++[x]))
pop :: State (Queue a) a
pop = state (\(x:xs) -> (x,xs))
queueManip :: State (Queue Int) Int
queueManip =
do
mapM_ push [1..]
a <- pop
return a
main :: IO()
main = do
let (a,_) = runState queueManip []
print a
Shouldn't the mapM_ be lazy ? Besides for implementing a queue shouldn't the complexity be O(1)?
Because the append (++) itself is lazy ...

What if I'm evil and use
push' :: Int -> State (Queue Int) ()
push' 1052602983 = state $ \_ -> ((), []) -- "Muarhar!"
push' x = state $ \xs -> ((),xs++[x])
Then mapM push' [1..] should clearly render the state as [1052602983, 1052602984 ..]. It would be wrong for pop to yield 1. But mapM can't possibly know this, without first evaluating a billion other numbers. Actually pushing them to the state is irrelevant here, and it also doesn't matter that push could be completely lazy: mapM at least has to give it a chance to check any given number, before handing on the monadic program flow.

Note that do mapM_ push [1..3]; something is the same as:
do push 1; push 2; push 3; something
so that should explain why
do mapM_ push [1..]; something
never gets around to executing something.
If you look at the definition of the State monad:
type State s a = s -> (a, s)
instance Monad (State s) where
return a = \s -> (a,s)
m >>= g = wpAB
where
wpAB = \s1 -> let (v2, s2) = m s1
(v3, s3) = g v2 s2
in (v3, s3)
-- (newtypes and such have been removed to declutter the code)
you see that the value of m >>= g always depends on g. Contrast that with the definition of Maybe monad:
instance Monad Maybe where
return x = Just x
(>>=) m g = case m of
Nothing -> Nothing
Just x -> g x
where m >>= g can be independent of g which explains how the Maybe monad can short-circuit a do-chain.

String concatenation with haskell state monad

I need to wrap my head around the state monad in haskell and I have some problems with that.
The task is to implement a function countConcat which concatenates string with the state monad and a function extractCC which gets the result of this function.
So extractCC ((return 0) >>= countConcat "a" >>= countConcat "b" >>= countConcat "c") would yield (3,"abc")
As far as I understand countConcat would be kind of a manipulator function and extractCC should contain some kind of runState, right?
Any tipps or ressources getting me into the right direction are highly appreciated.
(I´ve been through the wiki and the learnyouahaskell section, but still feeling quite stupid with this)

Try this first
concat' :: String -> State (Int,String) ()
concat' s = do
(c,st) <- get
put (c+1, st ++ s)
You can run this by
> runState ( concat' "A" >> concat' "B" >> concat' "C" ) (0,"")
((),(3,"ABC"))
I think if you understand state monad you can modify the above example for your need.

Thanks to Satvik I was able to solve the Problem. Here is my final solution:
newtype State s a = State {runState :: s -> (a,s)}
instance Monad (State s) where
return x = State (\s -> (x,s))
(State h) >>= f = State (\s -> let (a, newState) = h s
(State g) = f a
in g newState)
-- Save new state
countConcat :: String -> Int -> State String Int
countConcat s i =do
st <- get -- get current string
put ((st ++ s)) -- put conc. string
return (i+1) -- return new counter
extractCC f =(runState f ("")) --run the function, staring with an empty string
-- Helper from the wiki
put newState = State $ \_ -> ((), newState)
get = State $ \st -> (st, st)
-- extractCC ((return 0) >>= countConcat "a" >>= countConcat "b" >>= countConcat "c")
-- (3,"abc")

If you use the first combinator from Control.Arrow, then:
countConcat :: String -> State (String,Int) ()
countConcat s = modify ((<> s) *** (+1))

List Iterator using ContT

I have a simple list that I would like to iterate over "yield"ing between each element and printing that element to the output. I am trying to use the ContT monad to do this but running into issues. Here's what I have so far:
data K a = Nil | K (a,() -> K a)
listIterator :: (Monad m) => [r] -> m (K r)
listIterator [] = return Nil
listIterator (x:xs) = return (ContT (\k -> K (x,k))) >> listIterator xs
runIterator :: IO ()
runIterator = do
a <- listIterator ([1,2,3] :: [Int])
let loop Nil = liftIO $ print "nil"
loop (K (curr,newI)) =
do
liftIO $ print curr
loop (newI ())
loop a
The expected output is:
1
2
3
nil
What I get is:
nil
Any help is appreciated!

listIterator (x:xs) = return (ContT (\k -> K (x,k))) >> listIterator xs
does not do what you expect, equational reasoning
listIterator (x:xs)
= return (ContT (\k -> K (x,k))) >> listIterator xs
= (return (ContT (\k -> K (x,k)))) >>= \_ -> listIterator xs
= (\_ -> listIterator xs) (ContT (\k -> K (x,k)))
= listIterator xs
I'm not sure exactly why you want to use an iterator. Haskell is already lazy, so iteration patterns like this are mostly used only when you have resource management issues that need to interact well with a demand driven usage pattern. And, you don't need the continuation monad at all:
Instead of writing the K constructor to take a tuple it is more idiomatic to
data K a = Nil | K a (() -> K a)
intuitively, the type for the listIterator does not use its monadic structure: it just constructs a value, so
listIterator ::[r] -> K r
listIterator [] = Nil
listIterator (x:xs) = K x (\_ -> listIterator xs)
now life is trivial
runIterator :: IO ()
runIterator = do
let a = listIterator ([1,2,3] :: [Int])
loop Nil = liftIO $ print "nil"
loop (K curr newI) =
do
liftIO $ print curr
loop (newI ())
loop a
which would probably be best to write without the use of do notation.

This may not be the answer you were looking for, but if you are interested in this style of programming, you should look into pipes and similar libraries. (conduit is the rising star in the "real world", but pipes provides a simpler tool for teaching which is why I use it here.)
$ cabal update && cabal install pipes
Pipes are like iterators, except they come in three flavors: those that can acquire input (Consumers), those that produce output (Producers), and those that do both (Pipes). If you connect pipes such that the input and output ends are all satisfied, then it is called a "Pipeline", and it is a self-contained unit that can be run without any additional input.
Pipe provides a monad instance for convenience in creating pipes. The >+> operator connects two pipes together.
import Control.Pipe
import Control.Monad.Trans.Class
import Control.Monad.IO.Class
-- annoyingly, Pipe does not provide a MonadIO instance
instance (MonadIO m) => MonadIO (Pipe a b m) where
liftIO = lift . liftIO
listIterator :: Monad m => [a] -> Producer (Maybe a) m ()
listIterator (x:xs) = yield (Just x) >> listIterator xs
listIterator [] = yield Nothing
printer :: (MonadIO m, Show a) => Consumer (Maybe a) m ()
printer = do
mx <- await
case mx of
Just x -> liftIO (print x) >> printer
Nothing -> liftIO (putStrLn "nil")
main = runPipe $ listIterator [1, 2, 3] >+> printer
The source for Control.Pipe is delightfully simple, especially if you have been reading Gabriel's recent blog posts about Free monads, particularly Why free monads matter and Purify code using free monads.

Resources