File: IO.hs

package info (click to toggle)
hugs98 98.200109-5
  • links: PTS
  • area: main
  • in suites: woody
  • size: 3,344 kB
  • ctags: 5,368
  • sloc: ansic: 42,923; haskell: 6,574; xml: 1,143; yacc: 1,119; makefile: 332; sh: 260
file content (155 lines) | stat: -rw-r--r-- 5,533 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
-----------------------------------------------------------------------------
-- Standard Library: IO operations, beyond those included in the prelude
--
-- WARNING: The names and semantics of functions defined in this module
-- may change as the details of the IO standard are clarified.
--
-- Suitable for use with Hugs 98
-----------------------------------------------------------------------------

module IO (
    Handle, HandlePosn,
--  IOMode(ReadMode,WriteMode,AppendMode,ReadWriteMode),
    IOMode(ReadMode,WriteMode,AppendMode),
    BufferMode(NoBuffering,LineBuffering,BlockBuffering),
    SeekMode(AbsoluteSeek,RelativeSeek,SeekFromEnd),
    stdin, stdout, stderr, 
    openFile, hClose, 
--  hFileSize, hIsEOF, isEOF,
--  hSetBuffering, hGetBuffering, hFlush, 
    hFlush, 
    hGetPosn, hSetPosn, 
--  hSeek, hIsSeekable,
--  hReady, hGetChar, hLookAhead, hGetContents, 
    hGetChar, hGetLine, hGetContents, 
    hPutChar, hPutStr, hPutStrLn, hPrint,
    hIsOpen, hIsClosed, hIsReadable, hIsWritable, 
    isAlreadyExistsError, isDoesNotExistError, isAlreadyInUseError, 
    isFullError, isEOFError,
    isIllegalOperation, isPermissionError, isUserError, 
    ioeGetErrorString, ioeGetHandle, ioeGetFileName,
    try, bracket, bracket_,

    -- Non-standard extensions 
    hugsIsEOF, hugsHIsEOF,
    hugsIsSearchErr, hugsIsNameErr, hugsIsWriteErr,

    -- ... and what the Prelude exports
    IO,
    FilePath, IOError, ioError, userError, catch,
    putChar, putStr, putStrLn, print,
    getChar, getLine, getContents, interact,
    readFile, writeFile, appendFile, readIO, readLn
    ) where

import Ix(Ix)

data Handle
instance Eq Handle where (==) = primEqHandle
primitive primEqHandle :: Handle -> Handle -> Bool
newtype HandlePosn = HandlePosn Int deriving Eq

--data IOMode      =  ReadMode | WriteMode | AppendMode | ReadWriteMode
data IOMode      = ReadMode | WriteMode | AppendMode
                    deriving (Eq, Ord, Ix, Bounded, Enum, Read, Show)
data BufferMode  =  NoBuffering | LineBuffering 
                 |  BlockBuffering (Maybe Int)
                    deriving (Eq, Ord, Read, Show)
data SeekMode    =  AbsoluteSeek | RelativeSeek | SeekFromEnd
                    deriving (Eq, Ord, Ix, Bounded, Enum, Read, Show)

primitive stdin       :: Handle
primitive stdout      :: Handle
primitive stderr      :: Handle
primitive openFile    :: FilePath -> IOMode -> IO Handle
primitive hClose      :: Handle -> IO ()
--Not yet implemented:
--hFileSize           :: Handle -> IO Integer
--hIsEOF              :: Handle -> IO Bool
--isEOF               :: IO Bool
--isEOF                = hIsEOF stdin

--hSetBuffering       :: Handle  -> BufferMode -> IO ()
--hGetBuffering       :: Handle  -> IO BufferMode
primitive hFlush      :: Handle -> IO ()
primitive hGetPosn    :: Handle -> IO HandlePosn
primitive hSetPosn    :: HandlePosn -> IO () 
--hSeek               :: Handle -> SeekMode -> Integer -> IO () 

--hWaitForInput	      :: Handle -> Int -> IO Bool
--hReady              :: Handle -> IO Bool 
--hReady h	       = hWaitForInput h 0
primitive hGetChar    :: Handle -> IO Char

hGetLine              :: Handle -> IO String
hGetLine h             = do c <- hGetChar h
                            if c=='\n' then return ""
                              else do cs <- hGetLine h
                                      return (c:cs)

--hLookAhead          :: Handle -> IO Char
primitive hGetContents:: Handle -> IO String
primitive hPutChar    :: Handle -> Char -> IO ()
primitive hPutStr     :: Handle -> String -> IO ()

hPutStrLn             :: Handle -> String -> IO ()
hPutStrLn h s          = do { hPutStr h s; hPutChar h '\n' }

hPrint                :: Show a => Handle -> a -> IO ()
hPrint h               = hPutStrLn h . show

primitive hIsOpen,    
   	  hIsClosed,  
   	  hIsReadable,
   	  hIsWritable :: Handle -> IO Bool
--hIsSeekable         :: Handle -> IO Bool

primitive isIllegalOperation, 
	  isAlreadyExistsError, 
	  isDoesNotExistError, 
          isAlreadyInUseError,   
	  isFullError,     
          isEOFError, 
	  isPermissionError,
          isUserError        :: IOError -> Bool

primitive ioeGetErrorString "primShowIOError" :: IOError -> String
primitive ioeGetHandle      :: IOError -> Maybe Handle
primitive ioeGetFileName    :: IOError -> Maybe FilePath

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

bracket        :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket before after m = do
        x  <- before
        rs <- try (m x)
        after x
        case rs of
           Right r -> return r
           Left  e -> ioError e

-- variant of the above where middle computation doesn't want x
bracket_        :: IO a -> (a -> IO b) -> IO c -> IO c
bracket_ before after m = do
         x  <- before
         rs <- try m
         after x
         case rs of
            Right r -> return r
            Left  e -> ioError e

-----------------------------------------------------------------------------
-- Non-standard extensions 
-- (likely to disappear when IO library is more complete)

-- C library style test for EOF (doesn't obey Haskell semantics)
primitive hugsHIsEOF "hIsEOF" :: Handle -> IO Bool
hugsIsEOF             :: IO Bool
hugsIsEOF              = hugsHIsEOF stdin

primitive hugsIsSearchErr :: IOError -> Bool
primitive hugsIsNameErr   :: IOError -> Bool
primitive hugsIsWriteErr  :: IOError -> Bool

-----------------------------------------------------------------------------