(Haskell Logo).


Last Modified On Thu Dec 8 02:32:27 GMT 1994 By Kevin Hammond

The Definition of Monadic I/O for Haskell 1.3

Haskell 1.3 is a revision of Haskell 1.2 (Hudak 92). This document defines a standard monadic programming model for input/output (I/O) in Haskell 1.3. There is also a BIG unstructured version of this document, suitable for printing, searching or FTPing. Note: to keep it reasonably short and simple, the unstructured version does not include any of the sample operating system bindings such as LibPOSIX, and tags refer to the structured version.

A good general overview of the problems faced in designing an I/O standard, with tips to help implementors and programmers maximise portability can be found in Plauger's book on the Standard C library.

Purpose

The purpose of this definition is to provide a framework for Haskell I/O on a variety of commonly used operating systems. This document defines basic high-level I/O functionality for Haskell in a series of Prelude and Library modules.

Entities defined in Prelude modules (whose names begin with Prelude) are in scope unless explicitly renamed or hidden. Entities defined in Library modules (whose names begin with Lib) are in scope only if that module is explicitly imported (Rationale).

Conformance

A strictly-conforming Haskell 1.3 implementation implements the Core I/O operations completely and exactly. A mostly-conforming Haskell 1.3 implementation implements a large subset of the Core I/O operations, and provides full and complete documentation of any extensions to or deviations from the semantics given here. For any conforming implementation, all implementation dependencies which are allowed by the standard must be explicitly documented. (Rationale)

Bindings

It is possible to build on this framework to produce implementations which conform to accepted I/O standards or operating system interfaces. One such "binding" (for the POSIX standard -- IEEE 1003 -- LibPosix) has already been defined, and similar bindings should be defined for the Win32 and Macintosh environments, amongst others. As experience is gained with the I/O definition, it is expected that some common functions will be promoted into the Core I/O definition.

The Definition

Some of the computations defined here are specified in terms of other Haskell functions. This is done solely to simplify the semantics of the definition. An implementation is free to use any semantically correct definition of these computations.

Bibliography

This is the Bibliography of language standards, operating system references, and functional programming references consulted when defining this standard.

Recent Changes

A log of recent changes can be found here.


The Definition of Monadic I/O in Haskell 1.3
Haskell 1.3 Committee
haskell1.3@comp.vuw.ac.nz
Haskell 1.3 Highlights [Prev] [Up] [Next]


Highlights

Here are the highlights of the 1.3 I/O definition. Monadic programming models have proved to be more general and in many respects simpler than the stream-based I/O system used in Haskell 1.2. Several implementations exist. This document is intended to be a relatively conservative standard to allow programs to be ported between the various Haskell systems.

[Prev] [Up] [Next]


The Definition of Monadic I/O in Haskell 1.3
Haskell 1.3 Committee
haskell1.3@comp.vuw.ac.nz
Haskell 1.3 Notation [Prev] [Up] [Next]


Notation

We write specific phrases of the object language Haskell in this font and use this font for metavariables ranging over arbitrary phrases of the object language. For instance, Haskell function ident applied to an arbitrary x equals x.


[Prev] [Up] [Next]


The Definition of Monadic I/O in Haskell 1.3
Haskell 1.3 Committee
haskell1.3@comp.vuw.ac.nz
Haskell 1.3 Summary of I/O Operations [Prev] [Up] [Next]


Summary of I/O Operations

This is an unstructured list of the types, instances, values and operations supported by Core Haskell 1.3 I/O.

This summary is provided for information only, and does not form part of the I/O definition proper. In case of inconsistency, definitions given in the main body of the I/O definition take precedence over those given here.


Fixities

Only two infix entities are defined.

> infixr 1 >>, >>=                         -- PreludeMonadicIO

Types and Instances

This is a list of the types and instances required by the Core I/O definition.

> data IOError = AlreadyExists String           -- PreludeIOError
>              | Deadlock String
>              | HardwareFault String
>              | IllegalOperation String
>              | InappropriateType String
>              | InvalidArgument String
>              | NoSuchThing String
>              | OperationInterrupted String
>              | OtherError String
>              | PermissionDenied String
>              | ProtocolError String
>              | ResourceBusy String
>              | ResourceExhausted String
>              | ResourceVanished String
>              | SystemError String
>              | TimeExpired String
>              | UnsatisfiedConstraints String
>              | UnsupportedOperation String
>              | UserError String

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

> type Handle                                   -- PreludeStdIO
> type FilePath = String                        -- PreludeStdIO

> data IOMode     = ReadMode                    -- PreludeStdIO
>                 | WriteMode
>                 | AppendMode 
>                 | ReadWriteMode

> data BufferMode = NoBuffering                 -- PreludeStdIO
>                 | LineBuffering
>                 | BlockBuffering (Maybe Int)

> data HandlePosn                               -- PreludeStdIO
> data SeekMode   = AbsoluteSeek                -- PreludeStdIO
>                 | RelativeSeek
>                 | SeekFromEnd 

> data ExitCode   = ExitSuccess                 -- LibSystem
>                 | ExitFailure Int

> data ClockTime                                -- LibTime
> instance Ord ClockTime                        -- LibTime
> instance Eq  ClockTime                        -- LibTime
> instance Text ClockTime                       -- LibTime
> data CalendarTime =                           -- LibTime
>      CalendarTime  Int  Int  Int  Int  
>                    Int  Int  Integer 
>                    Int  Int  String 
>                    Int Bool

> data TimeDiff    =                            -- LibTime
>      TimeDiff Int  Int  
>               Int  Int  Int  Int  Integer
>      deriving (Eq,Ord)

Values

There are three predefined handles.

> stdin, stdout, stderr :: Handle          -- PreludeStdIO

Operations

The set of I/O operations is sorted alphabetically, subdivided by Prelude and Library operations.

Prelude Operations

> (>>=)                :: IO a     -> (a -> IO b)           -> IO b 
> (>>)                 :: IO a     -> IO b                  -> IO b
> accumulate           :: [IO a]                            -> IO [a] 
> appendFile           :: FilePath -> String                -> IO ()
> either               :: (a -> c) -> (b -> c) -> (Either a b) -> c
> fail                 :: String                            -> IO a 
> failWith             :: IOError                           -> IO a
> getChar              ::                                      IO Char
> handle               :: IO a     -> (IOError -> IO a)     -> IO a 
> hClose               :: Handle                            -> IO ()
> hFileSize            :: Handle                            -> IO Integer
> hFlush               :: Handle                            -> IO ()
> hGetChar             :: Handle                            -> IO Char
> hGetContents         :: Handle                            -> IO String
> hGetPosn             :: Handle                            -> IO HandlePosn
> hIsBlockBuffered     :: Handle                      -> IO (Bool,Maybe Int)
> hIsClosed            :: Handle                            -> IO Bool
> hIsEOF               :: Handle                            -> IO Bool
> hIsLineBuffered      :: Handle                            -> IO Bool
> hIsNotBuffered       :: Handle                            -> IO Bool
> hIsOpen              :: Handle                            -> IO Bool
> hIsReadable          :: Handle                            -> IO Bool
> hIsSeekable          :: Handle                            -> IO Bool
> hIsWritable          :: Handle                            -> IO Bool
> hLookAhead           :: Handle                            -> IO Char
> hPutChar             :: Handle   -> Char                  -> IO ()
> hPutStr              :: Handle   -> String                -> IO ()
> hPutText             :: Text a   => Handle     -> a       -> IO ()
> hReady               :: Handle                            -> IO Bool
> hSeek                :: Handle   -> SeekMode   -> Integer -> IO ()
> hSetBuffering        :: Handle   -> BufferMode            -> IO ()
> hSetPosn             :: HandlePosn                        -> IO ()
> interact             :: (String -> String)                -> IO ()
> isEOF                ::                                      IO Bool
> openFile             :: FilePath -> IOMode                -> IO Handle
> print                :: Text a =>                 a       -> IO ()
> putChar              :: Char                              -> IO () 
> putStr               :: String                            -> IO () 
> putText              :: Text a   => a                     -> IO () 
> readFile             :: FilePath                          -> IO String
> return               ::  a                                -> IO a
> sequence             :: [IO a]                            -> IO () 
> try                  ::  IO a                     -> IO (Either IOError a)
> writeFile            :: FilePath -> String               -> IO ()

