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