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