{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
module System.IO.Streams.Handle
(
handleToInputStream
, handleToOutputStream
, handleToStreams
, inputStreamToHandle
, outputStreamToHandle
, streamPairToHandle
, stdin
, stdout
, stderr
) where
import Data.ByteString (ByteString)
import qualified Data.ByteString as S
import qualified GHC.IO.Handle as H
import System.IO (Handle, hFlush)
import qualified System.IO as IO
import System.IO.Unsafe (unsafePerformIO)
import System.IO.Streams.Internal (InputStream, OutputStream, SP (..), lockingInputStream, lockingOutputStream, makeInputStream, makeOutputStream)
bUFSIZ :: Int
bUFSIZ :: Int
bUFSIZ = Int
32752
handleToInputStream :: Handle -> IO (InputStream ByteString)
handleToInputStream :: Handle -> IO (InputStream ByteString)
handleToInputStream Handle
h = IO (Maybe ByteString) -> IO (InputStream ByteString)
forall a. IO (Maybe a) -> IO (InputStream a)
makeInputStream IO (Maybe ByteString)
f
where
f :: IO (Maybe ByteString)
f = do
ByteString
x <- Handle -> Int -> IO ByteString
S.hGetSome Handle
h Int
bUFSIZ
Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> IO (Maybe ByteString))
-> Maybe ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$! if ByteString -> Bool
S.null ByteString
x then Maybe ByteString
forall a. Maybe a
Nothing else ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
x
handleToOutputStream :: Handle -> IO (OutputStream ByteString)
handleToOutputStream :: Handle -> IO (OutputStream ByteString)
handleToOutputStream Handle
h = (Maybe ByteString -> IO ()) -> IO (OutputStream ByteString)
forall a. (Maybe a -> IO ()) -> IO (OutputStream a)
makeOutputStream Maybe ByteString -> IO ()
f
where
f :: Maybe ByteString -> IO ()
f Maybe ByteString
Nothing = Handle -> IO ()
hFlush Handle
h
f (Just ByteString
x) = if ByteString -> Bool
S.null ByteString
x
then Handle -> IO ()
hFlush Handle
h
else Handle -> ByteString -> IO ()
S.hPut Handle
h ByteString
x
handleToStreams :: Handle
-> IO (InputStream ByteString, OutputStream ByteString)
handleToStreams :: Handle -> IO (InputStream ByteString, OutputStream ByteString)
handleToStreams Handle
h = do
InputStream ByteString
is <- Handle -> IO (InputStream ByteString)
handleToInputStream Handle
h
OutputStream ByteString
os <- Handle -> IO (OutputStream ByteString)
handleToOutputStream Handle
h
(InputStream ByteString, OutputStream ByteString)
-> IO (InputStream ByteString, OutputStream ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return ((InputStream ByteString, OutputStream ByteString)
-> IO (InputStream ByteString, OutputStream ByteString))
-> (InputStream ByteString, OutputStream ByteString)
-> IO (InputStream ByteString, OutputStream ByteString)
forall a b. (a -> b) -> a -> b
$! (InputStream ByteString
is, OutputStream ByteString
os)
inputStreamToHandle :: InputStream ByteString -> IO Handle
inputStreamToHandle :: InputStream ByteString -> IO Handle
inputStreamToHandle InputStream ByteString
is0 = do
InputStream ByteString
is <- InputStream ByteString -> IO (InputStream ByteString)
forall a. InputStream a -> IO (InputStream a)
lockingInputStream InputStream ByteString
is0
Handle
h <- InputStream ByteString
-> FilePath -> Maybe TextEncoding -> NewlineMode -> IO Handle
forall dev.
(IODevice dev, BufferedIO dev, Typeable dev) =>
dev -> FilePath -> Maybe TextEncoding -> NewlineMode -> IO Handle
H.mkDuplexHandle InputStream ByteString
is FilePath
"*input-stream*" Maybe TextEncoding
forall a. Maybe a
Nothing (NewlineMode -> IO Handle) -> NewlineMode -> IO Handle
forall a b. (a -> b) -> a -> b
$! NewlineMode
H.noNewlineTranslation
Handle -> BufferMode -> IO ()
H.hSetBuffering Handle
h BufferMode
H.NoBuffering
Handle -> IO Handle
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
h
outputStreamToHandle :: OutputStream ByteString -> IO Handle
outputStreamToHandle :: OutputStream ByteString -> IO Handle
outputStreamToHandle OutputStream ByteString
os0 = do
OutputStream ByteString
os <- OutputStream ByteString -> IO (OutputStream ByteString)
forall a. OutputStream a -> IO (OutputStream a)
lockingOutputStream OutputStream ByteString
os0
Handle
h <- OutputStream ByteString
-> FilePath -> Maybe TextEncoding -> NewlineMode -> IO Handle
forall dev.
(IODevice dev, BufferedIO dev, Typeable dev) =>
dev -> FilePath -> Maybe TextEncoding -> NewlineMode -> IO Handle
H.mkDuplexHandle OutputStream ByteString
os FilePath
"*output-stream*" Maybe TextEncoding
forall a. Maybe a
Nothing (NewlineMode -> IO Handle) -> NewlineMode -> IO Handle
forall a b. (a -> b) -> a -> b
$! NewlineMode
H.noNewlineTranslation
Handle -> BufferMode -> IO ()
H.hSetBuffering Handle
h BufferMode
H.NoBuffering
Handle -> IO Handle
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle -> IO Handle) -> Handle -> IO Handle
forall a b. (a -> b) -> a -> b
$! Handle
h
streamPairToHandle :: InputStream ByteString -> OutputStream ByteString -> IO Handle
streamPairToHandle :: InputStream ByteString -> OutputStream ByteString -> IO Handle
streamPairToHandle InputStream ByteString
is0 OutputStream ByteString
os0 = do
InputStream ByteString
is <- InputStream ByteString -> IO (InputStream ByteString)
forall a. InputStream a -> IO (InputStream a)
lockingInputStream InputStream ByteString
is0
OutputStream ByteString
os <- OutputStream ByteString -> IO (OutputStream ByteString)
forall a. OutputStream a -> IO (OutputStream a)
lockingOutputStream OutputStream ByteString
os0
Handle
h <- SP (InputStream ByteString) (OutputStream ByteString)
-> FilePath -> Maybe TextEncoding -> NewlineMode -> IO Handle
forall dev.
(IODevice dev, BufferedIO dev, Typeable dev) =>
dev -> FilePath -> Maybe TextEncoding -> NewlineMode -> IO Handle
H.mkDuplexHandle (InputStream ByteString
-> OutputStream ByteString
-> SP (InputStream ByteString) (OutputStream ByteString)
forall a b. a -> b -> SP a b
SP InputStream ByteString
is OutputStream ByteString
os) FilePath
"*stream*" Maybe TextEncoding
forall a. Maybe a
Nothing (NewlineMode -> IO Handle) -> NewlineMode -> IO Handle
forall a b. (a -> b) -> a -> b
$! NewlineMode
H.noNewlineTranslation
Handle -> BufferMode -> IO ()
H.hSetBuffering Handle
h BufferMode
H.NoBuffering
Handle -> IO Handle
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle -> IO Handle) -> Handle -> IO Handle
forall a b. (a -> b) -> a -> b
$! Handle
h
stdin :: InputStream ByteString
stdin :: InputStream ByteString
stdin = IO (InputStream ByteString) -> InputStream ByteString
forall a. IO a -> a
unsafePerformIO (Handle -> IO (InputStream ByteString)
handleToInputStream Handle
IO.stdin IO (InputStream ByteString)
-> (InputStream ByteString -> IO (InputStream ByteString))
-> IO (InputStream ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= InputStream ByteString -> IO (InputStream ByteString)
forall a. InputStream a -> IO (InputStream a)
lockingInputStream)
{-# NOINLINE stdin #-}
stdout :: OutputStream ByteString
stdout :: OutputStream ByteString
stdout = IO (OutputStream ByteString) -> OutputStream ByteString
forall a. IO a -> a
unsafePerformIO (Handle -> IO (OutputStream ByteString)
handleToOutputStream Handle
IO.stdout IO (OutputStream ByteString)
-> (OutputStream ByteString -> IO (OutputStream ByteString))
-> IO (OutputStream ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
OutputStream ByteString -> IO (OutputStream ByteString)
forall a. OutputStream a -> IO (OutputStream a)
lockingOutputStream)
{-# NOINLINE stdout #-}
stderr :: OutputStream ByteString
stderr :: OutputStream ByteString
stderr = IO (OutputStream ByteString) -> OutputStream ByteString
forall a. IO a -> a
unsafePerformIO (Handle -> IO (OutputStream ByteString)
handleToOutputStream Handle
IO.stderr IO (OutputStream ByteString)
-> (OutputStream ByteString -> IO (OutputStream ByteString))
-> IO (OutputStream ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
OutputStream ByteString -> IO (OutputStream ByteString)
forall a. OutputStream a -> IO (OutputStream a)
lockingOutputStream)
{-# NOINLINE stderr #-}