io-streams-1.0.2.0: src/System/IO/Streams/Internal.hs
-- | Internal implementation of the @io-streams@ library, intended for library
-- writers
--
-- Library users should use the interface provided by "System.IO.Streams"
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
module System.IO.Streams.Internal
( -- * Types
SP(..)
, Source(..)
, Sink(..)
, StreamPair
-- * About pushback
-- $pushback
-- * Pushback functions
, defaultPushback
, withDefaultPushback
-- * Basic sources and sinks
, nullSource
, nullSink
, singletonSource
, simpleSource
-- * Input and output streams
, InputStream(..)
, OutputStream(..)
-- * Primitive stream operations
, read
, unRead
, peek
, write
, atEOF
-- * Building streams
, sourceToStream
, sinkToStream
, makeInputStream
, makeOutputStream
, appendInputStream
, concatInputStreams
-- * Connecting streams
, connect
, connectTo
, supply
, supplyTo
-- * Thread safety
, lockingInputStream
, lockingOutputStream
-- * Utility streams
, nullInput
, nullOutput
-- * Generator monad
, Generator
, generatorToSource
, fromGenerator
, yield
-- * Consumer monad
, Consumer
, consumerToSink
, fromConsumer
, await
) where
------------------------------------------------------------------------------
import Control.Applicative (Applicative (..))
import Control.Concurrent (newMVar, withMVar)
import Control.Exception (throwIO)
import Control.Monad (liftM, (>=>))
import Control.Monad.IO.Class (MonadIO (..))
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Internal as S
import qualified Data.ByteString.Unsafe as S
import Data.IORef (IORef, newIORef, readIORef,
writeIORef)
import Data.Monoid (Monoid (..))
import Data.Typeable (Typeable)
import Data.Word (Word8)
import Foreign.Marshal.Utils (copyBytes)
import Foreign.Ptr (castPtr)
import qualified GHC.IO.Buffer as H
import qualified GHC.IO.BufferedIO as H
import qualified GHC.IO.Device as H
import GHC.IO.Exception (unsupportedOperation)
import Prelude hiding (read)
------------------------------------------------------------------------------
-- | A strict pair type.
data SP a b = SP !a !b
deriving (Typeable)
------------------------------------------------------------------------------
-- | A 'Source' generates values of type @c@ in the 'IO' monad.
--
-- 'Source's wrap ordinary values in a 'Just' and signal end-of-stream by
-- yielding 'Nothing'.
--
-- All 'Source's define an optional push-back mechanism. You can assume that:
--
-- @
-- Streams.'pushback' source c >>= Streams.'produce' = 'return' (source, 'Just' c)
-- @
--
-- ... unless a 'Source' documents otherwise.
--
-- 'Source' is to be considered an implementation detail of the library, and
-- should only be used in code that needs explicit control over the 'pushback'
-- semantics.
--
-- Most library users should instead directly use 'InputStream's, which prevent
-- reuse of previous 'Source's.
data Source c = Source {
produce :: IO (SP (Source c) (Maybe c))
, pushback :: c -> IO (Source c)
} deriving (Typeable)
------------------------------------------------------------------------------
-- | A 'Generator' is a coroutine monad that can be used to define complex
-- 'InputStream's. You can cause a value of type @Just r@ to appear when the
-- 'InputStream' is read by calling 'yield':
--
-- @
-- g :: 'Generator' Int ()
-- g = do
-- Streams.'yield' 1
-- Streams.'yield' 2
-- Streams.'yield' 3
-- @
--
-- A 'Generator' can be turned into an 'InputStream' by calling
-- 'fromGenerator':
--
-- @
-- m :: 'IO' ['Int']
-- m = Streams.'fromGenerator' g >>= Streams.'System.IO.Streams.toList' \-\- value returned is [1,2,3]
-- @
--
-- You can perform IO by calling 'liftIO', and turn a 'Generator' into an
-- 'InputStream' with 'fromGenerator'.
--
-- As a general rule, you should not acquire resources that need to be freed
-- from a 'Generator', because there is no guarantee the coroutine continuation
-- will ever be called, nor can you catch an exception from within a
-- 'Generator'.
newtype Generator r a = Generator {
unG :: IO (Either (SP r (Generator r a)) a)
} deriving (Typeable)
------------------------------------------------------------------------------
generatorBind :: Generator r a -> (a -> Generator r b) -> Generator r b
generatorBind (Generator m) f = Generator (m >>= either step value)
where
step (SP v r) = return $! Left $! SP v (generatorBind r f)
value = unG . f
{-# INLINE generatorBind #-}
------------------------------------------------------------------------------
instance Monad (Generator r) where
return = Generator . return . Right
(>>=) = generatorBind
------------------------------------------------------------------------------
instance MonadIO (Generator r) where
liftIO = Generator . (Right `fmap`)
------------------------------------------------------------------------------
instance Functor (Generator r) where
fmap f (Generator m) = Generator $ m >>= either step value
where
step (SP v m') = return $! Left $! SP v (fmap f m')
value v = return $! Right $! f v
------------------------------------------------------------------------------
instance Applicative (Generator r) where
pure = Generator . return . Right
m <*> n = do
f <- m
v <- n
return $! f v
------------------------------------------------------------------------------
-- | Calling @'yield' x@ causes the value @'Just' x@ to appear on the input
-- when this generator is converted to an 'InputStream'. The rest of the
-- computation after the call to 'yield' is resumed later when the
-- 'InputStream' is 'read' again.
yield :: r -> Generator r ()
yield x = Generator $! return $! Left $! SP x (return $! ())
------------------------------------------------------------------------------
-- | Turns a 'Generator' into a 'Source' using the default pushback mechanism.
generatorToSource :: Generator r a -> Source r
generatorToSource (Generator m) = withDefaultPushback go
where
go = m >>= either step finish
finish = const $ return $! SP nullSource Nothing
step (SP v gen) = return $! SP (generatorToSource gen) (Just v)
------------------------------------------------------------------------------
-- | Turns a 'Generator' into an 'InputStream'.
fromGenerator :: Generator r a -> IO (InputStream r)
fromGenerator (Generator m) = do
ref <- newIORef m
makeInputStream $! go ref
where
go ref = readIORef ref >>= (\n -> n >>= either step finish)
where
step (SP v gen) = do
writeIORef ref $! unG gen
return $! Just v
finish _ = return Nothing
------------------------------------------------------------------------------
newtype Consumer c a = Consumer {
unC :: IO (Either (Maybe c -> Consumer c a) a)
} deriving (Typeable)
------------------------------------------------------------------------------
instance Monad (Consumer c) where
return = Consumer . return . Right
(Consumer m) >>= f = Consumer $ m >>= either step value
where
step g = return $! Left $! (>>= f) . g
value v = unC $ f v
------------------------------------------------------------------------------
instance MonadIO (Consumer c) where
liftIO = Consumer . fmap Right
------------------------------------------------------------------------------
instance Functor (Consumer r) where
fmap f (Consumer m) = Consumer (m >>= either step value)
where
step g = return $! Left $! (fmap f) . g
value v = return $! Right $! f v
------------------------------------------------------------------------------
instance Applicative (Consumer r) where
pure = return
m <*> n = do
f <- m
v <- n
return $! f v
------------------------------------------------------------------------------
await :: Consumer r (Maybe r)
await = Consumer $ return (Left return)
------------------------------------------------------------------------------
consumerToSink :: Consumer r a -> Sink r
consumerToSink (Consumer m) = Sink $ go m
where
go act v = act >>= either step value
where
value _ = return nullSink
step f = unC (f v) >>=
either (\g -> return $! Sink $! go (return $ Left g))
(const $ return nullSink)
------------------------------------------------------------------------------
fromConsumer :: Consumer r a -> IO (OutputStream r)
fromConsumer = sinkToStream . consumerToSink
------------------------------------------------------------------------------
-- | A 'Sink' consumes values of type @c@ in the 'IO' monad.
--
-- Sinks are supplied ordinary values by wrapping them in 'Just', and you
-- indicate the end of the stream to a 'Sink' by supplying 'Nothing'.
--
-- If you supply a value after a 'Nothing', the behavior is defined by the
-- implementer of the given 'Sink'. (All 'Sink' definitions in this library
-- will simply discard the extra input.)
--
-- Library users should use 'OutputStream's, which prevent reuse of previous
-- 'Sink's.
data Sink c = Sink {
consume :: Maybe c -> IO (Sink c)
} deriving (Typeable)
------------------------------------------------------------------------------
-- | appendSource concatenates two 'Source's, analogous to ('++') for lists.
--
-- The second 'Source' continues where the first 'Source' ends.
--
-- appendSource defines a monoid with 'nullSource' as the identity:
--
-- > nullSource `appendSource` s = s
-- >
-- > s `appendSource` nullSource = s
-- >
-- > (s1 `appendSource` s2) `appendSource` s3
-- > = s1 `appendSource` (s2 `appendSource` s3)
appendSource :: Source c -> Source c -> Source c
appendSource !p !q = Source prod pb
where
prod = do
(SP p' c) <- produce p
maybe (produce q)
(const $ return $! SP (p' `appendSource` q) c)
c
pb c = do
s' <- pushback p c
return $! s' `appendSource` q
------------------------------------------------------------------------------
instance Monoid (Source a) where
mempty = nullSource
mappend = appendSource
{- TODO: Define better convenience functions for pushback. These convenience
functions still require that the user ties the knot to correctly define
pushback, which is error-prone for non-trivial pushback
customizations. -}
------------------------------------------------------------------------------
-- | The default pushback implementation. Given a 'Source' and a value to push
-- back, produces a new 'Source' that will 'produce' the value given and yield
-- the original 'Source', and where 'pushback' recursively calls
-- 'defaultPushback'.
defaultPushback :: Source c -> c -> IO (Source c)
defaultPushback s c = let s' = Source { produce = return $! SP s (Just c)
, pushback = defaultPushback s'
}
in return $! s'
------------------------------------------------------------------------------
-- | Given an action to use as 'produce', creates a 'Source' that uses
-- 'defaultPushback' as its 'pushback'.
withDefaultPushback :: IO (SP (Source c) (Maybe c)) -> Source c
withDefaultPushback prod = let s = Source prod (defaultPushback s)
in s
------------------------------------------------------------------------------
-- | If you have just an @IO (Maybe c)@ action and are happy with the default
-- pushback behaviour, this function is slightly more efficient than
-- using 'withDefaultPushback'. (It allocates less.)
simpleSource :: IO (Maybe c) -> IO (Source c)
simpleSource m = newIORef [] >>= \ref ->
let s = Source prod pb
prod = pop ref >>= maybe prodM prodP
prodM = m >>= \x -> return $!
maybe (SP nullSource Nothing) (const $ SP s x) x
prodP c = return $! SP s (Just c)
pb c = modifyRef ref (c:) >> return s
in return $! s
where
{-# INLINE pop #-}
pop ref = readIORef ref >>= \l ->
case l of
[] -> return Nothing
(x:xs) -> writeIORef ref xs >> (return $! Just x)
------------------------------------------------------------------------------
{-# INLINE modifyRef #-}
modifyRef :: IORef a -> (a -> a) -> IO ()
modifyRef ref f = do
x <- readIORef ref
writeIORef ref $! f x
------------------------------------------------------------------------------
-- | An empty source that immediately yields 'Nothing'.
nullSource :: Source c
nullSource = withDefaultPushback (return $! SP nullSource Nothing)
------------------------------------------------------------------------------
-- | 'nullSink' discards all values it consumes.
nullSink :: Sink c
nullSink = Sink $ const $ return nullSink
------------------------------------------------------------------------------
-- | Transforms any value into a 1-element 'Source'.
singletonSource :: c -> Source c
singletonSource c = withDefaultPushback $ return $! SP nullSource (Just c)
------------------------------------------------------------------------------
-- A note for readers: why are we using IORef inside InputStream and
-- OutputStream instead of MVar?
--
-- A modifyMVar takes about 35ns to run on my Macbook, and the equivalent
-- readIORef/writeIORef pair takes 6ns.
--
-- Given that we'll be composing these often, we'll give up thread safety in
-- order to gain a 6x performance improvement. If you want thread-safe access
-- to a stream, you can use lockingInputStream or lockingOutputStream.
------------------------------------------------------------------------------
------------------------------------------------------------------------------
-- | An 'InputStream' generates values of type @c@ in the 'IO' monad.
--
-- Two primitive operations are defined on 'InputStream':
--
-- * @'read' :: 'InputStream' c -> 'IO' ('Maybe' c)@ reads a value from the stream,
-- where \"end of stream\" is signaled by 'read' returning 'Nothing'.
--
-- * @'unRead' :: c -> 'InputStream' c -> 'IO' ()@ \"pushes back\" a value to the
-- stream.
--
-- It is intended that 'InputStream's obey the following law:
--
-- @'unRead' c stream >> 'read' stream === 'return' ('Just' c)@
--
newtype InputStream c = IS (IORef (Source c))
deriving (Typeable)
------------------------------------------------------------------------------
-- | An 'OutputStream' consumes values of type @c@ in the 'IO' monad.
-- The only primitive operation defined on 'OutputStream' is:
--
-- * @'write' :: 'Maybe' c -> 'OutputStream' c -> 'IO' ()@
--
-- Values of type @c@ are written in an 'OutputStream' by wrapping them in
-- 'Just', and the end of the stream is indicated by by supplying 'Nothing'.
--
-- If you supply a value after a 'Nothing', the behavior is defined by the
-- implementer of the given 'OutputStream'. (All 'OutputStream' definitions in
-- this library will simply discard the extra input.)
--
newtype OutputStream c = OS (IORef (Sink c))
deriving (Typeable)
------------------------------------------------------------------------------
-- | Reads one value from an 'InputStream'.
--
-- Returns either a value wrapped in a 'Just', or 'Nothing' if the end of the
-- stream is reached.
read :: InputStream c -> IO (Maybe c)
read (IS ref) = do
m <- readIORef ref
SP m' x <- produce m
writeIORef ref m'
return x
{-# INLINE read #-}
------------------------------------------------------------------------------
-- | Pushes a value back onto an input stream. 'read' and 'unRead' should
-- satisfy the following law, with the possible exception of side effects:
--
-- @
-- Streams.'unRead' c stream >> Streams.'read' stream === 'return' ('Just' c)
-- @
--
-- Note that this could be used to add values back to the stream that were not
-- originally drawn from the stream.
unRead :: c -> InputStream c -> IO ()
unRead c (IS ref) = readIORef ref >>= f >>= writeIORef ref
where
f (Source _ pb) = pb c
{-# INLINE unRead #-}
------------------------------------------------------------------------------
-- | Converts a 'Source' to an 'InputStream'.
sourceToStream :: Source a -> IO (InputStream a)
sourceToStream = liftM IS . newIORef
{-# INLINE sourceToStream #-}
------------------------------------------------------------------------------
-- | Converts a 'Sink' to an 'OutputStream'.
sinkToStream :: Sink a -> IO (OutputStream a)
sinkToStream = liftM OS . newIORef
{-# INLINE sinkToStream #-}
------------------------------------------------------------------------------
-- | 'concatInputStreams' concatenates a list of 'InputStream's, analogous to
-- ('++') for lists.
--
-- Subsequent 'InputStream's continue where the previous one 'InputStream'
-- ends.
--
-- Note: values pushed back to the 'InputStream' returned by
-- 'concatInputStreams' are not propagated to any of the source
-- 'InputStream's.
concatInputStreams :: [InputStream a] -> IO (InputStream a)
concatInputStreams inputStreams = do
ref <- newIORef inputStreams
makeInputStream $! run ref
where
run ref = go
where
go = do
streams <- readIORef ref
case streams of
[] -> return Nothing
(s:rest) -> do
next <- read s
case next of
Nothing -> writeIORef ref rest >> go
Just _ -> return next
------------------------------------------------------------------------------
-- | 'appendInputStream' concatenates two 'InputStream's, analogous to ('++')
-- for lists.
--
-- The second 'InputStream' continues where the first 'InputStream' ends.
--
-- Note: values pushed back to 'appendInputStream' are not propagated to either
-- wrapped 'InputStream'.
appendInputStream :: InputStream a -> InputStream a -> IO (InputStream a)
appendInputStream s1 s2 = concatInputStreams [s1, s2]
------------------------------------------------------------------------------
-- | Observes the first value from an 'InputStream' without consuming it.
--
-- Returns 'Nothing' if the 'InputStream' is empty. 'peek' satisfies the
-- following law:
--
-- @
-- Streams.'peek' stream >> Streams.'read' stream === Streams.'read' stream
-- @
peek :: InputStream c -> IO (Maybe c)
peek s = do
x <- read s
maybe (return $! ()) (\c -> unRead c s) x
return x
{-# INLINE peek #-}
------------------------------------------------------------------------------
-- | Feeds a value to an 'OutputStream'. Values of type @c@ are written in an
-- 'OutputStream' by wrapping them in 'Just', and the end of the stream is
-- indicated by by supplying 'Nothing'.
--
write :: Maybe c -> OutputStream c -> IO ()
write c (OS ref) = readIORef ref >>= (($ c) . consume) >>= writeIORef ref
{-# INLINE write #-}
------------------------------------------------------------------------------
-- | Connects an 'InputStream' and 'OutputStream', supplying values from the
-- 'InputStream' to the 'OutputStream', and propagating the end-of-stream
-- message from the 'InputStream' through to the 'OutputStream'.
--
-- The connection ends when the 'InputStream' yields a 'Nothing'.
connect :: InputStream a -> OutputStream a -> IO ()
connect p q = loop
where
loop = do
m <- read p
maybe (write Nothing q)
(const $ write m q >> loop)
m
{-# INLINE connect #-}
------------------------------------------------------------------------------
-- | The 'connectTo' function is just @'flip' 'connect'@.
--
-- Useful for writing expressions like @fromList [1,2,3] >>= connectTo foo@.
--
connectTo :: OutputStream a -> InputStream a -> IO ()
connectTo = flip connect
{-# INLINE connectTo #-}
------------------------------------------------------------------------------
-- | Connects an 'InputStream' to an 'OutputStream' without passing the
-- end-of-stream notification through to the 'OutputStream'.
--
-- Use this to supply an 'OutputStream' with multiple 'InputStream's and use
-- 'connect' for the final 'InputStream' to finalize the 'OutputStream', like
-- so:
--
-- @
-- do Streams.'supply' input1 output
-- Streams.'supply' input2 output
-- Streams.'connect' input3 output
-- @
--
supply :: InputStream a -> OutputStream a -> IO ()
supply p q = loop
where
loop = do
m <- read p
maybe (return $! ())
(const $ write m q >> loop)
m
{-# INLINE supply #-}
------------------------------------------------------------------------------
-- | 'supply' with the arguments flipped.
supplyTo :: OutputStream a -> InputStream a -> IO ()
supplyTo = flip supply
{-# INLINE supplyTo #-}
------------------------------------------------------------------------------
-- | Creates an 'InputStream' from a value-producing action.
--
-- (@makeInputStream m@) calls the action @m@ each time you request a value
-- from the 'InputStream'. The given action is extended with the default
-- pushback mechanism (see "System.IO.Streams.Internal#pushback").
makeInputStream :: IO (Maybe a) -> IO (InputStream a)
makeInputStream = simpleSource >=> sourceToStream
{-# INLINE makeInputStream #-}
------------------------------------------------------------------------------
-- | Creates an 'OutputStream' from a value-consuming action.
--
-- (@makeOutputStream f@) runs the computation @f@ on each value fed to it.
makeOutputStream :: (Maybe a -> IO ()) -> IO (OutputStream a)
makeOutputStream f = sinkToStream s
where
s = Sink (\x -> f x >> return s)
{-# INLINE makeOutputStream #-}
------------------------------------------------------------------------------
-- | Converts an 'InputStream' into a thread-safe 'InputStream', at a slight
-- performance penalty.
--
-- For performance reasons, this library provides non-thread-safe streams by
-- default. Use the @locking@ functions to convert these streams into slightly
-- slower, but thread-safe, equivalents.
lockingInputStream :: InputStream a -> IO (InputStream a)
lockingInputStream s = do
mv <- newMVar $! ()
let src = Source { produce = withMVar mv $ const $ do
x <- read s
return $! SP src x
, pushback = \c -> withMVar mv $ const $ do
unRead c s
return src
}
sourceToStream src
{-# INLINE lockingInputStream #-}
------------------------------------------------------------------------------
-- | Converts an 'OutputStream' into a thread-safe 'OutputStream', at a slight
-- performance penalty.
--
-- For performance reasons, this library provides non-thread-safe streams by
-- default. Use the @locking@ functions to convert these streams into slightly
-- slower, but thread-safe, equivalents.
lockingOutputStream :: OutputStream a -> IO (OutputStream a)
lockingOutputStream s = do
mv <- newMVar $! ()
makeOutputStream $ f mv
where
f mv x = withMVar mv $ const $ write x s
{-# INLINE lockingOutputStream #-}
------------------------------------------------------------------------------
-- | An empty 'InputStream' that yields 'Nothing' immediately.
nullInput :: IO (InputStream a)
nullInput = sourceToStream nullSource
------------------------------------------------------------------------------
-- | An empty 'OutputStream' that discards any input fed to it.
nullOutput :: IO (OutputStream a)
nullOutput = sinkToStream nullSink
------------------------------------------------------------------------------
-- | Checks if an 'InputStream' is at end-of-stream.
atEOF :: InputStream a -> IO Bool
atEOF s = read s >>= maybe (return True) (\k -> unRead k s >> return False)
------------------------------------------------------------------------------
-- $pushback
-- #pushback#
--
-- Users can push a value back into an input stream using the 'unRead'
-- function. Usually this will use the default pushback mechanism which
-- provides a buffer for the stream. Some stream transformers, like
-- 'takeBytes', produce streams that send pushed-back values back to the
-- streams that they wrap. A function like 'System.IO.Streams.Combinators.map'
-- cannot do this because the types don't match up:
--
-- @
-- 'System.IO.Streams.Combinators.map' :: (a -> b) -> 'InputStream' a -> 'IO' ('InputStream' b)
-- @
--
-- A function will usually document if its pushback behaviour differs from the
-- default. No matter what the case, input streams should obey the following
-- law:
--
-- @
-- Streams.'unRead' c stream >> Streams.'read' stream === 'return' ('Just' c)
-- @
--------------------------------------------
-- Typeclass instances for Handle support --
--------------------------------------------
------------------------------------------------------------------------------
bUFSIZ :: Int
bUFSIZ = 32752
------------------------------------------------------------------------------
unsupported :: IO a
unsupported = throwIO unsupportedOperation
------------------------------------------------------------------------------
bufferToBS :: H.Buffer Word8 -> ByteString
bufferToBS buf = S.copy $! S.fromForeignPtr raw l sz
where
raw = H.bufRaw buf
l = H.bufL buf
r = H.bufR buf
sz = r - l
------------------------------------------------------------------------------
instance H.RawIO (InputStream ByteString) where
read is ptr n = read is >>= maybe (return 0) f
where
f s = S.unsafeUseAsCStringLen s $ \(cstr, l) -> do
let c = min n l
copyBytes ptr (castPtr cstr) c
return $! c
readNonBlocking _ _ _ = unsupported
write _ _ _ = unsupported
writeNonBlocking _ _ _ = unsupported
------------------------------------------------------------------------------
instance H.RawIO (OutputStream ByteString) where
read _ _ _ = unsupported
readNonBlocking _ _ _ = unsupported
write os ptr n = S.packCStringLen (castPtr ptr, n) >>=
flip write os . Just
writeNonBlocking _ _ _ = unsupported
------------------------------------------------------------------------------
-- | Internal convenience synonym for a pair of input\/output streams.
type StreamPair a = SP (InputStream a) (OutputStream a)
instance H.RawIO (StreamPair ByteString) where
read (SP is _) ptr n = H.read is ptr n
readNonBlocking _ _ _ = unsupported
write (SP _ os) ptr n = H.write os ptr n
writeNonBlocking _ _ _ = unsupported
------------------------------------------------------------------------------
instance H.BufferedIO (OutputStream ByteString) where
newBuffer !_ bs = H.newByteBuffer bUFSIZ bs
fillReadBuffer !_ _ = unsupported
fillReadBuffer0 !_ _ = unsupported
flushWriteBuffer !os !buf = do
write (Just $! bufferToBS buf) os
emptyWriteBuffer buf
flushWriteBuffer0 !os !buf = do
let s = bufferToBS buf
let l = S.length s
write (Just s) os
buf' <- emptyWriteBuffer buf
return $! (l, buf')
------------------------------------------------------------------------------
instance H.BufferedIO (InputStream ByteString) where
newBuffer !_ !bs = H.newByteBuffer bUFSIZ bs
fillReadBuffer !is !buf = H.readBuf is buf
fillReadBuffer0 _ _ = unsupported
flushWriteBuffer _ _ = unsupported
flushWriteBuffer0 _ _ = unsupported
------------------------------------------------------------------------------
instance H.BufferedIO (StreamPair ByteString) where
newBuffer !_ bs = H.newByteBuffer bUFSIZ bs
fillReadBuffer (SP is _) = H.fillReadBuffer is
fillReadBuffer0 _ _ = unsupported
flushWriteBuffer (SP _ !os) = H.flushWriteBuffer os
flushWriteBuffer0 (SP _ !os) = H.flushWriteBuffer0 os
------------------------------------------------------------------------------
instance H.IODevice (OutputStream ByteString) where
ready _ _ _ = return True
close = write Nothing
devType _ = return H.Stream
------------------------------------------------------------------------------
instance H.IODevice (InputStream ByteString) where
ready _ _ _ = return True
close _ = return $! ()
devType _ = return H.Stream
------------------------------------------------------------------------------
instance H.IODevice (StreamPair ByteString) where
ready _ _ _ = return True
close (SP _ os) = write Nothing os
devType _ = return H.Stream
------------------------------------------------------------------------------
emptyWriteBuffer :: H.Buffer Word8
-> IO (H.Buffer Word8)
emptyWriteBuffer buf
= return buf { H.bufL=0, H.bufR=0, H.bufState = H.WriteBuffer }