Library Operations

> addToClockTime       :: TimeDiff  -> ClockTime           -> ClockTime
> diffClockTimes       :: ClockTime -> ClockTime           -> TimeDiff
> createDirectory      :: FilePath                         -> IO ()
> exitWith             :: ExitCode                         -> IO a
> getArgs              ::                                     IO [String]
> getClockTime         ::                                     IO ClockTime
> getCPUTime           ::                                     IO Integer
> getCurrentDirectory  ::                                     IO FilePath
> getDirectoryContents :: FilePath                         -> IO [FilePath]
> getEnv               :: String                           -> IO String
> getProgName          ::                                     IO String
> removeDirectory      :: FilePath                         -> IO ()
> removeFile           :: FilePath                         -> IO ()
> renameDirectory      :: FilePath -> FilePath             -> IO ()
> renameFile           :: FilePath -> FilePath             -> IO ()
> setCurrentDirectory  :: FilePath                         -> IO ()
> setUserInterrupt     :: Maybe (IO ())                -> IO (Maybe (IO ()))
> system               :: String                           -> IO ExitCode
> toCalendarTime       :: ClockTime                        -> CalendarTime
> toUTCTime            :: ClockTime                        -> CalendarTime
> toClockTime          :: CalendarTime                     -> ClockTime

"Derived" Operations

Some operations could notionally be defined in terms of other operations (though efficiency issues will probably mandate direct implementation). Previous versions of the I/O proposal distinguished "primitive" and "derived" operations, leading to some confusion, especially where definitions could be circular (and either could therefore be "primitive").

This proposal does not generally distinguish operations in this way, though definitions in terms of other operations are given where possible in order to simplify the semantics, aid comprehension, and speed implementation.

The following operations are currently defined in terms of other operations, and could therefore be considered "derived" in the sense used above. For the sake of completeness, the relevant definitions are repeated here.

"Derived" Prelude Operations

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

> 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)

> appendFile           :: FilePath -> String                -> IO ()
> appendFile name str =
>   openFile AppendMode name >>= \hdl -> hPutStr hdl str >> close hdl

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

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

> getChar              ::                                      IO Char
> getChar              =  hGetChar stdin

> hPutStr              :: Handle   -> String                -> IO ()
> hPutText             :: Text a   => Handle     -> a       -> IO ()
> hPutStr hdl          =  foldr (>>) (return ()) . map (hPutChar hdl)
> hPutText hdl         =  hPutStr hdl . show

> interact             :: (String -> String)                -> IO ()
> interact f           =  hGetContents stdin >>= (putStr . f)

> isEOF                ::                                      IO Bool
> isEOF                =  hIsEOF stdin

> print                :: Text a =>                 a       -> IO ()
> print x              =  putText x >> putChar '\n'

> putChar              :: Char                              -> IO () 
> putStr               :: String                            -> IO () 
> putText              :: Text a   => a                     -> IO () 
> putChar              =  hPutChar stdout
> putStr               =  hPutStr  stdout
> putText              =  hPutText stdout

> readFile             :: FilePath                          -> IO String
> readFile name        =  openFile ReadMode name >>= hGetContents

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

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

> writeFile            :: FilePath -> String               -> IO ()
> writeFile name str =
>   openFile WriteMode name >>= \hdl -> hPutStr hdl str >> close hdl


[Prev] [Up] [Next]


The Definition of Monadic I/O in Haskell 1.3
Haskell 1.3 Committee
haskell1.3@comp.vuw.ac.nz
Haskell 1.3 Programs [Prev] [Up] [Next]


Programs

Haskell 1.3 programs are the result of executing Main.main. This must have type IO (), as defined in PreludeMonadicIO. If a program p terminates without calling exitWith explicitly, it is treated identically to the computation
p>> exitWith ExitSuccess.

> module Main where
> 
> main :: IO ()
> main =  putStr "Hello World\n"


[Prev] [Up] [Next]


The Definition of Monadic I/O in Haskell 1.3
Haskell 1.3 Committee
haskell1.3@comp.vuw.ac.nz
Haskell 1.3 Top-Level I/O: PreludeIO [Prev] [Up] [Next]


Top Level I/O "PreludeIO"

This module collects and exports the more primitive Prelude modules.


> interface PreludeIO (
>       PreludeMonadicIO.., PreludeIOError..,
>       PreludeStdIO.., PreludeReadTextIO.., PreludeWriteTextIO..,
>       interact
>     ) where

> import PreludeMonadicIO
> import PreludeStdIO
> import PreludeIOError
> import PreludeReadTextIO
> import PreludeWriteTextIO

> interact      :: (String -> String)       -> IO ()
> interact f     = hGetContents stdin >>= (putStr . f)

The interact computation supports classical Landin-stream character I/O, as in Haskell 1.2 (Rationale).


[Prev] [Up] [Next]


