StateT example (an encore performance)

Isaac Jones ijones at syntaxpolice.org
Mon Apr 11 15:09:50 EDT 2005


I noticed a few bits lacking in the Control.Monad.State
documentation.  I think an example of using StateT to encapsulate IO
would be a useful addition...

In order to make StateT more interesting, the trick is to use a lift
inside a function that returns StateT, so you can actually perform IO.
I would guess that this is the kind of use case that most people would
want to use StateT, but lift isn't mentioned in the docs.

Also, the types of "runStateT" and "runState" are a little confusing,
since they're actually field accessor functions, so I'd like to make a
note on that.

So how 'bout I add an example like the following to the State
documentation?

module Main where

import Control.Monad.State

type MyState a = StateT Int IO a

stateFun :: MyState String
stateFun = do 
  modify (+100)
  liftIO (putStrLn "Hello!")
  return "foo"

main = do
  (s, n) <- runStateT (stateFun >> stateFun) 0
  putStrLn $ "n: " ++ (show n) ++ " s: " ++ s


peace,

  isaac


More information about the Libraries mailing list