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 instance Eq HandlePosn{-partain-}
 514
 515 data SeekMode    =  AbsoluteSeek | RelativeSeek | SeekFromEnd
 516                     deriving (Eq, Ord, Ix, Enum, Read, Show)
 517 \end{code}
 518
 519 Computation $hGetPosn hdl$ returns the current I/O
 520 position of {\em hdl} as an abstract position.  Computation
 521 $hSetPosn p$ sets the position of {\em hdl}
 522 to a previously obtained position {\em p}.
 523
 524 \begin{code}
 525 hGetPosn :: Handle -> IO HandlePosn
 526 hGetPosn handle =
 527     readHandle handle                               >>= \ htype ->
 528     case htype of
 529       ErrorHandle ioError ->
 530           writeHandle handle htype                  >>
 531           fail ioError
 532       ClosedHandle ->
 533           writeHandle handle htype                  >>
 534           ioe_closedHandle handle
 535       SemiClosedHandle _ _ ->
 536           writeHandle handle htype                  >>
 537           ioe_closedHandle handle
 538       other ->
 539           _ccall_ getFilePosn (filePtr other)      `thenIO_Prim` \ posn ->
 540           writeHandle handle htype                  >>
 541           if posn /= -1 then
 542               return (HandlePosn handle posn)
 543           else
 544               constructErrorAndFail "hGetPosn"
 545
 546 hSetPosn :: HandlePosn -> IO ()
 547 hSetPosn (HandlePosn handle posn) =
 548     readHandle handle                               >>= \ htype ->
 549     case htype of
 550       ErrorHandle ioError ->
 551           writeHandle handle htype                  >>
 552           fail ioError
 553       ClosedHandle ->
 554           writeHandle handle htype                  >>
 555           ioe_closedHandle handle
 556       SemiClosedHandle _ _ ->
 557           writeHandle handle htype                  >>
 558           ioe_closedHandle handle
 559       AppendHandle _ _ _ ->
 560           writeHandle handle htype                  >>
 561           fail (IOError (Just handle) IllegalOperation "handle is not seekable")
 562       other ->
 563           _ccall_ setFilePosn (filePtr other) posn `thenIO_Prim` \ rc ->
 564           writeHandle handle (markHandle htype)    >>
 565                if rc == 0 then
 566                    return ()
 567                else
 568                    constructErrorAndFail "hSetPosn"
 569 \end{code}
 570
 571 Computation $hSeek hdl mode i$ sets the position of handle
 572 {\em hdl} depending on $mode$.  If {\em mode} is
 573 \begin{itemize}
 574 \item[{\bf AbsoluteSeek}] The position of {\em hdl} is set to {\em i}.
 575 \item[{\bf RelativeSeek}] The position of {\em hdl} is set to offset {\em i} from
 576 the current position.
 577 \item[{\bf SeekToEnd}] The position of {\em hdl} is set to offset {\em i} from
 578 the end of the file.
 579 \item[{\bf SeekFromBeginning}] The position of {\em hdl} is set to offset {\em i} from
 580 the beginning of the file.
 581 \end{itemize}
 582
 583 Some handles may not be seekable $hIsSeekable$, or only support a
 584 subset of the possible positioning operations (e.g. it may only be
 585 possible to seek to the end of a tape, or to a positive offset from
 586 the beginning or current position).
 587
 588 It is not possible to set a negative I/O position, or for a physical
 589 file, an I/O position beyond the current end-of-file.
 590
 591 \begin{code}
 592 hSeek :: Handle -> SeekMode -> Integer -> IO ()
 593 hSeek handle mode offset@(J# _ s# d#) =
 594     readHandle handle                               >>= \ htype ->
 595     case htype of
 596       ErrorHandle ioError ->
 597           writeHandle handle htype                  >>
 598           fail ioError
 599       ClosedHandle ->
 600           writeHandle handle htype                  >>
 601           ioe_closedHandle handle
 602       SemiClosedHandle _ _ ->
 603           writeHandle handle htype                  >>
 604           ioe_closedHandle handle
 605       AppendHandle _ _ _ ->
 606           writeHandle handle htype                  >>
 607           fail (IOError (Just handle) IllegalOperation "handle is not seekable")
 608       other ->
 609           _ccall_ seekFile (filePtr other) whence (I# s#) (ByteArray (0,0) d#)
 610                                                     `thenIO_Prim` \ rc ->
 611           writeHandle handle (markHandle htype)   >>
 612                if rc == 0 then
 613                    return ()
 614                else
 615                     constructErrorAndFail "hSeek"
 616   where
 617     whence :: Int
 618     whence = case mode of
 619                AbsoluteSeek -> ``SEEK_SET''
 620                RelativeSeek -> ``SEEK_CUR''
 621                SeekFromEnd -> ``SEEK_END''
 622 \end{code}
 623
 624 %*********************************************************
 625 %*                                                      *
 626 \subsection[Query]{Handle Properties}
 627 %*                                                      *
 628 %*********************************************************
 629
 630 A number of operations return information about the properties of a
 631 handle.  Each of these operations returns $True$ if the
 632 handle has the specified property, and $False$
 633 otherwise.
 634
 635 Computation $hIsBlockBuffered hdl$ returns $( False, Nothing )$ if
 636 {\em hdl} is not block-buffered.  Otherwise it returns
 637 $( True, size )$, where {\em size} is $Nothing$ for default buffering, and
 638 $( Just n )$ for block-buffering of {\em n} bytes.
 639
 640 \begin{code}
 641 hIsOpen :: Handle -> IO Bool
 642 hIsOpen handle =
 643     readHandle handle                               >>= \ htype ->
 644     case htype of
 645       ErrorHandle ioError ->
 646           writeHandle handle htype                  >>
 647           fail ioError
 648       ClosedHandle ->
 649           writeHandle handle htype                  >>
 650           return False
 651       SemiClosedHandle _ _ ->
 652           writeHandle handle htype                  >>
 653           return False
 654       other ->
 655           writeHandle handle htype                  >>
 656           return True
 657
 658 hIsClosed :: Handle -> IO Bool
 659 hIsClosed handle =
 660     readHandle handle                               >>= \ htype ->
 661     case htype of
 662       ErrorHandle ioError ->
 663           writeHandle handle htype                  >>
 664           fail ioError
 665       ClosedHandle ->
 666           writeHandle handle htype                  >>
 667           return True
 668       other ->
 669           writeHandle handle htype                  >>
 670           return False
 671
 672 hIsReadable :: Handle -> IO Bool
 673 hIsReadable handle =
 674     readHandle handle                               >>= \ htype ->
 675     case htype of
 676       ErrorHandle ioError ->
 677           writeHandle handle htype                  >>
 678           fail ioError
 679       ClosedHandle ->
 680           writeHandle handle htype                  >>
 681           ioe_closedHandle handle
 682       SemiClosedHandle _ _ ->
 683           writeHandle handle htype                  >>
 684           ioe_closedHandle handle
 685       other ->
 686           writeHandle handle htype                  >>
 687           return (isReadable other)
 688   where
 689     isReadable (ReadHandle _ _ _) = True
 690     isReadable (ReadWriteHandle _ _ _) = True
 691     isReadable _ = False
 692
 693 hIsWritable :: Handle -> IO Bool
 694 hIsWritable handle =
 695     readHandle handle                       >>= \ htype ->
 696     case htype of
 697       ErrorHandle ioError ->
 698           writeHandle handle htype          >>
 699           fail ioError
 700       ClosedHandle ->
 701           writeHandle handle htype          >>
 702           ioe_closedHandle handle
 703       SemiClosedHandle _ _ ->
 704           writeHandle handle htype          >>
 705           ioe_closedHandle handle
 706       other ->
 707           writeHandle handle htype          >>
 708           return (isWritable other)
 709   where
 710     isWritable (AppendHandle _ _ _) = True
 711     isWritable (WriteHandle _ _ _) = True
 712     isWritable (ReadWriteHandle _ _ _) = True
 713     isWritable _ = False
 714
 715 getBufferMode :: Handle__ -> PrimIO Handle__
 716 getBufferMode htype =
 717     case bufferMode htype of
 718       Just x -> returnPrimIO htype
 719       Nothing ->
 720         _ccall_ getBufferMode (filePtr htype)       `thenPrimIO` \ rc ->
 721         let
 722             mode =
 723                 case rc of
 724                   0  -> Just NoBuffering
 725                   -1 -> Just LineBuffering
 726                   -2 -> Just (BlockBuffering Nothing)
 727                   -3 -> Nothing
 728                   n  -> Just (BlockBuffering (Just n))
 729         in
 730         returnPrimIO (case htype of
 731           ReadHandle      fp _ b -> ReadHandle      fp mode b
 732           WriteHandle     fp _ b -> WriteHandle     fp mode b
 733           AppendHandle    fp _ b -> AppendHandle    fp mode b
 734           ReadWriteHandle fp _ b -> ReadWriteHandle fp mode b)
 735
 736 hIsBlockBuffered :: Handle -> IO (Bool,Maybe Int)
 737 hIsBlockBuffered handle =
 738     readHandle handle                               >>= \ htype ->
 739     case htype of
 740       ErrorHandle ioError ->
 741           writeHandle handle htype                  >>
 742           fail ioError
 743       ClosedHandle ->
 744           writeHandle handle htype                  >>
 745           ioe_closedHandle handle
 746       SemiClosedHandle _ _ ->
 747           writeHandle handle htype                  >>
 748           ioe_closedHandle handle
 749       other ->
 750           getBufferMode other                       `thenIO_Prim` \ other ->
 751           case bufferMode other of
 752             Just (BlockBuffering size) ->
 753                 writeHandle handle other            >>
 754                 return (True, size)
 755             Just _ ->
 756                 writeHandle handle other            >>
 757                 return (False, Nothing)
 758             Nothing ->
 759                 constructErrorAndFail "hIsBlockBuffered"
 760
 761 hIsLineBuffered :: Handle -> IO Bool
 762 hIsLineBuffered handle =
 763     readHandle handle                               >>= \ htype ->
 764     case htype of
 765       ErrorHandle ioError ->
 766           writeHandle handle htype                  >>
 767           fail ioError
 768       ClosedHandle ->
 769           writeHandle handle htype                  >>
 770           ioe_closedHandle handle
 771       SemiClosedHandle _ _ ->
 772           writeHandle handle htype                  >>
 773           ioe_closedHandle handle
 774       other ->
 775           getBufferMode other                       `thenIO_Prim` \ other ->
 776           case bufferMode other of
 777             Just LineBuffering ->
 778                 writeHandle handle other            >>
 779                 return True
 780             Just _ ->
 781                 writeHandle handle other            >>
 782                 return False
 783             Nothing ->
 784                 constructErrorAndFail "hIsLineBuffered"
 785
 786 hIsNotBuffered :: Handle -> IO Bool
 787 hIsNotBuffered handle =
 788     readHandle handle                               >>= \ htype ->
 789     case htype of
 790       ErrorHandle ioError ->
 791           writeHandle handle htype                  >>
 792           fail ioError
 793       ClosedHandle ->
 794           writeHandle handle htype                  >>
 795           ioe_closedHandle handle
 796       SemiClosedHandle _ _ ->
 797           writeHandle handle htype                  >>
 798           ioe_closedHandle handle
 799       other ->
 800           getBufferMode other                       `thenIO_Prim` \ other ->
 801           case bufferMode other of
 802             Just NoBuffering ->
 803                 writeHandle handle other            >>
 804                 return True
 805             Just _ ->
 806                 writeHandle handle other            >>
 807                 return False
 808             Nothing ->
 809                 constructErrorAndFail "hIsNotBuffered"
 810
 811 hGetBuffering :: Handle -> IO BufferMode
 812 hGetBuffering handle =
 813     readHandle handle                               >>= \ htype ->
 814     case htype of
 815       ErrorHandle ioError ->
 816           writeHandle handle htype                  >>
 817           fail ioError
 818       ClosedHandle ->
 819           writeHandle handle htype                  >>
 820           ioe_closedHandle handle
 821       SemiClosedHandle _ _ ->
 822           writeHandle handle htype                  >>
 823           ioe_closedHandle handle
 824       other ->
 825           getBufferMode other                       `thenIO_Prim` \ other ->
 826           case bufferMode other of
 827             Just v ->
 828                 writeHandle handle other            >>
 829                 return v
 830             Nothing ->
 831                 constructErrorAndFail "hGetBuffering"
 832
 833 hIsSeekable :: Handle -> IO Bool
 834 hIsSeekable handle =
 835     readHandle handle                               >>= \ htype ->
 836     case htype of
 837       ErrorHandle ioError ->
 838           writeHandle handle htype                  >>
 839           fail ioError
 840       ClosedHandle ->
 841           writeHandle handle htype                  >>
 842           ioe_closedHandle handle
 843       SemiClosedHandle _ _ ->
 844           writeHandle handle htype                  >>
 845           ioe_closedHandle handle
 846       AppendHandle _ _ _ ->
 847           writeHandle handle htype                  >>
 848           return False
 849       other ->
 850           _ccall_ seekFileP (filePtr other)         `thenIO_Prim` \ rc ->
 851           writeHandle handle htype                  >>
 852           case rc of
 853             0 -> return False
 854             1 -> return True
 855             _ -> constructErrorAndFail "hIsSeekable"
 856 \end{code}
 857
 858
 859 %*********************************************************
 860 %*                                                      *
 861 \subsection{Miscellaneous}
 862 %*                                                      *
 863 %*********************************************************
 864
 865 These two functions are meant to get things out of @IOErrors@.  They don't!
 866
 867 \begin{code}
 868 ioeGetFileName        :: IOError -> Maybe FilePath
 869 ioeGetErrorString     :: IOError -> String
 870 ioeGetHandle          :: IOError -> Maybe Handle
 871
 872 ioeGetHandle   (IOError h _ _)   = h
 873 ioeGetErrorString (IOError _ iot str) =
 874  case iot of
 875    EOF -> "end of file"
 876    _   -> str
 877
 878 ioeGetFileName (IOError _ _ str) =
 879  case span (/=':') str of
 880    (fs,[]) -> Nothing
 881    (fs,_)  -> Just fs
 882
 883 \end{code}
 884
 885 Internal function for creating an @IOError@ representing the
 886 access of a closed file.
 887
 888 \begin{code}
 889
 890 ioe_closedHandle :: Handle -> IO a
 891 ioe_closedHandle h = fail (IOError (Just h) IllegalOperation "handle is closed")
 892
 893 \end{code}