ghc/lib/std/PrelHandle.lhs

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