1 {-# OPTIONS -fno-implicit-prelude #-}
6 -- -----------------------------------------------------------------------------
7 -- $Id: PrelHandle.hsc,v 1.17 2001/10/16 15:06:38 simonmar Exp $
9 -- (c) The University of Glasgow, 1994-2001
11 -- This module defines the basic operations on I/O "handles".
14 withHandle, withHandle', withHandle_,
15 wantWritableHandle, wantReadableHandle, wantSeekableHandle,
17 newEmptyBuffer, allocateBuffer, readCharFromBuffer, writeCharIntoBuffer,
18 flushWriteBufferOnly, flushWriteBuffer, flushReadBuffer, fillReadBuffer,
21 ioe_closedHandle, ioe_EOF, ioe_notReadable, ioe_notWritable,
23 stdin, stdout, stderr,
24 IOMode(..), IOModeEx(..), openFile, openFileEx, openFd,
25 hFileSize, hIsEOF, isEOF, hLookAhead, hSetBuffering, hSetBinaryMode,
30 HandlePosn(..), hGetPosn, hSetPosn,
33 hIsOpen, hIsClosed, hIsReadable, hIsWritable, hGetBuffering, hIsSeekable,
34 hSetEcho, hGetEcho, hIsTerminalDevice,
35 ioeGetFileName, ioeGetErrorString, ioeGetHandle,
49 import PrelMarshalUtils
58 import PrelRead ( Read )
61 import PrelMaybe ( Maybe(..) )
64 import PrelNum ( Integer(..), Num(..) )
66 import PrelReal ( toInteger )
70 -- -----------------------------------------------------------------------------
73 -- hWaitForInput blocks (should use a timeout)
75 -- unbuffered hGetLine is a bit dodgy
77 -- hSetBuffering: can't change buffering on a stream,
78 -- when the read buffer is non-empty? (no way to flush the buffer)
80 -- ---------------------------------------------------------------------------
81 -- Are files opened by default in text or binary mode, if the user doesn't
83 dEFAULT_OPEN_IN_BINARY_MODE :: Bool
84 dEFAULT_OPEN_IN_BINARY_MODE = False
86 -- Is seeking on text-mode handles allowed, or not?
87 tEXT_MODE_SEEK_ALLOWED :: Bool
88 #if defined(mingw32_TARGET_OS)
89 tEXT_MODE_SEEK_ALLOWED = False
91 tEXT_MODE_SEEK_ALLOWED = True
95 -- ---------------------------------------------------------------------------
96 -- Creating a new handle
98 newFileHandle :: (MVar Handle__ -> IO ()) -> Handle__ -> IO Handle
99 newFileHandle finalizer hc = do
101 addMVarFinalizer m (finalizer m)
102 return (FileHandle m)
104 -- ---------------------------------------------------------------------------
105 -- Working with Handles
108 In the concurrent world, handles are locked during use. This is done
109 by wrapping an MVar around the handle which acts as a mutex over
110 operations on the handle.
112 To avoid races, we use the following bracketing operations. The idea
113 is to obtain the lock, do some operation and replace the lock again,
114 whether the operation succeeded or failed. We also want to handle the
115 case where the thread receives an exception while processing the IO
116 operation: in these cases we also want to relinquish the lock.
118 There are three versions of @withHandle@: corresponding to the three
119 possible combinations of:
121 - the operation may side-effect the handle
122 - the operation may return a result
124 If the operation generates an error or an exception is raised, the
125 original handle is always replaced [ this is the case at the moment,
126 but we might want to revisit this in the future --SDM ].
129 {-# INLINE withHandle #-}
130 withHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
131 withHandle fun h@(FileHandle m) act = withHandle' fun h m act
132 withHandle fun h@(DuplexHandle m _) act = withHandle' fun h m act
134 withHandle' fun h m act =
137 checkBufferInvariants h_
138 (h',v) <- catchException (act h_)
139 (\ ex -> putMVar m h_ >> throw (augmentIOError ex fun h h_))
140 checkBufferInvariants h'
144 {-# INLINE withHandle_ #-}
145 withHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a
146 withHandle_ fun h@(FileHandle m) act = withHandle_' fun h m act
147 withHandle_ fun h@(DuplexHandle m _) act = withHandle_' fun h m act
149 withHandle_' fun h m act =
152 checkBufferInvariants h_
153 v <- catchException (act h_)
154 (\ ex -> putMVar m h_ >> throw (augmentIOError ex fun h h_))
155 checkBufferInvariants h_
159 withAllHandles__ :: String -> Handle -> (Handle__ -> IO Handle__) -> IO ()
160 withAllHandles__ fun h@(FileHandle m) act = withHandle__' fun h m act
161 withAllHandles__ fun h@(DuplexHandle r w) act = do
162 withHandle__' fun h r act
163 withHandle__' fun h w act
165 withHandle__' fun h m act =
168 checkBufferInvariants h_
169 h' <- catchException (act h_)
170 (\ ex -> putMVar m h_ >> throw (augmentIOError ex fun h h_))
171 checkBufferInvariants h'
175 augmentIOError (IOException (IOError _ iot _ str fp)) fun h h_
176 = IOException (IOError (Just h) iot fun str filepath)
177 where filepath | Just _ <- fp = fp
178 | otherwise = Just (haFilePath h_)
179 augmentIOError other_exception _ _ _
182 -- ---------------------------------------------------------------------------
183 -- Wrapper for write operations.
185 wantWritableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
186 wantWritableHandle fun h@(FileHandle m) act
187 = wantWritableHandle' fun h m act
188 wantWritableHandle fun h@(DuplexHandle _ m) act
189 = wantWritableHandle' fun h m act
190 -- ToDo: in the Duplex case, we don't need to checkWritableHandle
193 :: String -> Handle -> MVar Handle__
194 -> (Handle__ -> IO a) -> IO a
195 wantWritableHandle' fun h m act
196 = withHandle_' fun h m (checkWritableHandle act)
198 checkWritableHandle act handle_
199 = case haType handle_ of
200 ClosedHandle -> ioe_closedHandle
201 SemiClosedHandle -> ioe_closedHandle
202 ReadHandle -> ioe_notWritable
203 ReadWriteHandle -> do
204 let ref = haBuffer handle_
207 if not (bufferIsWritable buf)
208 then do b <- flushReadBuffer (haFD handle_) buf
209 return b{ bufState=WriteBuffer }
211 writeIORef ref new_buf
213 _other -> act handle_
215 -- ---------------------------------------------------------------------------
216 -- Wrapper for read operations.
218 wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
219 wantReadableHandle fun h@(FileHandle m) act
220 = wantReadableHandle' fun h m act
221 wantReadableHandle fun h@(DuplexHandle m _) act
222 = wantReadableHandle' fun h m act
223 -- ToDo: in the Duplex case, we don't need to checkReadableHandle
226 :: String -> Handle -> MVar Handle__
227 -> (Handle__ -> IO a) -> IO a
228 wantReadableHandle' fun h m act
229 = withHandle_' fun h m (checkReadableHandle act)
231 checkReadableHandle act handle_ =
232 case haType handle_ of
233 ClosedHandle -> ioe_closedHandle
234 SemiClosedHandle -> ioe_closedHandle
235 AppendHandle -> ioe_notReadable
236 WriteHandle -> ioe_notReadable
237 ReadWriteHandle -> do
238 let ref = haBuffer handle_
240 when (bufferIsWritable buf) $ do
241 new_buf <- flushWriteBuffer (haFD handle_) buf
242 writeIORef ref new_buf{ bufState=ReadBuffer }
244 _other -> act handle_
246 -- ---------------------------------------------------------------------------
247 -- Wrapper for seek operations.
249 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
250 wantSeekableHandle fun h@(DuplexHandle _ _) _act =
251 ioException (IOError (Just h) IllegalOperation fun
252 "handle is not seekable" Nothing)
253 wantSeekableHandle fun h@(FileHandle m) act =
254 withHandle_' fun h m (checkSeekableHandle act)
256 checkSeekableHandle act handle_ =
257 case haType handle_ of
258 ClosedHandle -> ioe_closedHandle
259 SemiClosedHandle -> ioe_closedHandle
260 AppendHandle -> ioe_notSeekable
261 _ | haIsBin handle_ || tEXT_MODE_SEEK_ALLOWED -> act handle_
262 | otherwise -> ioe_notSeekable_notBin
264 -- -----------------------------------------------------------------------------
267 ioe_closedHandle, ioe_EOF,
268 ioe_notReadable, ioe_notWritable,
269 ioe_notSeekable, ioe_notSeekable_notBin :: IO a
271 ioe_closedHandle = ioException
272 (IOError Nothing IllegalOperation ""
273 "handle is closed" Nothing)
274 ioe_EOF = ioException
275 (IOError Nothing EOF "" "" Nothing)
276 ioe_notReadable = ioException
277 (IOError Nothing IllegalOperation ""
278 "handle is not open for reading" Nothing)
279 ioe_notWritable = ioException
280 (IOError Nothing IllegalOperation ""
281 "handle is not open for writing" Nothing)
282 ioe_notSeekable = ioException
283 (IOError Nothing IllegalOperation ""
284 "handle is not seekable" Nothing)
285 ioe_notSeekable_notBin = ioException
286 (IOError Nothing IllegalOperation ""
287 "seek operations on text-mode handles are not allowed on this platform"
290 ioe_bufsiz :: Int -> IO a
291 ioe_bufsiz n = ioException
292 (IOError Nothing InvalidArgument "hSetBuffering"
293 ("illegal buffer size " ++ showsPrec 9 n []) Nothing)
294 -- 9 => should be parens'ified.
296 -- -----------------------------------------------------------------------------
299 -- For a duplex handle, we arrange that the read side points to the write side
300 -- (and hence keeps it alive if the read side is alive). This is done by
301 -- having the haType field of the read side be ReadSideHandle with a pointer
302 -- to the write side. The finalizer is then placed on the write side, and
303 -- the handle only gets finalized once, when both sides are no longer
306 addFinalizer :: Handle -> IO ()
307 addFinalizer (FileHandle m) = addMVarFinalizer m (handleFinalizer m)
308 addFinalizer (DuplexHandle _ w) = addMVarFinalizer w (handleFinalizer w)
310 stdHandleFinalizer :: MVar Handle__ -> IO ()
311 stdHandleFinalizer m = do
313 flushWriteBufferOnly h_
315 handleFinalizer :: MVar Handle__ -> IO ()
316 handleFinalizer m = do
318 flushWriteBufferOnly h_
319 let fd = fromIntegral (haFD h_)
321 -- ToDo: closesocket() for a WINSOCK socket?
322 when (fd /= -1) (c_close fd >> return ())
325 -- ---------------------------------------------------------------------------
326 -- Grimy buffer operations
329 checkBufferInvariants h_ = do
330 let ref = haBuffer h_
331 Buffer{ bufWPtr=w, bufRPtr=r, bufSize=size, bufState=state } <- readIORef ref
336 && ( r /= w || (r == 0 && w == 0) )
337 && ( state /= WriteBuffer || r == 0 )
338 && ( state /= WriteBuffer || w < size ) -- write buffer is never full
340 then error "buffer invariant violation"
343 checkBufferInvariants h_ = return ()
346 newEmptyBuffer :: RawBuffer -> BufferState -> Int -> Buffer
347 newEmptyBuffer b state size
348 = Buffer{ bufBuf=b, bufRPtr=0, bufWPtr=0, bufSize=size, bufState=state }
350 allocateBuffer :: Int -> BufferState -> IO Buffer
351 allocateBuffer sz@(I## size) state = IO $ \s ->
352 case newByteArray## size s of { (## s, b ##) ->
353 (## s, newEmptyBuffer b state sz ##) }
355 writeCharIntoBuffer :: RawBuffer -> Int -> Char -> IO Int
356 writeCharIntoBuffer slab (I## off) (C## c)
357 = IO $ \s -> case writeCharArray## slab off c s of
358 s -> (## s, I## (off +## 1##) ##)
360 readCharFromBuffer :: RawBuffer -> Int -> IO (Char, Int)
361 readCharFromBuffer slab (I## off)
362 = IO $ \s -> case readCharArray## slab off s of
363 (## s, c ##) -> (## s, (C## c, I## (off +## 1##)) ##)
365 dEFAULT_BUFFER_SIZE = (#const BUFSIZ) :: Int
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 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_) 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) (#const SEEK_CUR))
424 return buf{ bufWPtr=0, bufRPtr=0 }
426 flushWriteBuffer :: FD -> Buffer -> IO Buffer
427 flushWriteBuffer fd 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 (fromIntegral fd) b (fromIntegral r)
437 (fromIntegral bytes))
439 let res' = fromIntegral res
441 then flushWriteBuffer fd (buf{ bufRPtr = r + res' })
442 else return buf{ bufRPtr=0, bufWPtr=0 }
444 foreign import "write_PrelHandle_wrap" unsafe
445 write_off :: CInt -> RawBuffer -> Int -> CInt -> IO CInt
447 int write_PrelHandle_wrap(int fd, void *ptr, HsInt off, int size) \
448 { return write(fd, ptr + off, size); }
451 fillReadBuffer :: FD -> Bool -> Buffer -> IO Buffer
452 fillReadBuffer fd is_line
453 buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w, bufSize=size } =
454 -- buffer better be empty:
455 assert (r == 0 && w == 0) $ do
456 fillReadBufferLoop fd is_line buf b w size
458 -- For a line buffer, we just get the first chunk of data to arrive,
459 -- and don't wait for the whole buffer to be full (but we *do* wait
460 -- until some data arrives). This isn't really line buffering, but it
461 -- appears to be what GHC has done for a long time, and I suspect it
462 -- is more useful than line buffering in most cases.
464 fillReadBufferLoop fd is_line buf b w size = do
466 if bytes == 0 -- buffer full?
467 then return buf{ bufRPtr=0, bufWPtr=w }
470 puts ("fillReadBufferLoop: bytes = " ++ show bytes ++ "\n")
472 res <- throwErrnoIfMinus1RetryMayBlock "fillReadBuffer"
473 (read_off fd b (fromIntegral w) (fromIntegral bytes))
475 let res' = fromIntegral res
477 puts ("fillReadBufferLoop: res' = " ++ show res' ++ "\n")
482 else return buf{ bufRPtr=0, bufWPtr=w }
483 else if res' < bytes && not is_line
484 then fillReadBufferLoop fd is_line buf b (w+res') size
485 else return buf{ bufRPtr=0, bufWPtr=w+res' }
487 foreign import "read_PrelHandle_wrap" unsafe
488 read_off :: FD -> RawBuffer -> Int -> CInt -> IO CInt
490 int read_PrelHandle_wrap(int fd, void *ptr, HsInt off, int size) \
491 { return read(fd, ptr + off, size); }
493 -- ---------------------------------------------------------------------------
496 -- Three handles are allocated during program initialisation. The first
497 -- two manage input or output from the Haskell program's standard input
498 -- or output channel respectively. The third manages output to the
499 -- standard error channel. These handles are initially open.
506 stdin = unsafePerformIO $ do
507 -- ToDo: acquire lock
508 setNonBlockingFD fd_stdin
509 (buf, bmode) <- getBuffer fd_stdin ReadBuffer
510 spares <- newIORef BufferListNil
511 newFileHandle stdHandleFinalizer
512 (Handle__ { haFD = fd_stdin,
514 haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
515 haBufferMode = bmode,
516 haFilePath = "<stdin>",
522 stdout = unsafePerformIO $ do
523 -- ToDo: acquire lock
524 -- We don't set non-blocking mode on stdout or sterr, because
525 -- some shells don't recover properly.
526 -- setNonBlockingFD fd_stdout
527 (buf, bmode) <- getBuffer fd_stdout WriteBuffer
528 spares <- newIORef BufferListNil
529 newFileHandle stdHandleFinalizer
530 (Handle__ { haFD = fd_stdout,
531 haType = WriteHandle,
532 haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
533 haBufferMode = bmode,
534 haFilePath = "<stdout>",
540 stderr = unsafePerformIO $ do
541 -- ToDo: acquire lock
542 -- We don't set non-blocking mode on stdout or sterr, because
543 -- some shells don't recover properly.
544 -- setNonBlockingFD fd_stderr
546 spares <- newIORef BufferListNil
547 newFileHandle stdHandleFinalizer
548 (Handle__ { haFD = fd_stderr,
549 haType = WriteHandle,
550 haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
551 haBufferMode = NoBuffering,
552 haFilePath = "<stderr>",
557 -- ---------------------------------------------------------------------------
558 -- Opening and Closing Files
561 Computation `openFile file mode' allocates and returns a new, open
562 handle to manage the file `file'. It manages input if `mode'
563 is `ReadMode', output if `mode' is `WriteMode' or `AppendMode',
564 and both input and output if mode is `ReadWriteMode'.
566 If the file does not exist and it is opened for output, it should be
567 created as a new file. If `mode' is `WriteMode' and the file
568 already exists, then it should be truncated to zero length. The
569 handle is positioned at the end of the file if `mode' is
570 `AppendMode', and otherwise at the beginning (in which case its
571 internal position is 0).
573 Implementations should enforce, locally to the Haskell process,
574 multiple-reader single-writer locking on files, which is to say that
575 there may either be many handles on the same file which manage input,
576 or just one handle on the file which manages output. If any open or
577 semi-closed handle is managing a file for output, no new handle can be
578 allocated for that file. If any open or semi-closed handle is
579 managing a file for input, new handles can only be allocated if they
580 do not manage output.
582 Two files are the same if they have the same absolute name. An
583 implementation is free to impose stricter conditions.
586 data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode
587 deriving (Eq, Ord, Ix, Enum, Read, Show)
592 deriving (Eq, Read, Show)
594 addFilePathToIOError fun fp (IOException (IOError h iot _ str _))
595 = IOException (IOError h iot fun str (Just fp))
596 addFilePathToIOError _ _ other_exception
599 openFile :: FilePath -> IOMode -> IO Handle
602 (openFile' fp (if dEFAULT_OPEN_IN_BINARY_MODE
605 (\e -> throw (addFilePathToIOError "openFile" fp e))
607 openFileEx :: FilePath -> IOModeEx -> IO Handle
611 (\e -> throw (addFilePathToIOError "openFileEx" fp e))
614 openFile' filepath ex_mode =
615 withCString filepath $ \ f ->
620 BinaryMode bmo -> (bmo, True)
621 TextMode tmo -> (tmo, False)
623 oflags1 = case mode of
624 ReadMode -> read_flags
625 WriteMode -> write_flags
626 ReadWriteMode -> rw_flags
627 AppendMode -> append_flags
629 truncate | WriteMode <- mode = True
638 oflags = oflags1 .|. binary_flags
641 -- the old implementation had a complicated series of three opens,
642 -- which is perhaps because we have to be careful not to open
643 -- directories. However, the man pages I've read say that open()
644 -- always returns EISDIR if the file is a directory and was opened
645 -- for writing, so I think we're ok with a single open() here...
646 fd <- fromIntegral `liftM`
647 throwErrnoIfMinus1Retry "openFile"
648 (c_open f (fromIntegral oflags) 0o666)
650 openFd fd filepath mode binary truncate
651 -- ASSERT: if we just created the file, then openFd won't fail
652 -- (so we don't need to worry about removing the newly created file
653 -- in the event of an error).
656 std_flags = o_NONBLOCK .|. o_NOCTTY
657 output_flags = std_flags .|. o_CREAT
658 read_flags = std_flags .|. o_RDONLY
659 write_flags = output_flags .|. o_WRONLY
660 rw_flags = output_flags .|. o_RDWR
661 append_flags = write_flags .|. o_APPEND
663 -- ---------------------------------------------------------------------------
666 openFd :: FD -> FilePath -> IOMode -> Bool -> Bool -> IO Handle
667 openFd fd filepath mode binary truncate = do
668 -- turn on non-blocking mode
671 let (ha_type, write) =
673 ReadMode -> ( ReadHandle, False )
674 WriteMode -> ( WriteHandle, True )
675 ReadWriteMode -> ( ReadWriteHandle, True )
676 AppendMode -> ( AppendHandle, True )
678 -- open() won't tell us if it was a directory if we only opened for
679 -- reading, so check again.
683 ioException (IOError Nothing InappropriateType "openFile"
684 "is a directory" Nothing)
687 | ReadWriteHandle <- ha_type -> mkDuplexHandle fd filepath binary
688 | otherwise -> mkFileHandle fd filepath ha_type binary
690 -- regular files need to be locked
692 r <- lockFile (fromIntegral fd) (fromBool write) 1{-exclusive-}
694 ioException (IOError Nothing ResourceBusy "openFile"
695 "file is locked" Nothing)
697 -- truncate the file if necessary
698 when truncate (fileTruncate filepath)
700 mkFileHandle fd filepath ha_type binary
703 foreign import "lockFile" unsafe
704 lockFile :: CInt -> CInt -> CInt -> IO CInt
706 foreign import "unlockFile" unsafe
707 unlockFile :: CInt -> IO CInt
709 mkFileHandle :: FD -> FilePath -> HandleType -> Bool -> IO Handle
710 mkFileHandle fd filepath ha_type binary = do
711 (buf, bmode) <- getBuffer fd (initBufferState ha_type)
712 spares <- newIORef BufferListNil
713 newFileHandle handleFinalizer
714 (Handle__ { haFD = fd,
717 haBufferMode = bmode,
718 haFilePath = filepath,
723 mkDuplexHandle :: FD -> FilePath -> Bool -> IO Handle
724 mkDuplexHandle fd filepath binary = do
725 (w_buf, w_bmode) <- getBuffer fd WriteBuffer
726 w_spares <- newIORef BufferListNil
728 Handle__ { haFD = fd,
729 haType = WriteHandle,
731 haBufferMode = w_bmode,
732 haFilePath = filepath,
736 write_side <- newMVar w_handle_
738 (r_buf, r_bmode) <- getBuffer fd ReadBuffer
739 r_spares <- newIORef BufferListNil
741 Handle__ { haFD = fd,
742 haType = ReadSideHandle write_side,
744 haBufferMode = r_bmode,
745 haFilePath = filepath,
749 read_side <- newMVar r_handle_
751 addMVarFinalizer write_side (handleFinalizer write_side)
752 return (DuplexHandle read_side write_side)
755 initBufferState ReadHandle = ReadBuffer
756 initBufferState _ = WriteBuffer
758 -- ---------------------------------------------------------------------------
761 -- Computation `hClose hdl' makes handle `hdl' closed. Before the
762 -- computation finishes, any items buffered for output and not already
763 -- sent to the operating system are flushed as for `hFlush'.
765 -- For a duplex handle, we close&flush the write side, and just close
768 hClose :: Handle -> IO ()
769 hClose h@(FileHandle m) = hClose' h m
770 hClose h@(DuplexHandle r w) = do
772 withHandle__' "hClose" h r $ \ handle_ -> do
773 return handle_{ haFD = -1,
774 haType = ClosedHandle
777 hClose' h m = withHandle__' "hClose" h m $ hClose_help
779 hClose_help handle_ =
780 case haType handle_ of
781 ClosedHandle -> return handle_
783 let fd = fromIntegral (haFD handle_)
784 flushWriteBufferOnly handle_
785 throwErrnoIfMinus1Retry_ "hClose" (c_close fd)
787 -- free the spare buffers
788 writeIORef (haBuffers handle_) BufferListNil
793 -- we must set the fd to -1, because the finalizer is going
794 -- to run eventually and try to close/unlock it.
795 return (handle_{ haFD = -1,
796 haType = ClosedHandle
799 -----------------------------------------------------------------------------
800 -- Detecting the size of a file
802 -- For a handle `hdl' which attached to a physical file, `hFileSize
803 -- hdl' returns the size of `hdl' in terms of the number of items
804 -- which can be read from `hdl'.
806 hFileSize :: Handle -> IO Integer
808 withHandle_ "hFileSize" handle $ \ handle_ -> do
809 case haType handle_ of
810 ClosedHandle -> ioe_closedHandle
811 SemiClosedHandle -> ioe_closedHandle
812 _ -> do flushWriteBufferOnly handle_
813 r <- fdFileSize (haFD handle_)
816 else ioException (IOError Nothing InappropriateType "hFileSize"
817 "not a regular file" Nothing)
819 -- ---------------------------------------------------------------------------
820 -- Detecting the End of Input
822 -- For a readable handle `hdl', `hIsEOF hdl' returns
823 -- `True' if no further input can be taken from `hdl' or for a
824 -- physical file, if the current I/O position is equal to the length of
825 -- the file. Otherwise, it returns `False'.
827 hIsEOF :: Handle -> IO Bool
830 (do hLookAhead handle; return False)
831 (\e -> if isEOFError e then return True else throw e)
836 -- ---------------------------------------------------------------------------
839 -- hLookahead returns the next character from the handle without
840 -- removing it from the input buffer, blocking until a character is
843 hLookAhead :: Handle -> IO Char
844 hLookAhead handle = do
845 wantReadableHandle "hLookAhead" handle $ \handle_ -> do
846 let ref = haBuffer handle_
848 is_line = haBufferMode handle_ == LineBuffering
851 -- fill up the read buffer if necessary
852 new_buf <- if bufferEmpty buf
853 then fillReadBuffer fd is_line buf
856 writeIORef ref new_buf
858 (c,_) <- readCharFromBuffer (bufBuf buf) (bufRPtr buf)
861 -- ---------------------------------------------------------------------------
862 -- Buffering Operations
864 -- Three kinds of buffering are supported: line-buffering,
865 -- block-buffering or no-buffering. See PrelIOBase for definition and
866 -- further explanation of what the type represent.
868 -- Computation `hSetBuffering hdl mode' sets the mode of buffering for
869 -- handle hdl on subsequent reads and writes.
871 -- * If mode is LineBuffering, line-buffering should be enabled if possible.
873 -- * If mode is `BlockBuffering size', then block-buffering
874 -- should be enabled if possible. The size of the buffer is n items
875 -- if size is `Just n' and is otherwise implementation-dependent.
877 -- * If mode is NoBuffering, then buffering is disabled if possible.
879 -- If the buffer mode is changed from BlockBuffering or
880 -- LineBuffering to NoBuffering, then any items in the output
881 -- buffer are written to the device, and any items in the input buffer
882 -- are discarded. The default buffering mode when a handle is opened
883 -- is implementation-dependent and may depend on the object which is
884 -- attached to that handle.
886 hSetBuffering :: Handle -> BufferMode -> IO ()
887 hSetBuffering handle mode =
888 withAllHandles__ "hSetBuffering" handle $ \ handle_ -> do
889 case haType handle_ of
890 ClosedHandle -> ioe_closedHandle
893 - we flush the old buffer regardless of whether
894 the new buffer could fit the contents of the old buffer
896 - allow a handle's buffering to change even if IO has
897 occurred (ANSI C spec. does not allow this, nor did
898 the previous implementation of IO.hSetBuffering).
899 - a non-standard extension is to allow the buffering
900 of semi-closed handles to change [sof 6/98]
904 let state = initBufferState (haType handle_)
907 -- we always have a 1-character read buffer for
908 -- unbuffered handles: it's needed to
909 -- support hLookAhead.
910 NoBuffering -> allocateBuffer 1 ReadBuffer
911 LineBuffering -> allocateBuffer dEFAULT_BUFFER_SIZE state
912 BlockBuffering Nothing -> allocateBuffer dEFAULT_BUFFER_SIZE state
913 BlockBuffering (Just n) | n <= 0 -> ioe_bufsiz n
914 | otherwise -> allocateBuffer n state
915 writeIORef (haBuffer handle_) new_buf
917 -- for input terminals we need to put the terminal into
918 -- cooked or raw mode depending on the type of buffering.
919 is_tty <- fdIsTTY (haFD handle_)
920 when (is_tty && isReadableHandleType (haType handle_)) $
922 NoBuffering -> setCooked (haFD handle_) False
923 _ -> setCooked (haFD handle_) True
925 -- throw away spare buffers, they might be the wrong size
926 writeIORef (haBuffers handle_) BufferListNil
928 return (handle_{ haBufferMode = mode })
930 -- -----------------------------------------------------------------------------
933 -- The action `hFlush hdl' causes any items buffered for output
934 -- in handle `hdl' to be sent immediately to the operating
937 hFlush :: Handle -> IO ()
939 wantWritableHandle "hFlush" handle $ \ handle_ -> do
940 buf <- readIORef (haBuffer handle_)
941 if bufferIsWritable buf && not (bufferEmpty buf)
942 then do flushed_buf <- flushWriteBuffer (haFD handle_) buf
943 writeIORef (haBuffer handle_) flushed_buf
947 -- -----------------------------------------------------------------------------
948 -- Repositioning Handles
950 data HandlePosn = HandlePosn Handle HandlePosition
952 instance Eq HandlePosn where
953 (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
955 instance Show HandlePosn where
956 showsPrec p (HandlePosn h pos) =
957 showsPrec p h . showString " at position " . shows pos
959 -- HandlePosition is the Haskell equivalent of POSIX' off_t.
960 -- We represent it as an Integer on the Haskell side, but
961 -- cheat slightly in that hGetPosn calls upon a C helper
962 -- that reports the position back via (merely) an Int.
963 type HandlePosition = Integer
965 -- Computation `hGetPosn hdl' returns the current I/O position of
966 -- `hdl' as an abstract position. Computation `hSetPosn p' sets the
967 -- position of `hdl' to a previously obtained position `p'.
969 hGetPosn :: Handle -> IO HandlePosn
971 wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
974 -- urgh, on Windows we have to worry about \n -> \r\n translation,
975 -- so we can't easily calculate the file position using the
976 -- current buffer size. Just flush instead.
979 let fd = fromIntegral (haFD handle_)
980 posn <- fromIntegral `liftM`
981 throwErrnoIfMinus1Retry "hGetPosn"
982 (c_lseek fd 0 (#const SEEK_CUR))
984 let ref = haBuffer handle_
988 | bufferIsWritable buf = posn + fromIntegral (bufWPtr buf)
989 | otherwise = posn - fromIntegral (bufWPtr buf - bufRPtr buf)
991 puts ("\nhGetPosn: (fd, posn, real_posn) = " ++ show (fd, posn, real_posn) ++ "\n")
992 puts (" (bufWPtr, bufRPtr) = " ++ show (bufWPtr buf, bufRPtr buf) ++ "\n")
994 return (HandlePosn handle real_posn)
997 hSetPosn :: HandlePosn -> IO ()
998 hSetPosn (HandlePosn h i) = hSeek h AbsoluteSeek i
1000 -- ---------------------------------------------------------------------------
1004 The action `hSeek hdl mode i' sets the position of handle
1005 `hdl' depending on `mode'. If `mode' is
1007 * AbsoluteSeek - The position of `hdl' is set to `i'.
1008 * RelativeSeek - The position of `hdl' is set to offset `i' from
1009 the current position.
1010 * SeekFromEnd - The position of `hdl' is set to offset `i' from
1011 the end of the file.
1013 Some handles may not be seekable (see `hIsSeekable'), or only
1014 support a subset of the possible positioning operations (e.g. it may
1015 only be possible to seek to the end of a tape, or to a positive
1016 offset from the beginning or current position).
1018 It is not possible to set a negative I/O position, or for a physical
1019 file, an I/O position beyond the current end-of-file.
1022 - when seeking using `SeekFromEnd', positive offsets (>=0) means
1023 seeking at or past EOF.
1025 - we possibly deviate from the report on the issue of seeking within
1026 the buffer and whether to flush it or not. The report isn't exactly
1030 data SeekMode = AbsoluteSeek | RelativeSeek | SeekFromEnd
1031 deriving (Eq, Ord, Ix, Enum, Read, Show)
1033 hSeek :: Handle -> SeekMode -> Integer -> IO ()
1034 hSeek handle mode offset =
1035 wantSeekableHandle "hSeek" handle $ \ handle_ -> do
1037 puts ("hSeek " ++ show (mode,offset) ++ "\n")
1039 let ref = haBuffer handle_
1040 buf <- readIORef ref
1046 throwErrnoIfMinus1Retry_ "hSeek"
1047 (c_lseek (fromIntegral (haFD handle_)) (fromIntegral offset) whence)
1050 whence = case mode of
1051 AbsoluteSeek -> (#const SEEK_SET)
1052 RelativeSeek -> (#const SEEK_CUR)
1053 SeekFromEnd -> (#const SEEK_END)
1055 if bufferIsWritable buf
1056 then do new_buf <- flushWriteBuffer fd buf
1057 writeIORef ref new_buf
1061 if mode == RelativeSeek && offset >= 0 && offset < fromIntegral (w - r)
1062 then writeIORef ref buf{ bufRPtr = r + fromIntegral offset }
1065 new_buf <- flushReadBuffer (haFD handle_) buf
1066 writeIORef ref new_buf
1069 -- -----------------------------------------------------------------------------
1070 -- Handle Properties
1072 -- A number of operations return information about the properties of a
1073 -- handle. Each of these operations returns `True' if the handle has
1074 -- the specified property, and `False' otherwise.
1076 hIsOpen :: Handle -> IO Bool
1078 withHandle_ "hIsOpen" handle $ \ handle_ -> do
1079 case haType handle_ of
1080 ClosedHandle -> return False
1081 SemiClosedHandle -> return False
1084 hIsClosed :: Handle -> IO Bool
1086 withHandle_ "hIsClosed" handle $ \ handle_ -> do
1087 case haType handle_ of
1088 ClosedHandle -> return True
1091 {- not defined, nor exported, but mentioned
1092 here for documentation purposes:
1094 hSemiClosed :: Handle -> IO Bool
1098 return (not (ho || hc))
1101 hIsReadable :: Handle -> IO Bool
1102 hIsReadable (DuplexHandle _ _) = return True
1103 hIsReadable handle =
1104 withHandle_ "hIsReadable" handle $ \ handle_ -> do
1105 case haType handle_ of
1106 ClosedHandle -> ioe_closedHandle
1107 SemiClosedHandle -> ioe_closedHandle
1108 htype -> return (isReadableHandleType htype)
1110 hIsWritable :: Handle -> IO Bool
1111 hIsWritable (DuplexHandle _ _) = return False
1112 hIsWritable handle =
1113 withHandle_ "hIsWritable" handle $ \ handle_ -> do
1114 case haType handle_ of
1115 ClosedHandle -> ioe_closedHandle
1116 SemiClosedHandle -> ioe_closedHandle
1117 htype -> return (isWritableHandleType htype)
1119 -- Querying how a handle buffers its data:
1121 hGetBuffering :: Handle -> IO BufferMode
1122 hGetBuffering handle =
1123 withHandle_ "hGetBuffering" handle $ \ handle_ -> do
1124 case haType handle_ of
1125 ClosedHandle -> ioe_closedHandle
1127 -- We're being non-standard here, and allow the buffering
1128 -- of a semi-closed handle to be queried. -- sof 6/98
1129 return (haBufferMode handle_) -- could be stricter..
1131 hIsSeekable :: Handle -> IO Bool
1132 hIsSeekable handle =
1133 withHandle_ "hIsSeekable" handle $ \ handle_ -> do
1134 case haType handle_ of
1135 ClosedHandle -> ioe_closedHandle
1136 SemiClosedHandle -> ioe_closedHandle
1137 AppendHandle -> return False
1138 _ -> do t <- fdType (haFD handle_)
1139 return (t == RegularFile
1140 && (haIsBin handle_ || tEXT_MODE_SEEK_ALLOWED))
1142 -- -----------------------------------------------------------------------------
1143 -- Changing echo status
1145 -- Non-standard GHC extension is to allow the echoing status
1146 -- of a handles connected to terminals to be reconfigured:
1148 hSetEcho :: Handle -> Bool -> IO ()
1149 hSetEcho handle on = do
1150 isT <- hIsTerminalDevice handle
1154 withHandle_ "hSetEcho" handle $ \ handle_ -> do
1155 case haType handle_ of
1156 ClosedHandle -> ioe_closedHandle
1157 _ -> setEcho (haFD handle_) on
1159 hGetEcho :: Handle -> IO Bool
1160 hGetEcho handle = do
1161 isT <- hIsTerminalDevice handle
1165 withHandle_ "hGetEcho" handle $ \ handle_ -> do
1166 case haType handle_ of
1167 ClosedHandle -> ioe_closedHandle
1168 _ -> getEcho (haFD handle_)
1170 hIsTerminalDevice :: Handle -> IO Bool
1171 hIsTerminalDevice handle = do
1172 withHandle_ "hIsTerminalDevice" handle $ \ handle_ -> do
1173 case haType handle_ of
1174 ClosedHandle -> ioe_closedHandle
1175 _ -> fdIsTTY (haFD handle_)
1177 -- -----------------------------------------------------------------------------
1181 hSetBinaryMode handle bin =
1182 withAllHandles__ "hSetBinaryMode" handle $ \ handle_ ->
1183 do let flg | bin = (#const O_BINARY)
1184 | otherwise = (#const O_TEXT)
1185 throwErrnoIfMinus1_ "hSetBinaryMode"
1186 (setmode (fromIntegral (haFD handle_)) flg)
1187 return handle_{haIsBin=bin}
1189 foreign import "setmode" setmode :: CInt -> CInt -> IO CInt
1191 hSetBinaryMode handle bin =
1192 withAllHandles__ "hSetBinaryMode" handle $ \ handle_ ->
1193 return handle_{haIsBin=bin}
1196 -- -----------------------------------------------------------------------------
1199 -- These three functions are meant to get things out of an IOError.
1201 ioeGetFileName :: IOError -> Maybe FilePath
1202 ioeGetErrorString :: IOError -> String
1203 ioeGetHandle :: IOError -> Maybe Handle
1205 ioeGetHandle (IOException (IOError h _ _ _ _)) = h
1206 ioeGetHandle (UserError _) = Nothing
1207 ioeGetHandle _ = error "IO.ioeGetHandle: not an IO error"
1209 ioeGetErrorString (IOException (IOError _ iot _ _ _)) = show iot
1210 ioeGetErrorString (UserError str) = str
1211 ioeGetErrorString _ = error "IO.ioeGetErrorString: not an IO error"
1213 ioeGetFileName (IOException (IOError _ _ _ _ fn)) = fn
1214 ioeGetFileName (UserError _) = Nothing
1215 ioeGetFileName _ = error "IO.ioeGetFileName: not an IO error"
1217 -- ---------------------------------------------------------------------------
1221 puts :: String -> IO ()
1222 puts s = withCString s $ \cstr -> do c_write 1 cstr (fromIntegral (length s))