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