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