1 {-# OPTIONS -fno-implicit-prelude -#include "HsCore.h" #-}
6 -- -----------------------------------------------------------------------------
7 -- $Id: Handle.hs,v 1.3 2002/02/05 17:32:26 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,
19 read_off, read_off_ba,
20 write_off, write_off_ba,
22 ioe_closedHandle, ioe_EOF, ioe_notReadable, ioe_notWritable,
24 stdin, stdout, stderr,
25 IOMode(..), IOModeEx(..), openFile, openFileEx, openFd,
26 hFileSize, hIsEOF, isEOF, hLookAhead, hSetBuffering, hSetBinaryMode,
31 HandlePosn(..), hGetPosn, hSetPosn,
34 hIsOpen, hIsClosed, hIsReadable, hIsWritable, hGetBuffering, hIsSeekable,
35 hSetEcho, hGetEcho, hIsTerminalDevice,
48 import System.IO.Error
55 import GHC.Read ( Read )
60 import GHC.Num ( Integer(..), Num(..) )
62 import GHC.Real ( toInteger )
66 -- -----------------------------------------------------------------------------
69 -- hWaitForInput blocks (should use a timeout)
71 -- unbuffered hGetLine is a bit dodgy
73 -- hSetBuffering: can't change buffering on a stream,
74 -- when the read buffer is non-empty? (no way to flush the buffer)
76 -- ---------------------------------------------------------------------------
77 -- Are files opened by default in text or binary mode, if the user doesn't
80 dEFAULT_OPEN_IN_BINARY_MODE = False :: Bool
82 -- ---------------------------------------------------------------------------
83 -- Creating a new handle
85 newFileHandle :: (MVar Handle__ -> IO ()) -> Handle__ -> IO Handle
86 newFileHandle finalizer hc = do
88 addMVarFinalizer m (finalizer m)
91 -- ---------------------------------------------------------------------------
92 -- Working with Handles
95 In the concurrent world, handles are locked during use. This is done
96 by wrapping an MVar around the handle which acts as a mutex over
97 operations on the handle.
99 To avoid races, we use the following bracketing operations. The idea
100 is to obtain the lock, do some operation and replace the lock again,
101 whether the operation succeeded or failed. We also want to handle the
102 case where the thread receives an exception while processing the IO
103 operation: in these cases we also want to relinquish the lock.
105 There are three versions of @withHandle@: corresponding to the three
106 possible combinations of:
108 - the operation may side-effect the handle
109 - the operation may return a result
111 If the operation generates an error or an exception is raised, the
112 original handle is always replaced [ this is the case at the moment,
113 but we might want to revisit this in the future --SDM ].
116 {-# INLINE withHandle #-}
117 withHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
118 withHandle fun h@(FileHandle m) act = withHandle' fun h m act
119 withHandle fun h@(DuplexHandle m _) act = withHandle' fun h m act
121 withHandle' fun h m act =
124 checkBufferInvariants h_
125 (h',v) <- catchException (act h_)
126 (\ ex -> putMVar m h_ >> throw (augmentIOError ex fun h h_))
127 checkBufferInvariants h'
131 {-# INLINE withHandle_ #-}
132 withHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a
133 withHandle_ fun h@(FileHandle m) act = withHandle_' fun h m act
134 withHandle_ fun h@(DuplexHandle m _) act = withHandle_' fun h m act
136 withHandle_' fun h m act =
139 checkBufferInvariants h_
140 v <- catchException (act h_)
141 (\ ex -> putMVar m h_ >> throw (augmentIOError ex fun h h_))
142 checkBufferInvariants h_
146 withAllHandles__ :: String -> Handle -> (Handle__ -> IO Handle__) -> IO ()
147 withAllHandles__ fun h@(FileHandle m) act = withHandle__' fun h m act
148 withAllHandles__ fun h@(DuplexHandle r w) act = do
149 withHandle__' fun h r act
150 withHandle__' fun h w act
152 withHandle__' fun h m act =
155 checkBufferInvariants h_
156 h' <- catchException (act h_)
157 (\ ex -> putMVar m h_ >> throw (augmentIOError ex fun h h_))
158 checkBufferInvariants h'
162 augmentIOError (IOException (IOError _ iot _ str fp)) fun h h_
163 = IOException (IOError (Just h) iot fun str filepath)
164 where filepath | Just _ <- fp = fp
165 | otherwise = Just (haFilePath h_)
166 augmentIOError other_exception _ _ _
169 -- ---------------------------------------------------------------------------
170 -- Wrapper for write operations.
172 wantWritableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
173 wantWritableHandle fun h@(FileHandle m) act
174 = wantWritableHandle' fun h m act
175 wantWritableHandle fun h@(DuplexHandle _ m) act
176 = wantWritableHandle' fun h m act
177 -- ToDo: in the Duplex case, we don't need to checkWritableHandle
180 :: String -> Handle -> MVar Handle__
181 -> (Handle__ -> IO a) -> IO a
182 wantWritableHandle' fun h m act
183 = withHandle_' fun h m (checkWritableHandle act)
185 checkWritableHandle act handle_
186 = case haType handle_ of
187 ClosedHandle -> ioe_closedHandle
188 SemiClosedHandle -> ioe_closedHandle
189 ReadHandle -> ioe_notWritable
190 ReadWriteHandle -> do
191 let ref = haBuffer handle_
194 if not (bufferIsWritable buf)
195 then do b <- flushReadBuffer (haFD handle_) buf
196 return b{ bufState=WriteBuffer }
198 writeIORef ref new_buf
200 _other -> act handle_
202 -- ---------------------------------------------------------------------------
203 -- Wrapper for read operations.
205 wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
206 wantReadableHandle fun h@(FileHandle m) act
207 = wantReadableHandle' fun h m act
208 wantReadableHandle fun h@(DuplexHandle m _) act
209 = wantReadableHandle' fun h m act
210 -- ToDo: in the Duplex case, we don't need to checkReadableHandle
213 :: String -> Handle -> MVar Handle__
214 -> (Handle__ -> IO a) -> IO a
215 wantReadableHandle' fun h m act
216 = withHandle_' fun h m (checkReadableHandle act)
218 checkReadableHandle act handle_ =
219 case haType handle_ of
220 ClosedHandle -> ioe_closedHandle
221 SemiClosedHandle -> ioe_closedHandle
222 AppendHandle -> ioe_notReadable
223 WriteHandle -> ioe_notReadable
224 ReadWriteHandle -> do
225 let ref = haBuffer handle_
227 when (bufferIsWritable buf) $ do
228 new_buf <- flushWriteBuffer (haFD handle_) (haIsStream handle_) buf
229 writeIORef ref new_buf{ bufState=ReadBuffer }
231 _other -> act handle_
233 -- ---------------------------------------------------------------------------
234 -- Wrapper for seek operations.
236 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
237 wantSeekableHandle fun h@(DuplexHandle _ _) _act =
238 ioException (IOError (Just h) IllegalOperation fun
239 "handle is not seekable" Nothing)
240 wantSeekableHandle fun h@(FileHandle m) act =
241 withHandle_' fun h m (checkSeekableHandle act)
243 checkSeekableHandle act handle_ =
244 case haType handle_ of
245 ClosedHandle -> ioe_closedHandle
246 SemiClosedHandle -> ioe_closedHandle
247 AppendHandle -> ioe_notSeekable
248 _ | haIsBin handle_ || tEXT_MODE_SEEK_ALLOWED -> act handle_
249 | otherwise -> ioe_notSeekable_notBin
251 -- -----------------------------------------------------------------------------
254 ioe_closedHandle, ioe_EOF,
255 ioe_notReadable, ioe_notWritable,
256 ioe_notSeekable, ioe_notSeekable_notBin :: IO a
258 ioe_closedHandle = ioException
259 (IOError Nothing IllegalOperation ""
260 "handle is closed" Nothing)
261 ioe_EOF = ioException
262 (IOError Nothing EOF "" "" Nothing)
263 ioe_notReadable = ioException
264 (IOError Nothing IllegalOperation ""
265 "handle is not open for reading" Nothing)
266 ioe_notWritable = ioException
267 (IOError Nothing IllegalOperation ""
268 "handle is not open for writing" Nothing)
269 ioe_notSeekable = ioException
270 (IOError Nothing IllegalOperation ""
271 "handle is not seekable" Nothing)
272 ioe_notSeekable_notBin = ioException
273 (IOError Nothing IllegalOperation ""
274 "seek operations on text-mode handles are not allowed on this platform"
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 haOtherSide field of the read side point to the read side.
289 -- The finalizer is then placed on the write side, and the handle only gets
290 -- finalized once, when both sides are no longer required.
292 stdHandleFinalizer :: MVar Handle__ -> IO ()
293 stdHandleFinalizer m = do
295 flushWriteBufferOnly h_
297 handleFinalizer :: MVar Handle__ -> IO ()
298 handleFinalizer m = do
300 flushWriteBufferOnly h_
301 let fd = fromIntegral (haFD h_)
304 #ifdef mingw32_TARGET_OS
305 (closeFd (haIsStream h_) fd >> return ())
307 (c_close fd >> return ())
311 -- ---------------------------------------------------------------------------
312 -- Grimy buffer operations
315 checkBufferInvariants h_ = do
316 let ref = haBuffer h_
317 Buffer{ bufWPtr=w, bufRPtr=r, bufSize=size, bufState=state } <- readIORef ref
322 && ( r /= w || (r == 0 && w == 0) )
323 && ( state /= WriteBuffer || r == 0 )
324 && ( state /= WriteBuffer || w < size ) -- write buffer is never full
326 then error "buffer invariant violation"
329 checkBufferInvariants h_ = return ()
332 newEmptyBuffer :: RawBuffer -> BufferState -> Int -> Buffer
333 newEmptyBuffer b state size
334 = Buffer{ bufBuf=b, bufRPtr=0, bufWPtr=0, bufSize=size, bufState=state }
336 allocateBuffer :: Int -> BufferState -> IO Buffer
337 allocateBuffer sz@(I# size) state = IO $ \s ->
338 case newByteArray# size s of { (# s, b #) ->
339 (# s, newEmptyBuffer b state sz #) }
341 writeCharIntoBuffer :: RawBuffer -> Int -> Char -> IO Int
342 writeCharIntoBuffer slab (I# off) (C# c)
343 = IO $ \s -> case writeCharArray# slab off c s of
344 s -> (# s, I# (off +# 1#) #)
346 readCharFromBuffer :: RawBuffer -> Int -> IO (Char, Int)
347 readCharFromBuffer slab (I# off)
348 = IO $ \s -> case readCharArray# slab off s of
349 (# s, c #) -> (# s, (C# c, I# (off +# 1#)) #)
351 getBuffer :: FD -> BufferState -> IO (IORef Buffer, BufferMode)
352 getBuffer fd state = do
353 buffer <- allocateBuffer dEFAULT_BUFFER_SIZE state
354 ioref <- newIORef buffer
358 | is_tty = LineBuffering
359 | otherwise = BlockBuffering Nothing
361 return (ioref, buffer_mode)
363 mkUnBuffer :: IO (IORef Buffer)
365 buffer <- allocateBuffer 1 ReadBuffer
368 -- flushWriteBufferOnly flushes the buffer iff it contains pending write data.
369 flushWriteBufferOnly :: Handle__ -> IO ()
370 flushWriteBufferOnly h_ = do
374 new_buf <- if bufferIsWritable buf
375 then flushWriteBuffer fd (haIsStream h_) buf
377 writeIORef ref new_buf
379 -- flushBuffer syncs the file with the buffer, including moving the
380 -- file pointer backwards in the case of a read buffer.
381 flushBuffer :: Handle__ -> IO ()
383 let ref = haBuffer h_
388 ReadBuffer -> flushReadBuffer (haFD h_) buf
389 WriteBuffer -> flushWriteBuffer (haFD h_) (haIsStream h_) buf
391 writeIORef ref flushed_buf
393 -- When flushing a read buffer, we seek backwards by the number of
394 -- characters in the buffer. The file descriptor must therefore be
395 -- seekable: attempting to flush the read buffer on an unseekable
396 -- handle is not allowed.
398 flushReadBuffer :: FD -> Buffer -> IO Buffer
399 flushReadBuffer fd buf
400 | bufferEmpty buf = return buf
402 let off = negate (bufWPtr buf - bufRPtr buf)
404 puts ("flushReadBuffer: new file offset = " ++ show off ++ "\n")
406 throwErrnoIfMinus1Retry "flushReadBuffer"
407 (c_lseek (fromIntegral fd) (fromIntegral off) sEEK_CUR)
408 return buf{ bufWPtr=0, bufRPtr=0 }
410 flushWriteBuffer :: FD -> Bool -> Buffer -> IO Buffer
411 flushWriteBuffer fd is_stream buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w } = do
414 puts ("flushWriteBuffer, fd=" ++ show fd ++ ", bytes=" ++ show bytes ++ "\n")
417 then return (buf{ bufRPtr=0, bufWPtr=0 })
419 res <- throwErrnoIfMinus1RetryMayBlock "flushWriteBuffer"
420 (write_off_ba (fromIntegral fd) is_stream b (fromIntegral r)
421 (fromIntegral bytes))
423 let res' = fromIntegral res
425 then flushWriteBuffer fd is_stream (buf{ bufRPtr = r + res' })
426 else return buf{ bufRPtr=0, bufWPtr=0 }
428 foreign import ccall unsafe "__hscore_PrelHandle_write"
429 write_off_ba :: CInt -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
431 foreign import ccall unsafe "__hscore_PrelHandle_write"
432 write_off :: CInt -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
434 fillReadBuffer :: FD -> Bool -> Bool -> Buffer -> IO Buffer
435 fillReadBuffer fd is_line is_stream
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 is_stream 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 is_stream 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_ba fd is_stream 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 is_stream buf b (w+res') size
468 else return buf{ bufRPtr=0, bufWPtr=w+res' }
470 foreign import ccall unsafe "__hscore_PrelHandle_read"
471 read_off_ba :: FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
473 foreign import ccall unsafe "__hscore_PrelHandle_read"
474 read_off :: FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
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 mkStdHandle fd_stdin "<stdin>" ReadHandle buf bmode
496 stdout = unsafePerformIO $ do
497 -- ToDo: acquire lock
498 -- We don't set non-blocking mode on stdout or sterr, because
499 -- some shells don't recover properly.
500 -- setNonBlockingFD fd_stdout
501 (buf, bmode) <- getBuffer fd_stdout WriteBuffer
502 mkStdHandle fd_stdout "<stdout>" WriteHandle buf bmode
505 stderr = 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_stderr
511 mkStdHandle fd_stderr "<stderr>" WriteHandle buf NoBuffering
513 -- ---------------------------------------------------------------------------
514 -- Opening and Closing Files
517 Computation `openFile file mode' allocates and returns a new, open
518 handle to manage the file `file'. It manages input if `mode'
519 is `ReadMode', output if `mode' is `WriteMode' or `AppendMode',
520 and both input and output if mode is `ReadWriteMode'.
522 If the file does not exist and it is opened for output, it should be
523 created as a new file. If `mode' is `WriteMode' and the file
524 already exists, then it should be truncated to zero length. The
525 handle is positioned at the end of the file if `mode' is
526 `AppendMode', and otherwise at the beginning (in which case its
527 internal position is 0).
529 Implementations should enforce, locally to the Haskell process,
530 multiple-reader single-writer locking on files, which is to say that
531 there may either be many handles on the same file which manage input,
532 or just one handle on the file which manages output. If any open or
533 semi-closed handle is managing a file for output, no new handle can be
534 allocated for that file. If any open or semi-closed handle is
535 managing a file for input, new handles can only be allocated if they
536 do not manage output.
538 Two files are the same if they have the same absolute name. An
539 implementation is free to impose stricter conditions.
542 data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode
543 deriving (Eq, Ord, Ix, Enum, Read, Show)
548 deriving (Eq, Read, Show)
550 addFilePathToIOError fun fp (IOException (IOError h iot _ str _))
551 = IOException (IOError h iot fun str (Just fp))
552 addFilePathToIOError _ _ other_exception
555 openFile :: FilePath -> IOMode -> IO Handle
558 (openFile' fp (if dEFAULT_OPEN_IN_BINARY_MODE
561 (\e -> throw (addFilePathToIOError "openFile" fp e))
563 openFileEx :: FilePath -> IOModeEx -> IO Handle
567 (\e -> throw (addFilePathToIOError "openFileEx" fp e))
570 openFile' filepath ex_mode =
571 withCString filepath $ \ f ->
576 BinaryMode bmo -> (bmo, True)
577 TextMode tmo -> (tmo, False)
579 oflags1 = case mode of
580 ReadMode -> read_flags
581 WriteMode -> write_flags
582 ReadWriteMode -> rw_flags
583 AppendMode -> append_flags
585 truncate | WriteMode <- mode = True
592 oflags = oflags1 .|. binary_flags
595 -- the old implementation had a complicated series of three opens,
596 -- which is perhaps because we have to be careful not to open
597 -- directories. However, the man pages I've read say that open()
598 -- always returns EISDIR if the file is a directory and was opened
599 -- for writing, so I think we're ok with a single open() here...
600 fd <- fromIntegral `liftM`
601 throwErrnoIfMinus1Retry "openFile"
602 (c_open f (fromIntegral oflags) 0o666)
604 openFd fd Nothing filepath mode binary truncate
605 -- ASSERT: if we just created the file, then openFd won't fail
606 -- (so we don't need to worry about removing the newly created file
607 -- in the event of an error).
610 std_flags = o_NONBLOCK .|. o_NOCTTY
611 output_flags = std_flags .|. o_CREAT
612 read_flags = std_flags .|. o_RDONLY
613 write_flags = output_flags .|. o_WRONLY
614 rw_flags = output_flags .|. o_RDWR
615 append_flags = write_flags .|. o_APPEND
617 -- ---------------------------------------------------------------------------
620 openFd :: FD -> Maybe FDType -> FilePath -> IOMode -> Bool -> Bool -> IO Handle
621 openFd fd mb_fd_type filepath mode binary truncate = do
622 -- turn on non-blocking mode
625 let (ha_type, write) =
627 ReadMode -> ( ReadHandle, False )
628 WriteMode -> ( WriteHandle, True )
629 ReadWriteMode -> ( ReadWriteHandle, True )
630 AppendMode -> ( AppendHandle, True )
632 -- open() won't tell us if it was a directory if we only opened for
633 -- reading, so check again.
638 let is_stream = fd_type == Stream
641 ioException (IOError Nothing InappropriateType "openFile"
642 "is a directory" Nothing)
645 | ReadWriteHandle <- ha_type -> mkDuplexHandle fd is_stream filepath binary
646 | otherwise -> mkFileHandle fd is_stream filepath ha_type binary
648 -- regular files need to be locked
650 r <- lockFile (fromIntegral fd) (fromBool write) 1{-exclusive-}
652 ioException (IOError Nothing ResourceBusy "openFile"
653 "file is locked" Nothing)
655 -- truncate the file if necessary
656 when truncate (fileTruncate filepath)
658 mkFileHandle fd is_stream filepath ha_type binary
661 foreign import ccall unsafe "lockFile"
662 lockFile :: CInt -> CInt -> CInt -> IO CInt
664 foreign import ccall unsafe "unlockFile"
665 unlockFile :: CInt -> IO CInt
667 mkStdHandle :: FD -> FilePath -> HandleType -> IORef Buffer -> BufferMode
669 mkStdHandle fd filepath ha_type buf bmode = do
670 spares <- newIORef BufferListNil
671 newFileHandle stdHandleFinalizer
672 (Handle__ { haFD = fd,
674 haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
676 haBufferMode = bmode,
677 haFilePath = filepath,
680 haOtherSide = Nothing
683 mkFileHandle :: FD -> Bool -> FilePath -> HandleType -> Bool -> IO Handle
684 mkFileHandle fd is_stream filepath ha_type binary = do
685 (buf, bmode) <- getBuffer fd (initBufferState ha_type)
686 spares <- newIORef BufferListNil
687 newFileHandle handleFinalizer
688 (Handle__ { haFD = fd,
691 haIsStream = is_stream,
692 haBufferMode = bmode,
693 haFilePath = filepath,
696 haOtherSide = Nothing
699 mkDuplexHandle :: FD -> Bool -> FilePath -> Bool -> IO Handle
700 mkDuplexHandle fd is_stream filepath binary = do
701 (w_buf, w_bmode) <- getBuffer fd WriteBuffer
702 w_spares <- newIORef BufferListNil
704 Handle__ { haFD = fd,
705 haType = WriteHandle,
707 haIsStream = is_stream,
708 haBufferMode = w_bmode,
709 haFilePath = filepath,
711 haBuffers = w_spares,
712 haOtherSide = Nothing
714 write_side <- newMVar w_handle_
716 (r_buf, r_bmode) <- getBuffer fd ReadBuffer
717 r_spares <- newIORef BufferListNil
719 Handle__ { haFD = fd,
722 haIsStream = is_stream,
723 haBufferMode = r_bmode,
724 haFilePath = filepath,
726 haBuffers = r_spares,
727 haOtherSide = Just write_side
729 read_side <- newMVar r_handle_
731 addMVarFinalizer read_side (handleFinalizer read_side)
732 return (DuplexHandle read_side write_side)
735 initBufferState ReadHandle = ReadBuffer
736 initBufferState _ = WriteBuffer
738 -- ---------------------------------------------------------------------------
741 -- Computation `hClose hdl' makes handle `hdl' closed. Before the
742 -- computation finishes, any items buffered for output and not already
743 -- sent to the operating system are flushed as for `hFlush'.
745 -- For a duplex handle, we close&flush the write side, and just close
748 hClose :: Handle -> IO ()
749 hClose h@(FileHandle m) = hClose' h m
750 hClose h@(DuplexHandle r w) = hClose' h w >> hClose' h r
752 hClose' h m = withHandle__' "hClose" h m $ hClose_help
754 -- hClose_help is also called by lazyRead (in PrelIO) when EOF is read
755 -- or an IO error occurs on a lazy stream. The semi-closed Handle is
756 -- then closed immediately. We have to be careful with DuplexHandles
757 -- though: we have to leave the closing to the finalizer in that case,
758 -- because the write side may still be in use.
759 hClose_help handle_ =
760 case haType handle_ of
761 ClosedHandle -> return handle_
763 let fd = haFD handle_
764 c_fd = fromIntegral fd
766 flushWriteBufferOnly handle_
768 -- close the file descriptor, but not when this is the read
769 -- side of a duplex handle, and not when this is one of the
771 case haOtherSide handle_ of
773 when (fd /= fd_stdin && fd /= fd_stdout && fd /= fd_stderr) $
774 throwErrnoIfMinus1Retry_ "hClose"
775 #ifdef mingw32_TARGET_OS
776 (closeFd (haIsStream handle_) c_fd)
782 -- free the spare buffers
783 writeIORef (haBuffers handle_) BufferListNil
788 -- we must set the fd to -1, because the finalizer is going
789 -- to run eventually and try to close/unlock it.
790 return (handle_{ haFD = -1,
791 haType = ClosedHandle
794 -----------------------------------------------------------------------------
795 -- Detecting the size of a file
797 -- For a handle `hdl' which attached to a physical file, `hFileSize
798 -- hdl' returns the size of `hdl' in terms of the number of items
799 -- which can be read from `hdl'.
801 hFileSize :: Handle -> IO Integer
803 withHandle_ "hFileSize" handle $ \ handle_ -> do
804 case haType handle_ of
805 ClosedHandle -> ioe_closedHandle
806 SemiClosedHandle -> ioe_closedHandle
807 _ -> do flushWriteBufferOnly handle_
808 r <- fdFileSize (haFD handle_)
811 else ioException (IOError Nothing InappropriateType "hFileSize"
812 "not a regular file" Nothing)
814 -- ---------------------------------------------------------------------------
815 -- Detecting the End of Input
817 -- For a readable handle `hdl', `hIsEOF hdl' returns
818 -- `True' if no further input can be taken from `hdl' or for a
819 -- physical file, if the current I/O position is equal to the length of
820 -- the file. Otherwise, it returns `False'.
822 hIsEOF :: Handle -> IO Bool
825 (do hLookAhead handle; return False)
826 (\e -> if isEOFError e then return True else throw e)
831 -- ---------------------------------------------------------------------------
834 -- hLookahead returns the next character from the handle without
835 -- removing it from the input buffer, blocking until a character is
838 hLookAhead :: Handle -> IO Char
839 hLookAhead handle = do
840 wantReadableHandle "hLookAhead" handle $ \handle_ -> do
841 let ref = haBuffer handle_
843 is_line = haBufferMode handle_ == LineBuffering
846 -- fill up the read buffer if necessary
847 new_buf <- if bufferEmpty buf
848 then fillReadBuffer fd is_line (haIsStream handle_) buf
851 writeIORef ref new_buf
853 (c,_) <- readCharFromBuffer (bufBuf buf) (bufRPtr buf)
856 -- ---------------------------------------------------------------------------
857 -- Buffering Operations
859 -- Three kinds of buffering are supported: line-buffering,
860 -- block-buffering or no-buffering. See GHC.IOBase for definition and
861 -- further explanation of what the type represent.
863 -- Computation `hSetBuffering hdl mode' sets the mode of buffering for
864 -- handle hdl on subsequent reads and writes.
866 -- * If mode is LineBuffering, line-buffering should be enabled if possible.
868 -- * If mode is `BlockBuffering size', then block-buffering
869 -- should be enabled if possible. The size of the buffer is n items
870 -- if size is `Just n' and is otherwise implementation-dependent.
872 -- * If mode is NoBuffering, then buffering is disabled if possible.
874 -- If the buffer mode is changed from BlockBuffering or
875 -- LineBuffering to NoBuffering, then any items in the output
876 -- buffer are written to the device, and any items in the input buffer
877 -- are discarded. The default buffering mode when a handle is opened
878 -- is implementation-dependent and may depend on the object which is
879 -- attached to that handle.
881 hSetBuffering :: Handle -> BufferMode -> IO ()
882 hSetBuffering handle mode =
883 withAllHandles__ "hSetBuffering" handle $ \ handle_ -> do
884 case haType handle_ of
885 ClosedHandle -> ioe_closedHandle
888 - we flush the old buffer regardless of whether
889 the new buffer could fit the contents of the old buffer
891 - allow a handle's buffering to change even if IO has
892 occurred (ANSI C spec. does not allow this, nor did
893 the previous implementation of IO.hSetBuffering).
894 - a non-standard extension is to allow the buffering
895 of semi-closed handles to change [sof 6/98]
899 let state = initBufferState (haType handle_)
902 -- we always have a 1-character read buffer for
903 -- unbuffered handles: it's needed to
904 -- support hLookAhead.
905 NoBuffering -> allocateBuffer 1 ReadBuffer
906 LineBuffering -> allocateBuffer dEFAULT_BUFFER_SIZE state
907 BlockBuffering Nothing -> allocateBuffer dEFAULT_BUFFER_SIZE state
908 BlockBuffering (Just n) | n <= 0 -> ioe_bufsiz n
909 | otherwise -> allocateBuffer n state
910 writeIORef (haBuffer handle_) new_buf
912 -- for input terminals we need to put the terminal into
913 -- cooked or raw mode depending on the type of buffering.
914 is_tty <- fdIsTTY (haFD handle_)
915 when (is_tty && isReadableHandleType (haType handle_)) $
917 NoBuffering -> setCooked (haFD handle_) False
918 _ -> setCooked (haFD handle_) True
920 -- throw away spare buffers, they might be the wrong size
921 writeIORef (haBuffers handle_) BufferListNil
923 return (handle_{ haBufferMode = mode })
925 -- -----------------------------------------------------------------------------
928 -- The action `hFlush hdl' causes any items buffered for output
929 -- in handle `hdl' to be sent immediately to the operating
932 hFlush :: Handle -> IO ()
934 wantWritableHandle "hFlush" handle $ \ handle_ -> do
935 buf <- readIORef (haBuffer handle_)
936 if bufferIsWritable buf && not (bufferEmpty buf)
937 then do flushed_buf <- flushWriteBuffer (haFD handle_) (haIsStream handle_) buf
938 writeIORef (haBuffer handle_) flushed_buf
942 -- -----------------------------------------------------------------------------
943 -- Repositioning Handles
945 data HandlePosn = HandlePosn Handle HandlePosition
947 instance Eq HandlePosn where
948 (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
950 instance Show HandlePosn where
951 showsPrec p (HandlePosn h pos) =
952 showsPrec p h . showString " at position " . shows pos
954 -- HandlePosition is the Haskell equivalent of POSIX' off_t.
955 -- We represent it as an Integer on the Haskell side, but
956 -- cheat slightly in that hGetPosn calls upon a C helper
957 -- that reports the position back via (merely) an Int.
958 type HandlePosition = Integer
960 -- Computation `hGetPosn hdl' returns the current I/O position of
961 -- `hdl' as an abstract position. Computation `hSetPosn p' sets the
962 -- position of `hdl' to a previously obtained position `p'.
964 hGetPosn :: Handle -> IO HandlePosn
966 wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
968 #if defined(mingw32_TARGET_OS)
969 -- urgh, on Windows we have to worry about \n -> \r\n translation,
970 -- so we can't easily calculate the file position using the
971 -- current buffer size. Just flush instead.
974 let fd = fromIntegral (haFD handle_)
975 posn <- fromIntegral `liftM`
976 throwErrnoIfMinus1Retry "hGetPosn"
977 (c_lseek fd 0 sEEK_CUR)
979 let ref = haBuffer handle_
983 | bufferIsWritable buf = posn + fromIntegral (bufWPtr buf)
984 | otherwise = posn - fromIntegral (bufWPtr buf - bufRPtr buf)
986 puts ("\nhGetPosn: (fd, posn, real_posn) = " ++ show (fd, posn, real_posn) ++ "\n")
987 puts (" (bufWPtr, bufRPtr) = " ++ show (bufWPtr buf, bufRPtr buf) ++ "\n")
989 return (HandlePosn handle real_posn)
992 hSetPosn :: HandlePosn -> IO ()
993 hSetPosn (HandlePosn h i) = hSeek h AbsoluteSeek i
995 -- ---------------------------------------------------------------------------
999 The action `hSeek hdl mode i' sets the position of handle
1000 `hdl' depending on `mode'. If `mode' is
1002 * AbsoluteSeek - The position of `hdl' is set to `i'.
1003 * RelativeSeek - The position of `hdl' is set to offset `i' from
1004 the current position.
1005 * SeekFromEnd - The position of `hdl' is set to offset `i' from
1006 the end of the file.
1008 Some handles may not be seekable (see `hIsSeekable'), or only
1009 support a subset of the possible positioning operations (e.g. it may
1010 only be possible to seek to the end of a tape, or to a positive
1011 offset from the beginning or current position).
1013 It is not possible to set a negative I/O position, or for a physical
1014 file, an I/O position beyond the current end-of-file.
1017 - when seeking using `SeekFromEnd', positive offsets (>=0) means
1018 seeking at or past EOF.
1020 - we possibly deviate from the report on the issue of seeking within
1021 the buffer and whether to flush it or not. The report isn't exactly
1025 data SeekMode = AbsoluteSeek | RelativeSeek | SeekFromEnd
1026 deriving (Eq, Ord, Ix, Enum, Read, Show)
1028 hSeek :: Handle -> SeekMode -> Integer -> IO ()
1029 hSeek handle mode offset =
1030 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
1032 puts ("hSeek " ++ show (mode,offset) ++ "\n")
1034 let ref = haBuffer handle_
1035 buf <- readIORef ref
1041 throwErrnoIfMinus1Retry_ "hSeek"
1042 (c_lseek (fromIntegral (haFD handle_)) (fromIntegral offset) whence)
1045 whence = case mode of
1046 AbsoluteSeek -> sEEK_SET
1047 RelativeSeek -> sEEK_CUR
1048 SeekFromEnd -> sEEK_END
1050 if bufferIsWritable buf
1051 then do new_buf <- flushWriteBuffer fd (haIsStream handle_) buf
1052 writeIORef ref new_buf
1056 if mode == RelativeSeek && offset >= 0 && offset < fromIntegral (w - r)
1057 then writeIORef ref buf{ bufRPtr = r + fromIntegral offset }
1060 new_buf <- flushReadBuffer (haFD handle_) buf
1061 writeIORef ref new_buf
1064 -- -----------------------------------------------------------------------------
1065 -- Handle Properties
1067 -- A number of operations return information about the properties of a
1068 -- handle. Each of these operations returns `True' if the handle has
1069 -- the specified property, and `False' otherwise.
1071 hIsOpen :: Handle -> IO Bool
1073 withHandle_ "hIsOpen" handle $ \ handle_ -> do
1074 case haType handle_ of
1075 ClosedHandle -> return False
1076 SemiClosedHandle -> return False
1079 hIsClosed :: Handle -> IO Bool
1081 withHandle_ "hIsClosed" handle $ \ handle_ -> do
1082 case haType handle_ of
1083 ClosedHandle -> return True
1086 {- not defined, nor exported, but mentioned
1087 here for documentation purposes:
1089 hSemiClosed :: Handle -> IO Bool
1093 return (not (ho || hc))
1096 hIsReadable :: Handle -> IO Bool
1097 hIsReadable (DuplexHandle _ _) = return True
1098 hIsReadable handle =
1099 withHandle_ "hIsReadable" handle $ \ handle_ -> do
1100 case haType handle_ of
1101 ClosedHandle -> ioe_closedHandle
1102 SemiClosedHandle -> ioe_closedHandle
1103 htype -> return (isReadableHandleType htype)
1105 hIsWritable :: Handle -> IO Bool
1106 hIsWritable (DuplexHandle _ _) = return False
1107 hIsWritable handle =
1108 withHandle_ "hIsWritable" handle $ \ handle_ -> do
1109 case haType handle_ of
1110 ClosedHandle -> ioe_closedHandle
1111 SemiClosedHandle -> ioe_closedHandle
1112 htype -> return (isWritableHandleType htype)
1114 -- Querying how a handle buffers its data:
1116 hGetBuffering :: Handle -> IO BufferMode
1117 hGetBuffering handle =
1118 withHandle_ "hGetBuffering" handle $ \ handle_ -> do
1119 case haType handle_ of
1120 ClosedHandle -> ioe_closedHandle
1122 -- We're being non-standard here, and allow the buffering
1123 -- of a semi-closed handle to be queried. -- sof 6/98
1124 return (haBufferMode handle_) -- could be stricter..
1126 hIsSeekable :: Handle -> IO Bool
1127 hIsSeekable handle =
1128 withHandle_ "hIsSeekable" handle $ \ handle_ -> do
1129 case haType handle_ of
1130 ClosedHandle -> ioe_closedHandle
1131 SemiClosedHandle -> ioe_closedHandle
1132 AppendHandle -> return False
1133 _ -> do t <- fdType (haFD handle_)
1134 return (t == RegularFile
1136 || tEXT_MODE_SEEK_ALLOWED))
1138 -- -----------------------------------------------------------------------------
1139 -- Changing echo status
1141 -- Non-standard GHC extension is to allow the echoing status
1142 -- of a handles connected to terminals to be reconfigured:
1144 hSetEcho :: Handle -> Bool -> IO ()
1145 hSetEcho handle on = do
1146 isT <- hIsTerminalDevice handle
1150 withHandle_ "hSetEcho" handle $ \ handle_ -> do
1151 case haType handle_ of
1152 ClosedHandle -> ioe_closedHandle
1153 _ -> setEcho (haFD handle_) on
1155 hGetEcho :: Handle -> IO Bool
1156 hGetEcho handle = do
1157 isT <- hIsTerminalDevice handle
1161 withHandle_ "hGetEcho" handle $ \ handle_ -> do
1162 case haType handle_ of
1163 ClosedHandle -> ioe_closedHandle
1164 _ -> getEcho (haFD handle_)
1166 hIsTerminalDevice :: Handle -> IO Bool
1167 hIsTerminalDevice handle = do
1168 withHandle_ "hIsTerminalDevice" handle $ \ handle_ -> do
1169 case haType handle_ of
1170 ClosedHandle -> ioe_closedHandle
1171 _ -> fdIsTTY (haFD handle_)
1173 -- -----------------------------------------------------------------------------
1176 hSetBinaryMode handle bin =
1177 withAllHandles__ "hSetBinaryMode" handle $ \ handle_ ->
1178 do throwErrnoIfMinus1_ "hSetBinaryMode"
1179 (setmode (fromIntegral (haFD handle_)) bin)
1180 return handle_{haIsBin=bin}
1182 foreign import ccall unsafe "__hscore_setmode"
1183 setmode :: CInt -> Bool -> IO CInt
1185 -- ---------------------------------------------------------------------------
1189 puts :: String -> IO ()
1190 puts s = withCString s $ \cstr -> do write_off_ba 1 False cstr 0 (fromIntegral (length s))
1194 -- -----------------------------------------------------------------------------
1195 -- wrappers to platform-specific constants:
1197 foreign import ccall unsafe "__hscore_supportsTextMode"
1198 tEXT_MODE_SEEK_ALLOWED :: Bool
1200 foreign import ccall unsafe "__hscore_bufsiz" dEFAULT_BUFFER_SIZE :: Int
1201 foreign import ccall unsafe "__hscore_seek_cur" sEEK_CUR :: CInt
1202 foreign import ccall unsafe "__hscore_seek_set" sEEK_SET :: CInt
1203 foreign import ccall unsafe "__hscore_seek_end" sEEK_END :: CInt