[Haskell-cafe] background question about IO monad

Uwe Hollerbach uhollerbach at gmail.com
Thu Feb 7 02:32:17 EST 2008


All right, after a bit of dinner and some time to mess about, here's
another attempt to check my understanding: here is a simplified
version of the lisp-time example:

> module Main where
> import System.Time
>
> pure_fn :: Integer -> String
> pure_fn n = calendarTimeToString (toUTCTime (TOD n 0))
>
> wicked_fn :: IO String
> wicked_fn = getClockTime >>= return . pure_fn . toI
>   where toI (TOD n _) = n
>
> make_wicked :: String -> IO String
> make_wicked str = return str
>
> -- use of pure_fn
> -- main = putStrLn (pure_fn 1230000000)
>
> -- use of wicked_fn
> -- main = wicked_fn >>= putStrLn
>
> -- use of make_wicked
> main = (make_wicked (pure_fn 1234567890)) >>= putStrLn

If I use the first of the three "main" alternatives, I'm calling a
pure function directly: it takes an integer, 123..., and produces a
string. If I pass the same integer to the pure function, I'll get the
same value, every time. This string is passed to putStrLn, an IO
action, in order that I may gaze upon it, but the string itself is not
thereby stuck in the IO monad.

If I use the second of the three "main" alternatives, I'm calling an
IO action: wicked_fn, which returns the current time formatted as UTC.
In principle, every time I call wicked_fn, I could get a different
answer. Because it's an IO action, I can't just pass it to putStrLn in
the same way I passed in the previous pure_fn value, but instead I
have to use the bind operator >>=.

If I use the third of the "main" alternatives, I am starting with a
pure function: it's that number formatted as UTC (it happens to come
to Fri Feb 13 of next year), but then I pass it through the
make_wicked function, which transmogrifies it into the IO monad.
Therefore, as in the above, I have to use >>= in order to get it to
work; "putStrLn (make_wicked (pure_fn 123...))" doesn't work.

<deep breath>

OK, after all that, my original question, in terms of this example:
"the IO monad is one-way" is equivalent to saying there is no haskell
function that I could write that would take

> (make_wicked (pure_fn 123456))

and make it into something that could be used in the same way and the
same places as just plain

> (pure_fn 123456)

?

And, coming back to my scheme interpreter, this is at least somewhat
irrelevant, because, since I am in a REPL of my own devising, I'm
firmly in IO-monad-land, now and forever.

Right?

thanks, Uwe


More information about the Haskell-Cafe mailing list