ghc/lib/ghc/IOHandle.lhs

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