[project @ 2002-10-09 17:24:12 by malcolm]
[packages/old-time.git] / System / IO / Error.hs
1 {-# OPTIONS -fno-implicit-prelude #-}
2
3 -----------------------------------------------------------------------------
4 -- |
5 -- Module : System.IO.Error
6 -- Copyright : (c) The University of Glasgow 2001
7 -- License : BSD-style (see the file libraries/base/LICENSE)
8 --
9 -- Maintainer : libraries@haskell.org
10 -- Stability : provisional
11 -- Portability : portable
12 --
13 -- Standard IO Errors.
14 --
15 -----------------------------------------------------------------------------
16
17 module System.IO.Error (
18 IOError, -- abstract
19 #ifdef __GLASGOW_HASKELL__
20 IOErrorType, -- abstract
21 #endif
22
23 ioError, -- :: IOError -> IO a
24 userError, -- :: String -> IOError
25
26 #ifdef __GLASGOW_HASKELL__
27 mkIOError, -- :: IOErrorType -> String -> Maybe Handle
28 -- -> Maybe FilePath -> IOError
29
30 alreadyExistsErrorType, -- :: IOErrorType
31 doesNotExistErrorType,
32 alreadyInUseErrorType,
33 fullErrorType,
34 eofErrorType,
35 illegalOperationErrorType,
36 permissionErrorType,
37 userErrorType,
38
39 isAlreadyExistsErrorType, -- :: IOErrorType -> Bool
40 isDoesNotExistErrorType,
41 isAlreadyInUseErrorType,
42 isFullErrorType,
43 isEOFErrorType,
44 isIllegalOperationErrorType,
45 isPermissionErrorType,
46 isUserErrorType,
47 #endif /* __GLASGOW_HASKELL__ */
48
49 isAlreadyExistsError, -- :: IOError -> Bool
50 isDoesNotExistError,
51 isAlreadyInUseError,
52 isFullError,
53 isEOFError,
54 isIllegalOperation,
55 isPermissionError,
56 isUserError,
57
58 #ifdef __GLASGOW_HASKELL__
59 ioeGetErrorType, -- :: IOError -> IOErrorType
60 #endif
61 ioeGetErrorString, -- :: IOError -> String
62 ioeGetHandle, -- :: IOError -> Maybe Handle
63 ioeGetFileName, -- :: IOError -> Maybe FilePath
64
65 ) where
66
67
68 #ifdef __GLASGOW_HASKELL__
69 import GHC.Base
70 import Data.Maybe
71 import GHC.IOBase
72 import Text.Show
73 #endif
74
75 #ifdef __HUGS__
76 import Hugs.IO
77 #endif
78
79 #ifdef __NHC__
80 import IO
81 ( IOError ()
82 , ioError
83 , userError
84 , isAlreadyExistsError -- :: IOError -> Bool
85 , isDoesNotExistError
86 , isAlreadyInUseError
87 , isFullError
88 , isEOFError
89 , isIllegalOperation
90 , isPermissionError
91 , isUserError
92 , ioeGetErrorString -- :: IOError -> String
93 , ioeGetHandle -- :: IOError -> Maybe Handle
94 , ioeGetFileName -- :: IOError -> Maybe FilePath
95 )
96 --import Data.Maybe (fromJust)
97 --import Control.Monad (MonadPlus(mplus))
98 #endif
99
100 #ifdef __GLASGOW_HASKELL__
101 -- -----------------------------------------------------------------------------
102 -- Constructing an IOError
103
104 mkIOError :: IOErrorType -> String -> Maybe Handle -> Maybe FilePath -> IOError
105 mkIOError t location maybe_hdl maybe_filename =
106 IOException IOError{ ioe_type = t,
107 ioe_location = location,
108 ioe_descr = "",
109 ioe_handle = maybe_hdl,
110 ioe_filename = maybe_filename
111 }
112 #ifdef __NHC__
113 mkIOError EOF location maybe_hdl maybe_filename =
114 EOFError location (fromJust maybe_hdl)
115 mkIOError UserError location maybe_hdl maybe_filename =
116 UserError location ""
117 mkIOError t location maybe_hdl maybe_filename =
118 NHC.FFI.mkIOError location maybe_filename maybe_handle (ioeTypeToInt t)
119 where
120 ioeTypeToInt AlreadyExists = fromEnum EEXIST
121 ioeTypeToInt NoSuchThing = fromEnum ENOENT
122 ioeTypeToInt ResourceBusy = fromEnum EBUSY
123 ioeTypeToInt ResourceExhausted = fromEnum ENOSPC
124 ioeTypeToInt IllegalOperation = fromEnum EPERM
125 ioeTypeToInt PermissionDenied = fromEnum EACCES
126 #endif
127
128 -- -----------------------------------------------------------------------------
129 -- IOErrorType
130
131 isAlreadyExistsError, isDoesNotExistError, isAlreadyInUseError,
132 isFullError, isEOFError, isIllegalOperation, isPermissionError,
133 isUserError :: IOError -> Bool
134
135 isAlreadyExistsError = isAlreadyExistsErrorType . ioeGetErrorType
136 isDoesNotExistError = isDoesNotExistErrorType . ioeGetErrorType
137 isAlreadyInUseError = isAlreadyInUseErrorType . ioeGetErrorType
138 isFullError = isFullErrorType . ioeGetErrorType
139 isEOFError = isEOFErrorType . ioeGetErrorType
140 isIllegalOperation = isIllegalOperationErrorType . ioeGetErrorType
141 isPermissionError = isPermissionErrorType . ioeGetErrorType
142 isUserError = isUserErrorType . ioeGetErrorType
143 #endif
144
145 -- -----------------------------------------------------------------------------
146 -- IOErrorTypes
147
148 #ifdef __NHC__
149 data IOErrorType = AlreadyExists | NoSuchThing | ResourceBusy
150 | ResourceExhausted | EOF | IllegalOperation
151 | PermissionDenied | UserError
152 #endif
153
154 #ifdef __GLASGOW_HASKELL__
155 alreadyExistsErrorType, doesNotExistErrorType, alreadyInUseErrorType,
156 fullErrorType, eofErrorType, illegalOperationErrorType,
157 permissionErrorType, userErrorType :: IOErrorType
158
159 alreadyExistsErrorType = AlreadyExists
160 doesNotExistErrorType = NoSuchThing
161 alreadyInUseErrorType = ResourceBusy
162 fullErrorType = ResourceExhausted
163 eofErrorType = EOF
164 illegalOperationErrorType = IllegalOperation
165 permissionErrorType = PermissionDenied
166 userErrorType = UserError
167 #endif
168
169 -- -----------------------------------------------------------------------------
170 -- IOErrorType predicates
171
172 #ifdef __GLASGOW_HASKELL__
173 isAlreadyExistsErrorType, isDoesNotExistErrorType, isAlreadyInUseErrorType,
174 isFullErrorType, isEOFErrorType, isIllegalOperationErrorType,
175 isPermissionErrorType, isUserErrorType :: IOErrorType -> Bool
176 #endif
177
178 #ifdef __GLASGOW_HASKELL__
179 isAlreadyExistsErrorType AlreadyExists = True
180 isAlreadyExistsErrorType _ = False
181
182 isDoesNotExistErrorType NoSuchThing = True
183 isDoesNotExistErrorType _ = False
184
185 isAlreadyInUseErrorType ResourceBusy = True
186 isAlreadyInUseErrorType _ = False
187
188 isFullErrorType ResourceExhausted = True
189 isFullErrorType _ = False
190
191 isEOFErrorType EOF = True
192 isEOFErrorType _ = False
193
194 isIllegalOperationErrorType IllegalOperation = True
195 isIllegalOperationErrorType _ = False
196
197 isPermissionErrorType PermissionDenied = True
198 isPermissionErrorType _ = False
199
200 isUserErrorType UserError = True
201 isUserErrorType _ = False
202 #endif
203
204 -- -----------------------------------------------------------------------------
205 -- Miscellaneous
206
207 #ifdef __GLASGOW_HASKELL__
208 ioeGetErrorType :: IOError -> IOErrorType
209 ioeGetHandle :: IOError -> Maybe Handle
210 ioeGetErrorString :: IOError -> String
211 ioeGetFileName :: IOError -> Maybe FilePath
212
213 ioeGetErrorType (IOException ioe) = ioe_type ioe
214 ioeGetErrorType _ = error "System.IO.Error.ioeGetErrorType: not an IO error"
215
216 ioeGetHandle (IOException ioe) = ioe_handle ioe
217 ioeGetHandle _ = error "System.IO.Error.ioeGetHandle: not an IO error"
218
219 ioeGetErrorString (IOException ioe)
220 | isUserErrorType (ioe_type ioe) = ioe_descr ioe
221 | otherwise = show (ioe_type ioe)
222 ioeGetErrorString _ = error "System.IO.Error.ioeGetErrorString: not an IO error"
223
224 ioeGetFileName (IOException ioe) = ioe_filename ioe
225 ioeGetFileName _ = error "System.IO.Error.ioeGetFileName: not an IO error"
226 #endif
227
228 -- -----------------------------------------------------------------------------
229 -- annotating an IOError
230
231 #ifdef __GLASGOW_HASKELL__
232 annotateIOError :: IOError
233 -> String
234 -> Maybe FilePath
235 -> Maybe Handle
236 -> IOError
237 annotateIOError (IOException (IOError hdl errTy _ str path)) loc opath ohdl =
238 IOException (IOError (hdl `mplus` ohdl) errTy loc str (path `mplus` opath))
239 where
240 Nothing `mplus` ys = ys
241 xs `mplus` _ = xs
242 annotateIOError exc _ _ _ =
243 exc
244 #endif
245
246 #ifdef 0 /*__NHC__*/
247 annotateIOError (IOError msg file hdl code) msg' file' hdl' =
248 IOError (msg++'\n':msg') (file`mplus`file') (hdl`mplus`hdl') code
249 annotateIOError (EOFError msg hdl) msg' file' hdl' =
250 EOFError (msg++'\n':msg') (hdl`mplus`hdl')
251 annotateIOError (UserError loc msg) msg' file' hdl' =
252 UserError loc (msg++'\n':msg')
253 annotateIOError (PatternError loc) msg' file' hdl' =
254 PatternError (loc++'\n':msg')
255 #endif