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