{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeSynonymInstances #-}
module System.IO.Streams.Internal
(
SP(..)
, StreamPair
, InputStream(..)
, OutputStream(..)
, read
, unRead
, peek
, write
, writeTo
, atEOF
, makeInputStream
, makeOutputStream
, appendInputStream
, concatInputStreams
, connect
, connectTo
, supply
, supplyTo
, lockingInputStream
, lockingOutputStream
, nullInput
, nullOutput
, Generator
, fromGenerator
, yield
, Consumer
, fromConsumer
, await
) where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative (Applicative (..), (<$>))
#endif
import Control.Concurrent (newMVar, withMVar)
import Control.Exception (throwIO)
import Control.Monad (when)
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 (newIORef, readIORef, writeIORef)
import Data.Maybe (isNothing)
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)
data SP a b = SP !a !b
deriving (Typeable)
data InputStream a = InputStream {
forall a. InputStream a -> IO (Maybe a)
_read :: IO (Maybe a)
, forall a. InputStream a -> a -> IO ()
_unRead :: a -> IO ()
} deriving (Typeable)
data OutputStream a = OutputStream {
forall a. OutputStream a -> Maybe a -> IO ()
_write :: Maybe a -> IO ()
} deriving (Typeable)
read :: InputStream a -> IO (Maybe a)
read :: forall a. InputStream a -> IO (Maybe a)
read = forall a. InputStream a -> IO (Maybe a)
_read
{-# INLINE read #-}
write :: Maybe a -> OutputStream a -> IO ()
write :: forall a. Maybe a -> OutputStream a -> IO ()
write = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. OutputStream a -> Maybe a -> IO ()
_write
{-# INLINE write #-}
writeTo :: OutputStream a -> Maybe a -> IO ()
writeTo :: forall a. OutputStream a -> Maybe a -> IO ()
writeTo = forall a. OutputStream a -> Maybe a -> IO ()
_write
{-# INLINE writeTo #-}
peek :: InputStream a -> IO (Maybe a)
peek :: forall a. InputStream a -> IO (Maybe a)
peek InputStream a
s = do
Maybe a
x <- forall a. InputStream a -> IO (Maybe a)
read InputStream a
s
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! ()) (forall a. InputStream a -> a -> IO ()
_unRead InputStream a
s) Maybe a
x
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
x
unRead :: a -> InputStream a -> IO ()
unRead :: forall a. a -> InputStream a -> IO ()
unRead = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. InputStream a -> a -> IO ()
_unRead
connect :: InputStream a -> OutputStream a -> IO ()
connect :: forall a. InputStream a -> OutputStream a -> IO ()
connect InputStream a
p OutputStream a
q = IO ()
loop
where
loop :: IO ()
loop = do
Maybe a
m <- forall a. InputStream a -> IO (Maybe a)
read InputStream a
p
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. Maybe a -> OutputStream a -> IO ()
write forall a. Maybe a
Nothing OutputStream a
q)
(forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> OutputStream a -> IO ()
write Maybe a
m OutputStream a
q forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
loop)
Maybe a
m
{-# INLINE connect #-}
connectTo :: OutputStream a -> InputStream a -> IO ()
connectTo :: forall a. OutputStream a -> InputStream a -> IO ()
connectTo = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. InputStream a -> OutputStream a -> IO ()
connect
{-# INLINE connectTo #-}
supply :: InputStream a -> OutputStream a -> IO ()
supply :: forall a. InputStream a -> OutputStream a -> IO ()
supply InputStream a
p OutputStream a
q = IO ()
loop
where
loop :: IO ()
loop = do
Maybe a
m <- forall a. InputStream a -> IO (Maybe a)
read InputStream a
p
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! ())
(forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> OutputStream a -> IO ()
write Maybe a
m OutputStream a
q forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
loop)
Maybe a
m
{-# INLINE supply #-}
supplyTo :: OutputStream a -> InputStream a -> IO ()
supplyTo :: forall a. OutputStream a -> InputStream a -> IO ()
supplyTo = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. InputStream a -> OutputStream a -> IO ()
supply
{-# INLINE supplyTo #-}
makeInputStream :: IO (Maybe a) -> IO (InputStream a)
makeInputStream :: forall a. IO (Maybe a) -> IO (InputStream a)
makeInputStream IO (Maybe a)
m = do
IORef Bool
doneRef <- forall a. a -> IO (IORef a)
newIORef Bool
False
IORef [a]
pbRef <- forall a. a -> IO (IORef a)
newIORef []
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. IO (Maybe a) -> (a -> IO ()) -> InputStream a
InputStream (IORef Bool -> IORef [a] -> IO (Maybe a)
grab IORef Bool
doneRef IORef [a]
pbRef) (forall {a}. IORef [a] -> a -> IO ()
pb IORef [a]
pbRef)
where
grab :: IORef Bool -> IORef [a] -> IO (Maybe a)
grab IORef Bool
doneRef IORef [a]
pbRef = do
[a]
l <- forall a. IORef a -> IO a
readIORef IORef [a]
pbRef
case [a]
l of
[] -> do Bool
done <- forall a. IORef a -> IO a
readIORef IORef Bool
doneRef
if Bool
done
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else do
Maybe a
x <- IO (Maybe a)
m
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing Maybe a
x) forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
doneRef Bool
True
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
x
(a
x:[a]
xs) -> forall a. IORef a -> a -> IO ()
writeIORef IORef [a]
pbRef [a]
xs forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. a -> Maybe a
Just a
x)
pb :: IORef [a] -> a -> IO ()
pb IORef [a]
ref a
x = forall a. IORef a -> IO a
readIORef IORef [a]
ref forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[a]
xs -> forall a. IORef a -> a -> IO ()
writeIORef IORef [a]
ref (a
xforall a. a -> [a] -> [a]
:[a]
xs)
{-# INLINE makeInputStream #-}
makeOutputStream :: (Maybe a -> IO ()) -> IO (OutputStream a)
makeOutputStream :: forall a. (Maybe a -> IO ()) -> IO (OutputStream a)
makeOutputStream Maybe a -> IO ()
func = (forall a. (Maybe a -> IO ()) -> OutputStream a
OutputStream forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef Bool -> Maybe a -> IO ()
go) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (IORef a)
newIORef Bool
False
where
go :: IORef Bool -> Maybe a -> IO ()
go IORef Bool
closedRef !Maybe a
m = do
Bool
closed <- forall a. IORef a -> IO a
readIORef IORef Bool
closedRef
if Bool
closed
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! ()
else do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing Maybe a
m) forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
closedRef Bool
True
Maybe a -> IO ()
func Maybe a
m
{-# INLINE makeOutputStream #-}
lockingInputStream :: InputStream a -> IO (InputStream a)
lockingInputStream :: forall a. InputStream a -> IO (InputStream a)
lockingInputStream InputStream a
s = do
MVar ()
mv <- forall a. a -> IO (MVar a)
newMVar forall a b. (a -> b) -> a -> b
$! ()
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. IO (Maybe a) -> (a -> IO ()) -> InputStream a
InputStream (forall {a}. MVar a -> IO (Maybe a)
grab MVar ()
mv) (forall {a}. MVar a -> a -> IO ()
pb MVar ()
mv)
where
grab :: MVar a -> IO (Maybe a)
grab MVar a
mv = forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar a
mv forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. InputStream a -> IO (Maybe a)
read InputStream a
s
pb :: MVar a -> a -> IO ()
pb MVar a
mv a
x = forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar a
mv forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. a -> InputStream a -> IO ()
unRead a
x InputStream a
s
{-# INLINE lockingInputStream #-}
lockingOutputStream :: OutputStream a -> IO (OutputStream a)
lockingOutputStream :: forall a. OutputStream a -> IO (OutputStream a)
lockingOutputStream OutputStream a
s = do
MVar ()
mv <- forall a. a -> IO (MVar a)
newMVar forall a b. (a -> b) -> a -> b
$! ()
forall a. (Maybe a -> IO ()) -> IO (OutputStream a)
makeOutputStream forall a b. (a -> b) -> a -> b
$ forall {a}. MVar a -> Maybe a -> IO ()
f MVar ()
mv
where
f :: MVar a -> Maybe a -> IO ()
f MVar a
mv Maybe a
x = forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar a
mv forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> OutputStream a -> IO ()
write Maybe a
x OutputStream a
s
{-# INLINE lockingOutputStream #-}
nullInput :: IO (InputStream a)
nullInput :: forall a. IO (InputStream a)
nullInput = forall a. IO (Maybe a) -> IO (InputStream a)
makeInputStream forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
nullOutput :: IO (OutputStream a)
nullOutput :: forall a. IO (OutputStream a)
nullOutput = forall a. (Maybe a -> IO ()) -> IO (OutputStream a)
makeOutputStream forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! ()
appendInputStream :: InputStream a -> InputStream a -> IO (InputStream a)
appendInputStream :: forall a. InputStream a -> InputStream a -> IO (InputStream a)
appendInputStream InputStream a
s1 InputStream a
s2 = forall a. [InputStream a] -> IO (InputStream a)
concatInputStreams [InputStream a
s1, InputStream a
s2]
concatInputStreams :: [InputStream a] -> IO (InputStream a)
concatInputStreams :: forall a. [InputStream a] -> IO (InputStream a)
concatInputStreams [InputStream a]
inputStreams = do
IORef [InputStream a]
ref <- forall a. a -> IO (IORef a)
newIORef [InputStream a]
inputStreams
forall a. IO (Maybe a) -> IO (InputStream a)
makeInputStream forall a b. (a -> b) -> a -> b
$! forall {a}. IORef [InputStream a] -> IO (Maybe a)
run IORef [InputStream a]
ref
where
run :: IORef [InputStream a] -> IO (Maybe a)
run IORef [InputStream a]
ref = IO (Maybe a)
go
where
go :: IO (Maybe a)
go = do
[InputStream a]
streams <- forall a. IORef a -> IO a
readIORef IORef [InputStream a]
ref
case [InputStream a]
streams of
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
(InputStream a
s:[InputStream a]
rest) -> do
Maybe a
next <- forall a. InputStream a -> IO (Maybe a)
read InputStream a
s
case Maybe a
next of
Maybe a
Nothing -> forall a. IORef a -> a -> IO ()
writeIORef IORef [InputStream a]
ref [InputStream a]
rest forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO (Maybe a)
go
Just a
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
next
atEOF :: InputStream a -> IO Bool
atEOF :: forall a. InputStream a -> IO Bool
atEOF InputStream a
s = forall a. InputStream a -> IO (Maybe a)
read InputStream a
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) (\a
k -> forall a. a -> InputStream a -> IO ()
unRead a
k InputStream a
s forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
bUFSIZ :: Int
bUFSIZ :: Int
bUFSIZ = Int
32752
unsupported :: IO a
unsupported :: forall a. IO a
unsupported = forall e a. Exception e => e -> IO a
throwIO IOError
unsupportedOperation
bufferToBS :: H.Buffer Word8 -> ByteString
bufferToBS :: Buffer Word8 -> ByteString
bufferToBS Buffer Word8
buf = ByteString -> ByteString
S.copy forall a b. (a -> b) -> a -> b
$! ForeignPtr Word8 -> Int -> Int -> ByteString
S.fromForeignPtr ForeignPtr Word8
raw Int
l Int
sz
where
raw :: ForeignPtr Word8
raw = forall e. Buffer e -> RawBuffer e
H.bufRaw Buffer Word8
buf
l :: Int
l = forall e. Buffer e -> Int
H.bufL Buffer Word8
buf
r :: Int
r = forall e. Buffer e -> Int
H.bufR Buffer Word8
buf
sz :: Int
sz = Int
r forall a. Num a => a -> a -> a
- Int
l
#if MIN_VERSION_base(4,15,0)
ignoreOffset :: (a -> ptr -> n -> ioint) -> a -> ptr -> off -> n -> ioint
ignoreOffset :: forall a ptr n ioint off.
(a -> ptr -> n -> ioint) -> a -> ptr -> off -> n -> ioint
ignoreOffset a -> ptr -> n -> ioint
f a
a ptr
ptr off
_ n
n = a -> ptr -> n -> ioint
f a
a ptr
ptr n
n
#else
ignoreOffset :: a -> a
ignoreOffset = id
#endif
{-# INLINE ignoreOffset #-}
instance H.RawIO (InputStream ByteString) where
read :: InputStream ByteString -> Ptr Word8 -> Word64 -> Int -> IO Int
read = forall a ptr n ioint off.
(a -> ptr -> n -> ioint) -> a -> ptr -> off -> n -> ioint
ignoreOffset forall a b. (a -> b) -> a -> b
$ \InputStream ByteString
is Ptr Word8
ptr Int
n ->
let f :: ByteString -> IO Int
f ByteString
s = forall a. ByteString -> (CStringLen -> IO a) -> IO a
S.unsafeUseAsCStringLen ByteString
s forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
cstr, Int
l) -> do
let c :: Int
c = forall a. Ord a => a -> a -> a
min Int
n Int
l
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word8
ptr (forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
cstr) Int
c
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Int
c
in forall a. InputStream a -> IO (Maybe a)
read InputStream ByteString
is forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return Int
0) ByteString -> IO Int
f
readNonBlocking :: InputStream ByteString
-> Ptr Word8 -> Word64 -> Int -> IO (Maybe Int)
readNonBlocking = forall a ptr n ioint off.
(a -> ptr -> n -> ioint) -> a -> ptr -> off -> n -> ioint
ignoreOffset forall a b. (a -> b) -> a -> b
$ \InputStream ByteString
_ Ptr Word8
_ Int
_ -> forall a. IO a
unsupported
write :: InputStream ByteString -> Ptr Word8 -> Word64 -> Int -> IO ()
write = forall a ptr n ioint off.
(a -> ptr -> n -> ioint) -> a -> ptr -> off -> n -> ioint
ignoreOffset forall a b. (a -> b) -> a -> b
$ \InputStream ByteString
_ Ptr Word8
_ Int
_ -> forall a. IO a
unsupported
writeNonBlocking :: InputStream ByteString -> Ptr Word8 -> Word64 -> Int -> IO Int
writeNonBlocking = forall a ptr n ioint off.
(a -> ptr -> n -> ioint) -> a -> ptr -> off -> n -> ioint
ignoreOffset forall a b. (a -> b) -> a -> b
$ \InputStream ByteString
_ Ptr Word8
_ Int
_ -> forall a. IO a
unsupported
instance H.RawIO (OutputStream ByteString) where
read :: OutputStream ByteString -> Ptr Word8 -> Word64 -> Int -> IO Int
read = forall a ptr n ioint off.
(a -> ptr -> n -> ioint) -> a -> ptr -> off -> n -> ioint
ignoreOffset forall a b. (a -> b) -> a -> b
$ \OutputStream ByteString
_ Ptr Word8
_ Int
_ -> forall a. IO a
unsupported
readNonBlocking :: OutputStream ByteString
-> Ptr Word8 -> Word64 -> Int -> IO (Maybe Int)
readNonBlocking = forall a ptr n ioint off.
(a -> ptr -> n -> ioint) -> a -> ptr -> off -> n -> ioint
ignoreOffset forall a b. (a -> b) -> a -> b
$ \OutputStream ByteString
_ Ptr Word8
_ Int
_ -> forall a. IO a
unsupported
write :: OutputStream ByteString -> Ptr Word8 -> Word64 -> Int -> IO ()
write = forall a ptr n ioint off.
(a -> ptr -> n -> ioint) -> a -> ptr -> off -> n -> ioint
ignoreOffset forall a b. (a -> b) -> a -> b
$ \OutputStream ByteString
os Ptr Word8
ptr Int
n -> CStringLen -> IO ByteString
S.packCStringLen (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr, Int
n) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Maybe a -> OutputStream a -> IO ()
write OutputStream ByteString
os forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just
writeNonBlocking :: OutputStream ByteString -> Ptr Word8 -> Word64 -> Int -> IO Int
writeNonBlocking = forall a ptr n ioint off.
(a -> ptr -> n -> ioint) -> a -> ptr -> off -> n -> ioint
ignoreOffset forall a b. (a -> b) -> a -> b
$ \OutputStream ByteString
_ Ptr Word8
_ Int
_ -> forall a. IO a
unsupported
type StreamPair a = SP (InputStream a) (OutputStream a)
instance H.RawIO (StreamPair ByteString) where
read :: StreamPair ByteString -> Ptr Word8 -> Word64 -> Int -> IO Int
read (SP InputStream ByteString
is OutputStream ByteString
_) = forall a. RawIO a => a -> Ptr Word8 -> Word64 -> Int -> IO Int
H.read InputStream ByteString
is
readNonBlocking :: StreamPair ByteString
-> Ptr Word8 -> Word64 -> Int -> IO (Maybe Int)
readNonBlocking = forall a ptr n ioint off.
(a -> ptr -> n -> ioint) -> a -> ptr -> off -> n -> ioint
ignoreOffset forall a b. (a -> b) -> a -> b
$ \StreamPair ByteString
_ Ptr Word8
_ Int
_ -> forall a. IO a
unsupported
write :: StreamPair ByteString -> Ptr Word8 -> Word64 -> Int -> IO ()
write (SP InputStream ByteString
_ OutputStream ByteString
os) = forall a. RawIO a => a -> Ptr Word8 -> Word64 -> Int -> IO ()
H.write OutputStream ByteString
os
writeNonBlocking :: StreamPair ByteString -> Ptr Word8 -> Word64 -> Int -> IO Int
writeNonBlocking = forall a ptr n ioint off.
(a -> ptr -> n -> ioint) -> a -> ptr -> off -> n -> ioint
ignoreOffset forall a b. (a -> b) -> a -> b
$ \StreamPair ByteString
_ Ptr Word8
_ Int
_ -> forall a. IO a
unsupported
instance H.BufferedIO (OutputStream ByteString) where
newBuffer :: OutputStream ByteString -> BufferState -> IO (Buffer Word8)
newBuffer !OutputStream ByteString
_ BufferState
bs = Int -> BufferState -> IO (Buffer Word8)
H.newByteBuffer Int
bUFSIZ BufferState
bs
fillReadBuffer :: OutputStream ByteString -> Buffer Word8 -> IO (Int, Buffer Word8)
fillReadBuffer !OutputStream ByteString
_ Buffer Word8
_ = forall a. IO a
unsupported
fillReadBuffer0 :: OutputStream ByteString
-> Buffer Word8 -> IO (Maybe Int, Buffer Word8)
fillReadBuffer0 !OutputStream ByteString
_ Buffer Word8
_ = forall a. IO a
unsupported
flushWriteBuffer :: OutputStream ByteString -> Buffer Word8 -> IO (Buffer Word8)
flushWriteBuffer !OutputStream ByteString
os !Buffer Word8
buf = do
forall a. Maybe a -> OutputStream a -> IO ()
write (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! Buffer Word8 -> ByteString
bufferToBS Buffer Word8
buf) OutputStream ByteString
os
Buffer Word8 -> IO (Buffer Word8)
emptyWriteBuffer Buffer Word8
buf
flushWriteBuffer0 :: OutputStream ByteString -> Buffer Word8 -> IO (Int, Buffer Word8)
flushWriteBuffer0 !OutputStream ByteString
os !Buffer Word8
buf = do
let s :: ByteString
s = Buffer Word8 -> ByteString
bufferToBS Buffer Word8
buf
let l :: Int
l = ByteString -> Int
S.length ByteString
s
forall a. Maybe a -> OutputStream a -> IO ()
write (forall a. a -> Maybe a
Just ByteString
s) OutputStream ByteString
os
Buffer Word8
buf' <- Buffer Word8 -> IO (Buffer Word8)
emptyWriteBuffer Buffer Word8
buf
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! (Int
l, Buffer Word8
buf')
instance H.BufferedIO (InputStream ByteString) where
newBuffer :: InputStream ByteString -> BufferState -> IO (Buffer Word8)
newBuffer !InputStream ByteString
_ !BufferState
bs = Int -> BufferState -> IO (Buffer Word8)
H.newByteBuffer Int
bUFSIZ BufferState
bs
fillReadBuffer :: InputStream ByteString -> Buffer Word8 -> IO (Int, Buffer Word8)
fillReadBuffer !InputStream ByteString
is !Buffer Word8
buf = forall dev.
RawIO dev =>
dev -> Buffer Word8 -> IO (Int, Buffer Word8)
H.readBuf InputStream ByteString
is Buffer Word8
buf
fillReadBuffer0 :: InputStream ByteString
-> Buffer Word8 -> IO (Maybe Int, Buffer Word8)
fillReadBuffer0 InputStream ByteString
_ Buffer Word8
_ = forall a. IO a
unsupported
flushWriteBuffer :: InputStream ByteString -> Buffer Word8 -> IO (Buffer Word8)
flushWriteBuffer InputStream ByteString
_ Buffer Word8
_ = forall a. IO a
unsupported
flushWriteBuffer0 :: InputStream ByteString -> Buffer Word8 -> IO (Int, Buffer Word8)
flushWriteBuffer0 InputStream ByteString
_ Buffer Word8
_ = forall a. IO a
unsupported
instance H.BufferedIO (StreamPair ByteString) where
newBuffer :: StreamPair ByteString -> BufferState -> IO (Buffer Word8)
newBuffer !StreamPair ByteString
_ BufferState
bs = Int -> BufferState -> IO (Buffer Word8)
H.newByteBuffer Int
bUFSIZ BufferState
bs
fillReadBuffer :: StreamPair ByteString -> Buffer Word8 -> IO (Int, Buffer Word8)
fillReadBuffer (SP InputStream ByteString
is OutputStream ByteString
_) = forall dev.
BufferedIO dev =>
dev -> Buffer Word8 -> IO (Int, Buffer Word8)
H.fillReadBuffer InputStream ByteString
is
fillReadBuffer0 :: StreamPair ByteString
-> Buffer Word8 -> IO (Maybe Int, Buffer Word8)
fillReadBuffer0 StreamPair ByteString
_ Buffer Word8
_ = forall a. IO a
unsupported
flushWriteBuffer :: StreamPair ByteString -> Buffer Word8 -> IO (Buffer Word8)
flushWriteBuffer (SP InputStream ByteString
_ !OutputStream ByteString
os) = forall dev.
BufferedIO dev =>
dev -> Buffer Word8 -> IO (Buffer Word8)
H.flushWriteBuffer OutputStream ByteString
os
flushWriteBuffer0 :: StreamPair ByteString -> Buffer Word8 -> IO (Int, Buffer Word8)
flushWriteBuffer0 (SP InputStream ByteString
_ !OutputStream ByteString
os) = forall dev.
BufferedIO dev =>
dev -> Buffer Word8 -> IO (Int, Buffer Word8)
H.flushWriteBuffer0 OutputStream ByteString
os
instance H.IODevice (OutputStream ByteString) where
ready :: OutputStream ByteString -> Bool -> Int -> IO Bool
ready OutputStream ByteString
_ Bool
_ Int
_ = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
close :: OutputStream ByteString -> IO ()
close = forall a. Maybe a -> OutputStream a -> IO ()
write forall a. Maybe a
Nothing
devType :: OutputStream ByteString -> IO IODeviceType
devType OutputStream ByteString
_ = forall (m :: * -> *) a. Monad m => a -> m a
return IODeviceType
H.Stream
instance H.IODevice (InputStream ByteString) where
ready :: InputStream ByteString -> Bool -> Int -> IO Bool
ready InputStream ByteString
_ Bool
_ Int
_ = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
close :: InputStream ByteString -> IO ()
close InputStream ByteString
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! ()
devType :: InputStream ByteString -> IO IODeviceType
devType InputStream ByteString
_ = forall (m :: * -> *) a. Monad m => a -> m a
return IODeviceType
H.Stream
instance H.IODevice (StreamPair ByteString) where
ready :: StreamPair ByteString -> Bool -> Int -> IO Bool
ready StreamPair ByteString
_ Bool
_ Int
_ = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
close :: StreamPair ByteString -> IO ()
close (SP InputStream ByteString
_ OutputStream ByteString
os) = forall a. Maybe a -> OutputStream a -> IO ()
write forall a. Maybe a
Nothing OutputStream ByteString
os
devType :: StreamPair ByteString -> IO IODeviceType
devType StreamPair ByteString
_ = forall (m :: * -> *) a. Monad m => a -> m a
return IODeviceType
H.Stream
emptyWriteBuffer :: H.Buffer Word8
-> IO (H.Buffer Word8)
emptyWriteBuffer :: Buffer Word8 -> IO (Buffer Word8)
emptyWriteBuffer Buffer Word8
buf
= forall (m :: * -> *) a. Monad m => a -> m a
return Buffer Word8
buf { bufL :: Int
H.bufL=Int
0, bufR :: Int
H.bufR=Int
0, bufState :: BufferState
H.bufState = BufferState
H.WriteBuffer }
newtype Generator r a = Generator {
forall r a. Generator r a -> IO (Either (SP r (Generator r a)) a)
unG :: IO (Either (SP r (Generator r a)) a)
} deriving (Typeable)
generatorBind :: Generator r a -> (a -> Generator r b) -> Generator r b
generatorBind :: forall r a b.
Generator r a -> (a -> Generator r b) -> Generator r b
generatorBind (Generator IO (Either (SP r (Generator r a)) a)
m) a -> Generator r b
f = forall r a. IO (Either (SP r (Generator r a)) a) -> Generator r a
Generator (IO (Either (SP r (Generator r a)) a)
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {m :: * -> *} {a} {b}.
Monad m =>
SP a (Generator r a) -> m (Either (SP a (Generator r b)) b)
step a -> IO (Either (SP r (Generator r b)) b)
value)
where
step :: SP a (Generator r a) -> m (Either (SP a (Generator r b)) b)
step (SP a
v Generator r a
r) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$! forall a b. a -> b -> SP a b
SP a
v (forall r a b.
Generator r a -> (a -> Generator r b) -> Generator r b
generatorBind Generator r a
r a -> Generator r b
f)
value :: a -> IO (Either (SP r (Generator r b)) b)
value = forall r a. Generator r a -> IO (Either (SP r (Generator r a)) a)
unG forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Generator r b
f
{-# INLINE generatorBind #-}
instance Monad (Generator r) where
return :: forall a. a -> Generator r a
return = forall r a. IO (Either (SP r (Generator r a)) a) -> Generator r a
Generator forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right
>>= :: forall a b. Generator r a -> (a -> Generator r b) -> Generator r b
(>>=) = forall r a b.
Generator r a -> (a -> Generator r b) -> Generator r b
generatorBind
instance MonadIO (Generator r) where
liftIO :: forall a. IO a -> Generator r a
liftIO = forall r a. IO (Either (SP r (Generator r a)) a) -> Generator r a
Generator forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`)
instance Functor (Generator r) where
fmap :: forall a b. (a -> b) -> Generator r a -> Generator r b
fmap a -> b
f (Generator IO (Either (SP r (Generator r a)) a)
m) = forall r a. IO (Either (SP r (Generator r a)) a) -> Generator r a
Generator forall a b. (a -> b) -> a -> b
$ IO (Either (SP r (Generator r a)) a)
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {m :: * -> *} {f :: * -> *} {a} {b}.
(Monad m, Functor f) =>
SP a (f a) -> m (Either (SP a (f b)) b)
step forall {m :: * -> *} {a}. Monad m => a -> m (Either a b)
value
where
step :: SP a (f a) -> m (Either (SP a (f b)) b)
step (SP a
v f a
m') = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$! forall a b. a -> b -> SP a b
SP a
v (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f f a
m')
value :: a -> m (Either a b)
value a
v = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$! a -> b
f a
v
instance Applicative (Generator r) where
pure :: forall a. a -> Generator r a
pure = forall r a. IO (Either (SP r (Generator r a)) a) -> Generator r a
Generator forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right
Generator r (a -> b)
m <*> :: forall a b. Generator r (a -> b) -> Generator r a -> Generator r b
<*> Generator r a
n = do
a -> b
f <- Generator r (a -> b)
m
a
v <- Generator r a
n
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! a -> b
f a
v
yield :: r -> Generator r ()
yield :: forall r. r -> Generator r ()
yield r
x = forall r a. IO (Either (SP r (Generator r a)) a) -> Generator r a
Generator forall a b. (a -> b) -> a -> b
$! forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$! forall a b. a -> b -> SP a b
SP r
x (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! ())
fromGenerator :: Generator r a -> IO (InputStream r)
fromGenerator :: forall r a. Generator r a -> IO (InputStream r)
fromGenerator (Generator IO (Either (SP r (Generator r a)) a)
m) = do
IORef (IO (Either (SP r (Generator r a)) a))
ref <- forall a. a -> IO (IORef a)
newIORef IO (Either (SP r (Generator r a)) a)
m
forall a. IO (Maybe a) -> IO (InputStream a)
makeInputStream forall a b. (a -> b) -> a -> b
$! forall {r} {a}.
IORef (IO (Either (SP r (Generator r a)) a)) -> IO (Maybe r)
go IORef (IO (Either (SP r (Generator r a)) a))
ref
where
go :: IORef (IO (Either (SP r (Generator r a)) a)) -> IO (Maybe r)
go IORef (IO (Either (SP r (Generator r a)) a))
ref = forall a. IORef a -> IO a
readIORef IORef (IO (Either (SP r (Generator r a)) a))
ref forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\IO (Either (SP r (Generator r a)) a)
n -> IO (Either (SP r (Generator r a)) a)
n forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {a}. SP a (Generator r a) -> IO (Maybe a)
step forall {m :: * -> *} {p} {a}. Monad m => p -> m (Maybe a)
finish)
where
step :: SP a (Generator r a) -> IO (Maybe a)
step (SP a
v Generator r a
gen) = do
forall a. IORef a -> a -> IO ()
writeIORef IORef (IO (Either (SP r (Generator r a)) a))
ref forall a b. (a -> b) -> a -> b
$! forall r a. Generator r a -> IO (Either (SP r (Generator r a)) a)
unG Generator r a
gen
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. a -> Maybe a
Just a
v
finish :: p -> m (Maybe a)
finish p
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
newtype Consumer c a = Consumer {
forall c a. Consumer c a -> IO (Either (Maybe c -> Consumer c a) a)
unC :: IO (Either (Maybe c -> Consumer c a) a)
} deriving (Typeable)
instance Monad (Consumer c) where
return :: forall a. a -> Consumer c a
return = forall c a. IO (Either (Maybe c -> Consumer c a) a) -> Consumer c a
Consumer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right
(Consumer IO (Either (Maybe c -> Consumer c a) a)
m) >>= :: forall a b. Consumer c a -> (a -> Consumer c b) -> Consumer c b
>>= a -> Consumer c b
f = forall c a. IO (Either (Maybe c -> Consumer c a) a) -> Consumer c a
Consumer forall a b. (a -> b) -> a -> b
$ IO (Either (Maybe c -> Consumer c a) a)
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {m :: * -> *} {a} {b}.
Monad m =>
(a -> Consumer c a) -> m (Either (a -> Consumer c b) b)
step a -> IO (Either (Maybe c -> Consumer c b) b)
value
where
step :: (a -> Consumer c a) -> m (Either (a -> Consumer c b) b)
step a -> Consumer c a
g = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$! (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Consumer c b
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Consumer c a
g
value :: a -> IO (Either (Maybe c -> Consumer c b) b)
value a
v = forall c a. Consumer c a -> IO (Either (Maybe c -> Consumer c a) a)
unC forall a b. (a -> b) -> a -> b
$ a -> Consumer c b
f a
v
instance MonadIO (Consumer c) where
liftIO :: forall a. IO a -> Consumer c a
liftIO = forall c a. IO (Either (Maybe c -> Consumer c a) a) -> Consumer c a
Consumer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right
instance Functor (Consumer r) where
fmap :: forall a b. (a -> b) -> Consumer r a -> Consumer r b
fmap a -> b
f (Consumer IO (Either (Maybe r -> Consumer r a) a)
m) = forall c a. IO (Either (Maybe c -> Consumer c a) a) -> Consumer c a
Consumer (IO (Either (Maybe r -> Consumer r a) a)
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {m :: * -> *} {f :: * -> *} {a} {b}.
(Monad m, Functor f) =>
(a -> f a) -> m (Either (a -> f b) b)
step forall {m :: * -> *} {a}. Monad m => a -> m (Either a b)
value)
where
step :: (a -> f a) -> m (Either (a -> f b) b)
step a -> f a
g = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$! (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f a
g
value :: a -> m (Either a b)
value a
v = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$! a -> b
f a
v
instance Applicative (Consumer r) where
pure :: forall a. a -> Consumer r a
pure = forall (m :: * -> *) a. Monad m => a -> m a
return
Consumer r (a -> b)
m <*> :: forall a b. Consumer r (a -> b) -> Consumer r a -> Consumer r b
<*> Consumer r a
n = do
a -> b
f <- Consumer r (a -> b)
m
a
v <- Consumer r a
n
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! a -> b
f a
v
await :: Consumer r (Maybe r)
await :: forall r. Consumer r (Maybe r)
await = forall c a. IO (Either (Maybe c -> Consumer c a) a) -> Consumer c a
Consumer forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left forall (m :: * -> *) a. Monad m => a -> m a
return)
fromConsumer :: Consumer r a -> IO (OutputStream r)
fromConsumer :: forall r a. Consumer r a -> IO (OutputStream r)
fromConsumer Consumer r a
c0 = forall a. a -> IO (IORef a)
newIORef Consumer r a
c0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (Maybe a -> IO ()) -> IO (OutputStream a)
makeOutputStream forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {c} {a}. IORef (Consumer c a) -> Maybe c -> IO ()
go
where
go :: IORef (Consumer c a) -> Maybe c -> IO ()
go IORef (Consumer c a)
ref Maybe c
mb = do
Consumer c a
c <- forall a. IORef a -> IO a
readIORef IORef (Consumer c a)
ref
Consumer c a
c' <- forall c a. Consumer c a -> IO (Either (Maybe c -> Consumer c a) a)
unC Consumer c a
c forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {c} {a}. (Maybe c -> Consumer c a) -> IO (Consumer c a)
step (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$! forall (m :: * -> *) a. Monad m => a -> m a
return Consumer c a
c)
forall a. IORef a -> a -> IO ()
writeIORef IORef (Consumer c a)
ref Consumer c a
c'
where
force :: Consumer c a -> IO (Consumer c a)
force Consumer c a
c = do Either (Maybe c -> Consumer c a) a
e <- forall c a. Consumer c a -> IO (Either (Maybe c -> Consumer c a) a)
unC Consumer c a
c
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall c a. IO (Either (Maybe c -> Consumer c a) a) -> Consumer c a
Consumer forall a b. (a -> b) -> a -> b
$! forall (m :: * -> *) a. Monad m => a -> m a
return Either (Maybe c -> Consumer c a) a
e
step :: (Maybe c -> Consumer c a) -> IO (Consumer c a)
step Maybe c -> Consumer c a
g = forall {c} {a}. Consumer c a -> IO (Consumer c a)
force forall a b. (a -> b) -> a -> b
$! Maybe c -> Consumer c a
g Maybe c
mb