ghc/lib/std/PrelHandle.lhs

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