1{-# LANGUAGE Trustworthy #-}
2{-# LANGUAGE NoImplicitPrelude #-}
3
4-----------------------------------------------------------------------------
5-- |
6-- Module      :  System.IO.Error
7-- Copyright   :  (c) The University of Glasgow 2001
8-- License     :  BSD-style (see the file libraries/base/LICENSE)
9--
10-- Maintainer  :  libraries@haskell.org
11-- Stability   :  provisional
12-- Portability :  portable
13--
14-- Standard IO Errors.
15--
16-----------------------------------------------------------------------------
17
18module System.IO.Error (
19
20    -- * I\/O errors
21    IOError,
22
23    userError,
24
25    mkIOError,
26
27    annotateIOError,
28
29    -- ** Classifying I\/O errors
30    isAlreadyExistsError,
31    isDoesNotExistError,
32    isAlreadyInUseError,
33    isFullError,
34    isEOFError,
35    isIllegalOperation,
36    isPermissionError,
37    isUserError,
38    isResourceVanishedError,
39
40    -- ** Attributes of I\/O errors
41    ioeGetErrorType,
42    ioeGetLocation,
43    ioeGetErrorString,
44    ioeGetHandle,
45    ioeGetFileName,
46
47    ioeSetErrorType,
48    ioeSetErrorString,
49    ioeSetLocation,
50    ioeSetHandle,
51    ioeSetFileName,
52
53    -- * Types of I\/O error
54    IOErrorType,                -- abstract
55
56    alreadyExistsErrorType,
57    doesNotExistErrorType,
58    alreadyInUseErrorType,
59    fullErrorType,
60    eofErrorType,
61    illegalOperationErrorType,
62    permissionErrorType,
63    userErrorType,
64    resourceVanishedErrorType,
65
66    -- ** 'IOErrorType' predicates
67    isAlreadyExistsErrorType,
68    isDoesNotExistErrorType,
69    isAlreadyInUseErrorType,
70    isFullErrorType,
71    isEOFErrorType,
72    isIllegalOperationErrorType,
73    isPermissionErrorType,
74    isUserErrorType,
75    isResourceVanishedErrorType,
76
77    -- * Throwing and catching I\/O errors
78
79    ioError,
80
81    catchIOError,
82    tryIOError,
83
84    modifyIOError,
85  ) where
86
87import Control.Exception.Base
88
89import Data.Either
90import Data.Maybe
91
92import GHC.Base
93import GHC.IO
94import GHC.IO.Exception
95import GHC.IO.Handle.Types
96import Text.Show
97
98-- | The construct 'tryIOError' @comp@ exposes IO errors which occur within a
99-- computation, and which are not fully handled.
100--
101-- Non-I\/O exceptions are not caught by this variant; to catch all
102-- exceptions, use 'Control.Exception.try' from "Control.Exception".
103--
104-- @since 4.4.0.0
105tryIOError     :: IO a -> IO (Either IOError a)
106tryIOError f   =  catch (do r <- f
107                            return (Right r))
108                        (return . Left)
109
110-- -----------------------------------------------------------------------------
111-- Constructing an IOError
112
113-- | Construct an 'IOError' of the given type where the second argument
114-- describes the error location and the third and fourth argument
115-- contain the file handle and file path of the file involved in the
116-- error if applicable.
117mkIOError :: IOErrorType -> String -> Maybe Handle -> Maybe FilePath -> IOError
118mkIOError t location maybe_hdl maybe_filename =
119               IOError{ ioe_type = t,
120                        ioe_location = location,
121                        ioe_description = "",
122                        ioe_errno = Nothing,
123                        ioe_handle = maybe_hdl,
124                        ioe_filename = maybe_filename
125                        }
126
127-- -----------------------------------------------------------------------------
128-- IOErrorType
129
130-- | An error indicating that an 'IO' operation failed because
131-- one of its arguments already exists.
132isAlreadyExistsError :: IOError -> Bool
133isAlreadyExistsError = isAlreadyExistsErrorType    . ioeGetErrorType
134
135-- | An error indicating that an 'IO' operation failed because
136-- one of its arguments does not exist.
137isDoesNotExistError :: IOError -> Bool
138isDoesNotExistError  = isDoesNotExistErrorType     . ioeGetErrorType
139
140-- | An error indicating that an 'IO' operation failed because
141-- one of its arguments is a single-use resource, which is already
142-- being used (for example, opening the same file twice for writing
143-- might give this error).
144isAlreadyInUseError :: IOError -> Bool
145isAlreadyInUseError  = isAlreadyInUseErrorType     . ioeGetErrorType
146
147-- | An error indicating that an 'IO' operation failed because
148-- the device is full.
149isFullError         :: IOError -> Bool
150isFullError          = isFullErrorType             . ioeGetErrorType
151
152-- | An error indicating that an 'IO' operation failed because
153-- the end of file has been reached.
154isEOFError          :: IOError -> Bool
155isEOFError           = isEOFErrorType              . ioeGetErrorType
156
157-- | An error indicating that an 'IO' operation failed because
158-- the operation was not possible.
159-- Any computation which returns an 'IO' result may fail with
160-- 'isIllegalOperation'.  In some cases, an implementation will not be
161-- able to distinguish between the possible error causes.  In this case
162-- it should fail with 'isIllegalOperation'.
163isIllegalOperation  :: IOError -> Bool
164isIllegalOperation   = isIllegalOperationErrorType . ioeGetErrorType
165
166-- | An error indicating that an 'IO' operation failed because
167-- the user does not have sufficient operating system privilege
168-- to perform that operation.
169isPermissionError   :: IOError -> Bool
170isPermissionError    = isPermissionErrorType       . ioeGetErrorType
171
172-- | A programmer-defined error value constructed using 'userError'.
173isUserError         :: IOError -> Bool
174isUserError          = isUserErrorType             . ioeGetErrorType
175
176-- | An error indicating that the operation failed because the
177-- resource vanished. See 'resourceVanishedErrorType'.
178--
179-- @since 4.14.0.0
180isResourceVanishedError :: IOError -> Bool
181isResourceVanishedError = isResourceVanishedErrorType . ioeGetErrorType
182
183-- -----------------------------------------------------------------------------
184-- IOErrorTypes
185
186-- | I\/O error where the operation failed because one of its arguments
187-- already exists.
188alreadyExistsErrorType   :: IOErrorType
189alreadyExistsErrorType    = AlreadyExists
190
191-- | I\/O error where the operation failed because one of its arguments
192-- does not exist.
193doesNotExistErrorType    :: IOErrorType
194doesNotExistErrorType     = NoSuchThing
195
196-- | I\/O error where the operation failed because one of its arguments
197-- is a single-use resource, which is already being used.
198alreadyInUseErrorType    :: IOErrorType
199alreadyInUseErrorType     = ResourceBusy
200
201-- | I\/O error where the operation failed because the device is full.
202fullErrorType            :: IOErrorType
203fullErrorType             = ResourceExhausted
204
205-- | I\/O error where the operation failed because the end of file has
206-- been reached.
207eofErrorType             :: IOErrorType
208eofErrorType              = EOF
209
210-- | I\/O error where the operation is not possible.
211illegalOperationErrorType :: IOErrorType
212illegalOperationErrorType = IllegalOperation
213
214-- | I\/O error where the operation failed because the user does not
215-- have sufficient operating system privilege to perform that operation.
216permissionErrorType      :: IOErrorType
217permissionErrorType       = PermissionDenied
218
219-- | I\/O error that is programmer-defined.
220userErrorType            :: IOErrorType
221userErrorType             = UserError
222
223-- | I\/O error where the operation failed because the resource vanished.
224-- This happens when, for example, attempting to write to a closed
225-- socket or attempting to write to a named pipe that was deleted.
226--
227-- @since 4.14.0.0
228resourceVanishedErrorType :: IOErrorType
229resourceVanishedErrorType = ResourceVanished
230
231-- -----------------------------------------------------------------------------
232-- IOErrorType predicates
233
234-- | I\/O error where the operation failed because one of its arguments
235-- already exists.
236isAlreadyExistsErrorType :: IOErrorType -> Bool
237isAlreadyExistsErrorType AlreadyExists = True
238isAlreadyExistsErrorType _ = False
239
240-- | I\/O error where the operation failed because one of its arguments
241-- does not exist.
242isDoesNotExistErrorType :: IOErrorType -> Bool
243isDoesNotExistErrorType NoSuchThing = True
244isDoesNotExistErrorType _ = False
245
246-- | I\/O error where the operation failed because one of its arguments
247-- is a single-use resource, which is already being used.
248isAlreadyInUseErrorType :: IOErrorType -> Bool
249isAlreadyInUseErrorType ResourceBusy = True
250isAlreadyInUseErrorType _ = False
251
252-- | I\/O error where the operation failed because the device is full.
253isFullErrorType :: IOErrorType -> Bool
254isFullErrorType ResourceExhausted = True
255isFullErrorType _ = False
256
257-- | I\/O error where the operation failed because the end of file has
258-- been reached.
259isEOFErrorType :: IOErrorType -> Bool
260isEOFErrorType EOF = True
261isEOFErrorType _ = False
262
263-- | I\/O error where the operation is not possible.
264isIllegalOperationErrorType :: IOErrorType -> Bool
265isIllegalOperationErrorType IllegalOperation = True
266isIllegalOperationErrorType _ = False
267
268-- | I\/O error where the operation failed because the user does not
269-- have sufficient operating system privilege to perform that operation.
270isPermissionErrorType :: IOErrorType -> Bool
271isPermissionErrorType PermissionDenied = True
272isPermissionErrorType _ = False
273
274-- | I\/O error that is programmer-defined.
275isUserErrorType :: IOErrorType -> Bool
276isUserErrorType UserError = True
277isUserErrorType _ = False
278
279-- | I\/O error where the operation failed because the resource vanished.
280-- See 'resourceVanishedErrorType'.
281--
282-- @since 4.14.0.0
283isResourceVanishedErrorType :: IOErrorType -> Bool
284isResourceVanishedErrorType ResourceVanished = True
285isResourceVanishedErrorType _ = False
286
287-- -----------------------------------------------------------------------------
288-- Miscellaneous
289
290ioeGetErrorType       :: IOError -> IOErrorType
291ioeGetErrorString     :: IOError -> String
292ioeGetLocation        :: IOError -> String
293ioeGetHandle          :: IOError -> Maybe Handle
294ioeGetFileName        :: IOError -> Maybe FilePath
295
296ioeGetErrorType ioe = ioe_type ioe
297
298ioeGetErrorString ioe
299   | isUserErrorType (ioe_type ioe) = ioe_description ioe
300   | otherwise                      = show (ioe_type ioe)
301
302ioeGetLocation ioe = ioe_location ioe
303
304ioeGetHandle ioe = ioe_handle ioe
305
306ioeGetFileName ioe = ioe_filename ioe
307
308ioeSetErrorType   :: IOError -> IOErrorType -> IOError
309ioeSetErrorString :: IOError -> String      -> IOError
310ioeSetLocation    :: IOError -> String      -> IOError
311ioeSetHandle      :: IOError -> Handle      -> IOError
312ioeSetFileName    :: IOError -> FilePath    -> IOError
313
314ioeSetErrorType   ioe errtype  = ioe{ ioe_type = errtype }
315ioeSetErrorString ioe str      = ioe{ ioe_description = str }
316ioeSetLocation    ioe str      = ioe{ ioe_location = str }
317ioeSetHandle      ioe hdl      = ioe{ ioe_handle = Just hdl }
318ioeSetFileName    ioe filename = ioe{ ioe_filename = Just filename }
319
320-- | Catch any 'IOError' that occurs in the computation and throw a
321-- modified version.
322modifyIOError :: (IOError -> IOError) -> IO a -> IO a
323modifyIOError f io = catch io (\e -> ioError (f e))
324
325-- -----------------------------------------------------------------------------
326-- annotating an IOError
327
328-- | Adds a location description and maybe a file path and file handle
329-- to an 'IOError'.  If any of the file handle or file path is not given
330-- the corresponding value in the 'IOError' remains unaltered.
331annotateIOError :: IOError
332              -> String
333              -> Maybe Handle
334              -> Maybe FilePath
335              -> IOError
336annotateIOError ioe loc hdl path =
337  ioe{ ioe_handle = hdl `mplus` ioe_handle ioe,
338       ioe_location = loc, ioe_filename = path `mplus` ioe_filename ioe }
339
340-- | The 'catchIOError' function establishes a handler that receives any
341-- 'IOError' raised in the action protected by 'catchIOError'.
342-- An 'IOError' is caught by
343-- the most recent handler established by one of the exception handling
344-- functions.  These handlers are
345-- not selective: all 'IOError's are caught.  Exception propagation
346-- must be explicitly provided in a handler by re-raising any unwanted
347-- exceptions.  For example, in
348--
349-- > f = catchIOError g (\e -> if IO.isEOFError e then return [] else ioError e)
350--
351-- the function @f@ returns @[]@ when an end-of-file exception
352-- (cf. 'System.IO.Error.isEOFError') occurs in @g@; otherwise, the
353-- exception is propagated to the next outer handler.
354--
355-- When an exception propagates outside the main program, the Haskell
356-- system prints the associated 'IOError' value and exits the program.
357--
358-- Non-I\/O exceptions are not caught by this variant; to catch all
359-- exceptions, use 'Control.Exception.catch' from "Control.Exception".
360--
361-- @since 4.4.0.0
362catchIOError :: IO a -> (IOError -> IO a) -> IO a
363catchIOError = catch
364