1 {-# OPTIONS -fno-implicit-prelude -#include "HsBase.h" #-}
6 -----------------------------------------------------------------------------
9 -- Copyright : (c) The University of Glasgow, 1994-2001
10 -- License : see libraries/base/LICENSE
12 -- Maintainer : libraries@haskell.org
13 -- Stability : internal
14 -- Portability : non-portable
16 -- This module defines the basic operations on I\/O \"handles\".
18 -----------------------------------------------------------------------------
21 withHandle, withHandle', withHandle_,
22 wantWritableHandle, wantReadableHandle, wantSeekableHandle,
24 newEmptyBuffer, allocateBuffer, readCharFromBuffer, writeCharIntoBuffer,
25 flushWriteBufferOnly, flushWriteBuffer, flushReadBuffer, fillReadBuffer,
26 read_off, read_off_ba,
27 write_off, write_off_ba,
29 ioe_closedHandle, ioe_EOF, ioe_notReadable, ioe_notWritable,
31 stdin, stdout, stderr,
32 IOMode(..), IOModeEx(..), openFile, openFileEx, openFd,
33 hFileSize, hIsEOF, isEOF, hLookAhead, hSetBuffering, hSetBinaryMode,
38 HandlePosn(..), hGetPosn, hSetPosn,
39 SeekMode(..), hSeek, hTell,
41 hIsOpen, hIsClosed, hIsReadable, hIsWritable, hGetBuffering, hIsSeekable,
42 hSetEcho, hGetEcho, hIsTerminalDevice,
55 import System.IO.Error
62 import GHC.Read ( Read )
67 import GHC.Num ( Integer(..), Num(..) )
69 import GHC.Real ( toInteger )
73 -- -----------------------------------------------------------------------------
76 -- hWaitForInput blocks (should use a timeout)
78 -- unbuffered hGetLine is a bit dodgy
80 -- hSetBuffering: can't change buffering on a stream,
81 -- when the read buffer is non-empty? (no way to flush the buffer)
83 -- ---------------------------------------------------------------------------
84 -- Are files opened by default in text or binary mode, if the user doesn't
87 dEFAULT_OPEN_IN_BINARY_MODE = False :: Bool
89 -- ---------------------------------------------------------------------------
90 -- Creating a new handle
92 newFileHandle :: (MVar Handle__ -> IO ()) -> Handle__ -> IO Handle
93 newFileHandle finalizer hc = do
95 addMVarFinalizer m (finalizer m)
98 -- ---------------------------------------------------------------------------
99 -- Working with Handles
102 In the concurrent world, handles are locked during use. This is done
103 by wrapping an MVar around the handle which acts as a mutex over
104 operations on the handle.
106 To avoid races, we use the following bracketing operations. The idea
107 is to obtain the lock, do some operation and replace the lock again,
108 whether the operation succeeded or failed. We also want to handle the
109 case where the thread receives an exception while processing the IO
110 operation: in these cases we also want to relinquish the lock.
112 There are three versions of @withHandle@: corresponding to the three
113 possible combinations of:
115 - the operation may side-effect the handle
116 - the operation may return a result
118 If the operation generates an error or an exception is raised, the
119 original handle is always replaced [ this is the case at the moment,
120 but we might want to revisit this in the future --SDM ].
123 {-# INLINE withHandle #-}
124 withHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
125 withHandle fun h@(FileHandle m) act = withHandle' fun h m act
126 withHandle fun h@(DuplexHandle m _) act = withHandle' fun h m act
128 withHandle' :: String -> Handle -> MVar Handle__
129 -> (Handle__ -> IO (Handle__,a)) -> IO a
130 withHandle' fun h m act =
133 checkBufferInvariants h_
134 (h',v) <- catchException (act h_)
135 (\ ex -> putMVar m h_ >> throw (augmentIOError ex fun h h_))
136 checkBufferInvariants h'
140 {-# INLINE withHandle_ #-}
141 withHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a
142 withHandle_ fun h@(FileHandle m) act = withHandle_' fun h m act
143 withHandle_ fun h@(DuplexHandle m _) act = withHandle_' fun h m act
145 withHandle_' fun h m act =
148 checkBufferInvariants h_
149 v <- catchException (act h_)
150 (\ ex -> putMVar m h_ >> throw (augmentIOError ex fun h h_))
151 checkBufferInvariants h_
155 withAllHandles__ :: String -> Handle -> (Handle__ -> IO Handle__) -> IO ()
156 withAllHandles__ fun h@(FileHandle m) act = withHandle__' fun h m act
157 withAllHandles__ fun h@(DuplexHandle r w) act = do
158 withHandle__' fun h r act
159 withHandle__' fun h w act
161 withHandle__' fun h m act =
164 checkBufferInvariants h_
165 h' <- catchException (act h_)
166 (\ ex -> putMVar m h_ >> throw (augmentIOError ex fun h h_))
167 checkBufferInvariants h'
171 augmentIOError (IOException (IOError _ iot _ str fp)) fun h h_
172 = IOException (IOError (Just h) iot fun str filepath)
173 where filepath | Just _ <- fp = fp
174 | otherwise = Just (haFilePath h_)
175 augmentIOError other_exception _ _ _
178 -- ---------------------------------------------------------------------------
179 -- Wrapper for write operations.
181 wantWritableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
182 wantWritableHandle fun h@(FileHandle m) act
183 = wantWritableHandle' fun h m act
184 wantWritableHandle fun h@(DuplexHandle _ m) act
185 = wantWritableHandle' fun h m act
186 -- ToDo: in the Duplex case, we don't need to checkWritableHandle
189 :: String -> Handle -> MVar Handle__
190 -> (Handle__ -> IO a) -> IO a
191 wantWritableHandle' fun h m act
192 = withHandle_' fun h m (checkWritableHandle act)
194 checkWritableHandle act handle_
195 = case haType handle_ of
196 ClosedHandle -> ioe_closedHandle
197 SemiClosedHandle -> ioe_closedHandle
198 ReadHandle -> ioe_notWritable
199 ReadWriteHandle -> do
200 let ref = haBuffer handle_
203 if not (bufferIsWritable buf)
204 then do b <- flushReadBuffer (haFD handle_) buf
205 return b{ bufState=WriteBuffer }
207 writeIORef ref new_buf
209 _other -> act handle_
211 -- ---------------------------------------------------------------------------
212 -- Wrapper for read operations.
214 wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
215 wantReadableHandle fun h@(FileHandle m) act
216 = wantReadableHandle' fun h m act
217 wantReadableHandle fun h@(DuplexHandle m _) act
218 = wantReadableHandle' fun h m act
219 -- ToDo: in the Duplex case, we don't need to checkReadableHandle
222 :: String -> Handle -> MVar Handle__
223 -> (Handle__ -> IO a) -> IO a
224 wantReadableHandle' fun h m act
225 = withHandle_' fun h m (checkReadableHandle act)
227 checkReadableHandle act handle_ =
228 case haType handle_ of
229 ClosedHandle -> ioe_closedHandle
230 SemiClosedHandle -> ioe_closedHandle
231 AppendHandle -> ioe_notReadable
232 WriteHandle -> ioe_notReadable
233 ReadWriteHandle -> do
234 let ref = haBuffer handle_
236 when (bufferIsWritable buf) $ do
237 new_buf <- flushWriteBuffer (haFD handle_) (haIsStream handle_) buf
238 writeIORef ref new_buf{ bufState=ReadBuffer }
240 _other -> act handle_
242 -- ---------------------------------------------------------------------------
243 -- Wrapper for seek operations.
245 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
246 wantSeekableHandle fun h@(DuplexHandle _ _) _act =
247 ioException (IOError (Just h) IllegalOperation fun
248 "handle is not seekable" Nothing)
249 wantSeekableHandle fun h@(FileHandle m) act =
250 withHandle_' fun h m (checkSeekableHandle act)
252 checkSeekableHandle act handle_ =
253 case haType handle_ of
254 ClosedHandle -> ioe_closedHandle
255 SemiClosedHandle -> ioe_closedHandle
256 AppendHandle -> ioe_notSeekable
257 _ | haIsBin handle_ || tEXT_MODE_SEEK_ALLOWED -> act handle_
258 | otherwise -> ioe_notSeekable_notBin
260 -- -----------------------------------------------------------------------------
263 ioe_closedHandle, ioe_EOF,
264 ioe_notReadable, ioe_notWritable,
265 ioe_notSeekable, ioe_notSeekable_notBin :: IO a
267 ioe_closedHandle = ioException
268 (IOError Nothing IllegalOperation ""
269 "handle is closed" Nothing)
270 ioe_EOF = ioException
271 (IOError Nothing EOF "" "" Nothing)
272 ioe_notReadable = ioException
273 (IOError Nothing IllegalOperation ""
274 "handle is not open for reading" Nothing)
275 ioe_notWritable = ioException
276 (IOError Nothing IllegalOperation ""
277 "handle is not open for writing" Nothing)
278 ioe_notSeekable = ioException
279 (IOError Nothing IllegalOperation ""
280 "handle is not seekable" Nothing)
281 ioe_notSeekable_notBin = ioException
282 (IOError Nothing IllegalOperation ""
283 "seek operations on text-mode handles are not allowed on this platform"
286 ioe_bufsiz :: Int -> IO a
287 ioe_bufsiz n = ioException
288 (IOError Nothing InvalidArgument "hSetBuffering"
289 ("illegal buffer size " ++ showsPrec 9 n []) Nothing)
290 -- 9 => should be parens'ified.
292 -- -----------------------------------------------------------------------------
295 -- For a duplex handle, we arrange that the read side points to the write side
296 -- (and hence keeps it alive if the read side is alive). This is done by
297 -- having the haOtherSide field of the read side point to the read side.
298 -- The finalizer is then placed on the write side, and the handle only gets
299 -- finalized once, when both sides are no longer required.
301 stdHandleFinalizer :: MVar Handle__ -> IO ()
302 stdHandleFinalizer m = do
304 flushWriteBufferOnly h_
306 handleFinalizer :: MVar Handle__ -> IO ()
307 handleFinalizer m = do
309 flushWriteBufferOnly h_
310 let fd = fromIntegral (haFD h_)
313 #ifdef mingw32_TARGET_OS
314 (closeFd (haIsStream h_) fd >> return ())
316 (c_close fd >> return ())
320 -- ---------------------------------------------------------------------------
321 -- Grimy buffer operations
324 checkBufferInvariants h_ = do
325 let ref = haBuffer h_
326 Buffer{ bufWPtr=w, bufRPtr=r, bufSize=size, bufState=state } <- readIORef ref
331 && ( r /= w || (r == 0 && w == 0) )
332 && ( state /= WriteBuffer || r == 0 )
333 && ( state /= WriteBuffer || w < size ) -- write buffer is never full
335 then error "buffer invariant violation"
338 checkBufferInvariants h_ = return ()
341 newEmptyBuffer :: RawBuffer -> BufferState -> Int -> Buffer
342 newEmptyBuffer b state size
343 = Buffer{ bufBuf=b, bufRPtr=0, bufWPtr=0, bufSize=size, bufState=state }
345 allocateBuffer :: Int -> BufferState -> IO Buffer
346 allocateBuffer sz@(I# size) state = IO $ \s ->
347 case newByteArray# size s of { (# s, b #) ->
348 (# s, newEmptyBuffer b state sz #) }
350 writeCharIntoBuffer :: RawBuffer -> Int -> Char -> IO Int
351 writeCharIntoBuffer slab (I# off) (C# c)
352 = IO $ \s -> case writeCharArray# slab off c s of
353 s -> (# s, I# (off +# 1#) #)
355 readCharFromBuffer :: RawBuffer -> Int -> IO (Char, Int)
356 readCharFromBuffer slab (I# off)
357 = IO $ \s -> case readCharArray# slab off s of
358 (# s, c #) -> (# s, (C# c, I# (off +# 1#)) #)
360 getBuffer :: FD -> BufferState -> IO (IORef Buffer, BufferMode)
361 getBuffer fd state = do
362 buffer <- allocateBuffer dEFAULT_BUFFER_SIZE state
363 ioref <- newIORef buffer
367 | is_tty = LineBuffering
368 | otherwise = BlockBuffering Nothing
370 return (ioref, buffer_mode)
372 mkUnBuffer :: IO (IORef Buffer)
374 buffer <- allocateBuffer 1 ReadBuffer
377 -- flushWriteBufferOnly flushes the buffer iff it contains pending write data.
378 flushWriteBufferOnly :: Handle__ -> IO ()
379 flushWriteBufferOnly h_ = do
383 new_buf <- if bufferIsWritable buf
384 then flushWriteBuffer fd (haIsStream h_) buf
386 writeIORef ref new_buf
388 -- flushBuffer syncs the file with the buffer, including moving the
389 -- file pointer backwards in the case of a read buffer.
390 flushBuffer :: Handle__ -> IO ()
392 let ref = haBuffer h_
397 ReadBuffer -> flushReadBuffer (haFD h_) buf
398 WriteBuffer -> flushWriteBuffer (haFD h_) (haIsStream h_) buf
400 writeIORef ref flushed_buf
402 -- When flushing a read buffer, we seek backwards by the number of
403 -- characters in the buffer. The file descriptor must therefore be
404 -- seekable: attempting to flush the read buffer on an unseekable
405 -- handle is not allowed.
407 flushReadBuffer :: FD -> Buffer -> IO Buffer
408 flushReadBuffer fd buf
409 | bufferEmpty buf = return buf
411 let off = negate (bufWPtr buf - bufRPtr buf)
413 puts ("flushReadBuffer: new file offset = " ++ show off ++ "\n")
415 throwErrnoIfMinus1Retry "flushReadBuffer"
416 (c_lseek (fromIntegral fd) (fromIntegral off) sEEK_CUR)
417 return buf{ bufWPtr=0, bufRPtr=0 }
419 flushWriteBuffer :: FD -> Bool -> Buffer -> IO Buffer
420 flushWriteBuffer fd is_stream buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w } = do
423 puts ("flushWriteBuffer, fd=" ++ show fd ++ ", bytes=" ++ show bytes ++ "\n")
426 then return (buf{ bufRPtr=0, bufWPtr=0 })
428 res <- throwErrnoIfMinus1RetryMayBlock "flushWriteBuffer"
429 (write_off_ba (fromIntegral fd) is_stream b (fromIntegral r)
430 (fromIntegral bytes))
432 let res' = fromIntegral res
434 then flushWriteBuffer fd is_stream (buf{ bufRPtr = r + res' })
435 else return buf{ bufRPtr=0, bufWPtr=0 }
437 foreign import ccall unsafe "__hscore_PrelHandle_write"
438 write_off_ba :: CInt -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
440 foreign import ccall unsafe "__hscore_PrelHandle_write"
441 write_off :: CInt -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
443 fillReadBuffer :: FD -> Bool -> Bool -> Buffer -> IO Buffer
444 fillReadBuffer fd is_line is_stream
445 buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w, bufSize=size } =
446 -- buffer better be empty:
447 assert (r == 0 && w == 0) $ do
448 fillReadBufferLoop fd is_line is_stream buf b w size
450 -- For a line buffer, we just get the first chunk of data to arrive,
451 -- and don't wait for the whole buffer to be full (but we *do* wait
452 -- until some data arrives). This isn't really line buffering, but it
453 -- appears to be what GHC has done for a long time, and I suspect it
454 -- is more useful than line buffering in most cases.
456 fillReadBufferLoop fd is_line is_stream buf b w size = do
458 if bytes == 0 -- buffer full?
459 then return buf{ bufRPtr=0, bufWPtr=w }
462 puts ("fillReadBufferLoop: bytes = " ++ show bytes ++ "\n")
464 res <- throwErrnoIfMinus1RetryMayBlock "fillReadBuffer"
465 (read_off_ba fd is_stream b (fromIntegral w) (fromIntegral bytes))
467 let res' = fromIntegral res
469 puts ("fillReadBufferLoop: res' = " ++ show res' ++ "\n")
474 else return buf{ bufRPtr=0, bufWPtr=w }
475 else if res' < bytes && not is_line
476 then fillReadBufferLoop fd is_line is_stream buf b (w+res') size
477 else return buf{ bufRPtr=0, bufWPtr=w+res' }
479 foreign import ccall unsafe "__hscore_PrelHandle_read"
480 read_off_ba :: FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
482 foreign import ccall unsafe "__hscore_PrelHandle_read"
483 read_off :: FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
485 -- ---------------------------------------------------------------------------
488 -- Three handles are allocated during program initialisation. The first
489 -- two manage input or output from the Haskell program's standard input
490 -- or output channel respectively. The third manages output to the
491 -- standard error channel. These handles are initially open.
498 stdin = unsafePerformIO $ do
499 -- ToDo: acquire lock
500 setNonBlockingFD fd_stdin
501 (buf, bmode) <- getBuffer fd_stdin ReadBuffer
502 mkStdHandle fd_stdin "<stdin>" ReadHandle buf bmode
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 mkStdHandle fd_stdout "<stdout>" WriteHandle buf bmode
514 stderr = unsafePerformIO $ do
515 -- ToDo: acquire lock
516 -- We don't set non-blocking mode on stdout or sterr, because
517 -- some shells don't recover properly.
518 -- setNonBlockingFD fd_stderr
520 mkStdHandle fd_stderr "<stderr>" WriteHandle buf NoBuffering
522 -- ---------------------------------------------------------------------------
523 -- Opening and Closing Files
526 Computation `openFile file mode' allocates and returns a new, open
527 handle to manage the file `file'. It manages input if `mode'
528 is `ReadMode', output if `mode' is `WriteMode' or `AppendMode',
529 and both input and output if mode is `ReadWriteMode'.
531 If the file does not exist and it is opened for output, it should be
532 created as a new file. If `mode' is `WriteMode' and the file
533 already exists, then it should be truncated to zero length. The
534 handle is positioned at the end of the file if `mode' is
535 `AppendMode', and otherwise at the beginning (in which case its
536 internal position is 0).
538 Implementations should enforce, locally to the Haskell process,
539 multiple-reader single-writer locking on files, which is to say that
540 there may either be many handles on the same file which manage input,
541 or just one handle on the file which manages output. If any open or
542 semi-closed handle is managing a file for output, no new handle can be
543 allocated for that file. If any open or semi-closed handle is
544 managing a file for input, new handles can only be allocated if they
545 do not manage output.
547 Two files are the same if they have the same absolute name. An
548 implementation is free to impose stricter conditions.
551 data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode
552 deriving (Eq, Ord, Ix, Enum, Read, Show)
557 deriving (Eq, Read, Show)
559 addFilePathToIOError fun fp (IOException (IOError h iot _ str _))
560 = IOException (IOError h iot fun str (Just fp))
561 addFilePathToIOError _ _ other_exception
564 openFile :: FilePath -> IOMode -> IO Handle
567 (openFile' fp (if dEFAULT_OPEN_IN_BINARY_MODE
570 (\e -> throw (addFilePathToIOError "openFile" fp e))
572 openFileEx :: FilePath -> IOModeEx -> IO Handle
576 (\e -> throw (addFilePathToIOError "openFileEx" fp e))
579 openFile' filepath ex_mode =
580 withCString filepath $ \ f ->
585 BinaryMode bmo -> (bmo, True)
586 TextMode tmo -> (tmo, False)
588 oflags1 = case mode of
589 ReadMode -> read_flags
590 WriteMode -> write_flags
591 ReadWriteMode -> rw_flags
592 AppendMode -> append_flags
594 truncate | WriteMode <- mode = True
601 oflags = oflags1 .|. binary_flags
604 -- the old implementation had a complicated series of three opens,
605 -- which is perhaps because we have to be careful not to open
606 -- directories. However, the man pages I've read say that open()
607 -- always returns EISDIR if the file is a directory and was opened
608 -- for writing, so I think we're ok with a single open() here...
609 fd <- fromIntegral `liftM`
610 throwErrnoIfMinus1Retry "openFile"
611 (c_open f (fromIntegral oflags) 0o666)
613 openFd fd Nothing filepath mode binary truncate
614 -- ASSERT: if we just created the file, then openFd won't fail
615 -- (so we don't need to worry about removing the newly created file
616 -- in the event of an error).
619 std_flags = o_NONBLOCK .|. o_NOCTTY
620 output_flags = std_flags .|. o_CREAT
621 read_flags = std_flags .|. o_RDONLY
622 write_flags = output_flags .|. o_WRONLY
623 rw_flags = output_flags .|. o_RDWR
624 append_flags = write_flags .|. o_APPEND
626 -- ---------------------------------------------------------------------------
629 openFd :: FD -> Maybe FDType -> FilePath -> IOMode -> Bool -> Bool -> IO Handle
630 openFd fd mb_fd_type filepath mode binary truncate = do
631 -- turn on non-blocking mode
634 let (ha_type, write) =
636 ReadMode -> ( ReadHandle, False )
637 WriteMode -> ( WriteHandle, True )
638 ReadWriteMode -> ( ReadWriteHandle, True )
639 AppendMode -> ( AppendHandle, True )
641 -- open() won't tell us if it was a directory if we only opened for
642 -- reading, so check again.
647 let is_stream = fd_type == Stream
650 ioException (IOError Nothing InappropriateType "openFile"
651 "is a directory" Nothing)
654 | ReadWriteHandle <- ha_type -> mkDuplexHandle fd is_stream filepath binary
655 | otherwise -> mkFileHandle fd is_stream filepath ha_type binary
657 -- regular files need to be locked
659 r <- lockFile (fromIntegral fd) (fromBool write) 1{-exclusive-}
661 ioException (IOError Nothing ResourceBusy "openFile"
662 "file is locked" Nothing)
664 -- truncate the file if necessary
665 when truncate (fileTruncate filepath)
667 mkFileHandle fd is_stream filepath ha_type binary
670 foreign import ccall unsafe "lockFile"
671 lockFile :: CInt -> CInt -> CInt -> IO CInt
673 foreign import ccall unsafe "unlockFile"
674 unlockFile :: CInt -> IO CInt
676 mkStdHandle :: FD -> FilePath -> HandleType -> IORef Buffer -> BufferMode
678 mkStdHandle fd filepath ha_type buf bmode = do
679 spares <- newIORef BufferListNil
680 newFileHandle stdHandleFinalizer
681 (Handle__ { haFD = fd,
683 haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
685 haBufferMode = bmode,
686 haFilePath = filepath,
689 haOtherSide = Nothing
692 mkFileHandle :: FD -> Bool -> FilePath -> HandleType -> Bool -> IO Handle
693 mkFileHandle fd is_stream 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 haIsStream = is_stream,
701 haBufferMode = bmode,
702 haFilePath = filepath,
705 haOtherSide = Nothing
708 mkDuplexHandle :: FD -> Bool -> FilePath -> Bool -> IO Handle
709 mkDuplexHandle fd is_stream filepath binary = do
710 (w_buf, w_bmode) <- getBuffer fd WriteBuffer
711 w_spares <- newIORef BufferListNil
713 Handle__ { haFD = fd,
714 haType = WriteHandle,
716 haIsStream = is_stream,
717 haBufferMode = w_bmode,
718 haFilePath = filepath,
720 haBuffers = w_spares,
721 haOtherSide = Nothing
723 write_side <- newMVar w_handle_
725 (r_buf, r_bmode) <- getBuffer fd ReadBuffer
726 r_spares <- newIORef BufferListNil
728 Handle__ { haFD = fd,
731 haIsStream = is_stream,
732 haBufferMode = r_bmode,
733 haFilePath = filepath,
735 haBuffers = r_spares,
736 haOtherSide = Just write_side
738 read_side <- newMVar r_handle_
740 addMVarFinalizer read_side (handleFinalizer read_side)
741 return (DuplexHandle read_side write_side)
744 initBufferState ReadHandle = ReadBuffer
745 initBufferState _ = WriteBuffer
747 -- ---------------------------------------------------------------------------
750 -- Computation `hClose hdl' makes handle `hdl' closed. Before the
751 -- computation finishes, any items buffered for output and not already
752 -- sent to the operating system are flushed as for `hFlush'.
754 -- For a duplex handle, we close&flush the write side, and just close
757 hClose :: Handle -> IO ()
758 hClose h@(FileHandle m) = hClose' h m
759 hClose h@(DuplexHandle r w) = hClose' h w >> hClose' h r
761 hClose' h m = withHandle__' "hClose" h m $ hClose_help
763 -- hClose_help is also called by lazyRead (in PrelIO) when EOF is read
764 -- or an IO error occurs on a lazy stream. The semi-closed Handle is
765 -- then closed immediately. We have to be careful with DuplexHandles
766 -- though: we have to leave the closing to the finalizer in that case,
767 -- because the write side may still be in use.
768 hClose_help :: Handle__ -> IO Handle__
769 hClose_help handle_ =
770 case haType handle_ of
771 ClosedHandle -> return handle_
773 let fd = haFD handle_
774 c_fd = fromIntegral fd
776 flushWriteBufferOnly handle_
778 -- close the file descriptor, but not when this is the read
779 -- side of a duplex handle, and not when this is one of the
781 case haOtherSide handle_ of
783 when (fd /= fd_stdin && fd /= fd_stdout && fd /= fd_stderr) $
784 throwErrnoIfMinus1Retry_ "hClose"
785 #ifdef mingw32_TARGET_OS
786 (closeFd (haIsStream handle_) c_fd)
792 -- free the spare buffers
793 writeIORef (haBuffers handle_) BufferListNil
798 -- we must set the fd to -1, because the finalizer is going
799 -- to run eventually and try to close/unlock it.
800 return (handle_{ haFD = -1,
801 haType = ClosedHandle
804 -----------------------------------------------------------------------------
805 -- Detecting the size of a file
807 -- For a handle `hdl' which attached to a physical file, `hFileSize
808 -- hdl' returns the size of `hdl' in terms of the number of items
809 -- which can be read from `hdl'.
811 hFileSize :: Handle -> IO Integer
813 withHandle_ "hFileSize" handle $ \ handle_ -> do
814 case haType handle_ of
815 ClosedHandle -> ioe_closedHandle
816 SemiClosedHandle -> ioe_closedHandle
817 _ -> do flushWriteBufferOnly handle_
818 r <- fdFileSize (haFD handle_)
821 else ioException (IOError Nothing InappropriateType "hFileSize"
822 "not a regular file" Nothing)
824 -- ---------------------------------------------------------------------------
825 -- Detecting the End of Input
827 -- For a readable handle `hdl', `hIsEOF hdl' returns
828 -- `True' if no further input can be taken from `hdl' or for a
829 -- physical file, if the current I/O position is equal to the length of
830 -- the file. Otherwise, it returns `False'.
832 hIsEOF :: Handle -> IO Bool
835 (do hLookAhead handle; return False)
836 (\e -> if isEOFError e then return True else throw e)
841 -- ---------------------------------------------------------------------------
844 -- hLookahead returns the next character from the handle without
845 -- removing it from the input buffer, blocking until a character is
848 hLookAhead :: Handle -> IO Char
849 hLookAhead handle = do
850 wantReadableHandle "hLookAhead" handle $ \handle_ -> do
851 let ref = haBuffer handle_
853 is_line = haBufferMode handle_ == LineBuffering
856 -- fill up the read buffer if necessary
857 new_buf <- if bufferEmpty buf
858 then fillReadBuffer fd is_line (haIsStream handle_) buf
861 writeIORef ref new_buf
863 (c,_) <- readCharFromBuffer (bufBuf buf) (bufRPtr buf)
866 -- ---------------------------------------------------------------------------
867 -- Buffering Operations
869 -- Three kinds of buffering are supported: line-buffering,
870 -- block-buffering or no-buffering. See GHC.IOBase for definition and
871 -- further explanation of what the type represent.
873 -- Computation `hSetBuffering hdl mode' sets the mode of buffering for
874 -- handle hdl on subsequent reads and writes.
876 -- * If mode is LineBuffering, line-buffering should be enabled if possible.
878 -- * If mode is `BlockBuffering size', then block-buffering
879 -- should be enabled if possible. The size of the buffer is n items
880 -- if size is `Just n' and is otherwise implementation-dependent.
882 -- * If mode is NoBuffering, then buffering is disabled if possible.
884 -- If the buffer mode is changed from BlockBuffering or
885 -- LineBuffering to NoBuffering, then any items in the output
886 -- buffer are written to the device, and any items in the input buffer
887 -- are discarded. The default buffering mode when a handle is opened
888 -- is implementation-dependent and may depend on the object which is
889 -- attached to that handle.
891 hSetBuffering :: Handle -> BufferMode -> IO ()
892 hSetBuffering handle mode =
893 withAllHandles__ "hSetBuffering" handle $ \ handle_ -> do
894 case haType handle_ of
895 ClosedHandle -> ioe_closedHandle
898 - we flush the old buffer regardless of whether
899 the new buffer could fit the contents of the old buffer
901 - allow a handle's buffering to change even if IO has
902 occurred (ANSI C spec. does not allow this, nor did
903 the previous implementation of IO.hSetBuffering).
904 - a non-standard extension is to allow the buffering
905 of semi-closed handles to change [sof 6/98]
909 let state = initBufferState (haType handle_)
912 -- we always have a 1-character read buffer for
913 -- unbuffered handles: it's needed to
914 -- support hLookAhead.
915 NoBuffering -> allocateBuffer 1 ReadBuffer
916 LineBuffering -> allocateBuffer dEFAULT_BUFFER_SIZE state
917 BlockBuffering Nothing -> allocateBuffer dEFAULT_BUFFER_SIZE state
918 BlockBuffering (Just n) | n <= 0 -> ioe_bufsiz n
919 | otherwise -> allocateBuffer n state
920 writeIORef (haBuffer handle_) new_buf
922 -- for input terminals we need to put the terminal into
923 -- cooked or raw mode depending on the type of buffering.
924 is_tty <- fdIsTTY (haFD handle_)
925 when (is_tty && isReadableHandleType (haType handle_)) $
927 NoBuffering -> setCooked (haFD handle_) False
928 _ -> setCooked (haFD handle_) True
930 -- throw away spare buffers, they might be the wrong size
931 writeIORef (haBuffers handle_) BufferListNil
933 return (handle_{ haBufferMode = mode })
935 -- -----------------------------------------------------------------------------
938 -- The action `hFlush hdl' causes any items buffered for output
939 -- in handle `hdl' to be sent immediately to the operating
942 hFlush :: Handle -> IO ()
944 wantWritableHandle "hFlush" handle $ \ handle_ -> do
945 buf <- readIORef (haBuffer handle_)
946 if bufferIsWritable buf && not (bufferEmpty buf)
947 then do flushed_buf <- flushWriteBuffer (haFD handle_) (haIsStream handle_) buf
948 writeIORef (haBuffer handle_) flushed_buf
952 -- -----------------------------------------------------------------------------
953 -- Repositioning Handles
955 data HandlePosn = HandlePosn Handle HandlePosition
957 instance Eq HandlePosn where
958 (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
960 instance Show HandlePosn where
961 showsPrec p (HandlePosn h pos) =
962 showsPrec p h . showString " at position " . shows pos
964 -- HandlePosition is the Haskell equivalent of POSIX' off_t.
965 -- We represent it as an Integer on the Haskell side, but
966 -- cheat slightly in that hGetPosn calls upon a C helper
967 -- that reports the position back via (merely) an Int.
968 type HandlePosition = Integer
970 -- Computation `hGetPosn hdl' returns the current I/O position of
971 -- `hdl' as an abstract position. Computation `hSetPosn p' sets the
972 -- position of `hdl' to a previously obtained position `p'.
974 hGetPosn :: Handle -> IO HandlePosn
977 return (HandlePosn handle posn)
979 hSetPosn :: HandlePosn -> IO ()
980 hSetPosn (HandlePosn h i) = hSeek h AbsoluteSeek i
982 -- ---------------------------------------------------------------------------
986 The action `hSeek hdl mode i' sets the position of handle
987 `hdl' depending on `mode'. If `mode' is
989 * AbsoluteSeek - The position of `hdl' is set to `i'.
990 * RelativeSeek - The position of `hdl' is set to offset `i' from
991 the current position.
992 * SeekFromEnd - The position of `hdl' is set to offset `i' from
995 Some handles may not be seekable (see `hIsSeekable'), or only
996 support a subset of the possible positioning operations (e.g. it may
997 only be possible to seek to the end of a tape, or to a positive
998 offset from the beginning or current position).
1000 It is not possible to set a negative I/O position, or for a physical
1001 file, an I/O position beyond the current end-of-file.
1004 - when seeking using `SeekFromEnd', positive offsets (>=0) means
1005 seeking at or past EOF.
1007 - we possibly deviate from the report on the issue of seeking within
1008 the buffer and whether to flush it or not. The report isn't exactly
1012 data SeekMode = AbsoluteSeek | RelativeSeek | SeekFromEnd
1013 deriving (Eq, Ord, Ix, Enum, Read, Show)
1015 hSeek :: Handle -> SeekMode -> Integer -> IO ()
1016 hSeek handle mode offset =
1017 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
1019 puts ("hSeek " ++ show (mode,offset) ++ "\n")
1021 let ref = haBuffer handle_
1022 buf <- readIORef ref
1028 throwErrnoIfMinus1Retry_ "hSeek"
1029 (c_lseek (fromIntegral (haFD handle_)) (fromIntegral offset) whence)
1032 whence = case mode of
1033 AbsoluteSeek -> sEEK_SET
1034 RelativeSeek -> sEEK_CUR
1035 SeekFromEnd -> sEEK_END
1037 if bufferIsWritable buf
1038 then do new_buf <- flushWriteBuffer fd (haIsStream handle_) buf
1039 writeIORef ref new_buf
1043 if mode == RelativeSeek && offset >= 0 && offset < fromIntegral (w - r)
1044 then writeIORef ref buf{ bufRPtr = r + fromIntegral offset }
1047 new_buf <- flushReadBuffer (haFD handle_) buf
1048 writeIORef ref new_buf
1052 hTell :: Handle -> IO Integer
1054 wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
1056 #if defined(mingw32_TARGET_OS)
1057 -- urgh, on Windows we have to worry about \n -> \r\n translation,
1058 -- so we can't easily calculate the file position using the
1059 -- current buffer size. Just flush instead.
1062 let fd = fromIntegral (haFD handle_)
1063 posn <- fromIntegral `liftM`
1064 throwErrnoIfMinus1Retry "hGetPosn"
1065 (c_lseek fd 0 sEEK_CUR)
1067 let ref = haBuffer handle_
1068 buf <- readIORef ref
1071 | bufferIsWritable buf = posn + fromIntegral (bufWPtr buf)
1072 | otherwise = posn - fromIntegral (bufWPtr buf - bufRPtr buf)
1074 puts ("\nhGetPosn: (fd, posn, real_posn) = " ++ show (fd, posn, real_posn) ++ "\n")
1075 puts (" (bufWPtr, bufRPtr) = " ++ show (bufWPtr buf, bufRPtr buf) ++ "\n")
1079 -- -----------------------------------------------------------------------------
1080 -- Handle Properties
1082 -- A number of operations return information about the properties of a
1083 -- handle. Each of these operations returns `True' if the handle has
1084 -- the specified property, and `False' otherwise.
1086 hIsOpen :: Handle -> IO Bool
1088 withHandle_ "hIsOpen" handle $ \ handle_ -> do
1089 case haType handle_ of
1090 ClosedHandle -> return False
1091 SemiClosedHandle -> return False
1094 hIsClosed :: Handle -> IO Bool
1096 withHandle_ "hIsClosed" handle $ \ handle_ -> do
1097 case haType handle_ of
1098 ClosedHandle -> return True
1101 {- not defined, nor exported, but mentioned
1102 here for documentation purposes:
1104 hSemiClosed :: Handle -> IO Bool
1108 return (not (ho || hc))
1111 hIsReadable :: Handle -> IO Bool
1112 hIsReadable (DuplexHandle _ _) = return True
1113 hIsReadable handle =
1114 withHandle_ "hIsReadable" handle $ \ handle_ -> do
1115 case haType handle_ of
1116 ClosedHandle -> ioe_closedHandle
1117 SemiClosedHandle -> ioe_closedHandle
1118 htype -> return (isReadableHandleType htype)
1120 hIsWritable :: Handle -> IO Bool
1121 hIsWritable (DuplexHandle _ _) = return False
1122 hIsWritable handle =
1123 withHandle_ "hIsWritable" handle $ \ handle_ -> do
1124 case haType handle_ of
1125 ClosedHandle -> ioe_closedHandle
1126 SemiClosedHandle -> ioe_closedHandle
1127 htype -> return (isWritableHandleType htype)
1129 -- Querying how a handle buffers its data:
1131 hGetBuffering :: Handle -> IO BufferMode
1132 hGetBuffering handle =
1133 withHandle_ "hGetBuffering" handle $ \ handle_ -> do
1134 case haType handle_ of
1135 ClosedHandle -> ioe_closedHandle
1137 -- We're being non-standard here, and allow the buffering
1138 -- of a semi-closed handle to be queried. -- sof 6/98
1139 return (haBufferMode handle_) -- could be stricter..
1141 hIsSeekable :: Handle -> IO Bool
1142 hIsSeekable handle =
1143 withHandle_ "hIsSeekable" handle $ \ handle_ -> do
1144 case haType handle_ of
1145 ClosedHandle -> ioe_closedHandle
1146 SemiClosedHandle -> ioe_closedHandle
1147 AppendHandle -> return False
1148 _ -> do t <- fdType (haFD handle_)
1149 return (t == RegularFile
1151 || tEXT_MODE_SEEK_ALLOWED))
1153 -- -----------------------------------------------------------------------------
1154 -- Changing echo status
1156 -- Non-standard GHC extension is to allow the echoing status
1157 -- of a handles connected to terminals to be reconfigured:
1159 hSetEcho :: Handle -> Bool -> IO ()
1160 hSetEcho handle on = do
1161 isT <- hIsTerminalDevice handle
1165 withHandle_ "hSetEcho" handle $ \ handle_ -> do
1166 case haType handle_ of
1167 ClosedHandle -> ioe_closedHandle
1168 _ -> setEcho (haFD handle_) on
1170 hGetEcho :: Handle -> IO Bool
1171 hGetEcho handle = do
1172 isT <- hIsTerminalDevice handle
1176 withHandle_ "hGetEcho" handle $ \ handle_ -> do
1177 case haType handle_ of
1178 ClosedHandle -> ioe_closedHandle
1179 _ -> getEcho (haFD handle_)
1181 hIsTerminalDevice :: Handle -> IO Bool
1182 hIsTerminalDevice handle = do
1183 withHandle_ "hIsTerminalDevice" handle $ \ handle_ -> do
1184 case haType handle_ of
1185 ClosedHandle -> ioe_closedHandle
1186 _ -> fdIsTTY (haFD handle_)
1188 -- -----------------------------------------------------------------------------
1191 hSetBinaryMode :: Handle -> Bool -> IO ()
1192 hSetBinaryMode handle bin =
1193 withAllHandles__ "hSetBinaryMode" handle $ \ handle_ ->
1194 do throwErrnoIfMinus1_ "hSetBinaryMode"
1195 (setmode (fromIntegral (haFD handle_)) bin)
1196 return handle_{haIsBin=bin}
1198 foreign import ccall unsafe "__hscore_setmode"
1199 setmode :: CInt -> Bool -> IO CInt
1201 -- ---------------------------------------------------------------------------
1205 puts :: String -> IO ()
1206 puts s = withCString s $ \cstr -> do write_off_ba 1 False cstr 0 (fromIntegral (length s))
1210 -- -----------------------------------------------------------------------------
1211 -- wrappers to platform-specific constants:
1213 foreign import ccall unsafe "__hscore_supportsTextMode"
1214 tEXT_MODE_SEEK_ALLOWED :: Bool
1216 foreign import ccall unsafe "__hscore_bufsiz" dEFAULT_BUFFER_SIZE :: Int
1217 foreign import ccall unsafe "__hscore_seek_cur" sEEK_CUR :: CInt
1218 foreign import ccall unsafe "__hscore_seek_set" sEEK_SET :: CInt
1219 foreign import ccall unsafe "__hscore_seek_end" sEEK_END :: CInt