The Definition of Monadic I/O in Haskell 1.3
Haskell 1.3 Committee
haskell1.3@comp.vuw.ac.nz
Haskell 1.3 Monadic I/O Primitives: PreludeMonadicIO [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
Haskell 1.3 I/O Errors: PreludeIOError [Prev] [Up] [Next]


I/O Errors "PreludeIOError"

Haskell 1.2 does not provide standard error values for I/O errors. This is unacceptable for portable implementations which indulge in non-trivial I/O. The IOError type has therefore been extended from Haskell 1.2, and possible error values have been identified for all standard operations. (Rationale)


> interface PreludeIOError where

> data IOError = AlreadyExists String
>              | HardwareFault String
>              | IllegalOperation String
>              | InappropriateType String
>              | Interrupted String
>              | InvalidArgument String
>              | NoSuchThing String
>              | OtherError String
>              | PermissionDenied String
>              | ProtocolError String
>              | ResourceBusy String
>              | ResourceExhausted String
>              | ResourceVanished String
>              | SystemError String
>              | TimeExpired String
>              | UnsatisfiedConstraints String
>              | UnsupportedOperation String
>              | UserError String
>              | EOF

> instance Text IOError where
>    showsPrec _ e s = ...

SystemError is reserved for the low-level operating system interface routines, such as those defined in LibPOSIX, and should not be returned by the high-level routines in the Prelude.

The String part of an IOError is platform-dependent. However, to provide a uniform mechanism for distinguishing among errors within these broad categories, each platform-specific standard shall specify the exact strings to be used for particular errors. For errors not explicitly mentioned in the standard, any descriptive string may be used.


[Prev] [Up] [Next]


The Definition of Monadic I/O in Haskell 1.3
Haskell 1.3 Committee
haskell1.3@comp.vuw.ac.nz
Haskell 1.3 Standard I/O: PreludeStdIO [Prev] [Up] [Next]


Standard I/O "PreludeStdIO"

This module defines Haskell handles and the operations which are supported for them.

Haskell interfaces to the external world through an abstract file system. This file system is a collection of named file system objects, which may be organised in directories (see LibDirectory). In some implementations, directories may themselves be file system objects and could be entries in other directories. For simplicity, any non-directory file system object is termed a file, although it could in fact be a communication channel, or any other object recognised by the operating system. Physical files are persistent, ordered files, and normally reside on disk.

File and directory names are values of type String, whose precise meaning is operating system dependent. Files can be opened, yielding a handle which can then be used to operate on the contents of that file.


> interface PreludeStdIO where

> import PreludeMonadicIO
> import PreludeIOError

> type Handle
> type FilePath = String


Handles

The standard defines operations to read/write finite sequences of items from/to files, represented by values of type Handle. Each value of this type is a handle: a record used by the Haskell run-time system to manage I/O with operating system objects.

A handle has at least the following properties:

Most handles will also have a current I/O position indicating where the next input or output operation will occur.

A handle is readable if it manages only input or both input and output; likewise, it is writable if it manages only output or both input and output. A handle is open when first allocated. Once it is closed it can no longer be used for either input or output, though an implementation cannot re-use its storage while references remain to it (Rationale).

Semi-Closed Handles

The operation hGetContents puts a handle hdl into an intermediate state, semi-closed. In this state, hdl is effectively closed, but items are read from hdl on demand and accumulated in a special stream returned by hGetContents hdl. (Rationale)

Any operation except for hClose that fails because a handle is closed, also fails if a handle is semi-closed. A semi-closed handle becomes closed:

Once a semi-closed handle becomes closed, the contents of the associated stream becomes fixed, and is the list of those items which were successfully read from that handle. Any I/O errors encountered when a handle is semi-closed are simply discarded. (Rationale)

Standard Handles

> stdin, stdout, stderr :: Handle

Three handles are allocated during program initialisation . The first two manage input or output from the Haskell program's standard input or output channel respectively (Rationale). The third manages output to the standard error channel (Rationale). These handles are initially open.

Opening and Closing Files

Opening Files

(Rationale)

> data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode

> openFile      :: FilePath -> IOMode -> IO Handle

Computation openFile file mode allocates and returns a new, open handle to manage the file file. It manages input if mode is ReadMode, output if mode is WriteMode or AppendMode, and both input and output if mode is ReadWriteMode (Rationale).

If the file does not exist and it is opened for output, it should be created as a new file. If mode is WriteMode and the file already exists, then it should be truncated to zero length (note: some operating systems delete empty files, so there is no guarantee that the file will exist following an openFile with mode WriteMode unless it is subsequently written to successfully). The handle is positioned at the end of the file if mode is AppendMode, and otherwise at the beginning (in which case its internal I/O position is 0). The initial buffer mode is implementation-dependent.

The computation may fail with:

If openFile fails on a file opened for output, the file may still have been created if it did not already exist.

Implementations should enforce, locally to the Haskell process, multiple-reader single-writer locking on files, which is to say that there may either be many handles on the same file which manage input, or just one handle on the file which manages output. If any open or semi-closed handle is managing a file for output, no new handle can be allocated for that file. If any open or semi-closed handle is managing a file for input, new handles can only be allocated if they do not manage output.

Two physical files are the same if they have the same absolute name. An implementation is free to impose stricter conditions. (Rationale)

Closing Files

> hClose        :: Handle -> IO () 

Computation hClose hdl makes handle hdl closed. Before the computation finishes, if hdl is writable its buffer is flushed as for hFlush.

The computation may fail with:

If the operation fails for any reason, any further operations on the handle will still fail as for a closed handle.

Determining the Size of a File

> hFileSize     :: Handle -> IO Integer

For a handle hdl which attached to a physical file, hFileSize hdl returns the size of that file in 8-bit bytes (>= 0).

The computation may fail with:

Detecting the End of Input

> hIsEOF        :: Handle -> IO Bool
> isEOF         ::           IO Bool
> isEOF         =  hIsEOF stdin

For a readable handle hdl, computation hIsEOF hdl returns True if no further input can be taken from hdl or for a physical file, if the current I/O position is equal to the length of the file. Otherwise, it returns False.

The computation may fail with:

Buffering Operations

Three kinds of buffering are supported: line-buffering, block-buffering or no-buffering. These modes have the following effects. For output, items are written out from the internal buffer according to the buffer mode:
line-buffering
the entire buffer is written out whenever a newline is output, the buffer overflows, a flush is issued, or the handle is closed.
block-buffering
the entire buffer is written out whenever it overflows, a flush is issued, or the handle is closed.
no-buffering
output is written immediately, and never stored in the buffer.
The buffer is emptied as soon as it has been written out. (Rationale)

Similarly, input occurs according to the buffer mode for handle hdl.

line-buffering
when the buffer for hdl is not empty, the next item is obtained from the buffer; otherwise, when the buffer is empty, characters up to and including the next newline character are read into the buffer. No characters are available until the newline character is available.
block-buffering
when the buffer for hdl becomes empty, the next block of data is read into the buffer.
no-buffering
the next input item is read and returned.

For most implementations, physical files will normally be block-buffered and terminals will normally be line-buffered.

> data BufferMode = NoBuffering | LineBuffering | BlockBuffering (Maybe Int)

> hSetBuffering :: Handle -> BufferMode     -> IO ()

Computation hSetBuffering hdl mode sets the mode of buffering for handle hdl on subsequent reads and writes.

If the buffer mode is changed from BlockBuffering or LineBuffering to NoBuffering, then

The default buffering mode when a handle is opened is implementation-dependent and may depend on the object which is attached to that handle.

The computation may fail with:

Flushing Buffers

> hFlush        :: Handle -> IO () 

Computation hFlush hdl causes any items buffered for output in handle hdl to be sent immediately to the operating system.

The computation may fail with:

Repositioning Handles

(Rationale)

Revisiting an I/O Position

> data HandlePosn

> hGetPosn      :: Handle                 -> IO HandlePosn
> hSetPosn      :: HandlePosn             -> IO () 

Computation hGetPosn hdl returns the current I/O position of hdl as an abstract value. Computation hSetPosn p sets the position of hdl to a previously obtained position p.

The computation hSetPosn may fail with:

Seeking to a new Position

> data SeekMode =  AbsoluteSeek | RelativeSeek | SeekFromEnd
> hSeek         :: Handle -> SeekMode -> Integer      -> IO () 

Computation hSeek hdl mode i sets the position of handle hdl depending on mode. If mode is

AbsoluteSeek
the position of hdl is set to i.
RelativeSeek
The position of hdl is set to offset i from the current position.
SeekFromEnd
The position of hdl is set to offset i from the end of the file.
The offset is given in terms of 8-bit bytes.

If hdl is block- or line-buffered, then seeking to a position which is not in the current buffer will first cause any items in the output buffer to be written to the device, and then cause the input buffer to be discarded.

Some handles may not be seekable (see hIsSeekable), or only support a subset of the possible positioning operations (e.g. it may only be possible to seek to the end of a tape, or to a positive offset from the beginning or current position).

It is not possible to set a negative I/O position, or for a physical file, an I/O position beyond the current end-of-file.

The computation may fail with:

Handle Properties

> hIsOpen          :: Handle -> IO Bool
> hIsClosed        :: Handle -> IO Bool
> hIsReadable      :: Handle -> IO Bool
> hIsWritable      :: Handle -> IO Bool
> hIsBlockBuffered :: Handle -> IO (Bool,Maybe Int)
> hIsLineBuffered  :: Handle -> IO Bool
> hIsNotBuffered   :: Handle -> IO Bool
> hIsSeekable      :: Handle -> IO Bool

A number of operations return information about the properties of a handle. Each of these operations except hIsBlockBuffered returns True if the handle has the specified property, and False otherwise. (Rationale)

Computation hIsBlockBuffered hdl returns ( False, Nothing ) if hdl is not block-buffered. Otherwise it returns ( True, size ), where size is Nothing for default buffering, and ( Just n ) for block-buffering of n 8-bit bytes.

Any of the latter six computations may fail with


[Prev] [Up] [Next]


The Definition of Monadic I/O in Haskell 1.3
Haskell 1.3 Committee
haskell1.3@comp.vuw.ac.nz
Haskell 1.3 Text Input: PreludeReadTextIO [Prev] [Up] [Next]


Text Input "PreludeReadTextIO"

This module defines the standard set of input operations for reading characters and strings from text files, using handles.

> interface PreludeReadTextIO where

> import PreludeMonadicIO
> import PreludeIOError
> import PreludeStdIO

Checking for Input

> hReady        :: Handle -> IO Bool 

Computation hReady hdl indicates whether at least one item is available for input from handle hdl. (Rationale)

The computation may fail with:

Reading Characters

> getChar       ::           IO Char
> hGetChar      :: Handle -> IO Char
> getChar       =  hGetChar stdin

Computation hGetChar hdl reads the next character from handle hdl, blocking until a character is available.

The computation may fail with:

getChar reads the next character from stdin. The computation may fail with the same errors as hGetChar.

Reading Ahead

> hLookAhead    :: Handle -> IO Char

Computation hLookAhead hdl returns the next character from handle hdl without removing it from the input buffer, blocking until a character is available. (Rationale)

The computation may fail with:

> hGetContents  :: Handle -> IO String

Computation hGetContents hdl returns the list of characters corresponding to the unread portion of the channel or file managed by hdl, which is made semi-closed.

The computation may fail with:

> readFile      :: FilePath -> IO String
> readFile name =  openFile name ReadMode >>= hGetContents

readFile file returns the contents of file as a lazy string.

The computation may fail with:


[Prev] [Up] [Next]


The Definition of Monadic I/O in Haskell 1.3
Haskell 1.3 Committee
haskell1.3@comp.vuw.ac.nz
Haskell 1.3 Text Output: PreludeWriteTextIO [Prev] [Up] [Next]


Text Output "PreludeWriteTextIO"

This module defines the standard set of output operations for writing characters and strings to text files, using handles.


> interface PreludeWriteTextIO where

> import PreludeMonadicIO
> import PreludeIOError
> import PreludeStdIO

> putChar       ::                     Char   -> IO () 
> hPutChar      ::           Handle -> Char   -> IO ()
> putChar       =  hPutChar stdout

Computation hPutChar hdl c writes the character c to the file or channel managed by hdl. Characters may be buffered if buffering is enabled for hdl.

The computation may fail with:

> putStr        ::                     String -> IO () 
> hPutStr       ::           Handle -> String -> IO ()
> putText       :: Text a =>           a      -> IO () 
> hPutText      :: Text a => Handle -> a      -> IO ()
> print         :: Text a =>           a      -> IO ()

> putStr        =  hPutStr stdout
> hPutStr hdl   =  foldr (>>) (return ()) . map (hPutChar hdl)
> putText       =  hPutText stdout
> hPutText hdl  =  hPutStr hdl . show
> print x       =  putText x >> putChar '\n'

Computation hPutStr hdl s writes the string s to the file or channel managed by hdl.

The computation may fail with:

Computation putStr s writes the string s to stdout. The computation may fail with the same errors as hPutChar.

Computation hPutText hdl t writes the string representation of t given by the shows function to the file or channel managed by hdl.

The computation may fail with the same errors as hPutStr.

> writeFile  :: FilePath -> String -> IO ()
> appendFile :: FilePath -> String -> IO ()

> writeFile name str =
>   openFile name WriteMode >>= \hdl -> hPutStr hdl str >> hClose hdl

> appendFile name str =
>   openFile name AppendMode >>= \hdl -> hPutStr hdl str >> hClose hdl

writeFile file s replaces the contents of file by the string s.
appendFile file s appends string s to file.

These computations may fail with:


[Prev] [Up] [Next]


The Definition of Monadic I/O in Haskell 1.3
Haskell 1.3 Committee
haskell1.3@comp.vuw.ac.nz
Haskell 1.3 Standard I/O: LibDirectory [Prev] [Up] [Next]


Directory Operations

A directory contains a series of entries, each of which is a named reference to a file system object (file, directory etc.). Some entries may be hidden, inaccessible, or have some administrative function (e.g. "." or ".." under POSIX), but in this standard all such entries are considered to form part of the directory contents. Entries in sub-directories are not, however, considered to form part of the directory contents.

Each file system object is referenced by a path. There is normally at least one absolute path to each file system object. In some operating systems, it may also be possible to have paths which are relative to the current directory.


> interface LibDirectory where

> createDirectory :: FilePath -> IO ()

createDirectory dir creates a new directory dir which is initially empty, or as near to empty as the operating system allows.

The operation may fail with:

> removeDirectory :: FilePath -> IO ()

removeDirectory dir removes an existing directory dir. The implementation may specify additional constraints which must be satisfied before a directory can be removed (e.g. the directory has to be empty, or may not be in use by other processes). It is not legal for an implementation to partially remove a directory unless the entire directory is removed. A conformant implementation need not support directory removal in all situations (e.g. removal of the root directory).

The operation may fail with:

> removeFile :: FilePath -> IO ()

removeFile file removes the directory entry for an existing file file, where file is not itself a directory. The implementation may specify additional constraints which must be satisfied before a file can be removed (e.g. the file may not be in use by other processes).

The operation may fail with:

> renameDirectory :: FilePath -> FilePath -> IO ()

renameDirectory old new changes the name of an existing directory from old to new. If the new directory already exists, it is atomically replaced by the old directory. If the new directory is neither the old directory nor an alias of the old directory, it is removed as if by removeDirectory. A conformant implementation need not support renaming directories in all situations (e.g. renaming to an existing directory, or across different physical devices), but the constraints must be documented.

The operation may fail with:

> renameFile :: FilePath -> FilePath -> IO ()

renameFile old new changes the name of an existing file system object from old to new. If the new object already exists, it is atomically replaced by the old object. Neither path may refer to an existing directory. A conformant implementation need not support renaming files in all situations (e.g. renaming across different physical devices), but the constraints must be documented.

The operation may fail with:

> getDirectoryContents :: FilePath -> IO [FilePath]

getDirectoryContents dir returns a list of all entries in dir.

The operation may fail with:

> getCurrentDirectory :: IO FilePath

If the operating system has a notion of current directories, getCurrentDirectory returns an absolute path to the current directory of the calling process.

The operation may fail with:

> setCurrentDirectory :: FilePath -> IO ()

If the operating system has a notion of current directories, setCurrentDirectory dir changes the current directory of the calling process to dir.

The operation may fail with:


[Prev] [Up] [Next]


The Definition of Monadic I/O in Haskell 1.3
Haskell 1.3 Committee
haskell1.3@comp.vuw.ac.nz
Haskell 1.3 System Interaction: LibSystem [Prev] [Up] [Next]


System Interaction "LibSystem"


> interface LibSystem where

The ExitCode type defines the exit codes that a program can return. ExitSuccess indicates successful termination; and ExitFailure code indicates program failure with value code. The exact interpretation of code is operating-system dependent. In particular, some values of code may be prohibited (e.g. 0 on a POSIX-compliant system).
(Rationale)

> data ExitCode =  ExitSuccess | ExitFailure Int
> getArgs       :: IO [String] 
> getProgName   :: IO String
> getEnv        :: String -> IO String
> system        :: String -> IO ExitCode
> exitWith      :: ExitCode -> IO a

Computation getArgs returns a list of the program's command line arguments (not including the program name).

Computation getProgName returns the name of the program as it was invoked.

Computation getEnv var returns the value of the environment variable var.

This computation may fail with

(Rationale)

Computation system cmd returns the exit code produced when the operating system processes the command cmd.

This computation may fail with

Computation exitWith code terminates the program, returning code to the program's caller. Before it terminates, any open or semi-closed handles are first closed.


[Prev] [Up] [Next]


The Definition of Monadic I/O in Haskell 1.3
Haskell 1.3 Committee
haskell1.3@comp.vuw.ac.nz
Haskell 1.3 CPU Time Library: LibCPUTime [Prev] [Up] [Next]


The CPU Time Library "LibCPUTime"


> interface LibCPUTime where

> getCPUTime      :: IO Integer

Computation getCPUTime returns the number of nanoseconds CPU time used by the current program. The precision of this result is implementation-dependent.

(Rationale)


[Prev] [Up] [Next]


The Definition of Monadic I/O in Haskell 1.3
Haskell 1.3 Committee
haskell1.3@comp.vuw.ac.nz
Haskell 1.3 Time of Day: LibTime [Prev] [Up] [Next]


The Time of Day Library "LibTime"

The LibTime library provides the functionality of ANSI C "time.h", adapted to the Haskell environment. It includes timezone information, as in System V, and follows RFC 1129 in its use of Coordinated Universal Time (UTC). (Rationale)


> interface LibTime where
ClockTime is an abstract type, used for the internal clock time. Clock times may be compared, converted to strings, or converted to an external calendar time CalendarTime.

> data ClockTime
> instance Ord ClockTime
> instance Eq  ClockTime

When a ClockTime is shown, it is converted to a string of the form
"Mon Nov 28 21:45:41 GMT 1994".

> instance Text ClockTime where
>    showsPrec _ t _ = ...

CalendarTime is a user-readable and manipulable representation of the internal ClockTime type. The numeric fields have the following ranges.

Value         Range             Comments
-----         -----             --------

year    -maxInt .. maxInt       [Pre-Gregorian dates are inaccurate]
mon           0 .. 11           [Jan = 0, Dec = 11]
day           1 .. 31
hour          0 .. 23
min           0 .. 59
sec           0 .. 61           [Allows for two Leap Seconds]
picosec       0 .. (10^12)-1    [This could be over-precise?]
wday          0 .. 6            [Sunday = 0, Saturday = 6]
yday          0 .. 365          [364 in non-Leap years]
tz       -43200 .. 43200        [Variation from UTC in seconds]

The tzname field is the name of the time zone. The isdst field indicates whether Daylight Savings Time would be in effect.

> --                   year mon  day  hour min  sec  picosec wday yday tzname tz  isdst
> data CalendarTime = 
>        CalendarTime  Int  Int  Int  Int  Int  Int  Integer Int  Int  String Int Bool

The TimeDiff type records the difference between two clock times in a user-readable way.

> --                          year mon  day  hour min  sec  picosec
> data TimeDiff    = TimeDiff Int  Int  Int  Int  Int  Int  Integer
>                    deriving (Eq,Ord)

getClockTime returns the current time in its internal representation.

> getClockTime    :: IO ClockTime

addToClockTime d t adds a time difference d and a clock time t to yield a new clock time. The difference d may be either positive or negative. diffClockTimes t1 t2 returns the difference between two clock times t1 and t2 as a TimeDiff.

> addToClockTime  :: TimeDiff  -> ClockTime -> ClockTime
> diffClockTimes  :: ClockTime -> ClockTime -> TimeDiff

toCalendarTime t converts t to a local time, modified by the current timezone and daylight savings time settings. toUTCTime t converts t into UTC time. toClockTime l converts l into the corresponding internal ClockTime. The wday, yday, tzname, and isdst fields are ignored.

> toCalendarTime  :: ClockTime -> CalendarTime
> toUTCTime       :: ClockTime -> CalendarTime
> toClockTime     :: CalendarTime -> ClockTime


[Prev] [Up] [Next]


The Definition of Monadic I/O in Haskell 1.3
Haskell 1.3 Committee
haskell1.3@comp.vuw.ac.nz
Haskell 1.3 Interrupt Handling: LibUserInterrupt [Prev] [Up] [Next]


User Interrupt Handling "LibUserInterrupt"


> interface LibUserInterrupt where

> setUserInterrupt :: Maybe (IO ()) -> IO (Maybe (IO ()))

Whenever a user interrupt occurs, the program is stopped. If an interrupt handler is installed, this is then executed in place of the program. If no interrupt handler is installed, the program is simply terminated.

Computation setUserInterrupt (Justp) installs p as the interrupt handler; Computation setUserInterrupt Nothing removes the current interrupt handler. In either case, if an interrupt handler q was previously installed (Just q) is returned; otherwise Nothing is returned. (Rationale)

The operation may fail with:


[Prev] [Up] [Next]


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


Last Modified On Wed Dec 14 16:32:27 GMT 1994 By Kevin Hammond

Rationale for the Haskell 1.3 I/O Definition

Note: the text in this rationale is for explanation only and does not form part of the Haskell 1.3 definition. If the rationale conflicts with the definition, then the text of the definition always takes precedence.

The rationale is organised into a general section, and by module.


General

The proposal (like most of Haskell) is supposed to be rather boring. It provides a basic interface to common operating systems such as Unix, DOS, VMS, or the Macintosh, but does not address future operating systems, include ones based on object-orientation or persistence, or even graphical interface issues. Like other aspects of the Haskell design, it is somewhat more exciting than might be imagined, since it represents an attempt to provide "industrial-strength" input/output in a purely functional context. Other languages which have tried to do something like this are Hope+ and Clean.

Non-Determinism

I/O is not deterministic. That is, the same program could have different results when run multiple times (for example if a user gives different input from the keyboard). This is a requirement for real-world interaction.

The Haskell language is, however, both deterministic and referentially transparent. This apparent contradiction is resolved because I/O operations exist outside the language. Typically, a Haskell program is one process in a side-effecting operating system. The operating system affects the environment that the Haskell program exists in, and may respond to the result produced by that program (a series of monadic values>) by side-effecting the environment and returning the result as an input to the program. Internally, however, all expressions in the Haskell program are free from side-effect (including those of type IO a).

Libraries

In Haskell 1.3, Library modules are distinguished from Prelude modules in order to avoid cluttering the name space with infrequently used names, and also so that implementations can avoid loading unreferenced names. This should help produce faster translators and smaller binaries.

Conformance

Two levels of conformance are defined so that programmers can rely on exact portability between strictly-conforming Haskell implementations, while allowing implementation flexibility on systems where some operations are unnatural, or difficult to implement. Documentation of non-conformance, and of all implementation dependencies, is required so that programmers know exactly how their program will behave without needing to test it under each new implementation.

Compatibility with Haskell 1.2

The goal of strict backwards compatibility was abandoned in favour of a more compact, more flexible approach to I/O. Existing implementations are encouraged to continue to provide Haskell 1.2 I/O functions where possible, but new programs should be written using Haskell 1.3 operations.

Converting Existing Programs

Most existing Haskell programs written using continuation-passing style or streams should be easily convertible to monadic I/O.

The following operations which were supported in Haskell 1.2 are not supported in Haskell 1.3:

Omissions

There is a tension between providing enough functionality to allow sensible applications to be written, and providing a reasonably compact, easily implemented I/O system. This definition is intended to provide the functionality that most students or practising functional programmers are likely to need.

Here are some of the I/O operations that were considered, but which were not included in the final definition.


PreludeIO

interact

interact was provided in Haskell 1.2 as a way to write simple I/O programs as functions from input strings to output strings. This emulates the functionality provided by many previous functional languages, such as SASL.

Example: a program to replace all lower-case letters with their upper-case equivalents.

> main = interact (map toUpper)


PreludeMonadicIO

Use of fail rather than error

error aborts the program without giving any opportunity to recover from the error. It can be used in any type of expression. fail allows the error to be handled if appropriate, using operations such as handle and try but can only be used in expressions of type IO a.


PreludeIOError

This module tries to identify all errors which might arise when performing the I/O operations defined in the standard. It is much more informative than Haskell 1.2 in that it gives specific names to errors rather than relying on the general classes ReadError, WriteError, etc. This allows meaningful handlers to be written which are not implementation-dependent.


PreludeStdIO

The module is defined in terms of items read from a handle, rather than characters, to allow the possibility of reading structured files in an extended implementation. PreludeReadTextIO and PreludeWriteTextIO provide read and write operations for handles operating on steams of characters.

Handle Reuse

If an implementation reused a handle after it was closed while there where still implicit references to it from within the functional program, then the I/O semantics could be subverted, and cause non-intuitive results. For example, in

> openFile ReadMode "foo" >>= \ foo ->
> hClose foo              >>
> openFile ReadMode "bar" >>= \ bar ->
> hGetChar foo

if handle foo was reused for bar, then this code sequence would return the first character in "bar" rather than raising an error. This is therefore prohibited by the language semantics.

Semi-Closing

Semi-closing is used to emulate the lazy stream reading found in almost all functional languages.

Errors are discarded on a semi-closed handle because it is not possible to handle them! The value read from the semi-closed handle is fixed as a list of items, but in order to raise an error this would need to be a list of IO items. Using such a type would defeat the purpose of having semi-closed streams, which is to model lazy stream reading by returning a list of items from that stream.

Normally semi-closed handles will be closed automatically when the contents of the associated stream have been read completely. Occasionally, the programmer may want to force a semi-closed handle to be closed before this happens, by using hClose (e.g. if an error occurs when reading a handle, or if the entire contents is not needed but the file must be overwritten with a new value). In this case, the implementation defines exactly which characters have been read from the handle and which are frozen as the contents of the handle.

Standard Handles

Most operating systems provide a notion of standard program input and output. For interactive text-based programs, these are normally connected to the user's keyboard. Operating systems which do not have this concept (such as the Macintosh) are normally graphics-based. In such a system, it does not make sense to have a text-based program, unless some primitive text emulation is performed. Since, however, the majority of operating systems are still text-based, and it is unclear how to standardise a set of portable windowing operations for the graphics-based systems, the notion of standard input, output and error handles has been retained.

The stderr handle is provided because it is often useful to separate error output from normal user output on stdout. In operating systems which support this, one or the other is often directed into a file. If an operating system doesn't distinguish between user and error output, a sensible default is for the two names to refer to the same handle.

Opening Files

The openFile operation proved surprisingly controversial, and difficult to specify. In the interests of simplicity and portability, a single high-level openFile has been provided. It would be possible to separate this into simpler operations (such as open, create, truncate, lock, seek, setAccessRights, etc. etc.), but this would be awkward to use, and probably non-portable. Programmers should use the relevant operating-system specific bindings if they require these lower levels of file access.

Text/Binary Files

The definition doesn't distinguish text and binary file types. Files should be opened in the appropriate mode whenever possible. On some systems the operations permitted on the two types of file are different, but the file types are distinguished by convention rather than by the operating system. For these systems, it is important to specify whether a file is opened as in text or binary mode. In these cases, we recommend that the implementation introduces an extension, providing an additional openBinaryFile operation with the same parameters and results as openFile. If this proves sufficiently useful, and general, it will be promoted to the core definition.

ReadWrite Mode

It has been argued that this mode is not necessary, but many useful applications are impossible to write otherwise. Perhaps existing functional programmers only write compilers or similar functions from streams to streams? If a file is large and changes are small, however, it is much more efficient to make a small incremental change than to copy an entire file.

An on-screen interactive text editor is an example of an application where this mode is useful (it is possible to write editors which work on streams, but they can be unpleasant to use!), and there are many business examples. Providing this mode significantly extends the range of Haskell applications that can be written at almost no implementation cost. It is rare to find a modern operating system that does not provide this kind of access directly.

File Locking

A consistent problem with Haskell 1.2 was that implementations were not required to lock files when they where opened. Consequently, if a program reopened a file for writing while it was still being read, the results returned from the read could be garbled. Because of lazy evaluation and implicit buffering (also not specified by Haskell 1.2), it was possible for this to happen on some but not all program executions. This problem only occurs with languages which implement lazy stream input (hGetContents) and also have non-strict semantics.

It has been argued that programmers should avoid opening a file when it has already been opened in an incompatible way. Unfortunately, in general, this is difficult or even impossible to do -- almost all non-trivial programs open user-supplied filenames, and there is often no way of telling from the names whether two filenames refer to the same file. The only safe thing to do is implement file locks whenever a file is opened. This could be done by the programmer if a suitable locking operation was provided, but to be secure this would need to be done on every openFile operation, and might also require knowledge of the operating system.

The definition requires that identical files are locked against accidental overwriting within a single Haskell program (single-writer, multiple-reader). Two physical files are certainly identical if they have the same filename, but may be identical in other circumstances. A good implementation will use operating-system level locking (mandatory or advisory), if they are appropriate, to protect the user's data files. Even so, the definition only requires an implementation to take precautions to avoid obvious and persistent problems due to lazy file I/O (a language feature): it does not require the implementation to protect against interference by other applications or the operating system itself. Caveat user.

File Sizes

The file size is given as an integral number of bytes. On some operating systems, it is possible that this will not be an accurate indication of the number of characters that can be read from the file.

File Extents

On some systems (e.g. the Macintosh), it is much more efficient to define the maximum size of a file (or extent) when it is created, and to increase this extent by the total number of bytes written if the file is appended to, rather than increasing the file size each time a block of data is written. This may allow a file to be laid out contiguously on disk, for example, and therefore accessed more efficiently. In any case, the actual file size will be no greater than the extent.

While efficient file access is a desirable characteristic, the designers felt that dealing with this aspect of I/O led to a design which was over-complex for the normal programmer. The core Haskell I/O definition therefore does not distinguish between file size (the number of bytes in the file), and file extent (the amount of disk occupied by a file).

End of File

There are two alternative ways of detecting end-of-file, either by testing using hIsEOF or by handling the EOF error after a getChar or similar operation. While this may seem redundant, end-of-file detection often has algorithmic implications. This design allows error handlers to be reserved for unusual or unexpected situations.

Buffering

Buffering interacts with many of the operations provided here. While it might seem desirable to eliminate this complexity, for correct I/O semantics it is sometimes necessary to specify that a device should not be buffered, or that it should have a particular buffer size. In the absence of such strict buffering semantics, it can also be difficult to reason (even informally) about the contents of a file following a series of interacting I/O operations.

While it would be sufficient to provide hFlush, this would be tedious to use (for any kind of buffering other than BlockBuffering), error-prone, and would require programmers to cooperate by providing optional flushing after each I/O operations when writing library functions.

Buffer Modes

The three buffer modes mirror those provided by ANSI C. The programmer should normally accept the buffering modes that the implementation chooses as default.

Changing the I/O position

Many applications need direct access to files if they are to be implemented efficiently. Examples are text editors, or simple database applications. It is surprising how complicated such a common and apparently simple operation as changing the I/O position is in practice. The design given here draws heavily on the ANSI C standard.

Revisiting an I/O position

On some operating systems or devices, it is not possible to seek to arbitrary locations, but only to ones which have previously been visited. For example, if newlines in text files are represented by pairs of characters (as in DOS), then the I/O position will not be the same as the number of characters which have been read from the file up to that point and absolute seeking is not sensible. hSetPosn together provide this functionality, using an abstract type to represent the positioning information (which may be an Integer or any other suitable type). Note that there is no way to convert a handlePosn into an Integer offset. Since this is not generally possible, and it is not normally difficult for a programmer to record the current I/O position if using hSeek, on balance the designers felt that this should be omitted.
> toOffset :: HandlePosn -> Integer

Seeking to a new I/O position

Other operating systems (such as Unix or the Macintosh) allow I/O at any position in a file. The hSeek operation allows three kinds of positioning: absolute positioning, positioning relative to the current I/O position, and positioning relative to the current end-of-file. Some implementations may only support some of these operations.

All positioning offsets are an integral number of bytes. This seems to be fairly widely supported and is quite simple. The alternatives (e.g. defining positioning in terms of the number of items which can be read from the file) seem to give designs which are difficult both to understand and to use.

Handle Properties

The original Haskell 1.3 design provided a single operation to return all the properties of a handle. This proved to be very unwieldy, and would also have been difficult to extend to cover other properties (since Haskell does not have named records). The operation was therefore split into many component operations, one for each property that a handle must have (determining the I/O position is

PreludeReadTextIO

Checking for Input

hReady is intended to help write interactive programs or ones which manage multiple input streams. Because it is non-blocking, this can lead to serious inefficiency if it is used to poll several handles.

One solution is to define an operation based on Unix select.

> type SelectData = ([Handle], [Handle], [Handle], Maybe Integer)
> select :: SelectData -> IO (Maybe SelectData)

SelectData consists of three sets of handles (which need not be disjoint) and an optional time interval.

Computation select (ihs, ohs, ehs, mb) waits until input is possible on at least one member of ihs, output is available on at least one member of ohs or an exceptional condition arises on at least one member of ehs. All handles in the sets which meet the specified conditions are returned. If a timeout is given (mb is Just i) the computation waits at most i nanoseconds before timing out; in which case it returns Nothing. Otherwise, the time remaining before the timeout would occur is returned as the fourth component of the result (Nothing if no timeout was given).

Reading Ahead

It can be useful to examine the next character in the input stream when writing a lexical analyser or similar input-processing function. The functionality of Ada's lookAhead was preferred over that of ANSI C's ungetc because it is much less problematic to implement. Compared with Modula-3's unGetChar, this definition avoids needing to record in each handle whether the last I/O operation was a getChar. Even so, it is not entirely cost-free: a one-character buffer must be provided even for unbuffered handles.


PreludeWriteTextIO

There seems to be much less controversy over character-level output than input, and therefore no rationale is provided.


LibDirectory

No status operations are provided. Haskell 1.2 statusFile/statusChan were rarely, if ever, used. Their functionality is probably better provided by operating-system specific operations, which can give more exact information.


LibSystem

Exit Codes

Only ExitSuccess and ExitFailure are available. Some operating systems may wish to test whether a program failed due to an unhandled interrupt. This is best done using an operating-system specific routine, such as those provided in the POSIX binding LibPosix.

Environment Variables

getEnv is generally available in most operating systems in some form or other. When available it provides a useful way of communicating infrequently-changed information to a program (which it is inconvenient to specify on the command-line for shell-based systems). Setting environment variables is a much less common feature. Although this can be highly useful when available, it is therefore not provided as part of the core definition.


LibTime

This library codifies existing practice in the shape of the Time library provided by hbc. Unlike that library it is not Unix-specific, and it provides recognised support for international time standards, including time-zone information. Time differences are recorded in a meaningful datatype rather than as a double-precision number.

There are two obvious ways to specify subseconds. hbc has chosen to use a Double to represent fractions of a second. Because of limitations on floating-point accuracy, this is potentially unacceptable if these values are actually significant (for example if they are used to timestamp similarly-timed stock-market transactions). Since Haskell does not define the precision of Double, it is also not clear that double-precision values are sufficiently accurate for sub-second timings.

An Integer has therefore been used instead. Subseconds are specified to picosecond precision (but not necessarily accuracy!), which should be more than accurate enough for the forseeable future.


LibCPUTime

getCPUTime is specified to nanosecond precision, since this is the precision used by the most accurate existing clocks that are in common use. Note that while OSF/1 for the DEC Alpha specifies timings to nanosecond precision, the times returned are only accurate to around 1ms.


LibUserInterrupt

User-produced interrupts are the most important class of interrupt which programmers commonly want to handle. Almost all platforms, including small systems such as Macintosh and DOS, provide some ability to generate user-produced interrupts.


LibPOSIX

This section intentionally left blank.

[Up]


The Definition of Monadic I/O in Haskell 1.3
Haskell 1.3 Committee
haskell1.3@comp.vuw.ac.nz
Haskell 1.3 Recent Changes [Up]


Recent Changes to the Definition

941214
Final proofread.
Fixed several minor typos.
Reinstated print.
Improved User Interface.
KH
941207
Fixed typos pointed out by ADG.
Added Summary section for quick browsing.
KH
941130
Major revision to separate core and non-core functionality, and to enhance portability based on long-term feedback.
Removed the separation between primitive and derived values -- this was confusing, and not really useful.
Fixed HTML errors to allow code to be previewed on all platforms.
KH


[Up]


The Definition of Monadic I/O in Haskell 1.3
Haskell 1.3 Committee
haskell1.3@comp.vuw.ac.nz
Haskell 1.3 Credits [Up] [Next]


Credits

The authors of this definition were
Andy Gordon [Editor]
University of Cambridge, UK
Kevin Hammond [Editor]
Glasgow University, UK
Andy Gill
Glasgow University, UK
Ian Poole
MRC Genetics Unit, Edinburgh University, UK
Jim Mattson
Glasgow University, UK

The Haskell 1.3 Committee is

Lennart Augustsson
Chalmers University, Goteborg, Sweden
Brian Boutel
Wellington University, New Zealand
Warren Burton
Simon Fraser University, Canada
Joe Fasel
Los Alamos National Labs., New Mexico, USA
Andy Gordon
University of Cambridge, UK
Kevin Hammond
Glasgow University, UK
Mark Jones
Nottingham University, UK
John Peterson
Yale University, USA
Simon Peyton Jones
Glasgow University, UK
We are grateful to the many people who have made concrete suggestions for improvements to this definition, without being part of the Haskell 1.3 committee. These have included
Jon Fairbairn
University of Cambridge, UK
Ian Holyer
Bristol University, UK
Sandra Loosemoore
Yale University, USA
Will Partain
Glasgow University, UK
Alastair Reid
Yale University, USA
Phil Wadler
Glasgow University, UK

[Up] [Next]


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


Bibliography

Warning: not all references are here yet, especially in the operating systems section.

Language Standards and Definitions

Ada 83 Language Reference Manual,
ANSI Standard ANSI/MIL-STD-1815A-1983, (1983).

Programming Language Ada, Language and Standard Libraries (Draft Version 5.0),
Proposed ANSI/ISO Standard ISO/IEC CD 865, (June 1994).

Programming Language C, Language and Standard Libraries,
ANSI Standard X3.159-1989, ISO Standard 9899:1990, (1989/90).

P.J. Plauger, The Standard C Library,
Prentice Hall, (1992).

M.C.J.D. van Eekelen, E.G.J.M.H. Nöcker, M.J. Plasmeijer, and J.E.W. Smetsers,
"Concurrent Clean"
Technical Report 89-18, University of Nijmegen, (1989).

COBOL 9x.

G.L. Steele,
Common Lisp, the Language, 2nd Edition
,
Digital Press, ISBN 1-55558-041-6, (1990).

Fortran 9x.

P. Hudak, S.L. Peyton Jones, P.L. Wadler (eds.) et al.,
Report on the Functional Programming Language Haskell: A Non-strict, Purely Functional Language, Version 1.2.
ACM SIGPLAN Notices, 27(5) (March 1992).

N. Wirth,
Programming in Modula-2,
Springer-Verlag, (1983).

Modula-3: Language definition.

G. Nelson (ed.),
System Programming with Modula-3,
Prentice Hall Series in Innovative Technology, ISBN 0-13-590464-1. (1991).

A.J.R. Milner and M. Tofte,
The Definition of Standard ML,
MIT Press, 1990.


Operating System References

Berkeley Unix 4.3.

Macintosh System 7.

MS-DOS.

OS/2.

OSF/1.

POSIX.

Solaris.

SunOS 4.1.3.

Unix System V.

VMS.

Win16.

Win32.

Windows 3.1.

Windows NT.

Windows95.


I/O in Functional Programming Languages

P. Achten and M.J. Plasmeijer,
"The Ins and Outs of Clean I/O", (1994).

J. Cupitt,
"A brief walk through KAOS".
Technical Report 58, Computing Laboratory, UKC, Canterbury, Kent, (February 1989).

A.D. Gordon,
Functional Programming and Input/Output.
Distinguished Dissertations in Computer Science, Cambridge University Press, (1994).

J. Launchbury and S.L. Peyton Jones,
Lazy Functional State Threads.
Proc. ACM Conf. on Prog. Lang. Design and Implementation (PLDI '94), (1994).

N. Perry,
The Implementation of Practical Functional Programming Languages,
PhD Thesis, Department of Computing Science,
Imperial College, London, (1991).

S.L. Peyton Jones and P.L. Wadler,
Imperative functional programming.
Proc. 20th ACM Symp. on Principles of Programming Langs. (POPL '93),
Charleston, South Carolina, (January 1993).

P.L. Wadler,
The essence of functional programming.
Proc. 19th ACM Symp. on Principles of Programming Langs. (POPL '92),
(January 1992).


Miscellaneous

RFC 1129.


[Up]


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

Examples

Here are some simple examples showing how the Haskell 1.3 I/O operations can be used.


Hello World

The Hello World program in Haskell 1.3.

> main =  putStr "Hello World\n"


Summing Two Numbers

This program is adapted from the Haskell 1.2 report. It reads and sums two integers (default overloading resolution is used to resolve the types of x1 and x2 to be Int).

> main =
>       hSetBuffering stdout NoBuffering                  >>
>       putStr   "Enter an integer: "                     >>
>       readLine                                          >>= \ x1 -> 
>       putStr   "Enter another integer: "                >>
>       readLine                                          >>= \ x2 -> 
>       putStr  ("Their sum is " ++ show (x1+x2) ++ "\n")
>
>  where readLine = isEOF                                 >>= \ eof ->
>                   if eof then return []
>                   else getChar                          >>= \ c ->
>                        if c `isIn` ['\n','\p'] then
>                           return []
>                        else
>                           readLine                      >>= \ cs ->
>                           return (c:cs)


Copying Files

A simple program to create a copy of a file, with all lower-case characters translated to upper-case. This program will not allow a file to be copied to itself. This version uses character-level I/O.

> main   =  getArgs                           >>=        \ [f1,f2] ->
>           openFile f1 ReadMode              >>=        \ h1      ->
>           openFile f2 WriteMode             >>=        \ h2      ->
>           copyFile h1 h2                    >>
>           hClose h1                         >>
>           hClose h2

> copyFile h1 h2 =
>           hIsEOF h1                         >>=        \ eof ->
>           if eof
>             return ()
>           else
>             hGetChar h1                     >>=        \ c       ->
>             hPutChar h2 (toUpper c)         >>
>             copyFile h1 h2

An equivalent but much shorter version, using string I/O is:

> main =    getArgs                           >>=        \ [f1,f2] ->
>           readFile f1                       >>=        \ s       ->
>           writeFile f2 (map toUpper s)


A Simple Talk Program

It could be argued that this is somewhat whimsical, but it shows how some more advanced features can be used to good effect.

Assume that opening the "file" "u@h" will open a connection to user u at host h (so "kh@dcs.glasgow.ac.uk" will open a connection to Kevin Hammond at Glasgow), then the following is a simple communication program that allows the user to communicate across the network.

> main =   getArgs                            >>=        \ [user,host] ->
>          let username = (user ++ "@" ++ host) in
>          openFile username ReadWriteMode    >>=        \ cd          ->
>          hSetBuffering NoBuffering stdin    >>
>          hSetBuffering NoBuffering stdout   >>
>          hSetBuffering NoBuffering cd       >>
>          hPutString speakString             >>
>          speak cd
>
> speakString = "Someone wants to speak with you"

> speak cd =
>          hReady cd                          >>=        \ ready       ->
>          if ready then (hGetChar cd >>= putChar)
>          else return ()                     >>
>
>          hReady stdin                       >>=        \ ready       ->
>          if ready then (getChar >>= hPutChar cd)
>          else return ()                     >>
>
>          speak cd

Note the use of hReady to allow interleaved communication, and hSetBuffering to disable buffered input and output.


[Up]


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