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