ghc/lib/ghc/IOHandle.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1996
   3 %
   4
   5 \section[IOHandle]{Module @IOHandle@}
   6
   7 This module defines Haskell {\em handles} and the basic operations
   8 which are supported for them.
   9
  10 \begin{code}
  11 {-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
  12 #include "error.h"
  13
  14
  15 module IOHandle where
  16
  17 import ST
  18 import STBase
  19 import ArrBase  ( ByteArray(..), newVar, readVar, writeVar )
  20 import PrelRead ( Read )
  21 import PrelList (span)
  22 import Ix
  23 import IOBase
  24 import Unsafe   ( unsafePerformIO )
  25 import PrelTup
  26 import PrelMaybe
  27 import PrelBase
  28 import GHC
  29 import Addr
  30 import Error
  31
  32 #ifndef __PARALLEL_HASKELL__
  33 import Foreign  ( ForeignObj, makeForeignObj, writeForeignObj )
  34 #endif
  35
  36 #if defined(__CONCURRENT_HASKELL__)
  37 import ConcBase
  38 #endif
  39 \end{code}
  40
  41
  42 %*********************************************************
  43 %*                                                      *
  44 \subsection{Types @FilePath@, @Handle@, @Handle__@}
  45 %*                                                      *
  46 %*********************************************************
  47
  48 The @Handle@ and @Handle__@ types are defined in @IOBase@.
  49
  50 \begin{code}
  51 type FilePath = String
  52
  53 {-# INLINE newHandle   #-}
  54 {-# INLINE readHandle  #-}
  55 {-# INLINE writeHandle #-}
  56 newHandle   :: Handle__ -> IO Handle
  57 readHandle  :: Handle   -> IO Handle__
  58 writeHandle :: Handle -> Handle__ -> IO ()
  59
  60 #if defined(__CONCURRENT_HASKELL__)
  61
  62 -- Use MVars for concurrent Haskell
  63 newHandle hc  = newMVar hc      >>= \ h ->
  64                 return (Handle h)
  65
  66 readHandle  (Handle h)    = takeMVar h
  67 writeHandle (Handle h) hc = putMVar h hc
  68
  69 #else
  70
  71 -- Use ordinary MutableVars for non-concurrent Haskell
  72 newHandle hc  = stToIO (newVar  hc      >>= \ h ->
  73                         return (Handle h))
  74
  75 readHandle  (Handle h)    = stToIO (readVar h)
  76 writeHandle (Handle h) hc = stToIO (writeVar h hc)
  77
  78 #endif
  79 \end{code}
  80
  81 %*********************************************************
  82 %*                                                      *
  83 \subsection{Functions}
  84 %*                                                      *
  85 %*********************************************************
  86
  87 \begin{code}
  88 #ifndef __PARALLEL_HASKELL__
  89 filePtr :: Handle__ -> ForeignObj
  90 #else
  91 filePtr :: Handle__ -> Addr
  92 #endif
  93 filePtr (SemiClosedHandle fp _)  = fp
  94 filePtr (ReadHandle fp _ _)      = fp
  95 filePtr (WriteHandle fp _ _)     = fp
  96 filePtr (AppendHandle fp _ _)    = fp
  97 filePtr (ReadWriteHandle fp _ _) = fp
  98
  99 bufferMode :: Handle__ -> Maybe BufferMode
 100 bufferMode (ReadHandle _ m _)      = m
 101 bufferMode (WriteHandle _ m _)     = m
 102 bufferMode (AppendHandle _ m _)    = m
 103 bufferMode (ReadWriteHandle _ m _) = m
 104
 105 markHandle :: Handle__ -> Handle__
 106 markHandle h@(ReadHandle fp m b)
 107   | b = h
 108   | otherwise = ReadHandle fp m True
 109 markHandle h@(WriteHandle fp m b)
 110   | b = h
 111   | otherwise = WriteHandle fp m True
 112 markHandle h@(AppendHandle fp m b)
 113   | b = h
 114   | otherwise = AppendHandle fp m True
 115 markHandle h@(ReadWriteHandle fp m b)
 116   | b = h
 117   | otherwise = ReadWriteHandle fp m True
 118 \end{code}
 119
 120 -------------------------------------------
 121
 122 %*********************************************************
 123 %*                                                      *
 124 \subsection[StdHandles]{Standard handles}
 125 %*                                                      *
 126 %*********************************************************
 127
 128 Three handles are allocated during program initialisation.  The first
 129 two manage input or output from the Haskell program's standard input
 130 or output channel respectively.  The third manages output to the
 131 standard error channel. These handles are initially open.
 132
 133 \begin{code}
 134 stdin, stdout, stderr :: Handle
 135
 136 stdin = unsafePerformIO (do
 137     rc <- _ccall_ getLock (``stdin''::Addr) 0
 138     case rc of
 139        0 -> newHandle ClosedHandle
 140        1 -> do
 141 #ifndef __PARALLEL_HASKELL__
 142             fp <- makeForeignObj (``stdin''::Addr) (``&freeStdFile''::Addr)
 143             newHandle (ReadHandle fp Nothing False)
 144 #else
 145             newHandle (ReadHandle ``stdin'' Nothing False)
 146 #endif
 147        _ -> do ioError <- constructError "stdin"
 148                newHandle (ErrorHandle ioError)
 149   )
 150
 151 stdout = unsafePerformIO (do
 152     rc <- _ccall_ getLock (``stdout''::Addr) 1
 153     case rc of
 154        0 -> newHandle ClosedHandle
 155        1 -> do
 156 #ifndef __PARALLEL_HASKELL__
 157             fp <- makeForeignObj (``stdout''::Addr) (``&freeStdFile''::Addr)
 158             newHandle (WriteHandle fp Nothing False)
 159 #else
 160             newHandle (WriteHandle ``stdout'' Nothing False)
 161 #endif
 162        _ -> do ioError <- constructError "stdout"
 163                newHandle (ErrorHandle ioError)
 164   )
 165
 166 stderr = unsafePerformIO (do
 167     rc <- _ccall_ getLock (``stderr''::Addr) 1
 168     case rc of
 169        0 -> newHandle ClosedHandle
 170        1 -> do
 171 #ifndef __PARALLEL_HASKELL__
 172             fp <- makeForeignObj (``stderr''::Addr) (``&freeStdFile''::Addr)
 173             newHandle (WriteHandle fp (Just NoBuffering) False)
 174 #else
 175             newHandle (WriteHandle ``stderr'' (Just NoBuffering) False)
 176 #endif
 177        _ -> do ioError <- constructError "stderr"
 178                newHandle (ErrorHandle ioError)
 179   )
 180 \end{code}
 181
 182 %*********************************************************
 183 %*                                                      *
 184 \subsection[OpeningClosing]{Opening and Closing Files}
 185 %*                                                      *
 186 %*********************************************************
 187
 188 \begin{code}
 189 data IOMode      =  ReadMode | WriteMode | AppendMode | ReadWriteMode
 190                     deriving (Eq, Ord, Ix, Enum, Read, Show)
 191
 192 openFile :: FilePath -> IOMode -> IO Handle
 193
 194 openFile f m = do
 195     ptr <- _ccall_ openFile f m'
 196     if ptr /= ``NULL'' then do
 197 #ifndef __PARALLEL_HASKELL__
 198         fp <- makeForeignObj ptr ((``&freeFile'')::Addr)
 199         newHandle (htype fp Nothing False)
 200 #else
 201         newHandle (htype ptr Nothing False)
 202 #endif
 203       else do
 204         ioError@(IOError hn iot msg) <- constructError "openFile"
 205         let
 206             improved_error -- a HACK, I guess
 207               = case iot of
 208                   AlreadyExists    -> IOError hn AlreadyExists    (msg ++ ": " ++ f)
 209                   NoSuchThing      -> IOError hn NoSuchThing      (msg ++ ": " ++ f)
 210                   PermissionDenied -> IOError hn PermissionDenied (msg ++ ": " ++ f)
 211                   _                -> ioError
 212         fail improved_error
 213   where
 214     m' = case m of
 215            ReadMode      -> "r"
 216            WriteMode     -> "w"
 217            AppendMode    -> "a"
 218            ReadWriteMode -> "r+"
 219
 220     htype = case m of
 221               ReadMode      -> ReadHandle
 222               WriteMode     -> WriteHandle
 223               AppendMode    -> AppendHandle
 224               ReadWriteMode -> ReadWriteHandle
 225 \end{code}
 226
 227 Computation $openFile file mode$ allocates and returns a new, open
 228 handle to manage the file {\em file}.  It manages input if {\em mode}
 229 is $ReadMode$, output if {\em mode} is $WriteMode$ or $AppendMode$,
 230 and both input and output if mode is $ReadWriteMode$.
 231
 232 If the file does not exist and it is opened for output, it should be
 233 created as a new file.  If {\em mode} is $WriteMode$ and the file
 234 already exists, then it should be truncated to zero length.  The
 235 handle is positioned at the end of the file if {\em mode} is
 236 $AppendMode$, and otherwise at the beginning (in which case its
 237 internal position is 0).
 238
 239 Implementations should enforce, locally to the Haskell process,
 240 multiple-reader single-writer locking on files, which is to say that
 241 there may either be many handles on the same file which manage input,
 242 or just one handle on the file which manages output.  If any open or
 243 semi-closed handle is managing a file for output, no new handle can be
 244 allocated for that file.  If any open or semi-closed handle is
 245 managing a file for input, new handles can only be allocated if they
 246 do not manage output.
 247
 248 Two files are the same if they have the same absolute name.  An
 249 implementation is free to impose stricter conditions.
 250
 251 \begin{code}
 252 hClose :: Handle -> IO ()
 253
 254 hClose handle = do
 255     htype <- readHandle handle
 256     case htype of
 257       ErrorHandle ioError -> do
 258           writeHandle handle htype
 259           fail ioError
 260       ClosedHandle -> do
 261           writeHandle handle htype
 262           ioe_closedHandle handle
 263       SemiClosedHandle fp (buf,_) -> do
 264           (if buf /= ``NULL'' then
 265                 _ccall_ free buf
 266            else
 267                 return ())
 268           fp_a <- _casm_ `` %r = (char *)%0; '' fp
 269           if fp_a /= (``NULL''::Addr) then do
 270                 -- Under what condition can this be NULL?
 271                 rc <- _ccall_ closeFile fp
 272                   {- We explicitly close a file object so that we can be told
 273                      if there were any errors. Note that after @hClose@
 274                      has been performed, the ForeignObj embedded in the Handle
 275                      is still lying around in the heap, so care is taken
 276                      to avoid closing the file object when the ForeignObj
 277                      is finalised.  -}
 278                 if rc == 0 then do
 279 #ifndef __PARALLEL_HASKELL__
 280                   -- Mark the foreign object data value as
 281                   -- gone to the finaliser (freeFile())
 282                   writeForeignObj fp ``NULL''
 283 #endif
 284                   writeHandle handle ClosedHandle
 285                  else do
 286                   writeHandle handle htype
 287                   constructErrorAndFail "hClose"
 288
 289             else  writeHandle handle htype
 290
 291       other -> do
 292           let fp = filePtr other
 293           rc <- _ccall_ closeFile fp
 294           if rc == 0 then do
 295 #ifndef __PARALLEL_HASKELL__
 296                 -- Mark the foreign object data
 297                 writeForeignObj fp ``NULL''
 298 #endif
 299                 writeHandle handle ClosedHandle
 300             else do
 301                 writeHandle handle htype
 302                 constructErrorAndFail "hClose"
 303 \end{code}
 304
 305 Computation $hClose hdl$ makes handle {\em hdl} closed.  Before the
 306 computation finishes, any items buffered for output and not already
 307 sent to the operating system are flushed as for $flush$.
 308
 309 %*********************************************************
 310 %*                                                      *
 311 \subsection[EOF]{Detecting the End of Input}
 312 %*                                                      *
 313 %*********************************************************
 314
 315
 316 For a handle {\em hdl} which attached to a physical file, $hFileSize
 317 hdl$ returns the size of {\em hdl} in terms of the number of items
 318 which can be read from {\em hdl}.
 319
 320 \begin{code}
 321 hFileSize :: Handle -> IO Integer
 322 hFileSize handle = do
 323     htype <- readHandle handle
 324     case htype of
 325       ErrorHandle ioError -> do
 326           writeHandle handle htype
 327           fail ioError
 328       ClosedHandle -> do
 329           writeHandle handle htype
 330           ioe_closedHandle handle
 331       SemiClosedHandle _ _ -> do
 332           writeHandle handle htype
 333           ioe_closedHandle handle
 334       other ->
 335           -- HACK!  We build a unique MP_INT of the right shape to hold
 336           -- a single unsigned word, and we let the C routine
 337           -- change the data bits
 338           --
 339           -- For some reason, this fails to typecheck if converted to a do
 340           -- expression --SDM
 341           _casm_ ``%r = 1;'' >>= \(I# hack#) ->
 342           case int2Integer# hack# of
 343             result@(J# _ _ d#) -> do
 344                 let bogus_bounds = (error "fileSize"::(Int,Int))
 345                 rc <- _ccall_ fileSize (filePtr other)
 346                                 (ByteArray bogus_bounds d#)
 347                 writeHandle handle htype
 348                 if rc == 0 then
 349                    return result
 350                  else
 351                    constructErrorAndFail "hFileSize"
 352 \end{code}
 353
 354 For a readable handle {\em hdl}, computation $hIsEOF hdl$ returns
 355 $True$ if no further input can be taken from {\em hdl} or for a
 356 physical file, if the current I/O position is equal to the length of
 357 the file.  Otherwise, it returns $False$.
 358
 359 \begin{code}
 360 hIsEOF :: Handle -> IO Bool
 361 hIsEOF handle = do
 362     htype <- readHandle handle
 363     case htype of
 364       ErrorHandle ioError -> do
 365           writeHandle handle htype
 366           fail ioError
 367       ClosedHandle -> do
 368           writeHandle handle htype
 369           ioe_closedHandle handle
 370       SemiClosedHandle _ _ -> do
 371           writeHandle handle htype
 372           ioe_closedHandle handle
 373       WriteHandle _ _ _ -> do
 374           writeHandle handle htype
 375           fail (IOError (Just handle) IllegalOperation
 376                 "handle is not open for reading")
 377       AppendHandle _ _ _ -> do
 378           writeHandle handle htype
 379           fail (IOError (Just handle) IllegalOperation
 380                 "handle is not open for reading")
 381       other -> do
 382           rc <- _ccall_ fileEOF (filePtr other)
 383           writeHandle handle (markHandle htype)
 384           case rc of
 385             0 -> return False
 386             1 -> return True
 387             _ -> constructErrorAndFail "hIsEOF"
 388
 389 isEOF :: IO Bool
 390 isEOF = hIsEOF stdin
 391 \end{code}
 392
 393 %*********************************************************
 394 %*                                                      *
 395 \subsection[Buffering]{Buffering Operations}
 396 %*                                                      *
 397 %*********************************************************
 398
 399 Three kinds of buffering are supported: line-buffering,
 400 block-buffering or no-buffering.  See @IOBase@ for definition
 401 and further explanation of what the type represent.
 402
 403 Computation @hSetBuffering hdl mode@ sets the mode of buffering for
 404 handle {\em hdl} on subsequent reads and writes.
 405
 406 \begin{itemize}
 407 \item
 408 If {\em mode} is @LineBuffering@, line-buffering should be
 409 enabled if possible.
 410 \item
 411 If {\em mode} is @BlockBuffering@ {\em size}, then block-buffering
 412 should be enabled if possible.  The size of the buffer is {\em n} items
 413 if {\em size} is @Just@~{\em n} and is otherwise implementation-dependent.
 414 \item
 415 If {\em mode} is @NoBuffering@, then buffering is disabled if possible.
 416 \end{itemize}
 417
 418 If the buffer mode is changed from @BlockBuffering@ or @LineBuffering@
 419 to @NoBuffering@, then any items in the output buffer are written to
 420 the device, and any items in the input buffer are discarded.  The
 421 default buffering mode when a handle is opened is
 422 implementation-dependent and may depend on the object which is
 423 attached to that handle.
 424
 425 \begin{code}
 426 hSetBuffering :: Handle -> BufferMode -> IO ()
 427
 428 hSetBuffering handle mode =
 429     case mode of
 430       BlockBuffering (Just n)
 431         | n <= 0 -> fail (IOError (Just handle) InvalidArgument
 432                                 "illegal buffer size")
 433       other -> do
 434           htype <- readHandle handle
 435           if isMarked htype then do
 436               writeHandle handle htype
 437               fail (IOError (Just handle)
 438                             UnsupportedOperation
 439                             "can't set buffering for a dirty handle")
 440            else
 441               case htype of
 442                 ErrorHandle ioError -> do
 443                     writeHandle handle htype
 444                     fail ioError
 445                 ClosedHandle -> do
 446                     writeHandle handle htype
 447                     ioe_closedHandle handle
 448                 SemiClosedHandle _ _ -> do
 449                     writeHandle handle htype
 450                     ioe_closedHandle handle
 451                 other -> do
 452                     rc <- _ccall_ setBuffering (filePtr other) bsize
 453                     if rc == 0 then
 454                         writeHandle handle ((hcon other) (filePtr other)
 455                                                 (Just mode) True)
 456                      else do
 457                         writeHandle handle htype
 458                         constructErrorAndFail "hSetBuffering"
 459
 460   where
 461     isMarked :: Handle__ -> Bool
 462     isMarked (ReadHandle fp m b) = b
 463     isMarked (WriteHandle fp m b) = b
 464     isMarked (AppendHandle fp m b) = b
 465     isMarked (ReadWriteHandle fp m b) = b
 466
 467     bsize :: Int
 468     bsize = case mode of
 469               NoBuffering -> 0
 470               LineBuffering -> -1
 471               BlockBuffering Nothing -> -2
 472               BlockBuffering (Just n) -> n
 473
 474 #ifndef __PARALLEL_HASKELL__
 475     hcon :: Handle__ -> (ForeignObj -> (Maybe BufferMode) -> Bool -> Handle__)
 476 #else
 477     hcon :: Handle__ -> (Addr -> (Maybe BufferMode) -> Bool -> Handle__)
 478 #endif
 479     hcon (ReadHandle _ _ _) = ReadHandle
 480     hcon (WriteHandle _ _ _) = WriteHandle
 481     hcon (AppendHandle _ _ _) = AppendHandle
 482     hcon (ReadWriteHandle _ _ _) = ReadWriteHandle
 483 \end{code}
 484
 485 Computation $flush hdl$ causes any items buffered for output in handle
 486 {\em hdl} to be sent immediately to the operating system.
 487
 488 \begin{code}
 489 hFlush :: Handle -> IO ()
 490 hFlush handle = do
 491     htype <- readHandle handle
 492     case htype of
 493       ErrorHandle ioError -> do
 494           writeHandle handle htype
 495           fail ioError
 496       ClosedHandle -> do
 497           writeHandle handle htype
 498           ioe_closedHandle handle
 499       SemiClosedHandle _ _ -> do
 500           writeHandle handle htype
 501           ioe_closedHandle handle
 502       other -> do
 503           rc <- _ccall_ flushFile (filePtr other)
 504           writeHandle handle (markHandle htype)
 505           if rc == 0 then
 506                 return ()
 507            else
 508                 constructErrorAndFail "hFlush"
 509 \end{code}
 510
 511
 512 %*********************************************************
 513 %*                                                      *
 514 \subsection[Seeking]{Repositioning Handles}
 515 %*                                                      *
 516 %*********************************************************
 517
 518 \begin{code}
 519 data HandlePosn = HandlePosn Handle Int
 520
 521 data SeekMode    =  AbsoluteSeek | RelativeSeek | SeekFromEnd
 522                     deriving (Eq, Ord, Ix, Enum, Read, Show)
 523 \end{code}
 524
 525 Computation $hGetPosn hdl$ returns the current I/O
 526 position of {\em hdl} as an abstract position.  Computation
 527 $hSetPosn p$ sets the position of {\em hdl}
 528 to a previously obtained position {\em p}.
 529
 530 \begin{code}
 531 hGetPosn :: Handle -> IO HandlePosn
 532 hGetPosn handle = do
 533     htype <- readHandle handle
 534     case htype of
 535       ErrorHandle ioError -> do
 536           writeHandle handle htype
 537           fail ioError
 538       ClosedHandle -> do
 539           writeHandle handle htype
 540           ioe_closedHandle handle
 541       SemiClosedHandle _ _ -> do
 542           writeHandle handle htype
 543           ioe_closedHandle handle
 544       other -> do
 545           posn <- _ccall_ getFilePosn (filePtr other)
 546           writeHandle handle htype
 547           if posn /= -1 then
 548               return (HandlePosn handle posn)
 549            else
 550               constructErrorAndFail "hGetPosn"
 551
 552 hSetPosn :: HandlePosn -> IO ()
 553 hSetPosn (HandlePosn handle posn) = do
 554     htype <- readHandle handle
 555     case htype of
 556       ErrorHandle ioError -> do
 557           writeHandle handle htype
 558           fail ioError
 559       ClosedHandle -> do
 560           writeHandle handle htype
 561           ioe_closedHandle handle
 562       SemiClosedHandle _ _ -> do
 563           writeHandle handle htype
 564           ioe_closedHandle handle
 565       AppendHandle _ _ _ -> do
 566           writeHandle handle htype
 567           fail (IOError (Just handle) IllegalOperation "handle is not seekable")
 568       other -> do
 569           rc <- _ccall_ setFilePosn (filePtr other) posn
 570           writeHandle handle (markHandle htype)
 571           if rc == 0 then
 572                 return ()
 573            else
 574                 constructErrorAndFail "hSetPosn"
 575 \end{code}
 576
 577 Computation $hSeek hdl mode i$ sets the position of handle
 578 {\em hdl} depending on $mode$.  If {\em mode} is
 579 \begin{itemize}
 580 \item[{\bf AbsoluteSeek}] The position of {\em hdl} is set to {\em i}.
 581 \item[{\bf RelativeSeek}] The position of {\em hdl} is set to offset {\em i} from
 582 the current position.
 583 \item[{\bf SeekToEnd}] The position of {\em hdl} is set to offset {\em i} from
 584 the end of the file.
 585 \item[{\bf SeekFromBeginning}] The position of {\em hdl} is set to offset {\em i} from
 586 the beginning of the file.
 587 \end{itemize}
 588
 589 Some handles may not be seekable $hIsSeekable$, or only support a
 590 subset of the possible positioning operations (e.g. it may only be
 591 possible to seek to the end of a tape, or to a positive offset from
 592 the beginning or current position).
 593
 594 It is not possible to set a negative I/O position, or for a physical
 595 file, an I/O position beyond the current end-of-file.
 596
 597 \begin{code}
 598 hSeek :: Handle -> SeekMode -> Integer -> IO ()
 599 hSeek handle mode offset@(J# _ s# d#) =  do
 600     htype <- readHandle handle
 601     case htype of
 602       ErrorHandle ioError -> do
 603           writeHandle handle htype
 604           fail ioError
 605       ClosedHandle -> do
 606           writeHandle handle htype
 607           ioe_closedHandle handle
 608       SemiClosedHandle _ _ -> do
 609           writeHandle handle htype
 610           ioe_closedHandle handle
 611       AppendHandle _ _ _ -> do
 612           writeHandle handle htype
 613           fail (IOError (Just handle) IllegalOperation "handle is not seekable")
 614       other -> do
 615           rc <- _ccall_ seekFile (filePtr other) whence (I# s#)
 616                         (ByteArray (0,0) d#)
 617           writeHandle handle (markHandle htype)
 618           if rc == 0 then
 619                 return ()
 620            else
 621                 constructErrorAndFail "hSeek"
 622   where
 623     whence :: Int
 624     whence = case mode of
 625                AbsoluteSeek -> ``SEEK_SET''
 626                RelativeSeek -> ``SEEK_CUR''
 627                SeekFromEnd  -> ``SEEK_END''
 628 \end{code}
 629
 630 %*********************************************************
 631 %*                                                      *
 632 \subsection[Query]{Handle Properties}
 633 %*                                                      *
 634 %*********************************************************
 635
 636 A number of operations return information about the properties of a
 637 handle.  Each of these operations returns $True$ if the
 638 handle has the specified property, and $False$
 639 otherwise.
 640
 641 Computation $hIsBlockBuffered hdl$ returns $( False, Nothing )$ if
 642 {\em hdl} is not block-buffered.  Otherwise it returns
 643 $( True, size )$, where {\em size} is $Nothing$ for default buffering, and
 644 $( Just n )$ for block-buffering of {\em n} bytes.
 645
 646 \begin{code}
 647 hIsOpen :: Handle -> IO Bool
 648 hIsOpen handle = do
 649     htype <- readHandle handle
 650     case htype of
 651       ErrorHandle ioError -> do
 652           writeHandle handle htype
 653           fail ioError
 654       ClosedHandle -> do
 655           writeHandle handle htype
 656           return False
 657       SemiClosedHandle _ _ -> do
 658           writeHandle handle htype
 659           return False
 660       other -> do
 661           writeHandle handle htype
 662           return True
 663
 664 hIsClosed :: Handle -> IO Bool
 665 hIsClosed handle = do
 666     htype <- readHandle handle
 667     case htype of
 668       ErrorHandle ioError -> do
 669           writeHandle handle htype
 670           fail ioError
 671       ClosedHandle -> do
 672           writeHandle handle htype
 673           return True
 674       other -> do
 675           writeHandle handle htype
 676           return False
 677
 678 hIsReadable :: Handle -> IO Bool
 679 hIsReadable handle = do
 680     htype <- readHandle handle
 681     case htype of
 682       ErrorHandle ioError -> do
 683           writeHandle handle htype
 684           fail ioError
 685       ClosedHandle -> do
 686           writeHandle handle htype
 687           ioe_closedHandle handle
 688       SemiClosedHandle _ _ -> do
 689           writeHandle handle htype
 690           ioe_closedHandle handle
 691       other -> do
 692           writeHandle handle htype
 693           return (isReadable other)
 694   where
 695     isReadable (ReadHandle _ _ _) = True
 696     isReadable (ReadWriteHandle _ _ _) = True
 697     isReadable _ = False
 698
 699 hIsWritable :: Handle -> IO Bool
 700 hIsWritable handle = do
 701     htype <- readHandle handle
 702     case htype of
 703       ErrorHandle ioError -> do
 704           writeHandle handle htype
 705           fail ioError
 706       ClosedHandle -> do
 707           writeHandle handle htype
 708           ioe_closedHandle handle
 709       SemiClosedHandle _ _ -> do
 710           writeHandle handle htype
 711           ioe_closedHandle handle
 712       other -> do
 713           writeHandle handle htype
 714           return (isWritable other)
 715   where
 716     isWritable (AppendHandle _ _ _) = True
 717     isWritable (WriteHandle _ _ _) = True
 718     isWritable (ReadWriteHandle _ _ _) = True
 719     isWritable _ = False
 720
 721 getBufferMode :: Handle__ -> IO Handle__
 722 getBufferMode htype =
 723     case bufferMode htype of
 724       Just x -> return htype
 725       Nothing -> do
 726         rc <- _ccall_ getBufferMode (filePtr htype)
 727         let
 728             mode =
 729                 case rc of
 730                   0  -> Just NoBuffering
 731                   -1 -> Just LineBuffering
 732                   -2 -> Just (BlockBuffering Nothing)
 733                   -3 -> Nothing
 734                   n  -> Just (BlockBuffering (Just n))
 735         return (case htype of
 736           ReadHandle      fp _ b -> ReadHandle      fp mode b
 737           WriteHandle     fp _ b -> WriteHandle     fp mode b
 738           AppendHandle    fp _ b -> AppendHandle    fp mode b
 739           ReadWriteHandle fp _ b -> ReadWriteHandle fp mode b)
 740
 741 hIsBlockBuffered :: Handle -> IO (Bool,Maybe Int)
 742 hIsBlockBuffered handle = do
 743     htype <- readHandle handle
 744     case htype of
 745       ErrorHandle ioError -> do
 746           writeHandle handle htype
 747           fail ioError
 748       ClosedHandle -> do
 749           writeHandle handle htype
 750           ioe_closedHandle handle
 751       SemiClosedHandle _ _ -> do
 752           writeHandle handle htype
 753           ioe_closedHandle handle
 754       other -> do
 755           other <- getBufferMode other
 756           case bufferMode other of
 757             Just (BlockBuffering size) -> do
 758                 writeHandle handle other
 759                 return (True, size)
 760             Just _ -> do
 761                 writeHandle handle other
 762                 return (False, Nothing)
 763             Nothing ->
 764                 constructErrorAndFail "hIsBlockBuffered"
 765
 766 hIsLineBuffered :: Handle -> IO Bool
 767 hIsLineBuffered handle = do
 768     htype <- readHandle handle
 769     case htype of
 770       ErrorHandle ioError -> do
 771           writeHandle handle htype
 772           fail ioError
 773       ClosedHandle -> do
 774           writeHandle handle htype
 775           ioe_closedHandle handle
 776       SemiClosedHandle _ _ -> do
 777           writeHandle handle htype
 778           ioe_closedHandle handle
 779       other -> do
 780           other <- getBufferMode other
 781           case bufferMode other of
 782             Just LineBuffering -> do
 783                 writeHandle handle other
 784                 return True
 785             Just _ -> do
 786                 writeHandle handle other
 787                 return False
 788             Nothing ->
 789                 constructErrorAndFail "hIsLineBuffered"
 790
 791 hIsNotBuffered :: Handle -> IO Bool
 792 hIsNotBuffered handle = do
 793     htype <- readHandle handle
 794     case htype of
 795       ErrorHandle ioError -> do
 796           writeHandle handle htype
 797           fail ioError
 798       ClosedHandle -> do
 799           writeHandle handle htype
 800           ioe_closedHandle handle
 801       SemiClosedHandle _ _ -> do
 802           writeHandle handle htype
 803           ioe_closedHandle handle
 804       other -> do
 805           other <- getBufferMode other
 806           case bufferMode other of
 807             Just NoBuffering -> do
 808                 writeHandle handle other
 809                 return True
 810             Just _ -> do
 811                 writeHandle handle other
 812                 return False
 813             Nothing ->
 814                 constructErrorAndFail "hIsNotBuffered"
 815
 816 hGetBuffering :: Handle -> IO BufferMode
 817 hGetBuffering handle = do
 818     htype <- readHandle handle
 819     case htype of
 820       ErrorHandle ioError -> do
 821           writeHandle handle htype
 822           fail ioError
 823       ClosedHandle -> do
 824           writeHandle handle htype
 825           ioe_closedHandle handle
 826       SemiClosedHandle _ _ -> do
 827           writeHandle handle htype
 828           ioe_closedHandle handle
 829       other -> do
 830           other <- getBufferMode other
 831           case bufferMode other of
 832             Just v -> do
 833                 writeHandle handle other
 834                 return v
 835             Nothing ->
 836                 constructErrorAndFail "hGetBuffering"
 837
 838 hIsSeekable :: Handle -> IO Bool
 839 hIsSeekable handle = do
 840     htype <- readHandle handle
 841     case htype of
 842       ErrorHandle ioError -> do
 843           writeHandle handle htype
 844           fail ioError
 845       ClosedHandle -> do
 846           writeHandle handle htype
 847           ioe_closedHandle handle
 848       SemiClosedHandle _ _ -> do
 849           writeHandle handle htype
 850           ioe_closedHandle handle
 851       AppendHandle _ _ _ -> do
 852           writeHandle handle htype
 853           return False
 854       other -> do
 855           rc <- _ccall_ seekFileP (filePtr other)
 856           writeHandle handle htype
 857           case rc of
 858             0 -> return False
 859             1 -> return True
 860             _ -> constructErrorAndFail "hIsSeekable"
 861 \end{code}
 862
 863
 864 %*********************************************************
 865 %*                                                      *
 866 \subsection{Miscellaneous}
 867 %*                                                      *
 868 %*********************************************************
 869
 870 These two functions are meant to get things out of @IOErrors@.  They don't!
 871
 872 \begin{code}
 873 ioeGetFileName        :: IOError -> Maybe FilePath
 874 ioeGetErrorString     :: IOError -> String
 875 ioeGetHandle          :: IOError -> Maybe Handle
 876
 877 ioeGetHandle   (IOError h _ _)   = h
 878 ioeGetErrorString (IOError _ iot str) =
 879  case iot of
 880    EOF -> "end of file"
 881    _   -> str
 882
 883 ioeGetFileName (IOError _ _ str) =
 884  case span (/=':') str of
 885    (fs,[]) -> Nothing
 886    (fs,_)  -> Just fs
 887
 888 \end{code}
 889
 890 Internal function for creating an @IOError@ representing the
 891 access of a closed file.
 892
 893 \begin{code}
 894
 895 ioe_closedHandle :: Handle -> IO a
 896 ioe_closedHandle h = fail (IOError (Just h) IllegalOperation "handle is closed")
 897 \end{code}