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