1 {-# OPTIONS -fno-implicit-prelude #-}
6 -- -----------------------------------------------------------------------------
7 -- $Id: Handle.hsc,v 1.6 2001/09/14 11:25:24 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
431 fillReadBuffer :: FD -> Bool -> Buffer -> IO Buffer
432 fillReadBuffer fd is_line
433 buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w, bufSize=size } =
434 -- buffer better be empty:
435 assert (r == 0 && w == 0) $ do
436 fillReadBufferLoop fd is_line buf b w size
438 -- For a line buffer, we just get the first chunk of data to arrive,
439 -- and don't wait for the whole buffer to be full (but we *do* wait
440 -- until some data arrives). This isn't really line buffering, but it
441 -- appears to be what GHC has done for a long time, and I suspect it
442 -- is more useful than line buffering in most cases.
444 fillReadBufferLoop fd is_line buf b w size = do
446 if bytes == 0 -- buffer full?
447 then return buf{ bufRPtr=0, bufWPtr=w }
450 puts ("fillReadBufferLoop: bytes = " ++ show bytes ++ "\n")
452 res <- throwErrnoIfMinus1RetryMayBlock "fillReadBuffer"
453 (read_off fd b (fromIntegral w) (fromIntegral bytes))
455 let res' = fromIntegral res
457 puts ("fillReadBufferLoop: res' = " ++ show res' ++ "\n")
462 else return buf{ bufRPtr=0, bufWPtr=w }
463 else if res' < bytes && not is_line
464 then fillReadBufferLoop fd is_line buf b (w+res') size
465 else return buf{ bufRPtr=0, bufWPtr=w+res' }
467 foreign import "read_wrap" unsafe
468 read_off :: FD -> RawBuffer -> Int -> CInt -> IO CInt
470 -- ---------------------------------------------------------------------------
473 -- Three handles are allocated during program initialisation. The first
474 -- two manage input or output from the Haskell program's standard input
475 -- or output channel respectively. The third manages output to the
476 -- standard error channel. These handles are initially open.
483 stdin = unsafePerformIO $ do
484 -- ToDo: acquire lock
485 setNonBlockingFD fd_stdin
486 (buf, bmode) <- getBuffer fd_stdin ReadBuffer
487 spares <- newIORef BufferListNil
488 newFileHandle stdHandleFinalizer
489 (Handle__ { haFD = fd_stdin,
491 haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
492 haBufferMode = bmode,
493 haFilePath = "<stdin>",
499 stdout = unsafePerformIO $ do
500 -- ToDo: acquire lock
501 -- We don't set non-blocking mode on stdout or sterr, because
502 -- some shells don't recover properly.
503 -- setNonBlockingFD fd_stdout
504 (buf, bmode) <- getBuffer fd_stdout WriteBuffer
505 spares <- newIORef BufferListNil
506 newFileHandle stdHandleFinalizer
507 (Handle__ { haFD = fd_stdout,
508 haType = WriteHandle,
509 haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
510 haBufferMode = bmode,
511 haFilePath = "<stdout>",
517 stderr = unsafePerformIO $ do
518 -- ToDo: acquire lock
519 -- We don't set non-blocking mode on stdout or sterr, because
520 -- some shells don't recover properly.
521 -- setNonBlockingFD fd_stderr
523 spares <- newIORef BufferListNil
524 newFileHandle stdHandleFinalizer
525 (Handle__ { haFD = fd_stderr,
526 haType = WriteHandle,
527 haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
528 haBufferMode = NoBuffering,
529 haFilePath = "<stderr>",
534 -- ---------------------------------------------------------------------------
535 -- Opening and Closing Files
538 Computation `openFile file mode' allocates and returns a new, open
539 handle to manage the file `file'. It manages input if `mode'
540 is `ReadMode', output if `mode' is `WriteMode' or `AppendMode',
541 and both input and output if mode is `ReadWriteMode'.
543 If the file does not exist and it is opened for output, it should be
544 created as a new file. If `mode' is `WriteMode' and the file
545 already exists, then it should be truncated to zero length. The
546 handle is positioned at the end of the file if `mode' is
547 `AppendMode', and otherwise at the beginning (in which case its
548 internal position is 0).
550 Implementations should enforce, locally to the Haskell process,
551 multiple-reader single-writer locking on files, which is to say that
552 there may either be many handles on the same file which manage input,
553 or just one handle on the file which manages output. If any open or
554 semi-closed handle is managing a file for output, no new handle can be
555 allocated for that file. If any open or semi-closed handle is
556 managing a file for input, new handles can only be allocated if they
557 do not manage output.
559 Two files are the same if they have the same absolute name. An
560 implementation is free to impose stricter conditions.
563 data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode
564 deriving (Eq, Ord, Ix, Enum, Read, Show)
569 deriving (Eq, Read, Show)
571 addFilePathToIOError fun fp (IOException (IOError h iot _ str _))
572 = IOException (IOError h iot fun str (Just fp))
573 addFilePathToIOError _ _ other_exception
576 openFile :: FilePath -> IOMode -> IO Handle
579 (openFile' fp (if dEFAULT_OPEN_IN_BINARY_MODE
582 (\e -> throw (addFilePathToIOError "openFile" fp e))
584 openFileEx :: FilePath -> IOModeEx -> IO Handle
588 (\e -> throw (addFilePathToIOError "openFileEx" fp e))
591 openFile' filepath ex_mode =
592 withCString filepath $ \ f ->
597 BinaryMode bmo -> (bmo, True)
598 TextMode tmo -> (tmo, False)
600 oflags1 = case mode of
601 ReadMode -> read_flags
602 WriteMode -> write_flags
603 ReadWriteMode -> rw_flags
604 AppendMode -> append_flags
606 truncate | WriteMode <- mode = True
615 oflags = oflags1 .|. binary_flags
618 -- the old implementation had a complicated series of three opens,
619 -- which is perhaps because we have to be careful not to open
620 -- directories. However, the man pages I've read say that open()
621 -- always returns EISDIR if the file is a directory and was opened
622 -- for writing, so I think we're ok with a single open() here...
623 fd <- fromIntegral `liftM`
624 throwErrnoIfMinus1Retry "openFile"
625 (c_open f (fromIntegral oflags) 0o666)
627 openFd fd filepath mode binary truncate
628 -- ASSERT: if we just created the file, then openFd won't fail
629 -- (so we don't need to worry about removing the newly created file
630 -- in the event of an error).
633 std_flags = o_NONBLOCK .|. o_NOCTTY
634 output_flags = std_flags .|. o_CREAT
635 read_flags = std_flags .|. o_RDONLY
636 write_flags = output_flags .|. o_WRONLY
637 rw_flags = output_flags .|. o_RDWR
638 append_flags = write_flags .|. o_APPEND
640 -- ---------------------------------------------------------------------------
643 openFd :: FD -> FilePath -> IOMode -> Bool -> Bool -> IO Handle
644 openFd fd filepath mode binary truncate = do
645 -- turn on non-blocking mode
648 let (ha_type, write) =
650 ReadMode -> ( ReadHandle, False )
651 WriteMode -> ( WriteHandle, True )
652 ReadWriteMode -> ( ReadWriteHandle, True )
653 AppendMode -> ( AppendHandle, True )
655 -- open() won't tell us if it was a directory if we only opened for
656 -- reading, so check again.
660 ioException (IOError Nothing InappropriateType "openFile"
661 "is a directory" Nothing)
664 | ReadWriteHandle <- ha_type -> mkDuplexHandle fd filepath binary
665 | otherwise -> mkFileHandle fd filepath ha_type binary
667 -- regular files need to be locked
669 r <- lockFile (fromIntegral fd) (fromBool write) 1{-exclusive-}
671 ioException (IOError Nothing ResourceBusy "openFile"
672 "file is locked" Nothing)
674 -- truncate the file if necessary
675 when truncate (fileTruncate filepath)
677 mkFileHandle fd filepath ha_type binary
680 foreign import "lockFile" unsafe
681 lockFile :: CInt -> CInt -> CInt -> IO CInt
683 foreign import "unlockFile" unsafe
684 unlockFile :: CInt -> IO CInt
686 mkFileHandle :: FD -> FilePath -> HandleType -> Bool -> IO Handle
687 mkFileHandle fd filepath ha_type binary = do
688 (buf, bmode) <- getBuffer fd (initBufferState ha_type)
689 spares <- newIORef BufferListNil
690 newFileHandle handleFinalizer
691 (Handle__ { haFD = fd,
694 haBufferMode = bmode,
695 haFilePath = filepath,
700 mkDuplexHandle :: FD -> FilePath -> Bool -> IO Handle
701 mkDuplexHandle fd filepath binary = do
702 (w_buf, w_bmode) <- getBuffer fd WriteBuffer
703 w_spares <- newIORef BufferListNil
705 Handle__ { haFD = fd,
706 haType = WriteHandle,
708 haBufferMode = w_bmode,
709 haFilePath = filepath,
713 write_side <- newMVar w_handle_
715 (r_buf, r_bmode) <- getBuffer fd ReadBuffer
716 r_spares <- newIORef BufferListNil
718 Handle__ { haFD = fd,
719 haType = ReadSideHandle write_side,
721 haBufferMode = r_bmode,
722 haFilePath = filepath,
726 read_side <- newMVar r_handle_
728 addMVarFinalizer write_side (handleFinalizer write_side)
729 return (DuplexHandle read_side write_side)
732 initBufferState ReadHandle = ReadBuffer
733 initBufferState _ = WriteBuffer
735 -- ---------------------------------------------------------------------------
738 -- Computation `hClose hdl' makes handle `hdl' closed. Before the
739 -- computation finishes, any items buffered for output and not already
740 -- sent to the operating system are flushed as for `hFlush'.
742 -- For a duplex handle, we close&flush the write side, and just close
745 hClose :: Handle -> IO ()
746 hClose h@(FileHandle m) = hClose' h m
747 hClose h@(DuplexHandle r w) = do
749 withHandle__' "hClose" h r $ \ handle_ -> do
750 return handle_{ haFD = -1,
751 haType = ClosedHandle
754 hClose' h m = withHandle__' "hClose" h m $ hClose_help
756 hClose_help handle_ =
757 case haType handle_ of
758 ClosedHandle -> return handle_
760 let fd = fromIntegral (haFD handle_)
761 flushWriteBufferOnly handle_
762 throwErrnoIfMinus1Retry_ "hClose" (c_close fd)
764 -- free the spare buffers
765 writeIORef (haBuffers handle_) BufferListNil
770 -- we must set the fd to -1, because the finalizer is going
771 -- to run eventually and try to close/unlock it.
772 return (handle_{ haFD = -1,
773 haType = ClosedHandle
776 -----------------------------------------------------------------------------
777 -- Detecting the size of a file
779 -- For a handle `hdl' which attached to a physical file, `hFileSize
780 -- hdl' returns the size of `hdl' in terms of the number of items
781 -- which can be read from `hdl'.
783 hFileSize :: Handle -> IO Integer
785 withHandle_ "hFileSize" handle $ \ handle_ -> do
786 case haType handle_ of
787 ClosedHandle -> ioe_closedHandle
788 SemiClosedHandle -> ioe_closedHandle
789 _ -> do flushWriteBufferOnly handle_
790 r <- fdFileSize (haFD handle_)
793 else ioException (IOError Nothing InappropriateType "hFileSize"
794 "not a regular file" Nothing)
796 -- ---------------------------------------------------------------------------
797 -- Detecting the End of Input
799 -- For a readable handle `hdl', `hIsEOF hdl' returns
800 -- `True' if no further input can be taken from `hdl' or for a
801 -- physical file, if the current I/O position is equal to the length of
802 -- the file. Otherwise, it returns `False'.
804 hIsEOF :: Handle -> IO Bool
807 (do hLookAhead handle; return False)
808 (\e -> if isEOFError e then return True else throw e)
813 -- ---------------------------------------------------------------------------
816 -- hLookahead returns the next character from the handle without
817 -- removing it from the input buffer, blocking until a character is
820 hLookAhead :: Handle -> IO Char
821 hLookAhead handle = do
822 wantReadableHandle "hLookAhead" handle $ \handle_ -> do
823 let ref = haBuffer handle_
825 is_line = haBufferMode handle_ == LineBuffering
828 -- fill up the read buffer if necessary
829 new_buf <- if bufferEmpty buf
830 then fillReadBuffer fd is_line buf
833 writeIORef ref new_buf
835 (c,_) <- readCharFromBuffer (bufBuf buf) (bufRPtr buf)
838 -- ---------------------------------------------------------------------------
839 -- Buffering Operations
841 -- Three kinds of buffering are supported: line-buffering,
842 -- block-buffering or no-buffering. See GHC.IOBase for definition and
843 -- further explanation of what the type represent.
845 -- Computation `hSetBuffering hdl mode' sets the mode of buffering for
846 -- handle hdl on subsequent reads and writes.
848 -- * If mode is LineBuffering, line-buffering should be enabled if possible.
850 -- * If mode is `BlockBuffering size', then block-buffering
851 -- should be enabled if possible. The size of the buffer is n items
852 -- if size is `Just n' and is otherwise implementation-dependent.
854 -- * If mode is NoBuffering, then buffering is disabled if possible.
856 -- If the buffer mode is changed from BlockBuffering or
857 -- LineBuffering to NoBuffering, then any items in the output
858 -- buffer are written to the device, and any items in the input buffer
859 -- are discarded. The default buffering mode when a handle is opened
860 -- is implementation-dependent and may depend on the object which is
861 -- attached to that handle.
863 hSetBuffering :: Handle -> BufferMode -> IO ()
864 hSetBuffering handle mode =
865 withAllHandles__ "hSetBuffering" handle $ \ handle_ -> do
866 case haType handle_ of
867 ClosedHandle -> ioe_closedHandle
870 - we flush the old buffer regardless of whether
871 the new buffer could fit the contents of the old buffer
873 - allow a handle's buffering to change even if IO has
874 occurred (ANSI C spec. does not allow this, nor did
875 the previous implementation of IO.hSetBuffering).
876 - a non-standard extension is to allow the buffering
877 of semi-closed handles to change [sof 6/98]
881 let state = initBufferState (haType handle_)
884 -- we always have a 1-character read buffer for
885 -- unbuffered handles: it's needed to
886 -- support hLookAhead.
887 NoBuffering -> allocateBuffer 1 ReadBuffer
888 LineBuffering -> allocateBuffer dEFAULT_BUFFER_SIZE state
889 BlockBuffering Nothing -> allocateBuffer dEFAULT_BUFFER_SIZE state
890 BlockBuffering (Just n) | n <= 0 -> ioe_bufsiz n
891 | otherwise -> allocateBuffer n state
892 writeIORef (haBuffer handle_) new_buf
894 -- for input terminals we need to put the terminal into
895 -- cooked or raw mode depending on the type of buffering.
896 is_tty <- fdIsTTY (haFD handle_)
897 when (is_tty && isReadableHandleType (haType handle_)) $
899 NoBuffering -> setCooked (haFD handle_) False
900 _ -> setCooked (haFD handle_) True
902 -- throw away spare buffers, they might be the wrong size
903 writeIORef (haBuffers handle_) BufferListNil
905 return (handle_{ haBufferMode = mode })
907 -- -----------------------------------------------------------------------------
910 -- The action `hFlush hdl' causes any items buffered for output
911 -- in handle `hdl' to be sent immediately to the operating
914 hFlush :: Handle -> IO ()
916 wantWritableHandle "hFlush" handle $ \ handle_ -> do
917 buf <- readIORef (haBuffer handle_)
918 if bufferIsWritable buf && not (bufferEmpty buf)
919 then do flushed_buf <- flushWriteBuffer (haFD handle_) buf
920 writeIORef (haBuffer handle_) flushed_buf
924 -- -----------------------------------------------------------------------------
925 -- Repositioning Handles
927 data HandlePosn = HandlePosn Handle HandlePosition
929 instance Eq HandlePosn where
930 (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
932 -- HandlePosition is the Haskell equivalent of POSIX' off_t.
933 -- We represent it as an Integer on the Haskell side, but
934 -- cheat slightly in that hGetPosn calls upon a C helper
935 -- that reports the position back via (merely) an Int.
936 type HandlePosition = Integer
938 -- Computation `hGetPosn hdl' returns the current I/O position of
939 -- `hdl' as an abstract position. Computation `hSetPosn p' sets the
940 -- position of `hdl' to a previously obtained position `p'.
942 hGetPosn :: Handle -> IO HandlePosn
944 wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
947 -- urgh, on Windows we have to worry about \n -> \r\n translation,
948 -- so we can't easily calculate the file position using the
949 -- current buffer size. Just flush instead.
952 let fd = fromIntegral (haFD handle_)
953 posn <- fromIntegral `liftM`
954 throwErrnoIfMinus1Retry "hGetPosn"
955 (c_lseek fd 0 (#const SEEK_CUR))
957 let ref = haBuffer handle_
961 | bufferIsWritable buf = posn + fromIntegral (bufWPtr buf)
962 | otherwise = posn - fromIntegral (bufWPtr buf - bufRPtr buf)
964 puts ("\nhGetPosn: (fd, posn, real_posn) = " ++ show (fd, posn, real_posn) ++ "\n")
965 puts (" (bufWPtr, bufRPtr) = " ++ show (bufWPtr buf, bufRPtr buf) ++ "\n")
967 return (HandlePosn handle real_posn)
970 hSetPosn :: HandlePosn -> IO ()
971 hSetPosn (HandlePosn h i) = hSeek h AbsoluteSeek i
973 -- ---------------------------------------------------------------------------
977 The action `hSeek hdl mode i' sets the position of handle
978 `hdl' depending on `mode'. If `mode' is
980 * AbsoluteSeek - The position of `hdl' is set to `i'.
981 * RelativeSeek - The position of `hdl' is set to offset `i' from
982 the current position.
983 * SeekFromEnd - The position of `hdl' is set to offset `i' from
986 Some handles may not be seekable (see `hIsSeekable'), or only
987 support a subset of the possible positioning operations (e.g. it may
988 only be possible to seek to the end of a tape, or to a positive
989 offset from the beginning or current position).
991 It is not possible to set a negative I/O position, or for a physical
992 file, an I/O position beyond the current end-of-file.
995 - when seeking using `SeekFromEnd', positive offsets (>=0) means
996 seeking at or past EOF.
998 - we possibly deviate from the report on the issue of seeking within
999 the buffer and whether to flush it or not. The report isn't exactly
1003 data SeekMode = AbsoluteSeek | RelativeSeek | SeekFromEnd
1004 deriving (Eq, Ord, Ix, Enum, Read, Show)
1006 hSeek :: Handle -> SeekMode -> Integer -> IO ()
1007 hSeek handle mode offset =
1008 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
1010 puts ("hSeek " ++ show (mode,offset) ++ "\n")
1012 let ref = haBuffer handle_
1013 buf <- readIORef ref
1019 throwErrnoIfMinus1Retry_ "hSeek"
1020 (c_lseek (fromIntegral (haFD handle_)) (fromIntegral offset) whence)
1023 whence = case mode of
1024 AbsoluteSeek -> (#const SEEK_SET)
1025 RelativeSeek -> (#const SEEK_CUR)
1026 SeekFromEnd -> (#const SEEK_END)
1028 if bufferIsWritable buf
1029 then do new_buf <- flushWriteBuffer fd buf
1030 writeIORef ref new_buf
1034 if mode == RelativeSeek && offset >= 0 && offset < fromIntegral (w - r)
1035 then writeIORef ref buf{ bufRPtr = r + fromIntegral offset }
1038 new_buf <- flushReadBuffer (haFD handle_) buf
1039 writeIORef ref new_buf
1042 -- -----------------------------------------------------------------------------
1043 -- Handle Properties
1045 -- A number of operations return information about the properties of a
1046 -- handle. Each of these operations returns `True' if the handle has
1047 -- the specified property, and `False' otherwise.
1049 hIsOpen :: Handle -> IO Bool
1051 withHandle_ "hIsOpen" handle $ \ handle_ -> do
1052 case haType handle_ of
1053 ClosedHandle -> return False
1054 SemiClosedHandle -> return False
1057 hIsClosed :: Handle -> IO Bool
1059 withHandle_ "hIsClosed" handle $ \ handle_ -> do
1060 case haType handle_ of
1061 ClosedHandle -> return True
1064 {- not defined, nor exported, but mentioned
1065 here for documentation purposes:
1067 hSemiClosed :: Handle -> IO Bool
1071 return (not (ho || hc))
1074 hIsReadable :: Handle -> IO Bool
1075 hIsReadable (DuplexHandle _ _) = return True
1076 hIsReadable handle =
1077 withHandle_ "hIsReadable" handle $ \ handle_ -> do
1078 case haType handle_ of
1079 ClosedHandle -> ioe_closedHandle
1080 SemiClosedHandle -> ioe_closedHandle
1081 htype -> return (isReadableHandleType htype)
1083 hIsWritable :: Handle -> IO Bool
1084 hIsWritable (DuplexHandle _ _) = return False
1085 hIsWritable handle =
1086 withHandle_ "hIsWritable" handle $ \ handle_ -> do
1087 case haType handle_ of
1088 ClosedHandle -> ioe_closedHandle
1089 SemiClosedHandle -> ioe_closedHandle
1090 htype -> return (isWritableHandleType htype)
1092 -- Querying how a handle buffers its data:
1094 hGetBuffering :: Handle -> IO BufferMode
1095 hGetBuffering handle =
1096 withHandle_ "hGetBuffering" handle $ \ handle_ -> do
1097 case haType handle_ of
1098 ClosedHandle -> ioe_closedHandle
1100 -- We're being non-standard here, and allow the buffering
1101 -- of a semi-closed handle to be queried. -- sof 6/98
1102 return (haBufferMode handle_) -- could be stricter..
1104 hIsSeekable :: Handle -> IO Bool
1105 hIsSeekable handle =
1106 withHandle_ "hIsSeekable" handle $ \ handle_ -> do
1107 case haType handle_ of
1108 ClosedHandle -> ioe_closedHandle
1109 SemiClosedHandle -> ioe_closedHandle
1110 AppendHandle -> return False
1111 _ -> do t <- fdType (haFD handle_)
1112 return (t == RegularFile && haIsBin handle_)
1114 -- -----------------------------------------------------------------------------
1115 -- Changing echo status
1117 -- Non-standard GHC extension is to allow the echoing status
1118 -- of a handles connected to terminals to be reconfigured:
1120 hSetEcho :: Handle -> Bool -> IO ()
1121 hSetEcho handle on = do
1122 isT <- hIsTerminalDevice handle
1126 withHandle_ "hSetEcho" handle $ \ handle_ -> do
1127 case haType handle_ of
1128 ClosedHandle -> ioe_closedHandle
1129 _ -> setEcho (haFD handle_) on
1131 hGetEcho :: Handle -> IO Bool
1132 hGetEcho handle = do
1133 isT <- hIsTerminalDevice handle
1137 withHandle_ "hGetEcho" handle $ \ handle_ -> do
1138 case haType handle_ of
1139 ClosedHandle -> ioe_closedHandle
1140 _ -> getEcho (haFD handle_)
1142 hIsTerminalDevice :: Handle -> IO Bool
1143 hIsTerminalDevice handle = do
1144 withHandle_ "hIsTerminalDevice" handle $ \ handle_ -> do
1145 case haType handle_ of
1146 ClosedHandle -> ioe_closedHandle
1147 _ -> fdIsTTY (haFD handle_)
1149 -- -----------------------------------------------------------------------------
1153 hSetBinaryMode handle bin =
1154 withAllHandles__ "hSetBinaryMode" handle $ \ handle_ ->
1155 do let flg | bin = (#const O_BINARY)
1156 | otherwise = (#const O_TEXT)
1157 throwErrnoIfMinus1_ "hSetBinaryMode"
1158 (setmode (fromIntegral (haFD handle_)) flg)
1159 return handle_{haIsBin=bin}
1161 foreign import "setmode" setmode :: CInt -> CInt -> IO CInt
1163 hSetBinaryMode handle bin =
1164 withAllHandles__ "hSetBinaryMode" handle $ \ handle_ ->
1165 return handle_{haIsBin=bin}
1168 -- -----------------------------------------------------------------------------
1171 -- These three functions are meant to get things out of an IOError.
1173 ioeGetFileName :: IOError -> Maybe FilePath
1174 ioeGetErrorString :: IOError -> String
1175 ioeGetHandle :: IOError -> Maybe Handle
1177 ioeGetHandle (IOException (IOError h _ _ _ _)) = h
1178 ioeGetHandle (UserError _) = Nothing
1179 ioeGetHandle _ = error "IO.ioeGetHandle: not an IO error"
1181 ioeGetErrorString (IOException (IOError _ iot _ _ _)) = show iot
1182 ioeGetErrorString (UserError str) = str
1183 ioeGetErrorString _ = error "IO.ioeGetErrorString: not an IO error"
1185 ioeGetFileName (IOException (IOError _ _ _ _ fn)) = fn
1186 ioeGetFileName (UserError _) = Nothing
1187 ioeGetFileName _ = error "IO.ioeGetFileName: not an IO error"
1189 -- ---------------------------------------------------------------------------
1193 puts :: String -> IO ()
1194 puts s = withCString s $ \cstr -> do c_write 1 cstr (fromIntegral (length s))