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