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                 other -> do
 454                     {-
 455                       We're being non-standard here, and allow the buffering
 456                       of a semi-closed handle to be changed.   -- sof 6/98
 457                     -}
 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       other -> do
 834           {-
 835            We're being non-standard here, and allow the buffering
 836            of a semi-closed handle to be queried.   -- sof 6/98
 837           -}
 838           other <- getBufferMode other
 839           case bufferMode other of
 840             Just v -> do
 841                 writeHandle handle other
 842                 return v
 843             Nothing ->
 844                 constructErrorAndFail "hGetBuffering"
 845
 846 hIsSeekable :: Handle -> IO Bool
 847 hIsSeekable handle = do
 848     htype <- readHandle handle
 849     case htype of
 850       ErrorHandle ioError -> do
 851           writeHandle handle htype
 852           fail ioError
 853       ClosedHandle -> do
 854           writeHandle handle htype
 855           ioe_closedHandle handle
 856       SemiClosedHandle _ _ -> do
 857           writeHandle handle htype
 858           ioe_closedHandle handle
 859       AppendHandle _ _ _ -> do
 860           writeHandle handle htype
 861           return False
 862       other -> do
 863           rc <- _ccall_ seekFileP (filePtr other)
 864           writeHandle handle htype
 865           case rc of
 866             0 -> return False
 867             1 -> return True
 868             _ -> constructErrorAndFail "hIsSeekable"
 869 \end{code}
 870
 871
 872 %*********************************************************
 873 %*                                                      *
 874 \subsection{Changing echo status}
 875 %*                                                      *
 876 %*********************************************************
 877
 878 \begin{code}
 879 hSetEcho :: Handle -> Bool -> IO ()
 880 hSetEcho hdl on = do
 881     isT   <- hIsTerminalDevice hdl
 882     if not isT
 883      then return ()
 884      else do
 885       htype <- readHandle hdl
 886       case htype of
 887          ErrorHandle ioError ->  do
 888             writeHandle hdl htype
 889             fail ioError
 890          ClosedHandle      ->  do
 891             writeHandle hdl htype
 892             ioe_closedHandle hdl
 893          other -> do
 894             rc <- _ccall_ setTerminalEcho (filePtr htype) (if on then 1 else 0)
 895             writeHandle hdl htype
 896             if rc /= -1
 897              then return ()
 898              else constructErrorAndFail "hSetEcho"
 899
 900 hGetEcho :: Handle -> IO Bool
 901 hGetEcho hdl = do
 902     isT   <- hIsTerminalDevice hdl
 903     if not isT
 904      then return False
 905      else do
 906        htype <- readHandle hdl
 907        case htype of
 908          ErrorHandle ioError ->  do
 909             writeHandle hdl htype
 910             fail ioError
 911          ClosedHandle      ->  do
 912             writeHandle hdl htype
 913             ioe_closedHandle hdl
 914          other -> do
 915             rc <- _ccall_ getTerminalEcho (filePtr htype)
 916             writeHandle hdl htype
 917             case rc of
 918               1 -> return True
 919               0 -> return False
 920               _ -> constructErrorAndFail "hSetEcho"
 921
 922 hIsTerminalDevice :: Handle -> IO Bool
 923 hIsTerminalDevice hdl = do
 924     htype <- readHandle hdl
 925     case htype of
 926        ErrorHandle ioError ->  do
 927             writeHandle hdl htype
 928             fail ioError
 929        ClosedHandle        ->  do
 930             writeHandle hdl htype
 931             ioe_closedHandle hdl
 932        other -> do
 933           rc <- _ccall_ isTerminalDevice (filePtr htype)
 934           writeHandle hdl htype
 935           case rc of
 936             1 -> return True
 937             0 -> return False
 938             _ -> constructErrorAndFail "hIsTerminalDevice"
 939 \end{code}
 940
 941
 942
 943 %*********************************************************
 944 %*                                                      *
 945 \subsection{Miscellaneous}
 946 %*                                                      *
 947 %*********************************************************
 948
 949 These two functions are meant to get things out of @IOErrors@.
 950
 951 \begin{code}
 952 ioeGetFileName        :: IOError -> Maybe FilePath
 953 ioeGetErrorString     :: IOError -> String
 954 ioeGetHandle          :: IOError -> Maybe Handle
 955
 956 ioeGetHandle   (IOError h _ _)   = h
 957 ioeGetErrorString (IOError _ iot str) =
 958  case iot of
 959    EOF -> "end of file"
 960    _   -> str
 961
 962 ioeGetFileName (IOError _ _ str) =
 963  case span (/=':') str of
 964    (fs,[]) -> Nothing
 965    (fs,_)  -> Just fs
 966
 967 \end{code}
 968
 969 Internal function for creating an @IOError@ representing the
 970 access of a closed file.
 971
 972 \begin{code}
 973
 974 ioe_closedHandle :: Handle -> IO a
 975 ioe_closedHandle h = fail (IOError (Just h) IllegalOperation "handle is closed")
 976 \end{code}
 977
 978 A number of operations want to get at a readable or writeable handle, and fail
 979 if it isn't:
 980
 981 \begin{code}
 982 wantReadableHandle :: Handle -> IO Handle__
 983 wantReadableHandle handle = do
 984     htype <- readHandle handle
 985     case htype of
 986       ErrorHandle ioError -> do
 987           writeHandle handle htype
 988           fail ioError
 989       ClosedHandle -> do
 990           writeHandle handle htype
 991           ioe_closedHandle handle
 992       SemiClosedHandle _ _ -> do
 993           writeHandle handle htype
 994           ioe_closedHandle handle
 995       AppendHandle _ _ _ -> do
 996           writeHandle handle htype
 997           fail (IOError (Just handle) IllegalOperation
 998                 "handle is not open for reading")
 999       WriteHandle _ _ _ -> do
1000           writeHandle handle htype
1001           fail (IOError (Just handle) IllegalOperation
1002                 "handle is not open for reading")
1003       other -> return other
1004
1005 wantWriteableHandle :: Handle
1006                     -> IO Handle__
1007 wantWriteableHandle handle = do
1008     htype <- readHandle handle
1009     case htype of
1010       ErrorHandle ioError -> do
1011           writeHandle handle htype
1012           fail ioError
1013       ClosedHandle -> do
1014           writeHandle handle htype
1015           ioe_closedHandle handle
1016       SemiClosedHandle _ _ -> do
1017           writeHandle handle htype
1018           ioe_closedHandle handle
1019       ReadHandle _ _ _ -> do
1020           writeHandle handle htype
1021           fail (IOError (Just handle) IllegalOperation "handle is not open for writing")
1022       other -> return other
1023
1024 \end{code}