1 {-# OPTIONS -fno-implicit-prelude #-}
6 -- -----------------------------------------------------------------------------
7 -- $Id: Handle.hsc,v 1.5 2001/07/31 13:03:28 simonmar Exp $
9 -- (c) The University of Glasgow, 1994-2001
11 -- This module defines the basic operations on I/O "handles".
14 withHandle, withHandle', withHandle_,
15 wantWritableHandle, wantReadableHandle, wantSeekableHandle,
17 newEmptyBuffer, allocateBuffer, readCharFromBuffer, writeCharIntoBuffer,
18 flushWriteBufferOnly, flushWriteBuffer, flushReadBuffer, fillReadBuffer,
21 ioe_closedHandle, ioe_EOF, ioe_notReadable, ioe_notWritable,
23 stdin, stdout, stderr,
24 IOMode(..), IOModeEx(..), openFile, openFileEx, openFd,
25 hFileSize, hIsEOF, isEOF, hLookAhead, hSetBuffering, hSetBinaryMode,
30 HandlePosn(..), hGetPosn, hSetPosn,
33 hIsOpen, hIsClosed, hIsReadable, hIsWritable, hGetBuffering, hIsSeekable,
34 hSetEcho, hGetEcho, hIsTerminalDevice,
35 ioeGetFileName, ioeGetErrorString, ioeGetHandle,
56 import GHC.Read ( Read )
61 import GHC.Num ( Integer(..), Num(..) )
63 import GHC.Real ( toInteger )
67 -- -----------------------------------------------------------------------------
70 -- hWaitForInput blocks (should use a timeout)
72 -- unbuffered hGetLine is a bit dodgy
74 -- hSetBuffering: can't change buffering on a stream,
75 -- when the read buffer is non-empty? (no way to flush the buffer)
77 -- ---------------------------------------------------------------------------
78 -- Are files opened by default in text or binary mode, if the user doesn't
80 dEFAULT_OPEN_IN_BINARY_MODE :: Bool
81 dEFAULT_OPEN_IN_BINARY_MODE = False
83 -- ---------------------------------------------------------------------------
84 -- Creating a new handle
86 newFileHandle :: (MVar Handle__ -> IO ()) -> Handle__ -> IO Handle
87 newFileHandle finalizer hc = do
89 addMVarFinalizer m (finalizer m)
92 -- ---------------------------------------------------------------------------
93 -- Working with Handles
96 In the concurrent world, handles are locked during use. This is done
97 by wrapping an MVar around the handle which acts as a mutex over
98 operations on the handle.
100 To avoid races, we use the following bracketing operations. The idea
101 is to obtain the lock, do some operation and replace the lock again,
102 whether the operation succeeded or failed. We also want to handle the
103 case where the thread receives an exception while processing the IO
104 operation: in these cases we also want to relinquish the lock.
106 There are three versions of @withHandle@: corresponding to the three
107 possible combinations of:
109 - the operation may side-effect the handle
110 - the operation may return a result
112 If the operation generates an error or an exception is raised, the
113 original handle is always replaced [ this is the case at the moment,
114 but we might want to revisit this in the future --SDM ].
117 {-# INLINE withHandle #-}
118 withHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
119 withHandle fun h@(FileHandle m) act = withHandle' fun h m act
120 withHandle fun h@(DuplexHandle m _) act = withHandle' fun h m act
122 withHandle' fun h m act =
125 checkBufferInvariants h_
126 (h',v) <- catchException (act h_)
127 (\ ex -> putMVar m h_ >> throw (augmentIOError ex fun h h_))
128 checkBufferInvariants h'
132 {-# INLINE withHandle_ #-}
133 withHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a
134 withHandle_ fun h@(FileHandle m) act = withHandle_' fun h m act
135 withHandle_ fun h@(DuplexHandle m _) act = withHandle_' fun h m act
137 withHandle_' fun h m act =
140 checkBufferInvariants h_
141 v <- catchException (act h_)
142 (\ ex -> putMVar m h_ >> throw (augmentIOError ex fun h h_))
143 checkBufferInvariants h_
147 withAllHandles__ :: String -> Handle -> (Handle__ -> IO Handle__) -> IO ()
148 withAllHandles__ fun h@(FileHandle m) act = withHandle__' fun h m act
149 withAllHandles__ fun h@(DuplexHandle r w) act = do
150 withHandle__' fun h r act
151 withHandle__' fun h w act
153 withHandle__' fun h m act =
156 checkBufferInvariants h_
157 h' <- catchException (act h_)
158 (\ ex -> putMVar m h_ >> throw (augmentIOError ex fun h h_))
159 checkBufferInvariants h'
163 augmentIOError (IOException (IOError _ iot _ str fp)) fun h h_
164 = IOException (IOError (Just h) iot fun str filepath)
165 where filepath | Just _ <- fp = fp
166 | otherwise = Just (haFilePath h_)
167 augmentIOError other_exception _ _ _
170 -- ---------------------------------------------------------------------------
171 -- Wrapper for write operations.
173 wantWritableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
174 wantWritableHandle fun h@(FileHandle m) act
175 = wantWritableHandle' fun h m act
176 wantWritableHandle fun h@(DuplexHandle _ m) act
177 = wantWritableHandle' fun h m act
178 -- ToDo: in the Duplex case, we don't need to checkWritableHandle
181 :: String -> Handle -> MVar Handle__
182 -> (Handle__ -> IO a) -> IO a
183 wantWritableHandle' fun h m act
184 = withHandle_' fun h m (checkWritableHandle act)
186 checkWritableHandle act handle_
187 = case haType handle_ of
188 ClosedHandle -> ioe_closedHandle
189 SemiClosedHandle -> ioe_closedHandle
190 ReadHandle -> ioe_notWritable
191 ReadWriteHandle -> do
192 let ref = haBuffer handle_
195 if not (bufferIsWritable buf)
196 then do b <- flushReadBuffer (haFD handle_) buf
197 return b{ bufState=WriteBuffer }
199 writeIORef ref new_buf
201 _other -> act handle_
203 -- ---------------------------------------------------------------------------
204 -- Wrapper for read operations.
206 wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
207 wantReadableHandle fun h@(FileHandle m) act
208 = wantReadableHandle' fun h m act
209 wantReadableHandle fun h@(DuplexHandle m _) act
210 = wantReadableHandle' fun h m act
211 -- ToDo: in the Duplex case, we don't need to checkReadableHandle
214 :: String -> Handle -> MVar Handle__
215 -> (Handle__ -> IO a) -> IO a
216 wantReadableHandle' fun h m act
217 = withHandle_' fun h m (checkReadableHandle act)
219 checkReadableHandle act handle_ =
220 case haType handle_ of
221 ClosedHandle -> ioe_closedHandle
222 SemiClosedHandle -> ioe_closedHandle
223 AppendHandle -> ioe_notReadable
224 WriteHandle -> ioe_notReadable
225 ReadWriteHandle -> do
226 let ref = haBuffer handle_
228 when (bufferIsWritable buf) $ do
229 new_buf <- flushWriteBuffer (haFD handle_) buf
230 writeIORef ref new_buf{ bufState=ReadBuffer }
232 _other -> act handle_
234 -- ---------------------------------------------------------------------------
235 -- Wrapper for seek operations.
237 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
238 wantSeekableHandle fun h@(DuplexHandle _ _) _act =
239 ioException (IOError (Just h) IllegalOperation fun
240 "handle is not seekable" Nothing)
241 wantSeekableHandle fun h@(FileHandle m) act =
242 withHandle_' fun h m (checkSeekableHandle act)
244 checkSeekableHandle act handle_ =
245 case haType handle_ of
246 ClosedHandle -> ioe_closedHandle
247 SemiClosedHandle -> ioe_closedHandle
248 AppendHandle -> ioe_notSeekable
249 _ | haIsBin handle_ -> act handle_
250 | otherwise -> ioe_notSeekable_notBin
252 -- -----------------------------------------------------------------------------
255 ioe_closedHandle, ioe_EOF,
256 ioe_notReadable, ioe_notWritable,
257 ioe_notSeekable, ioe_notSeekable_notBin :: IO a
259 ioe_closedHandle = ioException
260 (IOError Nothing IllegalOperation ""
261 "handle is closed" Nothing)
262 ioe_EOF = ioException
263 (IOError Nothing EOF "" "" Nothing)
264 ioe_notReadable = ioException
265 (IOError Nothing IllegalOperation ""
266 "handle is not open for reading" Nothing)
267 ioe_notWritable = ioException
268 (IOError Nothing IllegalOperation ""
269 "handle is not open for writing" Nothing)
270 ioe_notSeekable = ioException
271 (IOError Nothing IllegalOperation ""
272 "handle is not seekable" Nothing)
273 ioe_notSeekable_notBin = ioException
274 (IOError Nothing IllegalOperation ""
275 "seek operations are only allowed on binary-mode handles" Nothing)
277 ioe_bufsiz :: Int -> IO a
278 ioe_bufsiz n = ioException
279 (IOError Nothing InvalidArgument "hSetBuffering"
280 ("illegal buffer size " ++ showsPrec 9 n []) Nothing)
281 -- 9 => should be parens'ified.
283 -- -----------------------------------------------------------------------------
286 -- For a duplex handle, we arrange that the read side points to the write side
287 -- (and hence keeps it alive if the read side is alive). This is done by
288 -- having the haType field of the read side be ReadSideHandle with a pointer
289 -- to the write side. The finalizer is then placed on the write side, and
290 -- the handle only gets finalized once, when both sides are no longer
293 stdHandleFinalizer :: MVar Handle__ -> IO ()
294 stdHandleFinalizer m = do
296 flushWriteBufferOnly h_
298 handleFinalizer :: MVar Handle__ -> IO ()
299 handleFinalizer m = do
301 flushWriteBufferOnly h_
302 let fd = fromIntegral (haFD h_)
304 -- ToDo: closesocket() for a WINSOCK socket?
305 when (fd /= -1) (c_close fd >> return ())
308 -- ---------------------------------------------------------------------------
309 -- Grimy buffer operations
312 checkBufferInvariants h_ = do
313 let ref = haBuffer h_
314 Buffer{ bufWPtr=w, bufRPtr=r, bufSize=size, bufState=state } <- readIORef ref
319 && ( r /= w || (r == 0 && w == 0) )
320 && ( state /= WriteBuffer || r == 0 )
321 && ( state /= WriteBuffer || w < size ) -- write buffer is never full
323 then error "buffer invariant violation"
326 checkBufferInvariants h_ = return ()
329 newEmptyBuffer :: RawBuffer -> BufferState -> Int -> Buffer
330 newEmptyBuffer b state size
331 = Buffer{ bufBuf=b, bufRPtr=0, bufWPtr=0, bufSize=size, bufState=state }
333 allocateBuffer :: Int -> BufferState -> IO Buffer
334 allocateBuffer sz@(I## size) state = IO $ \s ->
335 case newByteArray## size s of { (## s, b ##) ->
336 (## s, newEmptyBuffer b state sz ##) }
338 writeCharIntoBuffer :: RawBuffer -> Int -> Char -> IO Int
339 writeCharIntoBuffer slab (I## off) (C## c)
340 = IO $ \s -> case writeCharArray## slab off c s of
341 s -> (## s, I## (off +## 1##) ##)
343 readCharFromBuffer :: RawBuffer -> Int -> IO (Char, Int)
344 readCharFromBuffer slab (I## off)
345 = IO $ \s -> case readCharArray## slab off s of
346 (## s, c ##) -> (## s, (C## c, I## (off +## 1##)) ##)
348 dEFAULT_BUFFER_SIZE = (#const BUFSIZ) :: Int
350 getBuffer :: FD -> BufferState -> IO (IORef Buffer, BufferMode)
351 getBuffer fd state = do
352 buffer <- allocateBuffer dEFAULT_BUFFER_SIZE state
353 ioref <- newIORef buffer
357 | is_tty = LineBuffering
358 | otherwise = BlockBuffering Nothing
360 return (ioref, buffer_mode)
362 mkUnBuffer :: IO (IORef Buffer)
364 buffer <- allocateBuffer 1 ReadBuffer
367 -- flushWriteBufferOnly flushes the buffer iff it contains pending write data.
368 flushWriteBufferOnly :: Handle__ -> IO ()
369 flushWriteBufferOnly h_ = do
373 new_buf <- if bufferIsWritable buf
374 then flushWriteBuffer fd buf
376 writeIORef ref new_buf
378 -- flushBuffer syncs the file with the buffer, including moving the
379 -- file pointer backwards in the case of a read buffer.
380 flushBuffer :: Handle__ -> IO ()
382 let ref = haBuffer h_
387 ReadBuffer -> flushReadBuffer (haFD h_) buf
388 WriteBuffer -> flushWriteBuffer (haFD h_) buf
390 writeIORef ref flushed_buf
392 -- When flushing a read buffer, we seek backwards by the number of
393 -- characters in the buffer. The file descriptor must therefore be
394 -- seekable: attempting to flush the read buffer on an unseekable
395 -- handle is not allowed.
397 flushReadBuffer :: FD -> Buffer -> IO Buffer
398 flushReadBuffer fd buf
399 | bufferEmpty buf = return buf
401 let off = negate (bufWPtr buf - bufRPtr buf)
403 puts ("flushReadBuffer: new file offset = " ++ show off ++ "\n")
405 throwErrnoIfMinus1Retry "flushReadBuffer"
406 (c_lseek (fromIntegral fd) (fromIntegral off) (#const SEEK_CUR))
407 return buf{ bufWPtr=0, bufRPtr=0 }
409 flushWriteBuffer :: FD -> Buffer -> IO Buffer
410 flushWriteBuffer fd buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w } = do
413 puts ("flushWriteBuffer, fd=" ++ show fd ++ ", bytes=" ++ show bytes ++ "\n")
416 then return (buf{ bufRPtr=0, bufWPtr=0 })
418 res <- throwErrnoIfMinus1RetryMayBlock "flushWriteBuffer"
419 (write_off (fromIntegral fd) b (fromIntegral r)
420 (fromIntegral bytes))
422 let res' = fromIntegral res
424 then flushWriteBuffer fd (buf{ bufRPtr = r + res' })
425 else return buf{ bufRPtr=0, bufWPtr=0 }
427 foreign import "write_wrap" unsafe
428 write_off :: CInt -> RawBuffer -> Int -> CInt -> IO CInt
430 int write_wrap(int fd, void *ptr, HsInt off, int size) \
431 { return write(fd, ptr + off, size); }
434 fillReadBuffer :: FD -> Bool -> Buffer -> IO Buffer
435 fillReadBuffer fd is_line
436 buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w, bufSize=size } =
437 -- buffer better be empty:
438 assert (r == 0 && w == 0) $ do
439 fillReadBufferLoop fd is_line buf b w size
441 -- For a line buffer, we just get the first chunk of data to arrive,
442 -- and don't wait for the whole buffer to be full (but we *do* wait
443 -- until some data arrives). This isn't really line buffering, but it
444 -- appears to be what GHC has done for a long time, and I suspect it
445 -- is more useful than line buffering in most cases.
447 fillReadBufferLoop fd is_line buf b w size = do
449 if bytes == 0 -- buffer full?
450 then return buf{ bufRPtr=0, bufWPtr=w }
453 puts ("fillReadBufferLoop: bytes = " ++ show bytes ++ "\n")
455 res <- throwErrnoIfMinus1RetryMayBlock "fillReadBuffer"
456 (read_off fd b (fromIntegral w) (fromIntegral bytes))
458 let res' = fromIntegral res
460 puts ("fillReadBufferLoop: res' = " ++ show res' ++ "\n")
465 else return buf{ bufRPtr=0, bufWPtr=w }
466 else if res' < bytes && not is_line
467 then fillReadBufferLoop fd is_line buf b (w+res') size
468 else return buf{ bufRPtr=0, bufWPtr=w+res' }
470 foreign import "read_wrap" unsafe
471 read_off :: FD -> RawBuffer -> Int -> CInt -> IO CInt
473 int read_wrap(int fd, void *ptr, HsInt off, int size) \
474 { return read(fd, ptr + off, size); }
476 -- ---------------------------------------------------------------------------
479 -- Three handles are allocated during program initialisation. The first
480 -- two manage input or output from the Haskell program's standard input
481 -- or output channel respectively. The third manages output to the
482 -- standard error channel. These handles are initially open.
489 stdin = unsafePerformIO $ do
490 -- ToDo: acquire lock
491 setNonBlockingFD fd_stdin
492 (buf, bmode) <- getBuffer fd_stdin ReadBuffer
493 spares <- newIORef BufferListNil
494 newFileHandle stdHandleFinalizer
495 (Handle__ { haFD = fd_stdin,
497 haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
498 haBufferMode = bmode,
499 haFilePath = "<stdin>",
505 stdout = unsafePerformIO $ do
506 -- ToDo: acquire lock
507 -- We don't set non-blocking mode on stdout or sterr, because
508 -- some shells don't recover properly.
509 -- setNonBlockingFD fd_stdout
510 (buf, bmode) <- getBuffer fd_stdout WriteBuffer
511 spares <- newIORef BufferListNil
512 newFileHandle stdHandleFinalizer
513 (Handle__ { haFD = fd_stdout,
514 haType = WriteHandle,
515 haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
516 haBufferMode = bmode,
517 haFilePath = "<stdout>",
523 stderr = unsafePerformIO $ do
524 -- ToDo: acquire lock
525 -- We don't set non-blocking mode on stdout or sterr, because
526 -- some shells don't recover properly.
527 -- setNonBlockingFD fd_stderr
529 spares <- newIORef BufferListNil
530 newFileHandle stdHandleFinalizer
531 (Handle__ { haFD = fd_stderr,
532 haType = WriteHandle,
533 haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
534 haBufferMode = NoBuffering,
535 haFilePath = "<stderr>",
540 -- ---------------------------------------------------------------------------
541 -- Opening and Closing Files
544 Computation `openFile file mode' allocates and returns a new, open
545 handle to manage the file `file'. It manages input if `mode'
546 is `ReadMode', output if `mode' is `WriteMode' or `AppendMode',
547 and both input and output if mode is `ReadWriteMode'.
549 If the file does not exist and it is opened for output, it should be
550 created as a new file. If `mode' is `WriteMode' and the file
551 already exists, then it should be truncated to zero length. The
552 handle is positioned at the end of the file if `mode' is
553 `AppendMode', and otherwise at the beginning (in which case its
554 internal position is 0).
556 Implementations should enforce, locally to the Haskell process,
557 multiple-reader single-writer locking on files, which is to say that
558 there may either be many handles on the same file which manage input,
559 or just one handle on the file which manages output. If any open or
560 semi-closed handle is managing a file for output, no new handle can be
561 allocated for that file. If any open or semi-closed handle is
562 managing a file for input, new handles can only be allocated if they
563 do not manage output.
565 Two files are the same if they have the same absolute name. An
566 implementation is free to impose stricter conditions.
569 data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode
570 deriving (Eq, Ord, Ix, Enum, Read, Show)
575 deriving (Eq, Read, Show)
577 addFilePathToIOError fun fp (IOException (IOError h iot _ str _))
578 = IOException (IOError h iot fun str (Just fp))
579 addFilePathToIOError _ _ other_exception
582 openFile :: FilePath -> IOMode -> IO Handle
585 (openFile' fp (if dEFAULT_OPEN_IN_BINARY_MODE
588 (\e -> throw (addFilePathToIOError "openFile" fp e))
590 openFileEx :: FilePath -> IOModeEx -> IO Handle
594 (\e -> throw (addFilePathToIOError "openFileEx" fp e))
597 openFile' filepath ex_mode =
598 withCString filepath $ \ f ->
603 BinaryMode bmo -> (bmo, True)
604 TextMode tmo -> (tmo, False)
606 oflags1 = case mode of
607 ReadMode -> read_flags
608 WriteMode -> write_flags
609 ReadWriteMode -> rw_flags
610 AppendMode -> append_flags
612 truncate | WriteMode <- mode = True
621 oflags = oflags1 .|. binary_flags
624 -- the old implementation had a complicated series of three opens,
625 -- which is perhaps because we have to be careful not to open
626 -- directories. However, the man pages I've read say that open()
627 -- always returns EISDIR if the file is a directory and was opened
628 -- for writing, so I think we're ok with a single open() here...
629 fd <- fromIntegral `liftM`
630 throwErrnoIfMinus1Retry "openFile"
631 (c_open f (fromIntegral oflags) 0o666)
633 openFd fd filepath mode binary truncate
634 -- ASSERT: if we just created the file, then openFd won't fail
635 -- (so we don't need to worry about removing the newly created file
636 -- in the event of an error).
639 std_flags = o_NONBLOCK .|. o_NOCTTY
640 output_flags = std_flags .|. o_CREAT
641 read_flags = std_flags .|. o_RDONLY
642 write_flags = output_flags .|. o_WRONLY
643 rw_flags = output_flags .|. o_RDWR
644 append_flags = write_flags .|. o_APPEND
646 -- ---------------------------------------------------------------------------
649 openFd :: FD -> FilePath -> IOMode -> Bool -> Bool -> IO Handle
650 openFd fd filepath mode binary truncate = do
651 -- turn on non-blocking mode
654 let (ha_type, write) =
656 ReadMode -> ( ReadHandle, False )
657 WriteMode -> ( WriteHandle, True )
658 ReadWriteMode -> ( ReadWriteHandle, True )
659 AppendMode -> ( AppendHandle, True )
661 -- open() won't tell us if it was a directory if we only opened for
662 -- reading, so check again.
666 ioException (IOError Nothing InappropriateType "openFile"
667 "is a directory" Nothing)
670 | ReadWriteHandle <- ha_type -> mkDuplexHandle fd filepath binary
671 | otherwise -> mkFileHandle fd filepath ha_type binary
673 -- regular files need to be locked
675 r <- lockFile (fromIntegral fd) (fromBool write) 1{-exclusive-}
677 ioException (IOError Nothing ResourceBusy "openFile"
678 "file is locked" Nothing)
680 -- truncate the file if necessary
681 when truncate (fileTruncate filepath)
683 mkFileHandle fd filepath ha_type binary
686 foreign import "lockFile" unsafe
687 lockFile :: CInt -> CInt -> CInt -> IO CInt
689 foreign import "unlockFile" unsafe
690 unlockFile :: CInt -> IO CInt
692 mkFileHandle :: FD -> FilePath -> HandleType -> Bool -> IO Handle
693 mkFileHandle fd filepath ha_type binary = do
694 (buf, bmode) <- getBuffer fd (initBufferState ha_type)
695 spares <- newIORef BufferListNil
696 newFileHandle handleFinalizer
697 (Handle__ { haFD = fd,
700 haBufferMode = bmode,
701 haFilePath = filepath,
706 mkDuplexHandle :: FD -> FilePath -> Bool -> IO Handle
707 mkDuplexHandle fd filepath binary = do
708 (w_buf, w_bmode) <- getBuffer fd WriteBuffer
709 w_spares <- newIORef BufferListNil
711 Handle__ { haFD = fd,
712 haType = WriteHandle,
714 haBufferMode = w_bmode,
715 haFilePath = filepath,
719 write_side <- newMVar w_handle_
721 (r_buf, r_bmode) <- getBuffer fd ReadBuffer
722 r_spares <- newIORef BufferListNil
724 Handle__ { haFD = fd,
725 haType = ReadSideHandle write_side,
727 haBufferMode = r_bmode,
728 haFilePath = filepath,
732 read_side <- newMVar r_handle_
734 addMVarFinalizer write_side (handleFinalizer write_side)
735 return (DuplexHandle read_side write_side)
738 initBufferState ReadHandle = ReadBuffer
739 initBufferState _ = WriteBuffer
741 -- ---------------------------------------------------------------------------
744 -- Computation `hClose hdl' makes handle `hdl' closed. Before the
745 -- computation finishes, any items buffered for output and not already
746 -- sent to the operating system are flushed as for `hFlush'.
748 -- For a duplex handle, we close&flush the write side, and just close
751 hClose :: Handle -> IO ()
752 hClose h@(FileHandle m) = hClose' h m
753 hClose h@(DuplexHandle r w) = do
755 withHandle__' "hClose" h r $ \ handle_ -> do
756 return handle_{ haFD = -1,
757 haType = ClosedHandle
760 hClose' h m = withHandle__' "hClose" h m $ hClose_help
762 hClose_help handle_ =
763 case haType handle_ of
764 ClosedHandle -> return handle_
766 let fd = fromIntegral (haFD handle_)
767 flushWriteBufferOnly handle_
768 throwErrnoIfMinus1Retry_ "hClose" (c_close fd)
770 -- free the spare buffers
771 writeIORef (haBuffers handle_) BufferListNil
776 -- we must set the fd to -1, because the finalizer is going
777 -- to run eventually and try to close/unlock it.
778 return (handle_{ haFD = -1,
779 haType = ClosedHandle
782 -----------------------------------------------------------------------------
783 -- Detecting the size of a file
785 -- For a handle `hdl' which attached to a physical file, `hFileSize
786 -- hdl' returns the size of `hdl' in terms of the number of items
787 -- which can be read from `hdl'.
789 hFileSize :: Handle -> IO Integer
791 withHandle_ "hFileSize" handle $ \ handle_ -> do
792 case haType handle_ of
793 ClosedHandle -> ioe_closedHandle
794 SemiClosedHandle -> ioe_closedHandle
795 _ -> do flushWriteBufferOnly handle_
796 r <- fdFileSize (haFD handle_)
799 else ioException (IOError Nothing InappropriateType "hFileSize"
800 "not a regular file" Nothing)
802 -- ---------------------------------------------------------------------------
803 -- Detecting the End of Input
805 -- For a readable handle `hdl', `hIsEOF hdl' returns
806 -- `True' if no further input can be taken from `hdl' or for a
807 -- physical file, if the current I/O position is equal to the length of
808 -- the file. Otherwise, it returns `False'.
810 hIsEOF :: Handle -> IO Bool
813 (do hLookAhead handle; return False)
814 (\e -> if isEOFError e then return True else throw e)
819 -- ---------------------------------------------------------------------------
822 -- hLookahead returns the next character from the handle without
823 -- removing it from the input buffer, blocking until a character is
826 hLookAhead :: Handle -> IO Char
827 hLookAhead handle = do
828 wantReadableHandle "hLookAhead" handle $ \handle_ -> do
829 let ref = haBuffer handle_
831 is_line = haBufferMode handle_ == LineBuffering
834 -- fill up the read buffer if necessary
835 new_buf <- if bufferEmpty buf
836 then fillReadBuffer fd is_line buf
839 writeIORef ref new_buf
841 (c,_) <- readCharFromBuffer (bufBuf buf) (bufRPtr buf)
844 -- ---------------------------------------------------------------------------
845 -- Buffering Operations
847 -- Three kinds of buffering are supported: line-buffering,
848 -- block-buffering or no-buffering. See GHC.IOBase for definition and
849 -- further explanation of what the type represent.
851 -- Computation `hSetBuffering hdl mode' sets the mode of buffering for
852 -- handle hdl on subsequent reads and writes.
854 -- * If mode is LineBuffering, line-buffering should be enabled if possible.
856 -- * If mode is `BlockBuffering size', then block-buffering
857 -- should be enabled if possible. The size of the buffer is n items
858 -- if size is `Just n' and is otherwise implementation-dependent.
860 -- * If mode is NoBuffering, then buffering is disabled if possible.
862 -- If the buffer mode is changed from BlockBuffering or
863 -- LineBuffering to NoBuffering, then any items in the output
864 -- buffer are written to the device, and any items in the input buffer
865 -- are discarded. The default buffering mode when a handle is opened
866 -- is implementation-dependent and may depend on the object which is
867 -- attached to that handle.
869 hSetBuffering :: Handle -> BufferMode -> IO ()
870 hSetBuffering handle mode =
871 withAllHandles__ "hSetBuffering" handle $ \ handle_ -> do
872 case haType handle_ of
873 ClosedHandle -> ioe_closedHandle
876 - we flush the old buffer regardless of whether
877 the new buffer could fit the contents of the old buffer
879 - allow a handle's buffering to change even if IO has
880 occurred (ANSI C spec. does not allow this, nor did
881 the previous implementation of IO.hSetBuffering).
882 - a non-standard extension is to allow the buffering
883 of semi-closed handles to change [sof 6/98]
887 let state = initBufferState (haType handle_)
890 -- we always have a 1-character read buffer for
891 -- unbuffered handles: it's needed to
892 -- support hLookAhead.
893 NoBuffering -> allocateBuffer 1 ReadBuffer
894 LineBuffering -> allocateBuffer dEFAULT_BUFFER_SIZE state
895 BlockBuffering Nothing -> allocateBuffer dEFAULT_BUFFER_SIZE state
896 BlockBuffering (Just n) | n <= 0 -> ioe_bufsiz n
897 | otherwise -> allocateBuffer n state
898 writeIORef (haBuffer handle_) new_buf
900 -- for input terminals we need to put the terminal into
901 -- cooked or raw mode depending on the type of buffering.
902 is_tty <- fdIsTTY (haFD handle_)
903 when (is_tty && isReadableHandleType (haType handle_)) $
905 NoBuffering -> setCooked (haFD handle_) False
906 _ -> setCooked (haFD handle_) True
908 -- throw away spare buffers, they might be the wrong size
909 writeIORef (haBuffers handle_) BufferListNil
911 return (handle_{ haBufferMode = mode })
913 -- -----------------------------------------------------------------------------
916 -- The action `hFlush hdl' causes any items buffered for output
917 -- in handle `hdl' to be sent immediately to the operating
920 hFlush :: Handle -> IO ()
922 wantWritableHandle "hFlush" handle $ \ handle_ -> do
923 buf <- readIORef (haBuffer handle_)
924 if bufferIsWritable buf && not (bufferEmpty buf)
925 then do flushed_buf <- flushWriteBuffer (haFD handle_) buf
926 writeIORef (haBuffer handle_) flushed_buf
930 -- -----------------------------------------------------------------------------
931 -- Repositioning Handles
933 data HandlePosn = HandlePosn Handle HandlePosition
935 instance Eq HandlePosn where
936 (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
938 -- HandlePosition is the Haskell equivalent of POSIX' off_t.
939 -- We represent it as an Integer on the Haskell side, but
940 -- cheat slightly in that hGetPosn calls upon a C helper
941 -- that reports the position back via (merely) an Int.
942 type HandlePosition = Integer
944 -- Computation `hGetPosn hdl' returns the current I/O position of
945 -- `hdl' as an abstract position. Computation `hSetPosn p' sets the
946 -- position of `hdl' to a previously obtained position `p'.
948 hGetPosn :: Handle -> IO HandlePosn
950 wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
953 -- urgh, on Windows we have to worry about \n -> \r\n translation,
954 -- so we can't easily calculate the file position using the
955 -- current buffer size. Just flush instead.
958 let fd = fromIntegral (haFD handle_)
959 posn <- fromIntegral `liftM`
960 throwErrnoIfMinus1Retry "hGetPosn"
961 (c_lseek fd 0 (#const SEEK_CUR))
963 let ref = haBuffer handle_
967 | bufferIsWritable buf = posn + fromIntegral (bufWPtr buf)
968 | otherwise = posn - fromIntegral (bufWPtr buf - bufRPtr buf)
970 puts ("\nhGetPosn: (fd, posn, real_posn) = " ++ show (fd, posn, real_posn) ++ "\n")
971 puts (" (bufWPtr, bufRPtr) = " ++ show (bufWPtr buf, bufRPtr buf) ++ "\n")
973 return (HandlePosn handle real_posn)
976 hSetPosn :: HandlePosn -> IO ()
977 hSetPosn (HandlePosn h i) = hSeek h AbsoluteSeek i
979 -- ---------------------------------------------------------------------------
983 The action `hSeek hdl mode i' sets the position of handle
984 `hdl' depending on `mode'. If `mode' is
986 * AbsoluteSeek - The position of `hdl' is set to `i'.
987 * RelativeSeek - The position of `hdl' is set to offset `i' from
988 the current position.
989 * SeekFromEnd - The position of `hdl' is set to offset `i' from
992 Some handles may not be seekable (see `hIsSeekable'), or only
993 support a subset of the possible positioning operations (e.g. it may
994 only be possible to seek to the end of a tape, or to a positive
995 offset from the beginning or current position).
997 It is not possible to set a negative I/O position, or for a physical
998 file, an I/O position beyond the current end-of-file.
1001 - when seeking using `SeekFromEnd', positive offsets (>=0) means
1002 seeking at or past EOF.
1004 - we possibly deviate from the report on the issue of seeking within
1005 the buffer and whether to flush it or not. The report isn't exactly
1009 data SeekMode = AbsoluteSeek | RelativeSeek | SeekFromEnd
1010 deriving (Eq, Ord, Ix, Enum, Read, Show)
1012 hSeek :: Handle -> SeekMode -> Integer -> IO ()
1013 hSeek handle mode offset =
1014 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
1016 puts ("hSeek " ++ show (mode,offset) ++ "\n")
1018 let ref = haBuffer handle_
1019 buf <- readIORef ref
1025 throwErrnoIfMinus1Retry_ "hSeek"
1026 (c_lseek (fromIntegral (haFD handle_)) (fromIntegral offset) whence)
1029 whence = case mode of
1030 AbsoluteSeek -> (#const SEEK_SET)
1031 RelativeSeek -> (#const SEEK_CUR)
1032 SeekFromEnd -> (#const SEEK_END)
1034 if bufferIsWritable buf
1035 then do new_buf <- flushWriteBuffer fd buf
1036 writeIORef ref new_buf
1040 if mode == RelativeSeek && offset >= 0 && offset < fromIntegral (w - r)
1041 then writeIORef ref buf{ bufRPtr = r + fromIntegral offset }
1044 new_buf <- flushReadBuffer (haFD handle_) buf
1045 writeIORef ref new_buf
1048 -- -----------------------------------------------------------------------------
1049 -- Handle Properties
1051 -- A number of operations return information about the properties of a
1052 -- handle. Each of these operations returns `True' if the handle has
1053 -- the specified property, and `False' otherwise.
1055 hIsOpen :: Handle -> IO Bool
1057 withHandle_ "hIsOpen" handle $ \ handle_ -> do
1058 case haType handle_ of
1059 ClosedHandle -> return False
1060 SemiClosedHandle -> return False
1063 hIsClosed :: Handle -> IO Bool
1065 withHandle_ "hIsClosed" handle $ \ handle_ -> do
1066 case haType handle_ of
1067 ClosedHandle -> return True
1070 {- not defined, nor exported, but mentioned
1071 here for documentation purposes:
1073 hSemiClosed :: Handle -> IO Bool
1077 return (not (ho || hc))
1080 hIsReadable :: Handle -> IO Bool
1081 hIsReadable (DuplexHandle _ _) = return True
1082 hIsReadable handle =
1083 withHandle_ "hIsReadable" handle $ \ handle_ -> do
1084 case haType handle_ of
1085 ClosedHandle -> ioe_closedHandle
1086 SemiClosedHandle -> ioe_closedHandle
1087 htype -> return (isReadableHandleType htype)
1089 hIsWritable :: Handle -> IO Bool
1090 hIsWritable (DuplexHandle _ _) = return False
1091 hIsWritable handle =
1092 withHandle_ "hIsWritable" handle $ \ handle_ -> do
1093 case haType handle_ of
1094 ClosedHandle -> ioe_closedHandle
1095 SemiClosedHandle -> ioe_closedHandle
1096 htype -> return (isWritableHandleType htype)
1098 -- Querying how a handle buffers its data:
1100 hGetBuffering :: Handle -> IO BufferMode
1101 hGetBuffering handle =
1102 withHandle_ "hGetBuffering" handle $ \ handle_ -> do
1103 case haType handle_ of
1104 ClosedHandle -> ioe_closedHandle
1106 -- We're being non-standard here, and allow the buffering
1107 -- of a semi-closed handle to be queried. -- sof 6/98
1108 return (haBufferMode handle_) -- could be stricter..
1110 hIsSeekable :: Handle -> IO Bool
1111 hIsSeekable handle =
1112 withHandle_ "hIsSeekable" handle $ \ handle_ -> do
1113 case haType handle_ of
1114 ClosedHandle -> ioe_closedHandle
1115 SemiClosedHandle -> ioe_closedHandle
1116 AppendHandle -> return False
1117 _ -> do t <- fdType (haFD handle_)
1118 return (t == RegularFile && haIsBin handle_)
1120 -- -----------------------------------------------------------------------------
1121 -- Changing echo status
1123 -- Non-standard GHC extension is to allow the echoing status
1124 -- of a handles connected to terminals to be reconfigured:
1126 hSetEcho :: Handle -> Bool -> IO ()
1127 hSetEcho handle on = do
1128 isT <- hIsTerminalDevice handle
1132 withHandle_ "hSetEcho" handle $ \ handle_ -> do
1133 case haType handle_ of
1134 ClosedHandle -> ioe_closedHandle
1135 _ -> setEcho (haFD handle_) on
1137 hGetEcho :: Handle -> IO Bool
1138 hGetEcho handle = do
1139 isT <- hIsTerminalDevice handle
1143 withHandle_ "hGetEcho" handle $ \ handle_ -> do
1144 case haType handle_ of
1145 ClosedHandle -> ioe_closedHandle
1146 _ -> getEcho (haFD handle_)
1148 hIsTerminalDevice :: Handle -> IO Bool
1149 hIsTerminalDevice handle = do
1150 withHandle_ "hIsTerminalDevice" handle $ \ handle_ -> do
1151 case haType handle_ of
1152 ClosedHandle -> ioe_closedHandle
1153 _ -> fdIsTTY (haFD handle_)
1155 -- -----------------------------------------------------------------------------
1159 hSetBinaryMode handle bin =
1160 withAllHandles__ "hSetBinaryMode" handle $ \ handle_ ->
1161 do let flg | bin = (#const O_BINARY)
1162 | otherwise = (#const O_TEXT)
1163 throwErrnoIfMinus1_ "hSetBinaryMode"
1164 (setmode (fromIntegral (haFD handle_)) flg)
1165 return handle_{haIsBin=bin}
1167 foreign import "setmode" setmode :: CInt -> CInt -> IO CInt
1169 hSetBinaryMode handle bin =
1170 withAllHandles__ "hSetBinaryMode" handle $ \ handle_ ->
1171 return handle_{haIsBin=bin}
1174 -- -----------------------------------------------------------------------------
1177 -- These three functions are meant to get things out of an IOError.
1179 ioeGetFileName :: IOError -> Maybe FilePath
1180 ioeGetErrorString :: IOError -> String
1181 ioeGetHandle :: IOError -> Maybe Handle
1183 ioeGetHandle (IOException (IOError h _ _ _ _)) = h
1184 ioeGetHandle (UserError _) = Nothing
1185 ioeGetHandle _ = error "IO.ioeGetHandle: not an IO error"
1187 ioeGetErrorString (IOException (IOError _ iot _ _ _)) = show iot
1188 ioeGetErrorString (UserError str) = str
1189 ioeGetErrorString _ = error "IO.ioeGetErrorString: not an IO error"
1191 ioeGetFileName (IOException (IOError _ _ _ _ fn)) = fn
1192 ioeGetFileName (UserError _) = Nothing
1193 ioeGetFileName _ = error "IO.ioeGetFileName: not an IO error"
1195 -- ---------------------------------------------------------------------------
1199 puts :: String -> IO ()
1200 puts s = withCString s $ \cstr -> do c_write 1 cstr (fromIntegral (length s))