IO in action
The
IO
type serves as a tag for operations (actions) that interact with the outside world. TheIO
type is abstract: no constructors are visible to the user. [...]The Haskell 2010 Report (page 95 of 329).
Instead of that conventional approach:
data IO -- abstract
getChar :: IO Char
putChar :: Char -> IO ()
⋮
describe IO
using other types, ones with no visible constructors:
data (->) a b -- abstract
data OI -- also abstract
type IO a = OI -> a
getChar :: OI -> Char -- an I/O action
putChar :: Char -> (OI -> ()) -- a function with one parameter, whose result is an I/O action
⋮
Starting up
Main.main
is also an I/O action:
main :: OI -> ()
Therefore an internal subroutine in the Haskell implementation provides each running program with an initial OI
value. However, most programs will require more than just one:
getLine :: OI -> [Char]
getLine u = let !(u1, u2) = partOI u in
let !c = getChar u1 in
if c == '\n' then
[]
else
let !cs = getLine u2
in c:cs
putLine :: [Char] -> OI -> ()
putLine (c:cs) u = let !(u1, u2) = partOI u in
let !_ = putChar c u1 in
putLine cs u2
putLine [] u = putChar '\n' u
So another I/O action is needed in order to access that same internal subroutine from Haskell:
partOI :: OI -> (OI, OI)
If more than two new OI
values are needed:
partsOI :: OI -> [OI]
partsOI u = let !(u1, u2) = partOI u in u1 : partsOI u2
But why are these abstract OI
values needed at all - what purpose do they serve?
Actions and functions
Looking more closely at getLine
, putLine
and partsOI
reveals an interesting fact:
- each
OI
value is only used once (if at all).
Why is this important? Because in Haskell, functions have their basis in mathematics. That imposes certain requirements on function, including this one:
- if a function's result changes, it is only because one or more of it's arguments has changed.
If they're always used with different OI
values, then I/O actions can be used like functions:
partsOI :: OI -> [OI]
partsOI = unfoldr (Just . partOI)
even if they're defined using subroutines:
foreign import "oi_part" partOI :: OI -> (OI, OI)
foreign import "oi_getchar" getChar :: OI -> Char
foreign import "oi_putchar" putChar :: Char -> OI -> ()
The need for an OI
value also helps to prevent I/O actions from being used as subroutines:
trace :: [Char] -> a -> a
trace msg x = case putLine msg of !_ -> x -- how is this supposed to work?
Monadic actions
The monadic interface:
instance Monad ((->) OI)
return x = \ u -> let !_ = partOI u in x
m >>= k = \ u -> let !(u1, u2) = partOI u in
let !x = m u1 in
let !y = k x u2 in
y
allows getLine
and getLine
to be defined more compactly:
getLine :: OI -> [Char]
getLine = do c <- getChar
if c == '\n' then
return []
else
do cs <- getLine
return (c:cs)
putLine :: [Char] -> OI -> ()
putLine [] = putChar '\n'
putLine (c:cs) = putChar c >> putLine cs
and conceals the use of all those OI
values. But not all definitions will benefit from being monadic:
partsOI :: OI -> [OI]
partsOI = do (u1, u2) <- partOI; return (u1 : partsOI u2)
Further reading
- Merely monadic provides more information about Haskell's implementation of the monadic interface.
- For those who prefer it, John Launchbury and Simon Peyton Jones's State in Haskell explains the state-passing approach currently in widespread use.