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, unlockFile,
29 ioe_closedHandle, ioe_EOF, ioe_notReadable, ioe_notWritable,
31 stdin, stdout, stderr,
32 IOMode(..), IOModeEx(..), openFile, openFileEx, openFd, fdToHandle,
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
310 -- hClose puts both the fd and the handle's type
311 -- into a closed state, so it's a bit excessive
312 -- to test for both here, but caution sometimes
315 case haType h_ of { ClosedHandle{} -> True; _ -> False }
316 fd = fromIntegral (haFD h_)
318 when (not alreadyClosed && fd /= -1) $ do
319 flushWriteBufferOnly h_
321 #ifdef mingw32_TARGET_OS
322 (closeFd (haIsStream h_) fd >> return ())
324 (c_close fd >> return ())
327 -- ---------------------------------------------------------------------------
328 -- Grimy buffer operations
331 checkBufferInvariants h_ = do
332 let ref = haBuffer h_
333 Buffer{ bufWPtr=w, bufRPtr=r, bufSize=size, bufState=state } <- readIORef ref
338 && ( r /= w || (r == 0 && w == 0) )
339 && ( state /= WriteBuffer || r == 0 )
340 && ( state /= WriteBuffer || w < size ) -- write buffer is never full
342 then error "buffer invariant violation"
345 checkBufferInvariants h_ = return ()
348 newEmptyBuffer :: RawBuffer -> BufferState -> Int -> Buffer
349 newEmptyBuffer b state size
350 = Buffer{ bufBuf=b, bufRPtr=0, bufWPtr=0, bufSize=size, bufState=state }
352 allocateBuffer :: Int -> BufferState -> IO Buffer
353 allocateBuffer sz@(I# size) state = IO $ \s ->
354 case newByteArray# size s of { (# s, b #) ->
355 (# s, newEmptyBuffer b state sz #) }
357 writeCharIntoBuffer :: RawBuffer -> Int -> Char -> IO Int
358 writeCharIntoBuffer slab (I# off) (C# c)
359 = IO $ \s -> case writeCharArray# slab off c s of
360 s -> (# s, I# (off +# 1#) #)
362 readCharFromBuffer :: RawBuffer -> Int -> IO (Char, Int)
363 readCharFromBuffer slab (I# off)
364 = IO $ \s -> case readCharArray# slab off s of
365 (# s, c #) -> (# s, (C# c, I# (off +# 1#)) #)
367 getBuffer :: FD -> BufferState -> IO (IORef Buffer, BufferMode)
368 getBuffer fd state = do
369 buffer <- allocateBuffer dEFAULT_BUFFER_SIZE state
370 ioref <- newIORef buffer
374 | is_tty = LineBuffering
375 | otherwise = BlockBuffering Nothing
377 return (ioref, buffer_mode)
379 mkUnBuffer :: IO (IORef Buffer)
381 buffer <- allocateBuffer 1 ReadBuffer
384 -- flushWriteBufferOnly flushes the buffer iff it contains pending write data.
385 flushWriteBufferOnly :: Handle__ -> IO ()
386 flushWriteBufferOnly h_ = do
390 new_buf <- if bufferIsWritable buf
391 then flushWriteBuffer fd (haIsStream h_) buf
393 writeIORef ref new_buf
395 -- flushBuffer syncs the file with the buffer, including moving the
396 -- file pointer backwards in the case of a read buffer.
397 flushBuffer :: Handle__ -> IO ()
399 let ref = haBuffer h_
404 ReadBuffer -> flushReadBuffer (haFD h_) buf
405 WriteBuffer -> flushWriteBuffer (haFD h_) (haIsStream h_) buf
407 writeIORef ref flushed_buf
409 -- When flushing a read buffer, we seek backwards by the number of
410 -- characters in the buffer. The file descriptor must therefore be
411 -- seekable: attempting to flush the read buffer on an unseekable
412 -- handle is not allowed.
414 flushReadBuffer :: FD -> Buffer -> IO Buffer
415 flushReadBuffer fd buf
416 | bufferEmpty buf = return buf
418 let off = negate (bufWPtr buf - bufRPtr buf)
420 puts ("flushReadBuffer: new file offset = " ++ show off ++ "\n")
422 throwErrnoIfMinus1Retry "flushReadBuffer"
423 (c_lseek (fromIntegral fd) (fromIntegral off) sEEK_CUR)
424 return buf{ bufWPtr=0, bufRPtr=0 }
426 flushWriteBuffer :: FD -> Bool -> Buffer -> IO Buffer
427 flushWriteBuffer fd is_stream buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w } = do
430 puts ("flushWriteBuffer, fd=" ++ show fd ++ ", bytes=" ++ show bytes ++ "\n")
433 then return (buf{ bufRPtr=0, bufWPtr=0 })
435 res <- throwErrnoIfMinus1RetryMayBlock "flushWriteBuffer"
436 (write_off_ba (fromIntegral fd) is_stream b (fromIntegral r)
437 (fromIntegral bytes))
439 let res' = fromIntegral res
441 then flushWriteBuffer fd is_stream (buf{ bufRPtr = r + res' })
442 else return buf{ bufRPtr=0, bufWPtr=0 }
444 foreign import ccall unsafe "__hscore_PrelHandle_write"
445 write_off_ba :: CInt -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
447 foreign import ccall unsafe "__hscore_PrelHandle_write"
448 write_off :: CInt -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
450 fillReadBuffer :: FD -> Bool -> Bool -> Buffer -> IO Buffer
451 fillReadBuffer fd is_line is_stream
452 buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w, bufSize=size } =
453 -- buffer better be empty:
454 assert (r == 0 && w == 0) $ do
455 fillReadBufferLoop fd is_line is_stream buf b w size
457 -- For a line buffer, we just get the first chunk of data to arrive,
458 -- and don't wait for the whole buffer to be full (but we *do* wait
459 -- until some data arrives). This isn't really line buffering, but it
460 -- appears to be what GHC has done for a long time, and I suspect it
461 -- is more useful than line buffering in most cases.
463 fillReadBufferLoop fd is_line is_stream buf b w size = do
465 if bytes == 0 -- buffer full?
466 then return buf{ bufRPtr=0, bufWPtr=w }
469 puts ("fillReadBufferLoop: bytes = " ++ show bytes ++ "\n")
471 res <- throwErrnoIfMinus1RetryMayBlock "fillReadBuffer"
472 (read_off_ba fd is_stream b (fromIntegral w) (fromIntegral bytes))
474 let res' = fromIntegral res
476 puts ("fillReadBufferLoop: res' = " ++ show res' ++ "\n")
481 else return buf{ bufRPtr=0, bufWPtr=w }
482 else if res' < bytes && not is_line
483 then fillReadBufferLoop fd is_line is_stream buf b (w+res') size
484 else return buf{ bufRPtr=0, bufWPtr=w+res' }
486 foreign import ccall unsafe "__hscore_PrelHandle_read"
487 read_off_ba :: FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
489 foreign import ccall unsafe "__hscore_PrelHandle_read"
490 read_off :: FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
492 -- ---------------------------------------------------------------------------
495 -- Three handles are allocated during program initialisation. The first
496 -- two manage input or output from the Haskell program's standard input
497 -- or output channel respectively. The third manages output to the
498 -- standard error channel. These handles are initially open.
505 stdin = unsafePerformIO $ do
506 -- ToDo: acquire lock
507 setNonBlockingFD fd_stdin
508 (buf, bmode) <- getBuffer fd_stdin ReadBuffer
509 mkStdHandle fd_stdin "<stdin>" ReadHandle buf bmode
512 stdout = unsafePerformIO $ do
513 -- ToDo: acquire lock
514 -- We don't set non-blocking mode on stdout or sterr, because
515 -- some shells don't recover properly.
516 -- setNonBlockingFD fd_stdout
517 (buf, bmode) <- getBuffer fd_stdout WriteBuffer
518 mkStdHandle fd_stdout "<stdout>" WriteHandle buf bmode
521 stderr = unsafePerformIO $ do
522 -- ToDo: acquire lock
523 -- We don't set non-blocking mode on stdout or sterr, because
524 -- some shells don't recover properly.
525 -- setNonBlockingFD fd_stderr
527 mkStdHandle fd_stderr "<stderr>" WriteHandle buf NoBuffering
529 -- ---------------------------------------------------------------------------
530 -- Opening and Closing Files
533 Computation `openFile file mode' allocates and returns a new, open
534 handle to manage the file `file'. It manages input if `mode'
535 is `ReadMode', output if `mode' is `WriteMode' or `AppendMode',
536 and both input and output if mode is `ReadWriteMode'.
538 If the file does not exist and it is opened for output, it should be
539 created as a new file. If `mode' is `WriteMode' and the file
540 already exists, then it should be truncated to zero length. The
541 handle is positioned at the end of the file if `mode' is
542 `AppendMode', and otherwise at the beginning (in which case its
543 internal position is 0).
545 Implementations should enforce, locally to the Haskell process,
546 multiple-reader single-writer locking on files, which is to say that
547 there may either be many handles on the same file which manage input,
548 or just one handle on the file which manages output. If any open or
549 semi-closed handle is managing a file for output, no new handle can be
550 allocated for that file. If any open or semi-closed handle is
551 managing a file for input, new handles can only be allocated if they
552 do not manage output.
554 Two files are the same if they have the same absolute name. An
555 implementation is free to impose stricter conditions.
561 deriving (Eq, Read, Show)
563 addFilePathToIOError fun fp (IOException (IOError h iot _ str _))
564 = IOException (IOError h iot fun str (Just fp))
565 addFilePathToIOError _ _ other_exception
568 openFile :: FilePath -> IOMode -> IO Handle
571 (openFile' fp (if dEFAULT_OPEN_IN_BINARY_MODE
574 (\e -> throw (addFilePathToIOError "openFile" fp e))
576 openFileEx :: FilePath -> IOModeEx -> IO Handle
580 (\e -> throw (addFilePathToIOError "openFileEx" fp e))
583 openFile' filepath ex_mode =
584 withCString filepath $ \ f ->
589 BinaryMode bmo -> (bmo, True)
590 TextMode tmo -> (tmo, False)
592 oflags1 = case mode of
593 ReadMode -> read_flags
594 WriteMode -> write_flags
595 ReadWriteMode -> rw_flags
596 AppendMode -> append_flags
598 truncate | WriteMode <- mode = True
605 oflags = oflags1 .|. binary_flags
608 -- the old implementation had a complicated series of three opens,
609 -- which is perhaps because we have to be careful not to open
610 -- directories. However, the man pages I've read say that open()
611 -- always returns EISDIR if the file is a directory and was opened
612 -- for writing, so I think we're ok with a single open() here...
613 fd <- fromIntegral `liftM`
614 throwErrnoIfMinus1Retry "openFile"
615 (c_open f (fromIntegral oflags) 0o666)
617 openFd fd Nothing filepath mode binary truncate
618 -- ASSERT: if we just created the file, then openFd won't fail
619 -- (so we don't need to worry about removing the newly created file
620 -- in the event of an error).
623 std_flags = o_NONBLOCK .|. o_NOCTTY
624 output_flags = std_flags .|. o_CREAT
625 read_flags = std_flags .|. o_RDONLY
626 write_flags = output_flags .|. o_WRONLY
627 rw_flags = output_flags .|. o_RDWR
628 append_flags = write_flags .|. o_APPEND
630 -- ---------------------------------------------------------------------------
633 openFd :: FD -> Maybe FDType -> FilePath -> IOMode -> Bool -> Bool -> IO Handle
634 openFd fd mb_fd_type filepath mode binary truncate = do
635 -- turn on non-blocking mode
638 let (ha_type, write) =
640 ReadMode -> ( ReadHandle, False )
641 WriteMode -> ( WriteHandle, True )
642 ReadWriteMode -> ( ReadWriteHandle, True )
643 AppendMode -> ( AppendHandle, True )
645 -- open() won't tell us if it was a directory if we only opened for
646 -- reading, so check again.
651 let is_stream = fd_type == Stream
654 ioException (IOError Nothing InappropriateType "openFile"
655 "is a directory" Nothing)
658 | ReadWriteHandle <- ha_type -> mkDuplexHandle fd is_stream filepath binary
659 | otherwise -> mkFileHandle fd is_stream filepath ha_type binary
661 -- regular files need to be locked
663 r <- lockFile (fromIntegral fd) (fromBool write) 1{-exclusive-}
665 ioException (IOError Nothing ResourceBusy "openFile"
666 "file is locked" Nothing)
668 -- truncate the file if necessary
669 when truncate (fileTruncate filepath)
671 mkFileHandle fd is_stream filepath ha_type binary
674 fdToHandle :: FD -> IO Handle
677 let fd_str = "<file descriptor: " ++ show fd ++ ">"
678 openFd fd Nothing fd_str mode True{-bin mode-} False{-no truncate-}
680 foreign import ccall unsafe "lockFile"
681 lockFile :: CInt -> CInt -> CInt -> IO CInt
683 foreign import ccall unsafe "unlockFile"
684 unlockFile :: CInt -> IO CInt
686 mkStdHandle :: FD -> FilePath -> HandleType -> IORef Buffer -> BufferMode
688 mkStdHandle fd filepath ha_type buf bmode = do
689 spares <- newIORef BufferListNil
690 newFileHandle stdHandleFinalizer
691 (Handle__ { haFD = fd,
693 haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
695 haBufferMode = bmode,
696 haFilePath = filepath,
699 haOtherSide = Nothing
702 mkFileHandle :: FD -> Bool -> FilePath -> HandleType -> Bool -> IO Handle
703 mkFileHandle fd is_stream filepath ha_type binary = do
704 (buf, bmode) <- getBuffer fd (initBufferState ha_type)
705 spares <- newIORef BufferListNil
706 newFileHandle handleFinalizer
707 (Handle__ { haFD = fd,
710 haIsStream = is_stream,
711 haBufferMode = bmode,
712 haFilePath = filepath,
715 haOtherSide = Nothing
718 mkDuplexHandle :: FD -> Bool -> FilePath -> Bool -> IO Handle
719 mkDuplexHandle fd is_stream filepath binary = do
720 (w_buf, w_bmode) <- getBuffer fd WriteBuffer
721 w_spares <- newIORef BufferListNil
723 Handle__ { haFD = fd,
724 haType = WriteHandle,
726 haIsStream = is_stream,
727 haBufferMode = w_bmode,
728 haFilePath = filepath,
730 haBuffers = w_spares,
731 haOtherSide = Nothing
733 write_side <- newMVar w_handle_
735 (r_buf, r_bmode) <- getBuffer fd ReadBuffer
736 r_spares <- newIORef BufferListNil
738 Handle__ { haFD = fd,
741 haIsStream = is_stream,
742 haBufferMode = r_bmode,
743 haFilePath = filepath,
745 haBuffers = r_spares,
746 haOtherSide = Just write_side
748 read_side <- newMVar r_handle_
750 addMVarFinalizer read_side (handleFinalizer read_side)
751 return (DuplexHandle read_side write_side)
754 initBufferState ReadHandle = ReadBuffer
755 initBufferState _ = WriteBuffer
757 -- ---------------------------------------------------------------------------
760 -- Computation `hClose hdl' makes handle `hdl' closed. Before the
761 -- computation finishes, any items buffered for output and not already
762 -- sent to the operating system are flushed as for `hFlush'.
764 -- For a duplex handle, we close&flush the write side, and just close
767 hClose :: Handle -> IO ()
768 hClose h@(FileHandle m) = hClose' h m
769 hClose h@(DuplexHandle r w) = hClose' h w >> hClose' h r
771 hClose' h m = withHandle__' "hClose" h m $ hClose_help
773 -- hClose_help is also called by lazyRead (in PrelIO) when EOF is read
774 -- or an IO error occurs on a lazy stream. The semi-closed Handle is
775 -- then closed immediately. We have to be careful with DuplexHandles
776 -- though: we have to leave the closing to the finalizer in that case,
777 -- because the write side may still be in use.
778 hClose_help :: Handle__ -> IO Handle__
779 hClose_help handle_ =
780 case haType handle_ of
781 ClosedHandle -> return handle_
783 let fd = haFD handle_
784 c_fd = fromIntegral fd
786 flushWriteBufferOnly handle_
788 -- close the file descriptor, but not when this is the read
789 -- side of a duplex handle, and not when this is one of the
791 case haOtherSide handle_ of
793 when (fd /= fd_stdin && fd /= fd_stdout && fd /= fd_stderr) $
794 throwErrnoIfMinus1Retry_ "hClose"
795 #ifdef mingw32_TARGET_OS
796 (closeFd (haIsStream handle_) c_fd)
802 -- free the spare buffers
803 writeIORef (haBuffers handle_) BufferListNil
808 -- we must set the fd to -1, because the finalizer is going
809 -- to run eventually and try to close/unlock it.
810 return (handle_{ haFD = -1,
811 haType = ClosedHandle
814 -----------------------------------------------------------------------------
815 -- Detecting the size of a file
817 -- For a handle `hdl' which attached to a physical file, `hFileSize
818 -- hdl' returns the size of `hdl' in terms of the number of items
819 -- which can be read from `hdl'.
821 hFileSize :: Handle -> IO Integer
823 withHandle_ "hFileSize" handle $ \ handle_ -> do
824 case haType handle_ of
825 ClosedHandle -> ioe_closedHandle
826 SemiClosedHandle -> ioe_closedHandle
827 _ -> do flushWriteBufferOnly handle_
828 r <- fdFileSize (haFD handle_)
831 else ioException (IOError Nothing InappropriateType "hFileSize"
832 "not a regular file" Nothing)
834 -- ---------------------------------------------------------------------------
835 -- Detecting the End of Input
837 -- For a readable handle `hdl', `hIsEOF hdl' returns
838 -- `True' if no further input can be taken from `hdl' or for a
839 -- physical file, if the current I/O position is equal to the length of
840 -- the file. Otherwise, it returns `False'.
842 hIsEOF :: Handle -> IO Bool
845 (do hLookAhead handle; return False)
846 (\e -> if isEOFError e then return True else throw e)
851 -- ---------------------------------------------------------------------------
854 -- hLookahead returns the next character from the handle without
855 -- removing it from the input buffer, blocking until a character is
858 hLookAhead :: Handle -> IO Char
859 hLookAhead handle = do
860 wantReadableHandle "hLookAhead" handle $ \handle_ -> do
861 let ref = haBuffer handle_
863 is_line = haBufferMode handle_ == LineBuffering
866 -- fill up the read buffer if necessary
867 new_buf <- if bufferEmpty buf
868 then fillReadBuffer fd is_line (haIsStream handle_) buf
871 writeIORef ref new_buf
873 (c,_) <- readCharFromBuffer (bufBuf buf) (bufRPtr buf)
876 -- ---------------------------------------------------------------------------
877 -- Buffering Operations
879 -- Three kinds of buffering are supported: line-buffering,
880 -- block-buffering or no-buffering. See GHC.IOBase for definition and
881 -- further explanation of what the type represent.
883 -- Computation `hSetBuffering hdl mode' sets the mode of buffering for
884 -- handle hdl on subsequent reads and writes.
886 -- * If mode is LineBuffering, line-buffering should be enabled if possible.
888 -- * If mode is `BlockBuffering size', then block-buffering
889 -- should be enabled if possible. The size of the buffer is n items
890 -- if size is `Just n' and is otherwise implementation-dependent.
892 -- * If mode is NoBuffering, then buffering is disabled if possible.
894 -- If the buffer mode is changed from BlockBuffering or
895 -- LineBuffering to NoBuffering, then any items in the output
896 -- buffer are written to the device, and any items in the input buffer
897 -- are discarded. The default buffering mode when a handle is opened
898 -- is implementation-dependent and may depend on the object which is
899 -- attached to that handle.
901 hSetBuffering :: Handle -> BufferMode -> IO ()
902 hSetBuffering handle mode =
903 withAllHandles__ "hSetBuffering" handle $ \ handle_ -> do
904 case haType handle_ of
905 ClosedHandle -> ioe_closedHandle
908 - we flush the old buffer regardless of whether
909 the new buffer could fit the contents of the old buffer
911 - allow a handle's buffering to change even if IO has
912 occurred (ANSI C spec. does not allow this, nor did
913 the previous implementation of IO.hSetBuffering).
914 - a non-standard extension is to allow the buffering
915 of semi-closed handles to change [sof 6/98]
919 let state = initBufferState (haType handle_)
922 -- we always have a 1-character read buffer for
923 -- unbuffered handles: it's needed to
924 -- support hLookAhead.
925 NoBuffering -> allocateBuffer 1 ReadBuffer
926 LineBuffering -> allocateBuffer dEFAULT_BUFFER_SIZE state
927 BlockBuffering Nothing -> allocateBuffer dEFAULT_BUFFER_SIZE state
928 BlockBuffering (Just n) | n <= 0 -> ioe_bufsiz n
929 | otherwise -> allocateBuffer n state
930 writeIORef (haBuffer handle_) new_buf
932 -- for input terminals we need to put the terminal into
933 -- cooked or raw mode depending on the type of buffering.
934 is_tty <- fdIsTTY (haFD handle_)
935 when (is_tty && isReadableHandleType (haType handle_)) $
937 NoBuffering -> setCooked (haFD handle_) False
938 _ -> setCooked (haFD handle_) True
940 -- throw away spare buffers, they might be the wrong size
941 writeIORef (haBuffers handle_) BufferListNil
943 return (handle_{ haBufferMode = mode })
945 -- -----------------------------------------------------------------------------
948 -- The action `hFlush hdl' causes any items buffered for output
949 -- in handle `hdl' to be sent immediately to the operating
952 hFlush :: Handle -> IO ()
954 wantWritableHandle "hFlush" handle $ \ handle_ -> do
955 buf <- readIORef (haBuffer handle_)
956 if bufferIsWritable buf && not (bufferEmpty buf)
957 then do flushed_buf <- flushWriteBuffer (haFD handle_) (haIsStream handle_) buf
958 writeIORef (haBuffer handle_) flushed_buf
962 -- -----------------------------------------------------------------------------
963 -- Repositioning Handles
965 data HandlePosn = HandlePosn Handle HandlePosition
967 instance Eq HandlePosn where
968 (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
970 instance Show HandlePosn where
971 showsPrec p (HandlePosn h pos) =
972 showsPrec p h . showString " at position " . shows pos
974 -- HandlePosition is the Haskell equivalent of POSIX' off_t.
975 -- We represent it as an Integer on the Haskell side, but
976 -- cheat slightly in that hGetPosn calls upon a C helper
977 -- that reports the position back via (merely) an Int.
978 type HandlePosition = Integer
980 -- Computation `hGetPosn hdl' returns the current I/O position of
981 -- `hdl' as an abstract position. Computation `hSetPosn p' sets the
982 -- position of `hdl' to a previously obtained position `p'.
984 hGetPosn :: Handle -> IO HandlePosn
987 return (HandlePosn handle posn)
989 hSetPosn :: HandlePosn -> IO ()
990 hSetPosn (HandlePosn h i) = hSeek h AbsoluteSeek i
992 -- ---------------------------------------------------------------------------
996 The action `hSeek hdl mode i' sets the position of handle
997 `hdl' depending on `mode'. If `mode' is
999 * AbsoluteSeek - The position of `hdl' is set to `i'.
1000 * RelativeSeek - The position of `hdl' is set to offset `i' from
1001 the current position.
1002 * SeekFromEnd - The position of `hdl' is set to offset `i' from
1003 the end of the file.
1005 Some handles may not be seekable (see `hIsSeekable'), or only
1006 support a subset of the possible positioning operations (e.g. it may
1007 only be possible to seek to the end of a tape, or to a positive
1008 offset from the beginning or current position).
1010 It is not possible to set a negative I/O position, or for a physical
1011 file, an I/O position beyond the current end-of-file.
1014 - when seeking using `SeekFromEnd', positive offsets (>=0) means
1015 seeking at or past EOF.
1017 - we possibly deviate from the report on the issue of seeking within
1018 the buffer and whether to flush it or not. The report isn't exactly
1022 data SeekMode = AbsoluteSeek | RelativeSeek | SeekFromEnd
1023 deriving (Eq, Ord, Ix, Enum, Read, Show)
1025 hSeek :: Handle -> SeekMode -> Integer -> IO ()
1026 hSeek handle mode offset =
1027 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
1029 puts ("hSeek " ++ show (mode,offset) ++ "\n")
1031 let ref = haBuffer handle_
1032 buf <- readIORef ref
1038 throwErrnoIfMinus1Retry_ "hSeek"
1039 (c_lseek (fromIntegral (haFD handle_)) (fromIntegral offset) whence)
1042 whence = case mode of
1043 AbsoluteSeek -> sEEK_SET
1044 RelativeSeek -> sEEK_CUR
1045 SeekFromEnd -> sEEK_END
1047 if bufferIsWritable buf
1048 then do new_buf <- flushWriteBuffer fd (haIsStream handle_) buf
1049 writeIORef ref new_buf
1053 if mode == RelativeSeek && offset >= 0 && offset < fromIntegral (w - r)
1054 then writeIORef ref buf{ bufRPtr = r + fromIntegral offset }
1057 new_buf <- flushReadBuffer (haFD handle_) buf
1058 writeIORef ref new_buf
1062 hTell :: Handle -> IO Integer
1064 wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
1066 #if defined(mingw32_TARGET_OS)
1067 -- urgh, on Windows we have to worry about \n -> \r\n translation,
1068 -- so we can't easily calculate the file position using the
1069 -- current buffer size. Just flush instead.
1072 let fd = fromIntegral (haFD handle_)
1073 posn <- fromIntegral `liftM`
1074 throwErrnoIfMinus1Retry "hGetPosn"
1075 (c_lseek fd 0 sEEK_CUR)
1077 let ref = haBuffer handle_
1078 buf <- readIORef ref
1081 | bufferIsWritable buf = posn + fromIntegral (bufWPtr buf)
1082 | otherwise = posn - fromIntegral (bufWPtr buf - bufRPtr buf)
1084 puts ("\nhGetPosn: (fd, posn, real_posn) = " ++ show (fd, posn, real_posn) ++ "\n")
1085 puts (" (bufWPtr, bufRPtr) = " ++ show (bufWPtr buf, bufRPtr buf) ++ "\n")
1089 -- -----------------------------------------------------------------------------
1090 -- Handle Properties
1092 -- A number of operations return information about the properties of a
1093 -- handle. Each of these operations returns `True' if the handle has
1094 -- the specified property, and `False' otherwise.
1096 hIsOpen :: Handle -> IO Bool
1098 withHandle_ "hIsOpen" handle $ \ handle_ -> do
1099 case haType handle_ of
1100 ClosedHandle -> return False
1101 SemiClosedHandle -> return False
1104 hIsClosed :: Handle -> IO Bool
1106 withHandle_ "hIsClosed" handle $ \ handle_ -> do
1107 case haType handle_ of
1108 ClosedHandle -> return True
1111 {- not defined, nor exported, but mentioned
1112 here for documentation purposes:
1114 hSemiClosed :: Handle -> IO Bool
1118 return (not (ho || hc))
1121 hIsReadable :: Handle -> IO Bool
1122 hIsReadable (DuplexHandle _ _) = return True
1123 hIsReadable handle =
1124 withHandle_ "hIsReadable" handle $ \ handle_ -> do
1125 case haType handle_ of
1126 ClosedHandle -> ioe_closedHandle
1127 SemiClosedHandle -> ioe_closedHandle
1128 htype -> return (isReadableHandleType htype)
1130 hIsWritable :: Handle -> IO Bool
1131 hIsWritable (DuplexHandle _ _) = return False
1132 hIsWritable handle =
1133 withHandle_ "hIsWritable" handle $ \ handle_ -> do
1134 case haType handle_ of
1135 ClosedHandle -> ioe_closedHandle
1136 SemiClosedHandle -> ioe_closedHandle
1137 htype -> return (isWritableHandleType htype)
1139 -- Querying how a handle buffers its data:
1141 hGetBuffering :: Handle -> IO BufferMode
1142 hGetBuffering handle =
1143 withHandle_ "hGetBuffering" handle $ \ handle_ -> do
1144 case haType handle_ of
1145 ClosedHandle -> ioe_closedHandle
1147 -- We're being non-standard here, and allow the buffering
1148 -- of a semi-closed handle to be queried. -- sof 6/98
1149 return (haBufferMode handle_) -- could be stricter..
1151 hIsSeekable :: Handle -> IO Bool
1152 hIsSeekable handle =
1153 withHandle_ "hIsSeekable" handle $ \ handle_ -> do
1154 case haType handle_ of
1155 ClosedHandle -> ioe_closedHandle
1156 SemiClosedHandle -> ioe_closedHandle
1157 AppendHandle -> return False
1158 _ -> do t <- fdType (haFD handle_)
1159 return (t == RegularFile
1161 || tEXT_MODE_SEEK_ALLOWED))
1163 -- -----------------------------------------------------------------------------
1164 -- Changing echo status
1166 -- Non-standard GHC extension is to allow the echoing status
1167 -- of a handles connected to terminals to be reconfigured:
1169 hSetEcho :: Handle -> Bool -> IO ()
1170 hSetEcho handle on = do
1171 isT <- hIsTerminalDevice handle
1175 withHandle_ "hSetEcho" handle $ \ handle_ -> do
1176 case haType handle_ of
1177 ClosedHandle -> ioe_closedHandle
1178 _ -> setEcho (haFD handle_) on
1180 hGetEcho :: Handle -> IO Bool
1181 hGetEcho handle = do
1182 isT <- hIsTerminalDevice handle
1186 withHandle_ "hGetEcho" handle $ \ handle_ -> do
1187 case haType handle_ of
1188 ClosedHandle -> ioe_closedHandle
1189 _ -> getEcho (haFD handle_)
1191 hIsTerminalDevice :: Handle -> IO Bool
1192 hIsTerminalDevice handle = do
1193 withHandle_ "hIsTerminalDevice" handle $ \ handle_ -> do
1194 case haType handle_ of
1195 ClosedHandle -> ioe_closedHandle
1196 _ -> fdIsTTY (haFD handle_)
1198 -- -----------------------------------------------------------------------------
1201 -- | On Windows, reading a file in text mode (which is the default) will
1202 -- translate CRLF to LF, and writing will translate LF to CRLF. This
1203 -- is usually what you want with text files. With binary files this is
1204 -- undesirable; also, as usual under Microsoft operating systems, text
1205 -- mode treats control-Z as EOF. Setting binary mode using
1206 -- 'hSetBinaryMode' turns off all special treatment of end-of-line and
1207 -- end-of-file characters.
1209 hSetBinaryMode :: Handle -> Bool -> IO ()
1210 hSetBinaryMode handle bin =
1211 withAllHandles__ "hSetBinaryMode" handle $ \ handle_ ->
1212 do throwErrnoIfMinus1_ "hSetBinaryMode"
1213 (setmode (fromIntegral (haFD handle_)) bin)
1214 return handle_{haIsBin=bin}
1216 foreign import ccall unsafe "__hscore_setmode"
1217 setmode :: CInt -> Bool -> IO CInt
1219 -- ---------------------------------------------------------------------------
1223 puts :: String -> IO ()
1224 puts s = withCString s $ \cstr -> do write_off_ba 1 False cstr 0 (fromIntegral (length s))
1228 -- -----------------------------------------------------------------------------
1229 -- wrappers to platform-specific constants:
1231 foreign import ccall unsafe "__hscore_supportsTextMode"
1232 tEXT_MODE_SEEK_ALLOWED :: Bool
1234 foreign import ccall unsafe "__hscore_bufsiz" dEFAULT_BUFFER_SIZE :: Int
1235 foreign import ccall unsafe "__hscore_seek_cur" sEEK_CUR :: CInt
1236 foreign import ccall unsafe "__hscore_seek_set" sEEK_SET :: CInt
1237 foreign import ccall unsafe "__hscore_seek_end" sEEK_END :: CInt