[Prev] [Up] [Next]


Monadic I/O Primitives "PreludeMonadicIO"

This module defines the basic monadic framework for Haskell 1.3 I/O.

> interface PreludeMonadicIO where

> import PreludeIOError

> infixr 1 >>, >>=

The IO Monad

I/O operations may need to indicate errors, and implementations may need to handle these errors. The IO monad extends existing practice by making this functionality primitive. The exact errors which may occur are defined in PreludeIOError.

> type IO a
> data Either a b =  Left a | Right b

An expression of type IO a, for some type a, denotes a computation whose answer is either a result of type a or an error of type IOError. The computation succeeds with result succ if its answer is Right succ, and fails with result fail if its answer is Left fail. Note that the type system delimits the possibility of failure: only expressions of some type IO a can fail in the sense defined here.

> return        ::  a       -> IO a
> failWith      ::  IOError -> IO a

There are two primitives to create trivial computations, one for each of the two possibilities, success or failure.
return result is a computation that succeeds with result result.
failWith fail is a computation that fails with the error fail.

> (>>=)         ::  IO a    -> (a -> IO b)       -> IO b 

The >>= operation is used to sequence two computations, where the second computation is parameterised on the result of the first.

> (>>)          ::  IO a    -> IO b              -> IO b
> p >> q        = p >>= const q

The restricted form of >>=, >>, is used when the result of the first computation is uninteresting.

Error Handling

> handle           ::  IO a    -> (IOError -> IO a) -> IO a 

The construct handle comp handler can be used to handle a simple error during a computation comp. Its usefulness is limited in that the replacement value must be of the same type as the result of comp.

> try        ::  IO a    -> IO (Either IOError a) 
> try p      =   (p >>= (return . Right)) `handle` (return . Left)

The construct try comp exposes errors which occur within a computation, and which are not fully handled. It always succeeds.

User-Defined Errors

> fail :: String -> IO a 
> fail = failwith . UserError

As a convention for user-generated errors, to return an error message msg :: String, return the error value UserError msg via the computation fail msg.

This construct should be used instead of Haskell's error :: String -> a operation wherever convenient (Rationale).

Higher-Order Utility Functions

> either        ::  (a -> c) -> (b -> c) -> (Either a b) -> c
> either f g (Left x)  = f x
> either f g (Right x) = g x

The construct either a b can be used to generate functions on types of the form Either a b.

> accumulate    :: [IO a] -> IO [a] 
> accumulate  =
>   foldr mcons (return [])
>     where
>	mcons :: IO a -> IO [a] -> IO [a]
>	mcons p q = p >>= \x -> q >>= \y -> return (x : y)

The accumulate computation is used to process a list of computations of the same type, and to return a list of their results when executed in sequence.

> sequence      :: [IO a] -> IO () 
> sequence = foldr (>>) (return ())

The sequence computation is used for the simpler case when the computations are executed entirely for their external effect, and the results are therefore uninteresting.


[Prev] [Up] [Next]


The Definition of Monadic I/O in Haskell 1.3
Haskell 1.3 Committee
haskell1.3@comp.vuw.ac.nz