module GHC.IO.Handle (
Handle,
BufferMode(..),
mkFileHandle, mkDuplexHandle,
hFileSize, hSetFileSize, hIsEOF, hLookAhead,
hSetBuffering, hSetBinaryMode, hSetEncoding, hGetEncoding,
hFlush, hFlushAll, hDuplicate, hDuplicateTo,
hClose, hClose_help,
HandlePosition, HandlePosn(..), hGetPosn, hSetPosn,
SeekMode(..), hSeek, hTell,
hIsOpen, hIsClosed, hIsReadable, hIsWritable, hGetBuffering, hIsSeekable,
hSetEcho, hGetEcho, hIsTerminalDevice,
hSetNewlineMode, Newline(..), NewlineMode(..), nativeNewline,
noNewlineTranslation, universalNewlineMode, nativeNewlineMode,
hShow,
hWaitForInput, hGetChar, hGetLine, hGetContents, hPutChar, hPutStr,
hGetBuf, hGetBufNonBlocking, hPutBuf, hPutBufNonBlocking
) where
import GHC.IO
import GHC.IO.Exception
import GHC.IO.Encoding
import GHC.IO.Buffer
import GHC.IO.BufferedIO ( BufferedIO )
import GHC.IO.Device as IODevice
import GHC.IO.Handle.Types
import GHC.IO.Handle.Internals
import GHC.IO.Handle.Text
import qualified GHC.IO.BufferedIO as Buffered
import GHC.Base
import GHC.Exception
import GHC.MVar
import GHC.IORef
import GHC.Show
import GHC.Num
import GHC.Real
import Data.Maybe
import Data.Typeable
import Control.Monad
hClose :: Handle -> IO ()
hClose h@(FileHandle _ m) = do
mb_exc <- hClose' h m
hClose_maybethrow mb_exc h
hClose h@(DuplexHandle _ r w) = do
excs <- mapM (hClose' h) [r,w]
hClose_maybethrow (listToMaybe (catMaybes excs)) h
hClose_maybethrow :: Maybe SomeException -> Handle -> IO ()
hClose_maybethrow Nothing h = return ()
hClose_maybethrow (Just e) h = hClose_rethrow e h
hClose_rethrow :: SomeException -> Handle -> IO ()
hClose_rethrow e h =
case fromException e of
Just ioe -> ioError (augmentIOError ioe "hClose" h)
Nothing -> throwIO e
hClose' :: Handle -> MVar Handle__ -> IO (Maybe SomeException)
hClose' h m = withHandle' "hClose" h m $ hClose_help
hFileSize :: Handle -> IO Integer
hFileSize handle =
withHandle_ "hFileSize" handle $ \ handle_@Handle__{haDevice=dev} -> do
case haType handle_ of
ClosedHandle -> ioe_closedHandle
SemiClosedHandle -> ioe_closedHandle
_ -> do flushWriteBuffer handle_
r <- IODevice.getSize dev
if r /= 1
then return r
else ioException (IOError Nothing InappropriateType "hFileSize"
"not a regular file" Nothing Nothing)
hSetFileSize :: Handle -> Integer -> IO ()
hSetFileSize handle size =
withHandle_ "hSetFileSize" handle $ \ handle_@Handle__{haDevice=dev} -> do
case haType handle_ of
ClosedHandle -> ioe_closedHandle
SemiClosedHandle -> ioe_closedHandle
_ -> do flushWriteBuffer handle_
IODevice.setSize dev size
return ()
hIsEOF :: Handle -> IO Bool
hIsEOF handle = wantReadableHandle_ "hIsEOF" handle $ \Handle__{..} -> do
cbuf <- readIORef haCharBuffer
if not (isEmptyBuffer cbuf) then return False else do
bbuf <- readIORef haByteBuffer
if not (isEmptyBuffer bbuf) then return False else do
(r,bbuf') <- Buffered.fillReadBuffer haDevice bbuf
if r == 0
then return True
else do writeIORef haByteBuffer bbuf'
return False
hLookAhead :: Handle -> IO Char
hLookAhead handle =
wantReadableHandle_ "hLookAhead" handle hLookAhead_
hSetBuffering :: Handle -> BufferMode -> IO ()
hSetBuffering handle mode =
withAllHandles__ "hSetBuffering" handle $ \ handle_@Handle__{..} -> do
case haType of
ClosedHandle -> ioe_closedHandle
_ -> do
if mode == haBufferMode then return handle_ else do
case mode of
BlockBuffering (Just n) | n <= 0 -> ioe_bufsiz n
_ -> return ()
is_tty <- IODevice.isTerminal haDevice
when (is_tty && isReadableHandleType haType) $
case mode of
#ifndef mingw32_HOST_OS
NoBuffering -> IODevice.setRaw haDevice True
#else
NoBuffering -> return ()
#endif
_ -> IODevice.setRaw haDevice False
writeIORef haBuffers BufferListNil
return Handle__{ haBufferMode = mode,.. }
hSetEncoding :: Handle -> TextEncoding -> IO ()
hSetEncoding hdl encoding = do
withAllHandles__ "hSetEncoding" hdl $ \h_@Handle__{..} -> do
flushCharBuffer h_
closeTextCodecs h_
openTextEncoding (Just encoding) haType $ \ mb_encoder mb_decoder -> do
bbuf <- readIORef haByteBuffer
ref <- newIORef (error "last_decode")
return (Handle__{ haLastDecode = ref,
haDecoder = mb_decoder,
haEncoder = mb_encoder,
haCodec = Just encoding, .. })
hGetEncoding :: Handle -> IO (Maybe TextEncoding)
hGetEncoding hdl =
withHandle_ "hGetEncoding" hdl $ \h_@Handle__{..} -> return haCodec
hFlush :: Handle -> IO ()
hFlush handle = wantWritableHandle "hFlush" handle flushWriteBuffer
hFlushAll :: Handle -> IO ()
hFlushAll handle = withHandle_ "hFlushAll" handle flushBuffer
data HandlePosn = HandlePosn Handle HandlePosition
instance Eq HandlePosn where
(HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
instance Show HandlePosn where
showsPrec p (HandlePosn h pos) =
showsPrec p h . showString " at position " . shows pos
type HandlePosition = Integer
hGetPosn :: Handle -> IO HandlePosn
hGetPosn handle = do
posn <- hTell handle
return (HandlePosn handle posn)
hSetPosn :: HandlePosn -> IO ()
hSetPosn (HandlePosn h i) = hSeek h AbsoluteSeek i
hSeek :: Handle -> SeekMode -> Integer -> IO ()
hSeek handle mode offset =
wantSeekableHandle "hSeek" handle $ \ handle_@Handle__{..} -> do
debugIO ("hSeek " ++ show (mode,offset))
buf <- readIORef haCharBuffer
if isWriteBuffer buf
then do flushWriteBuffer handle_
IODevice.seek haDevice mode offset
else do
let r = bufL buf; w = bufR buf
if mode == RelativeSeek && isNothing haDecoder &&
offset >= 0 && offset < fromIntegral (w r)
then writeIORef haCharBuffer buf{ bufL = r + fromIntegral offset }
else do
flushCharReadBuffer handle_
flushByteReadBuffer handle_
IODevice.seek haDevice mode offset
hTell :: Handle -> IO Integer
hTell handle =
wantSeekableHandle "hGetPosn" handle $ \ handle_@Handle__{..} -> do
posn <- IODevice.tell haDevice
flushCharBuffer handle_
bbuf <- readIORef haByteBuffer
let real_posn
| isWriteBuffer bbuf = posn + fromIntegral (bufferElems bbuf)
| otherwise = posn fromIntegral (bufferElems bbuf)
cbuf <- readIORef haCharBuffer
debugIO ("\nhGetPosn: (posn, real_posn) = " ++ show (posn, real_posn))
debugIO (" cbuf: " ++ summaryBuffer cbuf ++
" bbuf: " ++ summaryBuffer bbuf)
return real_posn
hIsOpen :: Handle -> IO Bool
hIsOpen handle =
withHandle_ "hIsOpen" handle $ \ handle_ -> do
case haType handle_ of
ClosedHandle -> return False
SemiClosedHandle -> return False
_ -> return True
hIsClosed :: Handle -> IO Bool
hIsClosed handle =
withHandle_ "hIsClosed" handle $ \ handle_ -> do
case haType handle_ of
ClosedHandle -> return True
_ -> return False
hIsReadable :: Handle -> IO Bool
hIsReadable (DuplexHandle _ _ _) = return True
hIsReadable handle =
withHandle_ "hIsReadable" handle $ \ handle_ -> do
case haType handle_ of
ClosedHandle -> ioe_closedHandle
SemiClosedHandle -> ioe_closedHandle
htype -> return (isReadableHandleType htype)
hIsWritable :: Handle -> IO Bool
hIsWritable (DuplexHandle _ _ _) = return True
hIsWritable handle =
withHandle_ "hIsWritable" handle $ \ handle_ -> do
case haType handle_ of
ClosedHandle -> ioe_closedHandle
SemiClosedHandle -> ioe_closedHandle
htype -> return (isWritableHandleType htype)
hGetBuffering :: Handle -> IO BufferMode
hGetBuffering handle =
withHandle_ "hGetBuffering" handle $ \ handle_ -> do
case haType handle_ of
ClosedHandle -> ioe_closedHandle
_ ->
return (haBufferMode handle_)
hIsSeekable :: Handle -> IO Bool
hIsSeekable handle =
withHandle_ "hIsSeekable" handle $ \ handle_@Handle__{..} -> do
case haType of
ClosedHandle -> ioe_closedHandle
SemiClosedHandle -> ioe_closedHandle
AppendHandle -> return False
_ -> IODevice.isSeekable haDevice
hSetEcho :: Handle -> Bool -> IO ()
hSetEcho handle on = do
isT <- hIsTerminalDevice handle
if not isT
then return ()
else
withHandle_ "hSetEcho" handle $ \ Handle__{..} -> do
case haType of
ClosedHandle -> ioe_closedHandle
_ -> IODevice.setEcho haDevice on
hGetEcho :: Handle -> IO Bool
hGetEcho handle = do
isT <- hIsTerminalDevice handle
if not isT
then return False
else
withHandle_ "hGetEcho" handle $ \ Handle__{..} -> do
case haType of
ClosedHandle -> ioe_closedHandle
_ -> IODevice.getEcho haDevice
hIsTerminalDevice :: Handle -> IO Bool
hIsTerminalDevice handle = do
withHandle_ "hIsTerminalDevice" handle $ \ Handle__{..} -> do
case haType of
ClosedHandle -> ioe_closedHandle
_ -> IODevice.isTerminal haDevice
hSetBinaryMode :: Handle -> Bool -> IO ()
hSetBinaryMode handle bin =
withAllHandles__ "hSetBinaryMode" handle $ \ h_@Handle__{..} ->
do
flushCharBuffer h_
closeTextCodecs h_
mb_te <- if bin then return Nothing
else fmap Just getLocaleEncoding
openTextEncoding mb_te haType $ \ mb_encoder mb_decoder -> do
let nl | bin = noNewlineTranslation
| otherwise = nativeNewlineMode
bbuf <- readIORef haByteBuffer
ref <- newIORef (error "codec_state", bbuf)
return Handle__{ haLastDecode = ref,
haEncoder = mb_encoder,
haDecoder = mb_decoder,
haCodec = mb_te,
haInputNL = inputNL nl,
haOutputNL = outputNL nl, .. }
hSetNewlineMode :: Handle -> NewlineMode -> IO ()
hSetNewlineMode handle NewlineMode{ inputNL=i, outputNL=o } =
withAllHandles__ "hSetNewlineMode" handle $ \h_@Handle__{..} ->
do
flushBuffer h_
return h_{ haInputNL=i, haOutputNL=o }
hDuplicate :: Handle -> IO Handle
hDuplicate h@(FileHandle path m) = do
withHandle_' "hDuplicate" h m $ \h_ ->
dupHandle path h Nothing h_ (Just handleFinalizer)
hDuplicate h@(DuplexHandle path r w) = do
write_side@(FileHandle _ write_m) <-
withHandle_' "hDuplicate" h w $ \h_ ->
dupHandle path h Nothing h_ (Just handleFinalizer)
read_side@(FileHandle _ read_m) <-
withHandle_' "hDuplicate" h r $ \h_ ->
dupHandle path h (Just write_m) h_ Nothing
return (DuplexHandle path read_m write_m)
dupHandle :: FilePath
-> Handle
-> Maybe (MVar Handle__)
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle
dupHandle filepath h other_side h_@Handle__{..} mb_finalizer = do
flushBuffer h_
case other_side of
Nothing -> do
new_dev <- IODevice.dup haDevice
dupHandle_ new_dev filepath other_side h_ mb_finalizer
Just r ->
withHandle_' "dupHandle" h r $ \Handle__{haDevice=dev} -> do
dupHandle_ dev filepath other_side h_ mb_finalizer
dupHandle_ :: (IODevice dev, BufferedIO dev, Typeable dev) => dev
-> FilePath
-> Maybe (MVar Handle__)
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle
dupHandle_ new_dev filepath other_side h_@Handle__{..} mb_finalizer = do
mb_codec <- if isJust haEncoder then fmap Just getLocaleEncoding else return Nothing
mkHandle new_dev filepath haType True mb_codec
NewlineMode { inputNL = haInputNL, outputNL = haOutputNL }
mb_finalizer other_side
hDuplicateTo :: Handle -> Handle -> IO ()
hDuplicateTo h1@(FileHandle path m1) h2@(FileHandle _ m2) = do
withHandle__' "hDuplicateTo" h2 m2 $ \h2_ -> do
_ <- hClose_help h2_
withHandle_' "hDuplicateTo" h1 m1 $ \h1_ -> do
dupHandleTo path h1 Nothing h2_ h1_ (Just handleFinalizer)
hDuplicateTo h1@(DuplexHandle path r1 w1) h2@(DuplexHandle _ r2 w2) = do
withHandle__' "hDuplicateTo" h2 w2 $ \w2_ -> do
_ <- hClose_help w2_
withHandle_' "hDuplicateTo" h1 w1 $ \w1_ -> do
dupHandleTo path h1 Nothing w2_ w1_ (Just handleFinalizer)
withHandle__' "hDuplicateTo" h2 r2 $ \r2_ -> do
_ <- hClose_help r2_
withHandle_' "hDuplicateTo" h1 r1 $ \r1_ -> do
dupHandleTo path h1 (Just w1) r2_ r1_ Nothing
hDuplicateTo h1 _ =
ioe_dupHandlesNotCompatible h1
ioe_dupHandlesNotCompatible :: Handle -> IO a
ioe_dupHandlesNotCompatible h =
ioException (IOError (Just h) IllegalOperation "hDuplicateTo"
"handles are incompatible" Nothing Nothing)
dupHandleTo :: FilePath
-> Handle
-> Maybe (MVar Handle__)
-> Handle__
-> Handle__
-> Maybe HandleFinalizer
-> IO Handle__
dupHandleTo filepath h other_side
hto_@Handle__{haDevice=devTo,..}
h_@Handle__{haDevice=dev} mb_finalizer = do
flushBuffer h_
case cast devTo of
Nothing -> ioe_dupHandlesNotCompatible h
Just dev' -> do
_ <- IODevice.dup2 dev dev'
FileHandle _ m <- dupHandle_ dev' filepath other_side h_ mb_finalizer
takeMVar m
hShow :: Handle -> IO String
hShow h@(FileHandle path _) = showHandle' path False h
hShow h@(DuplexHandle path _ _) = showHandle' path True h
showHandle' :: String -> Bool -> Handle -> IO String
showHandle' filepath is_duplex h =
withHandle_ "showHandle" h $ \hdl_ ->
let
showType | is_duplex = showString "duplex (read-write)"
| otherwise = shows (haType hdl_)
in
return
(( showChar '{' .
showHdl (haType hdl_)
(showString "loc=" . showString filepath . showChar ',' .
showString "type=" . showType . showChar ',' .
showString "buffering=" . showBufMode (unsafePerformIO (readIORef (haCharBuffer hdl_))) (haBufferMode hdl_) . showString "}" )
) "")
where
showHdl :: HandleType -> ShowS -> ShowS
showHdl ht cont =
case ht of
ClosedHandle -> shows ht . showString "}"
_ -> cont
showBufMode :: Buffer e -> BufferMode -> ShowS
showBufMode buf bmo =
case bmo of
NoBuffering -> showString "none"
LineBuffering -> showString "line"
BlockBuffering (Just n) -> showString "block " . showParen True (shows n)
BlockBuffering Nothing -> showString "block " . showParen True (shows def)
where
def :: Int
def = bufSize buf
RetroSearch is an open source project built by @garambo | Open a GitHub Issue
Search and Browse the WWW like it's 1997 | Search results from DuckDuckGo
HTML:
3.2
| Encoding:
UTF-8
| Version:
0.7.4