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         constructErrorAndFailWithInfo "openFile" f
 210   where
 211     imo = case m of
 212            BinaryMode imo -> imo
 213            TextMode imo   -> imo
 214
 215     m' = case m of
 216            BinaryMode _   -> imo' ++ "b"
 217            TextMode imo   -> imo'
 218
 219     imo' =
 220       case imo of
 221            ReadMode      -> "r"
 222            WriteMode     -> "w"
 223            AppendMode    -> "a"
 224            ReadWriteMode -> "r+"
 225
 226     htype = case imo of
 227               ReadMode      -> ReadHandle
 228               WriteMode     -> WriteHandle
 229               AppendMode    -> AppendHandle
 230               ReadWriteMode -> ReadWriteHandle
 231 \end{code}
 232
 233 Computation $openFile file mode$ allocates and returns a new, open
 234 handle to manage the file {\em file}.  It manages input if {\em mode}
 235 is $ReadMode$, output if {\em mode} is $WriteMode$ or $AppendMode$,
 236 and both input and output if mode is $ReadWriteMode$.
 237
 238 If the file does not exist and it is opened for output, it should be
 239 created as a new file.  If {\em mode} is $WriteMode$ and the file
 240 already exists, then it should be truncated to zero length.  The
 241 handle is positioned at the end of the file if {\em mode} is
 242 $AppendMode$, and otherwise at the beginning (in which case its
 243 internal position is 0).
 244
 245 Implementations should enforce, locally to the Haskell process,
 246 multiple-reader single-writer locking on files, which is to say that
 247 there may either be many handles on the same file which manage input,
 248 or just one handle on the file which manages output.  If any open or
 249 semi-closed handle is managing a file for output, no new handle can be
 250 allocated for that file.  If any open or semi-closed handle is
 251 managing a file for input, new handles can only be allocated if they
 252 do not manage output.
 253
 254 Two files are the same if they have the same absolute name.  An
 255 implementation is free to impose stricter conditions.
 256
 257 \begin{code}
 258 hClose :: Handle -> IO ()
 259
 260 hClose handle = do
 261     htype <- readHandle handle
 262     case htype of
 263       ErrorHandle ioError -> do
 264           writeHandle handle htype
 265           fail ioError
 266       ClosedHandle -> do
 267           writeHandle handle htype
 268           ioe_closedHandle handle
 269       SemiClosedHandle fp (buf,_) -> do
 270           (if buf /= ``NULL'' then
 271                 _ccall_ free buf
 272            else
 273                 return ())
 274           fp_a <- _casm_ `` %r = (char *)%0; '' fp
 275           if fp_a /= (``NULL''::Addr) then do
 276                 -- Under what condition can this be NULL?
 277                 rc <- _ccall_ closeFile fp
 278                   {- We explicitly close a file object so that we can be told
 279                      if there were any errors. Note that after @hClose@
 280                      has been performed, the ForeignObj embedded in the Handle
 281                      is still lying around in the heap, so care is taken
 282                      to avoid closing the file object when the ForeignObj
 283                      is finalised.  -}
 284                 if rc == 0 then do
 285 #ifndef __PARALLEL_HASKELL__
 286                   -- Mark the foreign object data value as
 287                   -- gone to the finaliser (freeFile())
 288                   writeForeignObj fp ``NULL''
 289 #endif
 290                   writeHandle handle ClosedHandle
 291                  else do
 292                   writeHandle handle htype
 293                   constructErrorAndFail "hClose"
 294
 295             else  writeHandle handle htype
 296
 297       other -> do
 298           let fp = filePtr other
 299           rc <- _ccall_ closeFile fp
 300           if rc == 0 then do
 301 #ifndef __PARALLEL_HASKELL__
 302                 -- Mark the foreign object data
 303                 writeForeignObj fp ``NULL''
 304 #endif
 305                 writeHandle handle ClosedHandle
 306             else do
 307                 writeHandle handle htype
 308                 constructErrorAndFail "hClose"
 309 \end{code}
 310
 311 Computation $hClose hdl$ makes handle {\em hdl} closed.  Before the
 312 computation finishes, any items buffered for output and not already
 313 sent to the operating system are flushed as for $flush$.
 314
 315 %*********************************************************
 316 %*                                                      *
 317 \subsection[EOF]{Detecting the End of Input}
 318 %*                                                      *
 319 %*********************************************************
 320
 321
 322 For a handle {\em hdl} which attached to a physical file, $hFileSize
 323 hdl$ returns the size of {\em hdl} in terms of the number of items
 324 which can be read from {\em hdl}.
 325
 326 \begin{code}
 327 hFileSize :: Handle -> IO Integer
 328 hFileSize handle = do
 329     htype <- readHandle handle
 330     case htype of
 331       ErrorHandle ioError -> do
 332           writeHandle handle htype
 333           fail ioError
 334       ClosedHandle -> do
 335           writeHandle handle htype
 336           ioe_closedHandle handle
 337       SemiClosedHandle _ _ -> do
 338           writeHandle handle htype
 339           ioe_closedHandle handle
 340       other ->
 341           -- HACK!  We build a unique MP_INT of the right shape to hold
 342           -- a single unsigned word, and we let the C routine
 343           -- change the data bits
 344           --
 345           -- For some reason, this fails to typecheck if converted to a do
 346           -- expression --SDM
 347           _casm_ ``%r = 1;'' >>= \(I# hack#) ->
 348           case int2Integer# hack# of
 349             result@(J# _ _ d#) -> do
 350                 let bogus_bounds = (error "fileSize"::(Int,Int))
 351                 rc <- _ccall_ fileSize (filePtr other)
 352                                 (ByteArray bogus_bounds d#)
 353                 writeHandle handle htype
 354                 if rc == 0 then
 355                    return result
 356                  else
 357                    constructErrorAndFail "hFileSize"
 358 \end{code}
 359
 360 For a readable handle {\em hdl}, computation $hIsEOF hdl$ returns
 361 $True$ if no further input can be taken from {\em hdl} or for a
 362 physical file, if the current I/O position is equal to the length of
 363 the file.  Otherwise, it returns $False$.
 364
 365 \begin{code}
 366 hIsEOF :: Handle -> IO Bool
 367 hIsEOF handle = do
 368     htype <- readHandle handle
 369     case htype of
 370       ErrorHandle ioError -> do
 371           writeHandle handle htype
 372           fail ioError
 373       ClosedHandle -> do
 374           writeHandle handle htype
 375           ioe_closedHandle handle
 376       SemiClosedHandle _ _ -> do
 377           writeHandle handle htype
 378           ioe_closedHandle handle
 379       WriteHandle _ _ _ -> do
 380           writeHandle handle htype
 381           fail (IOError (Just handle) IllegalOperation
 382                 "handle is not open for reading")
 383       AppendHandle _ _ _ -> do
 384           writeHandle handle htype
 385           fail (IOError (Just handle) IllegalOperation
 386                 "handle is not open for reading")
 387       other -> do
 388           rc <- _ccall_ fileEOF (filePtr other)
 389           writeHandle handle (markHandle htype)
 390           case rc of
 391             0 -> return False
 392             1 -> return True
 393             _ -> constructErrorAndFail "hIsEOF"
 394
 395 isEOF :: IO Bool
 396 isEOF = hIsEOF stdin
 397 \end{code}
 398
 399 %*********************************************************
 400 %*                                                      *
 401 \subsection[Buffering]{Buffering Operations}
 402 %*                                                      *
 403 %*********************************************************
 404
 405 Three kinds of buffering are supported: line-buffering,
 406 block-buffering or no-buffering.  See @IOBase@ for definition
 407 and further explanation of what the type represent.
 408
 409 Computation @hSetBuffering hdl mode@ sets the mode of buffering for
 410 handle {\em hdl} on subsequent reads and writes.
 411
 412 \begin{itemize}
 413 \item
 414 If {\em mode} is @LineBuffering@, line-buffering should be
 415 enabled if possible.
 416 \item
 417 If {\em mode} is @BlockBuffering@ {\em size}, then block-buffering
 418 should be enabled if possible.  The size of the buffer is {\em n} items
 419 if {\em size} is @Just@~{\em n} and is otherwise implementation-dependent.
 420 \item
 421 If {\em mode} is @NoBuffering@, then buffering is disabled if possible.
 422 \end{itemize}
 423
 424 If the buffer mode is changed from @BlockBuffering@ or @LineBuffering@
 425 to @NoBuffering@, then any items in the output buffer are written to
 426 the device, and any items in the input buffer are discarded.  The
 427 default buffering mode when a handle is opened is
 428 implementation-dependent and may depend on the object which is
 429 attached to that handle.
 430
 431 \begin{code}
 432 hSetBuffering :: Handle -> BufferMode -> IO ()
 433
 434 hSetBuffering handle mode =
 435     case mode of
 436       BlockBuffering (Just n)
 437         | n <= 0 -> fail (IOError (Just handle) InvalidArgument
 438                                 "illegal buffer size")
 439       other -> do
 440           htype <- readHandle handle
 441           if isMarked htype then do
 442               writeHandle handle htype
 443               fail (IOError (Just handle)
 444                             UnsupportedOperation
 445                             "can't set buffering for a dirty handle")
 446            else
 447               case htype of
 448                 ErrorHandle ioError -> do
 449                     writeHandle handle htype
 450                     fail ioError
 451                 ClosedHandle -> do
 452                     writeHandle handle htype
 453                     ioe_closedHandle handle
 454                 SemiClosedHandle _ _ -> do
 455                     writeHandle handle htype
 456                     ioe_closedHandle handle
 457                 other -> do
 458                     rc <- _ccall_ setBuffering (filePtr other) bsize
 459                     if rc == 0 then
 460                         writeHandle handle ((hcon other) (filePtr other)
 461                                                 (Just mode) True)
 462                      else do
 463                         writeHandle handle htype
 464                         constructErrorAndFail "hSetBuffering"
 465
 466   where
 467     isMarked :: Handle__ -> Bool
 468     isMarked (ReadHandle fp m b) = b
 469     isMarked (WriteHandle fp m b) = b
 470     isMarked (AppendHandle fp m b) = b
 471     isMarked (ReadWriteHandle fp m b) = b
 472     isMarked _ = False
 473
 474     bsize :: Int
 475     bsize = case mode of
 476               NoBuffering -> 0
 477               LineBuffering -> -1
 478               BlockBuffering Nothing -> -2
 479               BlockBuffering (Just n) -> n
 480
 481 #ifndef __PARALLEL_HASKELL__
 482     hcon :: Handle__ -> (ForeignObj -> (Maybe BufferMode) -> Bool -> Handle__)
 483 #else
 484     hcon :: Handle__ -> (Addr -> (Maybe BufferMode) -> Bool -> Handle__)
 485 #endif
 486     hcon (ReadHandle _ _ _) = ReadHandle
 487     hcon (WriteHandle _ _ _) = WriteHandle
 488     hcon (AppendHandle _ _ _) = AppendHandle
 489     hcon (ReadWriteHandle _ _ _) = ReadWriteHandle
 490 \end{code}
 491
 492 Computation $flush hdl$ causes any items buffered for output in handle
 493 {\em hdl} to be sent immediately to the operating system.
 494
 495 \begin{code}
 496 hFlush :: Handle -> IO ()
 497 hFlush handle = do
 498     htype <- readHandle handle
 499     case htype of
 500       ErrorHandle ioError -> do
 501           writeHandle handle htype
 502           fail ioError
 503       ClosedHandle -> do
 504           writeHandle handle htype
 505           ioe_closedHandle handle
 506       SemiClosedHandle _ _ -> do
 507           writeHandle handle htype
 508           ioe_closedHandle handle
 509       other -> do
 510           rc <- _ccall_ flushFile (filePtr other)
 511           writeHandle handle (markHandle htype)
 512           if rc == 0 then
 513                 return ()
 514            else
 515                 constructErrorAndFail "hFlush"
 516 \end{code}
 517
 518
 519 %*********************************************************
 520 %*                                                      *
 521 \subsection[Seeking]{Repositioning Handles}
 522 %*                                                      *
 523 %*********************************************************
 524
 525 \begin{code}
 526 data HandlePosn = HandlePosn Handle Int
 527
 528 data SeekMode    =  AbsoluteSeek | RelativeSeek | SeekFromEnd
 529                     deriving (Eq, Ord, Ix, Enum, Read, Show)
 530 \end{code}
 531
 532 Computation $hGetPosn hdl$ returns the current I/O
 533 position of {\em hdl} as an abstract position.  Computation
 534 $hSetPosn p$ sets the position of {\em hdl}
 535 to a previously obtained position {\em p}.
 536
 537 \begin{code}
 538 hGetPosn :: Handle -> IO HandlePosn
 539 hGetPosn handle = do
 540     htype <- readHandle handle
 541     case htype of
 542       ErrorHandle ioError -> do
 543           writeHandle handle htype
 544           fail ioError
 545       ClosedHandle -> do
 546           writeHandle handle htype
 547           ioe_closedHandle handle
 548       SemiClosedHandle _ _ -> do
 549           writeHandle handle htype
 550           ioe_closedHandle handle
 551       other -> do
 552           posn <- _ccall_ getFilePosn (filePtr other)
 553           writeHandle handle htype
 554           if posn /= -1 then
 555               return (HandlePosn handle posn)
 556            else
 557               constructErrorAndFail "hGetPosn"
 558
 559 hSetPosn :: HandlePosn -> IO ()
 560 hSetPosn (HandlePosn handle posn) = do
 561     htype <- readHandle handle
 562     case htype of
 563       ErrorHandle ioError -> do
 564           writeHandle handle htype
 565           fail ioError
 566       ClosedHandle -> do
 567           writeHandle handle htype
 568           ioe_closedHandle handle
 569       SemiClosedHandle _ _ -> do
 570           writeHandle handle htype
 571           ioe_closedHandle handle
 572       AppendHandle _ _ _ -> do
 573           writeHandle handle htype
 574           fail (IOError (Just handle) IllegalOperation "handle is not seekable")
 575       other -> do
 576           rc <- _ccall_ setFilePosn (filePtr other) posn
 577           writeHandle handle (markHandle htype)
 578           if rc == 0 then
 579                 return ()
 580            else
 581                 constructErrorAndFail "hSetPosn"
 582 \end{code}
 583
 584 Computation $hSeek hdl mode i$ sets the position of handle
 585 {\em hdl} depending on $mode$.  If {\em mode} is
 586 \begin{itemize}
 587 \item[{\bf AbsoluteSeek}] The position of {\em hdl} is set to {\em i}.
 588 \item[{\bf RelativeSeek}] The position of {\em hdl} is set to offset {\em i} from
 589 the current position.
 590 \item[{\bf SeekToEnd}] The position of {\em hdl} is set to offset {\em i} from
 591 the end of the file.
 592 \item[{\bf SeekFromBeginning}] The position of {\em hdl} is set to offset {\em i} from
 593 the beginning of the file.
 594 \end{itemize}
 595
 596 Some handles may not be seekable $hIsSeekable$, or only support a
 597 subset of the possible positioning operations (e.g. it may only be
 598 possible to seek to the end of a tape, or to a positive offset from
 599 the beginning or current position).
 600
 601 It is not possible to set a negative I/O position, or for a physical
 602 file, an I/O position beyond the current end-of-file.
 603
 604 \begin{code}
 605 hSeek :: Handle -> SeekMode -> Integer -> IO ()
 606 hSeek handle mode offset@(J# _ s# d#) =  do
 607     htype <- readHandle handle
 608     case htype of
 609       ErrorHandle ioError -> do
 610           writeHandle handle htype
 611           fail ioError
 612       ClosedHandle -> do
 613           writeHandle handle htype
 614           ioe_closedHandle handle
 615       SemiClosedHandle _ _ -> do
 616           writeHandle handle htype
 617           ioe_closedHandle handle
 618       AppendHandle _ _ _ -> do
 619           writeHandle handle htype
 620           fail (IOError (Just handle) IllegalOperation "handle is not seekable")
 621       other -> do
 622           rc <- _ccall_ seekFile (filePtr other) whence (I# s#)
 623                         (ByteArray (0,0) d#)
 624           writeHandle handle (markHandle htype)
 625           if rc == 0 then
 626                 return ()
 627            else
 628                 constructErrorAndFail "hSeek"
 629   where
 630     whence :: Int
 631     whence = case mode of
 632                AbsoluteSeek -> ``SEEK_SET''
 633                RelativeSeek -> ``SEEK_CUR''
 634                SeekFromEnd  -> ``SEEK_END''
 635 \end{code}
 636
 637 %*********************************************************
 638 %*                                                      *
 639 \subsection[Query]{Handle Properties}
 640 %*                                                      *
 641 %*********************************************************
 642
 643 A number of operations return information about the properties of a
 644 handle.  Each of these operations returns $True$ if the
 645 handle has the specified property, and $False$
 646 otherwise.
 647
 648 Computation $hIsBlockBuffered hdl$ returns $( False, Nothing )$ if
 649 {\em hdl} is not block-buffered.  Otherwise it returns
 650 $( True, size )$, where {\em size} is $Nothing$ for default buffering, and
 651 $( Just n )$ for block-buffering of {\em n} bytes.
 652
 653 \begin{code}
 654 hIsOpen :: Handle -> IO Bool
 655 hIsOpen handle = do
 656     htype <- readHandle handle
 657     case htype of
 658       ErrorHandle ioError -> do
 659           writeHandle handle htype
 660           fail ioError
 661       ClosedHandle -> do
 662           writeHandle handle htype
 663           return False
 664       SemiClosedHandle _ _ -> do
 665           writeHandle handle htype
 666           return False
 667       other -> do
 668           writeHandle handle htype
 669           return True
 670
 671 hIsClosed :: Handle -> IO Bool
 672 hIsClosed handle = do
 673     htype <- readHandle handle
 674     case htype of
 675       ErrorHandle ioError -> do
 676           writeHandle handle htype
 677           fail ioError
 678       ClosedHandle -> do
 679           writeHandle handle htype
 680           return True
 681       other -> do
 682           writeHandle handle htype
 683           return False
 684
 685 hIsReadable :: Handle -> IO Bool
 686 hIsReadable handle = do
 687     htype <- readHandle handle
 688     case htype of
 689       ErrorHandle ioError -> do
 690           writeHandle handle htype
 691           fail ioError
 692       ClosedHandle -> do
 693           writeHandle handle htype
 694           ioe_closedHandle handle
 695       SemiClosedHandle _ _ -> do
 696           writeHandle handle htype
 697           ioe_closedHandle handle
 698       other -> do
 699           writeHandle handle htype
 700           return (isReadable other)
 701   where
 702     isReadable (ReadHandle _ _ _) = True
 703     isReadable (ReadWriteHandle _ _ _) = True
 704     isReadable _ = False
 705
 706 hIsWritable :: Handle -> IO Bool
 707 hIsWritable handle = do
 708     htype <- readHandle handle
 709     case htype of
 710       ErrorHandle ioError -> do
 711           writeHandle handle htype
 712           fail ioError
 713       ClosedHandle -> do
 714           writeHandle handle htype
 715           ioe_closedHandle handle
 716       SemiClosedHandle _ _ -> do
 717           writeHandle handle htype
 718           ioe_closedHandle handle
 719       other -> do
 720           writeHandle handle htype
 721           return (isWritable other)
 722   where
 723     isWritable (AppendHandle _ _ _) = True
 724     isWritable (WriteHandle _ _ _) = True
 725     isWritable (ReadWriteHandle _ _ _) = True
 726     isWritable _ = False
 727
 728 getBufferMode :: Handle__ -> IO Handle__
 729 getBufferMode htype =
 730     case bufferMode htype of
 731       Just x -> return htype
 732       Nothing -> do
 733         rc <- _ccall_ getBufferMode (filePtr htype)
 734         let
 735             mode =
 736                 case rc of
 737                   0  -> Just NoBuffering
 738                   -1 -> Just LineBuffering
 739                   -2 -> Just (BlockBuffering Nothing)
 740                   -3 -> Nothing
 741                   n  -> Just (BlockBuffering (Just n))
 742         return (case htype of
 743           ReadHandle      fp _ b -> ReadHandle      fp mode b
 744           WriteHandle     fp _ b -> WriteHandle     fp mode b
 745           AppendHandle    fp _ b -> AppendHandle    fp mode b
 746           ReadWriteHandle fp _ b -> ReadWriteHandle fp mode b)
 747
 748 hIsBlockBuffered :: Handle -> IO (Bool,Maybe Int)
 749 hIsBlockBuffered handle = do
 750     htype <- readHandle handle
 751     case htype of
 752       ErrorHandle ioError -> do
 753           writeHandle handle htype
 754           fail ioError
 755       ClosedHandle -> do
 756           writeHandle handle htype
 757           ioe_closedHandle handle
 758       SemiClosedHandle _ _ -> do
 759           writeHandle handle htype
 760           ioe_closedHandle handle
 761       other -> do
 762           other <- getBufferMode other
 763           case bufferMode other of
 764             Just (BlockBuffering size) -> do
 765                 writeHandle handle other
 766                 return (True, size)
 767             Just _ -> do
 768                 writeHandle handle other
 769                 return (False, Nothing)
 770             Nothing ->
 771                 constructErrorAndFail "hIsBlockBuffered"
 772
 773 hIsLineBuffered :: Handle -> IO Bool
 774 hIsLineBuffered handle = do
 775     htype <- readHandle handle
 776     case htype of
 777       ErrorHandle ioError -> do
 778           writeHandle handle htype
 779           fail ioError
 780       ClosedHandle -> do
 781           writeHandle handle htype
 782           ioe_closedHandle handle
 783       SemiClosedHandle _ _ -> do
 784           writeHandle handle htype
 785           ioe_closedHandle handle
 786       other -> do
 787           other <- getBufferMode other
 788           case bufferMode other of
 789             Just LineBuffering -> do
 790                 writeHandle handle other
 791                 return True
 792             Just _ -> do
 793                 writeHandle handle other
 794                 return False
 795             Nothing ->
 796                 constructErrorAndFail "hIsLineBuffered"
 797
 798 hIsNotBuffered :: Handle -> IO Bool
 799 hIsNotBuffered handle = do
 800     htype <- readHandle handle
 801     case htype of
 802       ErrorHandle ioError -> do
 803           writeHandle handle htype
 804           fail ioError
 805       ClosedHandle -> do
 806           writeHandle handle htype
 807           ioe_closedHandle handle
 808       SemiClosedHandle _ _ -> do
 809           writeHandle handle htype
 810           ioe_closedHandle handle
 811       other -> do
 812           other <- getBufferMode other
 813           case bufferMode other of
 814             Just NoBuffering -> do
 815                 writeHandle handle other
 816                 return True
 817             Just _ -> do
 818                 writeHandle handle other
 819                 return False
 820             Nothing ->
 821                 constructErrorAndFail "hIsNotBuffered"
 822
 823 hGetBuffering :: Handle -> IO BufferMode
 824 hGetBuffering handle = do
 825     htype <- readHandle handle
 826     case htype of
 827       ErrorHandle ioError -> do
 828           writeHandle handle htype
 829           fail ioError
 830       ClosedHandle -> do
 831           writeHandle handle htype
 832           ioe_closedHandle handle
 833       SemiClosedHandle _ _ -> do
 834           writeHandle handle htype
 835           ioe_closedHandle handle
 836       other -> do
 837           other <- getBufferMode other
 838           case bufferMode other of
 839             Just v -> do
 840                 writeHandle handle other
 841                 return v
 842             Nothing ->
 843                 constructErrorAndFail "hGetBuffering"
 844
 845 hIsSeekable :: Handle -> IO Bool
 846 hIsSeekable handle = do
 847     htype <- readHandle handle
 848     case htype of
 849       ErrorHandle ioError -> do
 850           writeHandle handle htype
 851           fail ioError
 852       ClosedHandle -> do
 853           writeHandle handle htype
 854           ioe_closedHandle handle
 855       SemiClosedHandle _ _ -> do
 856           writeHandle handle htype
 857           ioe_closedHandle handle
 858       AppendHandle _ _ _ -> do
 859           writeHandle handle htype
 860           return False
 861       other -> do
 862           rc <- _ccall_ seekFileP (filePtr other)
 863           writeHandle handle htype
 864           case rc of
 865             0 -> return False
 866             1 -> return True
 867             _ -> constructErrorAndFail "hIsSeekable"
 868 \end{code}
 869
 870
 871 %*********************************************************
 872 %*                                                      *
 873 \subsection{Miscellaneous}
 874 %*                                                      *
 875 %*********************************************************
 876
 877 These two functions are meant to get things out of @IOErrors@.  They don't!
 878
 879 \begin{code}
 880 ioeGetFileName        :: IOError -> Maybe FilePath
 881 ioeGetErrorString     :: IOError -> String
 882 ioeGetHandle          :: IOError -> Maybe Handle
 883
 884 ioeGetHandle   (IOError h _ _)   = h
 885 ioeGetErrorString (IOError _ iot str) =
 886  case iot of
 887    EOF -> "end of file"
 888    _   -> str
 889
 890 ioeGetFileName (IOError _ _ str) =
 891  case span (/=':') str of
 892    (fs,[]) -> Nothing
 893    (fs,_)  -> Just fs
 894
 895 \end{code}
 896
 897 Internal function for creating an @IOError@ representing the
 898 access of a closed file.
 899
 900 \begin{code}
 901
 902 ioe_closedHandle :: Handle -> IO a
 903 ioe_closedHandle h = fail (IOError (Just h) IllegalOperation "handle is closed")
 904 \end{code}
 905
 906 A number of operations want to get at a readable or writeable handle, and fail
 907 if it isn't:
 908
 909 \begin{code}
 910 wantReadableHandle :: Handle -> IO Handle__
 911 wantReadableHandle handle = do
 912     htype <- readHandle handle
 913     case htype of
 914       ErrorHandle ioError -> do
 915           writeHandle handle htype
 916           fail ioError
 917       ClosedHandle -> do
 918           writeHandle handle htype
 919           ioe_closedHandle handle
 920       SemiClosedHandle _ _ -> do
 921           writeHandle handle htype
 922           ioe_closedHandle handle
 923       AppendHandle _ _ _ -> do
 924           writeHandle handle htype
 925           fail (IOError (Just handle) IllegalOperation
 926                 "handle is not open for reading")
 927       WriteHandle _ _ _ -> do
 928           writeHandle handle htype
 929           fail (IOError (Just handle) IllegalOperation
 930                 "handle is not open for reading")
 931       other -> return other
 932
 933 wantWriteableHandle :: Handle
 934                     -> IO Handle__
 935 wantWriteableHandle handle = do
 936     htype <- readHandle handle
 937     case htype of
 938       ErrorHandle ioError -> do
 939           writeHandle handle htype
 940           fail ioError
 941       ClosedHandle -> do
 942           writeHandle handle htype
 943           ioe_closedHandle handle
 944       SemiClosedHandle _ _ -> do
 945           writeHandle handle htype
 946           ioe_closedHandle handle
 947       ReadHandle _ _ _ -> do
 948           writeHandle handle htype
 949           fail (IOError (Just handle) IllegalOperation "handle is not open for writing")
 950       other -> return other
 951
 952 \end{code}