{-# 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 {
InputStream a -> IO (Maybe a)
_read :: IO (Maybe a)
, InputStream a -> a -> IO ()
_unRead :: a -> IO ()
} deriving (Typeable)
data OutputStream a = OutputStream {
OutputStream a -> Maybe a -> IO ()
_write :: Maybe a -> IO ()
} deriving (Typeable)
read :: InputStream a -> IO (Maybe a)
read :: InputStream a -> IO (Maybe a)
read = InputStream a -> IO (Maybe a)
forall a. InputStream a -> IO (Maybe a)
_read
{-# INLINE read #-}
write :: Maybe a -> OutputStream a -> IO ()
write :: Maybe a -> OutputStream a -> IO ()
write = (OutputStream a -> Maybe a -> IO ())
-> Maybe a -> OutputStream a -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip OutputStream a -> Maybe a -> IO ()
forall a. OutputStream a -> Maybe a -> IO ()
_write
{-# INLINE write #-}
writeTo :: OutputStream a -> Maybe a -> IO ()
writeTo :: OutputStream a -> Maybe a -> IO ()
writeTo = OutputStream a -> Maybe a -> IO ()
forall a. OutputStream a -> Maybe a -> IO ()
_write
{-# INLINE writeTo #-}
peek :: InputStream a -> IO (Maybe a)
peek :: InputStream a -> IO (Maybe a)
peek InputStream a
s = do
Maybe a
x <- InputStream a -> IO (Maybe a)
forall a. InputStream a -> IO (Maybe a)
read InputStream a
s
IO () -> (a -> IO ()) -> Maybe a -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$! ()) (InputStream a -> a -> IO ()
forall a. InputStream a -> a -> IO ()
_unRead InputStream a
s) Maybe a
x
Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
x
unRead :: a -> InputStream a -> IO ()
unRead :: a -> InputStream a -> IO ()
unRead = (InputStream a -> a -> IO ()) -> a -> InputStream a -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip InputStream a -> a -> IO ()
forall a. InputStream a -> a -> IO ()
_unRead
connect :: InputStream a -> OutputStream a -> IO ()
connect :: InputStream a -> OutputStream a -> IO ()
connect InputStream a
p OutputStream a
q = IO ()
loop
where
loop :: IO ()
loop = do
Maybe a
m <- InputStream a -> IO (Maybe a)
forall a. InputStream a -> IO (Maybe a)
read InputStream a
p
IO () -> (a -> IO ()) -> Maybe a -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe a -> OutputStream a -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write Maybe a
forall a. Maybe a
Nothing OutputStream a
q)
(IO () -> a -> IO ()
forall a b. a -> b -> a
const (IO () -> a -> IO ()) -> IO () -> a -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe a -> OutputStream a -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write Maybe a
m OutputStream a
q IO () -> IO () -> IO ()
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 :: OutputStream a -> InputStream a -> IO ()
connectTo = (InputStream a -> OutputStream a -> IO ())
-> OutputStream a -> InputStream a -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip InputStream a -> OutputStream a -> IO ()
forall a. InputStream a -> OutputStream a -> IO ()
connect
{-# INLINE connectTo #-}
supply :: InputStream a -> OutputStream a -> IO ()
supply :: InputStream a -> OutputStream a -> IO ()
supply InputStream a
p OutputStream a
q = IO ()
loop
where
loop :: IO ()
loop = do
Maybe a
m <- InputStream a -> IO (Maybe a)
forall a. InputStream a -> IO (Maybe a)
read InputStream a
p
IO () -> (a -> IO ()) -> Maybe a -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$! ())
(IO () -> a -> IO ()
forall a b. a -> b -> a
const (IO () -> a -> IO ()) -> IO () -> a -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe a -> OutputStream a -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write Maybe a
m OutputStream a
q IO () -> IO () -> IO ()
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 :: OutputStream a -> InputStream a -> IO ()
supplyTo = (InputStream a -> OutputStream a -> IO ())
-> OutputStream a -> InputStream a -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip InputStream a -> OutputStream a -> IO ()
forall a. InputStream a -> OutputStream a -> IO ()
supply
{-# INLINE supplyTo #-}
makeInputStream :: IO (Maybe a) -> IO (InputStream a)
makeInputStream :: IO (Maybe a) -> IO (InputStream a)
makeInputStream IO (Maybe a)
m = do
IORef Bool
doneRef <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
IORef [a]
pbRef <- [a] -> IO (IORef [a])
forall a. a -> IO (IORef a)
newIORef []
InputStream a -> IO (InputStream a)
forall (m :: * -> *) a. Monad m => a -> m a
return (InputStream a -> IO (InputStream a))
-> InputStream a -> IO (InputStream a)
forall a b. (a -> b) -> a -> b
$! IO (Maybe a) -> (a -> IO ()) -> InputStream a
forall a. IO (Maybe a) -> (a -> IO ()) -> InputStream a
InputStream (IORef Bool -> IORef [a] -> IO (Maybe a)
grab IORef Bool
doneRef IORef [a]
pbRef) (IORef [a] -> a -> IO ()
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 <- IORef [a] -> IO [a]
forall a. IORef a -> IO a
readIORef IORef [a]
pbRef
case [a]
l of
[] -> do Bool
done <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
doneRef
if Bool
done
then Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
else do
Maybe a
x <- IO (Maybe a)
m
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing Maybe a
x) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
doneRef Bool
True
Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
x
(a
x:[a]
xs) -> IORef [a] -> [a] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [a]
pbRef [a]
xs IO () -> IO (Maybe a) -> IO (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> IO (Maybe a)) -> Maybe a -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$! a -> Maybe a
forall a. a -> Maybe a
Just a
x)
pb :: IORef [a] -> a -> IO ()
pb IORef [a]
ref a
x = IORef [a] -> IO [a]
forall a. IORef a -> IO a
readIORef IORef [a]
ref IO [a] -> ([a] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[a]
xs -> IORef [a] -> [a] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [a]
ref (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)
{-# INLINE makeInputStream #-}
makeOutputStream :: (Maybe a -> IO ()) -> IO (OutputStream a)
makeOutputStream :: (Maybe a -> IO ()) -> IO (OutputStream a)
makeOutputStream Maybe a -> IO ()
func = ((Maybe a -> IO ()) -> OutputStream a
forall a. (Maybe a -> IO ()) -> OutputStream a
OutputStream ((Maybe a -> IO ()) -> OutputStream a)
-> (IORef Bool -> Maybe a -> IO ()) -> IORef Bool -> OutputStream a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef Bool -> Maybe a -> IO ()
go) (IORef Bool -> OutputStream a)
-> IO (IORef Bool) -> IO (OutputStream a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> IO (IORef Bool)
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 <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
closedRef
if Bool
closed
then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$! ()
else do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing Maybe a
m) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> IO ()
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 :: InputStream a -> IO (InputStream a)
lockingInputStream InputStream a
s = do
MVar ()
mv <- () -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar (() -> IO (MVar ())) -> () -> IO (MVar ())
forall a b. (a -> b) -> a -> b
$! ()
InputStream a -> IO (InputStream a)
forall (m :: * -> *) a. Monad m => a -> m a
return (InputStream a -> IO (InputStream a))
-> InputStream a -> IO (InputStream a)
forall a b. (a -> b) -> a -> b
$! IO (Maybe a) -> (a -> IO ()) -> InputStream a
forall a. IO (Maybe a) -> (a -> IO ()) -> InputStream a
InputStream (MVar () -> IO (Maybe a)
forall b. MVar b -> IO (Maybe a)
grab MVar ()
mv) (MVar () -> a -> IO ()
forall b. MVar b -> a -> IO ()
pb MVar ()
mv)
where
grab :: MVar b -> IO (Maybe a)
grab MVar b
mv = MVar b -> (b -> IO (Maybe a)) -> IO (Maybe a)
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar b
mv ((b -> IO (Maybe a)) -> IO (Maybe a))
-> (b -> IO (Maybe a)) -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ IO (Maybe a) -> b -> IO (Maybe a)
forall a b. a -> b -> a
const (IO (Maybe a) -> b -> IO (Maybe a))
-> IO (Maybe a) -> b -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ InputStream a -> IO (Maybe a)
forall a. InputStream a -> IO (Maybe a)
read InputStream a
s
pb :: MVar b -> a -> IO ()
pb MVar b
mv a
x = MVar b -> (b -> IO ()) -> IO ()
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar b
mv ((b -> IO ()) -> IO ()) -> (b -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> b -> IO ()
forall a b. a -> b -> a
const (IO () -> b -> IO ()) -> IO () -> b -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> InputStream a -> IO ()
forall a. a -> InputStream a -> IO ()
unRead a
x InputStream a
s
{-# INLINE lockingInputStream #-}
lockingOutputStream :: OutputStream a -> IO (OutputStream a)
lockingOutputStream :: OutputStream a -> IO (OutputStream a)
lockingOutputStream OutputStream a
s = do
MVar ()
mv <- () -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar (() -> IO (MVar ())) -> () -> IO (MVar ())
forall a b. (a -> b) -> a -> b
$! ()
(Maybe a -> IO ()) -> IO (OutputStream a)
forall a. (Maybe a -> IO ()) -> IO (OutputStream a)
makeOutputStream ((Maybe a -> IO ()) -> IO (OutputStream a))
-> (Maybe a -> IO ()) -> IO (OutputStream a)
forall a b. (a -> b) -> a -> b
$ MVar () -> Maybe a -> IO ()
forall b. MVar b -> Maybe a -> IO ()
f MVar ()
mv
where
f :: MVar b -> Maybe a -> IO ()
f MVar b
mv Maybe a
x = MVar b -> (b -> IO ()) -> IO ()
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar b
mv ((b -> IO ()) -> IO ()) -> (b -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> b -> IO ()
forall a b. a -> b -> a
const (IO () -> b -> IO ()) -> IO () -> b -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe a -> OutputStream a -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write Maybe a
x OutputStream a
s
{-# INLINE lockingOutputStream #-}
nullInput :: IO (InputStream a)
nullInput :: IO (InputStream a)
nullInput = IO (Maybe a) -> IO (InputStream a)
forall a. IO (Maybe a) -> IO (InputStream a)
makeInputStream (IO (Maybe a) -> IO (InputStream a))
-> IO (Maybe a) -> IO (InputStream a)
forall a b. (a -> b) -> a -> b
$ Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
nullOutput :: IO (OutputStream a)
nullOutput :: IO (OutputStream a)
nullOutput = (Maybe a -> IO ()) -> IO (OutputStream a)
forall a. (Maybe a -> IO ()) -> IO (OutputStream a)
makeOutputStream ((Maybe a -> IO ()) -> IO (OutputStream a))
-> (Maybe a -> IO ()) -> IO (OutputStream a)
forall a b. (a -> b) -> a -> b
$ IO () -> Maybe a -> IO ()
forall a b. a -> b -> a
const (IO () -> Maybe a -> IO ()) -> IO () -> Maybe a -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$! ()
appendInputStream :: InputStream a -> InputStream a -> IO (InputStream a)
appendInputStream :: InputStream a -> InputStream a -> IO (InputStream a)
appendInputStream InputStream a
s1 InputStream a
s2 = [InputStream a] -> IO (InputStream a)
forall a. [InputStream a] -> IO (InputStream a)
concatInputStreams [InputStream a
s1, InputStream a
s2]
concatInputStreams :: [InputStream a] -> IO (InputStream a)
concatInputStreams :: [InputStream a] -> IO (InputStream a)
concatInputStreams [InputStream a]
inputStreams = do
IORef [InputStream a]
ref <- [InputStream a] -> IO (IORef [InputStream a])
forall a. a -> IO (IORef a)
newIORef [InputStream a]
inputStreams
IO (Maybe a) -> IO (InputStream a)
forall a. IO (Maybe a) -> IO (InputStream a)
makeInputStream (IO (Maybe a) -> IO (InputStream a))
-> IO (Maybe a) -> IO (InputStream a)
forall a b. (a -> b) -> a -> b
$! IORef [InputStream a] -> IO (Maybe a)
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 <- IORef [InputStream a] -> IO [InputStream a]
forall a. IORef a -> IO a
readIORef IORef [InputStream a]
ref
case [InputStream a]
streams of
[] -> Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
(InputStream a
s:[InputStream a]
rest) -> do
Maybe a
next <- InputStream a -> IO (Maybe a)
forall a. InputStream a -> IO (Maybe a)
read InputStream a
s
case Maybe a
next of
Maybe a
Nothing -> IORef [InputStream a] -> [InputStream a] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [InputStream a]
ref [InputStream a]
rest IO () -> IO (Maybe a) -> IO (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO (Maybe a)
go
Just a
_ -> Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
next
atEOF :: InputStream a -> IO Bool
atEOF :: InputStream a -> IO Bool
atEOF InputStream a
s = InputStream a -> IO (Maybe a)
forall a. InputStream a -> IO (Maybe a)
read InputStream a
s IO (Maybe a) -> (Maybe a -> IO Bool) -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO Bool -> (a -> IO Bool) -> Maybe a -> IO Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) (\a
k -> a -> InputStream a -> IO ()
forall a. a -> InputStream a -> IO ()
unRead a
k InputStream a
s IO () -> IO Bool -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
bUFSIZ :: Int
bUFSIZ :: Int
bUFSIZ = Int
32752
unsupported :: IO a
unsupported :: IO a
unsupported = IOError -> IO a
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 (ByteString -> ByteString) -> ByteString -> ByteString
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 = Buffer Word8 -> ForeignPtr Word8
forall e. Buffer e -> RawBuffer e
H.bufRaw Buffer Word8
buf
l :: Int
l = Buffer Word8 -> Int
forall e. Buffer e -> Int
H.bufL Buffer Word8
buf
r :: Int
r = Buffer Word8 -> Int
forall e. Buffer e -> Int
H.bufR Buffer Word8
buf
sz :: Int
sz = Int
r Int -> Int -> Int
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 f a ptr _ n = f a ptr n
#else
ignoreOffset :: a -> a
ignoreOffset :: a -> a
ignoreOffset = a -> a
forall a. a -> a
id
#endif
{-# INLINE ignoreOffset #-}
instance H.RawIO (InputStream ByteString) where
read :: InputStream ByteString -> Ptr Word8 -> Int -> IO Int
read = (InputStream ByteString -> Ptr Word8 -> Int -> IO Int)
-> InputStream ByteString -> Ptr Word8 -> Int -> IO Int
forall a. a -> a
ignoreOffset ((InputStream ByteString -> Ptr Word8 -> Int -> IO Int)
-> InputStream ByteString -> Ptr Word8 -> Int -> IO Int)
-> (InputStream ByteString -> Ptr Word8 -> Int -> IO Int)
-> InputStream ByteString
-> Ptr Word8
-> Int
-> IO Int
forall a b. (a -> b) -> a -> b
$ \InputStream ByteString
is Ptr Word8
ptr Int
n ->
let f :: ByteString -> IO Int
f ByteString
s = ByteString -> (CStringLen -> IO Int) -> IO Int
forall a. ByteString -> (CStringLen -> IO a) -> IO a
S.unsafeUseAsCStringLen ByteString
s ((CStringLen -> IO Int) -> IO Int)
-> (CStringLen -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
cstr, Int
l) -> do
let c :: Int
c = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n Int
l
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr Word8
ptr (Ptr CChar -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
cstr) Int
c
Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$! Int
c
in InputStream ByteString -> IO (Maybe ByteString)
forall a. InputStream a -> IO (Maybe a)
read InputStream ByteString
is IO (Maybe ByteString) -> (Maybe ByteString -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO Int -> (ByteString -> IO Int) -> Maybe ByteString -> IO Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
0) ByteString -> IO Int
f
readNonBlocking :: InputStream ByteString -> Ptr Word8 -> Int -> IO (Maybe Int)
readNonBlocking = (InputStream ByteString -> Ptr Word8 -> Int -> IO (Maybe Int))
-> InputStream ByteString -> Ptr Word8 -> Int -> IO (Maybe Int)
forall a. a -> a
ignoreOffset ((InputStream ByteString -> Ptr Word8 -> Int -> IO (Maybe Int))
-> InputStream ByteString -> Ptr Word8 -> Int -> IO (Maybe Int))
-> (InputStream ByteString -> Ptr Word8 -> Int -> IO (Maybe Int))
-> InputStream ByteString
-> Ptr Word8
-> Int
-> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ \InputStream ByteString
_ Ptr Word8
_ Int
_ -> IO (Maybe Int)
forall a. IO a
unsupported
write :: InputStream ByteString -> Ptr Word8 -> Int -> IO ()
write = (InputStream ByteString -> Ptr Word8 -> Int -> IO ())
-> InputStream ByteString -> Ptr Word8 -> Int -> IO ()
forall a. a -> a
ignoreOffset ((InputStream ByteString -> Ptr Word8 -> Int -> IO ())
-> InputStream ByteString -> Ptr Word8 -> Int -> IO ())
-> (InputStream ByteString -> Ptr Word8 -> Int -> IO ())
-> InputStream ByteString
-> Ptr Word8
-> Int
-> IO ()
forall a b. (a -> b) -> a -> b
$ \InputStream ByteString
_ Ptr Word8
_ Int
_ -> IO ()
forall a. IO a
unsupported
writeNonBlocking :: InputStream ByteString -> Ptr Word8 -> Int -> IO Int
writeNonBlocking = (InputStream ByteString -> Ptr Word8 -> Int -> IO Int)
-> InputStream ByteString -> Ptr Word8 -> Int -> IO Int
forall a. a -> a
ignoreOffset ((InputStream ByteString -> Ptr Word8 -> Int -> IO Int)
-> InputStream ByteString -> Ptr Word8 -> Int -> IO Int)
-> (InputStream ByteString -> Ptr Word8 -> Int -> IO Int)
-> InputStream ByteString
-> Ptr Word8
-> Int
-> IO Int
forall a b. (a -> b) -> a -> b
$ \InputStream ByteString
_ Ptr Word8
_ Int
_ -> IO Int
forall a. IO a
unsupported
instance H.RawIO (OutputStream ByteString) where
read :: OutputStream ByteString -> Ptr Word8 -> Int -> IO Int
read = (OutputStream ByteString -> Ptr Word8 -> Int -> IO Int)
-> OutputStream ByteString -> Ptr Word8 -> Int -> IO Int
forall a. a -> a
ignoreOffset ((OutputStream ByteString -> Ptr Word8 -> Int -> IO Int)
-> OutputStream ByteString -> Ptr Word8 -> Int -> IO Int)
-> (OutputStream ByteString -> Ptr Word8 -> Int -> IO Int)
-> OutputStream ByteString
-> Ptr Word8
-> Int
-> IO Int
forall a b. (a -> b) -> a -> b
$ \OutputStream ByteString
_ Ptr Word8
_ Int
_ -> IO Int
forall a. IO a
unsupported
readNonBlocking :: OutputStream ByteString -> Ptr Word8 -> Int -> IO (Maybe Int)
readNonBlocking = (OutputStream ByteString -> Ptr Word8 -> Int -> IO (Maybe Int))
-> OutputStream ByteString -> Ptr Word8 -> Int -> IO (Maybe Int)
forall a. a -> a
ignoreOffset ((OutputStream ByteString -> Ptr Word8 -> Int -> IO (Maybe Int))
-> OutputStream ByteString -> Ptr Word8 -> Int -> IO (Maybe Int))
-> (OutputStream ByteString -> Ptr Word8 -> Int -> IO (Maybe Int))
-> OutputStream ByteString
-> Ptr Word8
-> Int
-> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ \OutputStream ByteString
_ Ptr Word8
_ Int
_ -> IO (Maybe Int)
forall a. IO a
unsupported
write :: OutputStream ByteString -> Ptr Word8 -> Int -> IO ()
write = (OutputStream ByteString -> Ptr Word8 -> Int -> IO ())
-> OutputStream ByteString -> Ptr Word8 -> Int -> IO ()
forall a. a -> a
ignoreOffset ((OutputStream ByteString -> Ptr Word8 -> Int -> IO ())
-> OutputStream ByteString -> Ptr Word8 -> Int -> IO ())
-> (OutputStream ByteString -> Ptr Word8 -> Int -> IO ())
-> OutputStream ByteString
-> Ptr Word8
-> Int
-> IO ()
forall a b. (a -> b) -> a -> b
$ \OutputStream ByteString
os Ptr Word8
ptr Int
n -> CStringLen -> IO ByteString
S.packCStringLen (Ptr Word8 -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr, Int
n) IO ByteString -> (ByteString -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
(Maybe ByteString -> OutputStream ByteString -> IO ())
-> OutputStream ByteString -> Maybe ByteString -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Maybe ByteString -> OutputStream ByteString -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write OutputStream ByteString
os (Maybe ByteString -> IO ())
-> (ByteString -> Maybe ByteString) -> ByteString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just
writeNonBlocking :: OutputStream ByteString -> Ptr Word8 -> Int -> IO Int
writeNonBlocking = (OutputStream ByteString -> Ptr Word8 -> Int -> IO Int)
-> OutputStream ByteString -> Ptr Word8 -> Int -> IO Int
forall a. a -> a
ignoreOffset ((OutputStream ByteString -> Ptr Word8 -> Int -> IO Int)
-> OutputStream ByteString -> Ptr Word8 -> Int -> IO Int)
-> (OutputStream ByteString -> Ptr Word8 -> Int -> IO Int)
-> OutputStream ByteString
-> Ptr Word8
-> Int
-> IO Int
forall a b. (a -> b) -> a -> b
$ \OutputStream ByteString
_ Ptr Word8
_ Int
_ -> IO 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 -> Int -> IO Int
read (SP InputStream ByteString
is OutputStream ByteString
_) = InputStream ByteString -> Ptr Word8 -> Int -> IO Int
forall a. RawIO a => a -> Ptr Word8 -> Int -> IO Int
H.read InputStream ByteString
is
readNonBlocking :: StreamPair ByteString -> Ptr Word8 -> Int -> IO (Maybe Int)
readNonBlocking = (StreamPair ByteString -> Ptr Word8 -> Int -> IO (Maybe Int))
-> StreamPair ByteString -> Ptr Word8 -> Int -> IO (Maybe Int)
forall a. a -> a
ignoreOffset ((StreamPair ByteString -> Ptr Word8 -> Int -> IO (Maybe Int))
-> StreamPair ByteString -> Ptr Word8 -> Int -> IO (Maybe Int))
-> (StreamPair ByteString -> Ptr Word8 -> Int -> IO (Maybe Int))
-> StreamPair ByteString
-> Ptr Word8
-> Int
-> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ \StreamPair ByteString
_ Ptr Word8
_ Int
_ -> IO (Maybe Int)
forall a. IO a
unsupported
write :: StreamPair ByteString -> Ptr Word8 -> Int -> IO ()
write (SP InputStream ByteString
_ OutputStream ByteString
os) = OutputStream ByteString -> Ptr Word8 -> Int -> IO ()
forall a. RawIO a => a -> Ptr Word8 -> Int -> IO ()
H.write OutputStream ByteString
os
writeNonBlocking :: StreamPair ByteString -> Ptr Word8 -> Int -> IO Int
writeNonBlocking = (StreamPair ByteString -> Ptr Word8 -> Int -> IO Int)
-> StreamPair ByteString -> Ptr Word8 -> Int -> IO Int
forall a. a -> a
ignoreOffset ((StreamPair ByteString -> Ptr Word8 -> Int -> IO Int)
-> StreamPair ByteString -> Ptr Word8 -> Int -> IO Int)
-> (StreamPair ByteString -> Ptr Word8 -> Int -> IO Int)
-> StreamPair ByteString
-> Ptr Word8
-> Int
-> IO Int
forall a b. (a -> b) -> a -> b
$ \StreamPair ByteString
_ Ptr Word8
_ Int
_ -> IO 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
_ = IO (Int, Buffer Word8)
forall a. IO a
unsupported
fillReadBuffer0 :: OutputStream ByteString
-> Buffer Word8 -> IO (Maybe Int, Buffer Word8)
fillReadBuffer0 !OutputStream ByteString
_ Buffer Word8
_ = IO (Maybe Int, Buffer Word8)
forall a. IO a
unsupported
flushWriteBuffer :: OutputStream ByteString -> Buffer Word8 -> IO (Buffer Word8)
flushWriteBuffer !OutputStream ByteString
os !Buffer Word8
buf = do
Maybe ByteString -> OutputStream ByteString -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
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
Maybe ByteString -> OutputStream ByteString -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
s) OutputStream ByteString
os
Buffer Word8
buf' <- Buffer Word8 -> IO (Buffer Word8)
emptyWriteBuffer Buffer Word8
buf
(Int, Buffer Word8) -> IO (Int, Buffer Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int, Buffer Word8) -> IO (Int, Buffer Word8))
-> (Int, Buffer Word8) -> IO (Int, Buffer Word8)
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 = InputStream ByteString -> Buffer Word8 -> IO (Int, Buffer Word8)
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
_ = IO (Maybe Int, Buffer Word8)
forall a. IO a
unsupported
flushWriteBuffer :: InputStream ByteString -> Buffer Word8 -> IO (Buffer Word8)
flushWriteBuffer InputStream ByteString
_ Buffer Word8
_ = IO (Buffer Word8)
forall a. IO a
unsupported
flushWriteBuffer0 :: InputStream ByteString -> Buffer Word8 -> IO (Int, Buffer Word8)
flushWriteBuffer0 InputStream ByteString
_ Buffer Word8
_ = IO (Int, 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
_) = InputStream ByteString -> Buffer Word8 -> IO (Int, Buffer Word8)
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
_ = IO (Maybe Int, Buffer Word8)
forall a. IO a
unsupported
flushWriteBuffer :: StreamPair ByteString -> Buffer Word8 -> IO (Buffer Word8)
flushWriteBuffer (SP InputStream ByteString
_ !OutputStream ByteString
os) = OutputStream ByteString -> Buffer Word8 -> IO (Buffer Word8)
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) = OutputStream ByteString -> Buffer Word8 -> IO (Int, Buffer Word8)
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
_ = Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
close :: OutputStream ByteString -> IO ()
close = Maybe ByteString -> OutputStream ByteString -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write Maybe ByteString
forall a. Maybe a
Nothing
devType :: OutputStream ByteString -> IO IODeviceType
devType OutputStream ByteString
_ = IODeviceType -> IO IODeviceType
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
_ = Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
close :: InputStream ByteString -> IO ()
close InputStream ByteString
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$! ()
devType :: InputStream ByteString -> IO IODeviceType
devType InputStream ByteString
_ = IODeviceType -> IO IODeviceType
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
_ = Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
close :: StreamPair ByteString -> IO ()
close (SP InputStream ByteString
_ OutputStream ByteString
os) = Maybe ByteString -> OutputStream ByteString -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write Maybe ByteString
forall a. Maybe a
Nothing OutputStream ByteString
os
devType :: StreamPair ByteString -> IO IODeviceType
devType StreamPair ByteString
_ = IODeviceType -> IO IODeviceType
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
= Buffer Word8 -> IO (Buffer Word8)
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 {
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 :: 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 = IO (Either (SP r (Generator r b)) b) -> Generator r b
forall r a. IO (Either (SP r (Generator r a)) a) -> Generator r a
Generator (IO (Either (SP r (Generator r a)) a)
m IO (Either (SP r (Generator r a)) a)
-> (Either (SP r (Generator r a)) a
-> IO (Either (SP r (Generator r b)) b))
-> IO (Either (SP r (Generator r b)) b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (SP r (Generator r a) -> IO (Either (SP r (Generator r b)) b))
-> (a -> IO (Either (SP r (Generator r b)) b))
-> Either (SP r (Generator r a)) a
-> IO (Either (SP r (Generator r b)) b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SP r (Generator r a) -> IO (Either (SP r (Generator r b)) b)
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) = Either (SP a (Generator r b)) b
-> m (Either (SP a (Generator r b)) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (SP a (Generator r b)) b
-> m (Either (SP a (Generator r b)) b))
-> Either (SP a (Generator r b)) b
-> m (Either (SP a (Generator r b)) b)
forall a b. (a -> b) -> a -> b
$! SP a (Generator r b) -> Either (SP a (Generator r b)) b
forall a b. a -> Either a b
Left (SP a (Generator r b) -> Either (SP a (Generator r b)) b)
-> SP a (Generator r b) -> Either (SP a (Generator r b)) b
forall a b. (a -> b) -> a -> b
$! a -> Generator r b -> SP a (Generator r b)
forall a b. a -> b -> SP a b
SP a
v (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 Generator r a
r a -> Generator r b
f)
value :: a -> IO (Either (SP r (Generator r b)) b)
value = Generator r b -> IO (Either (SP r (Generator r b)) b)
forall r a. Generator r a -> IO (Either (SP r (Generator r a)) a)
unG (Generator r b -> IO (Either (SP r (Generator r b)) b))
-> (a -> Generator r b)
-> a
-> IO (Either (SP r (Generator r b)) b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Generator r b
f
{-# INLINE generatorBind #-}
instance Monad (Generator r) where
return :: a -> Generator r a
return = IO (Either (SP r (Generator r a)) a) -> Generator r a
forall r a. IO (Either (SP r (Generator r a)) a) -> Generator r a
Generator (IO (Either (SP r (Generator r a)) a) -> Generator r a)
-> (a -> IO (Either (SP r (Generator r a)) a))
-> a
-> Generator r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (SP r (Generator r a)) a
-> IO (Either (SP r (Generator r a)) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (SP r (Generator r a)) a
-> IO (Either (SP r (Generator r a)) a))
-> (a -> Either (SP r (Generator r a)) a)
-> a
-> IO (Either (SP r (Generator r a)) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either (SP r (Generator r a)) a
forall a b. b -> Either a b
Right
>>= :: Generator r a -> (a -> Generator r b) -> Generator r 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 :: IO a -> Generator r a
liftIO = IO (Either (SP r (Generator r a)) a) -> Generator r a
forall r a. IO (Either (SP r (Generator r a)) a) -> Generator r a
Generator (IO (Either (SP r (Generator r a)) a) -> Generator r a)
-> (IO a -> IO (Either (SP r (Generator r a)) a))
-> IO a
-> Generator r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Either (SP r (Generator r a)) a
forall a b. b -> Either a b
Right (a -> Either (SP r (Generator r a)) a)
-> IO a -> IO (Either (SP r (Generator r a)) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`)
instance Functor (Generator r) where
fmap :: (a -> b) -> Generator r a -> Generator r b
fmap a -> b
f (Generator IO (Either (SP r (Generator r a)) a)
m) = IO (Either (SP r (Generator r b)) b) -> Generator r b
forall r a. IO (Either (SP r (Generator r a)) a) -> Generator r a
Generator (IO (Either (SP r (Generator r b)) b) -> Generator r b)
-> IO (Either (SP r (Generator r b)) b) -> Generator r b
forall a b. (a -> b) -> a -> b
$ IO (Either (SP r (Generator r a)) a)
m IO (Either (SP r (Generator r a)) a)
-> (Either (SP r (Generator r a)) a
-> IO (Either (SP r (Generator r b)) b))
-> IO (Either (SP r (Generator r b)) b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (SP r (Generator r a) -> IO (Either (SP r (Generator r b)) b))
-> (a -> IO (Either (SP r (Generator r b)) b))
-> Either (SP r (Generator r a)) a
-> IO (Either (SP r (Generator r b)) b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SP r (Generator r a) -> IO (Either (SP r (Generator r b)) b)
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Functor f) =>
SP a (f a) -> m (Either (SP a (f b)) b)
step a -> IO (Either (SP r (Generator r b)) b)
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') = Either (SP a (f b)) b -> m (Either (SP a (f b)) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (SP a (f b)) b -> m (Either (SP a (f b)) b))
-> Either (SP a (f b)) b -> m (Either (SP a (f b)) b)
forall a b. (a -> b) -> a -> b
$! SP a (f b) -> Either (SP a (f b)) b
forall a b. a -> Either a b
Left (SP a (f b) -> Either (SP a (f b)) b)
-> SP a (f b) -> Either (SP a (f b)) b
forall a b. (a -> b) -> a -> b
$! a -> f b -> SP a (f b)
forall a b. a -> b -> SP a b
SP a
v ((a -> b) -> f a -> f b
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 = Either a b -> m (Either a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a b -> m (Either a b)) -> Either a b -> m (Either a b)
forall a b. (a -> b) -> a -> b
$! b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> b -> Either a b
forall a b. (a -> b) -> a -> b
$! a -> b
f a
v
instance Applicative (Generator r) where
pure :: a -> Generator r a
pure = IO (Either (SP r (Generator r a)) a) -> Generator r a
forall r a. IO (Either (SP r (Generator r a)) a) -> Generator r a
Generator (IO (Either (SP r (Generator r a)) a) -> Generator r a)
-> (a -> IO (Either (SP r (Generator r a)) a))
-> a
-> Generator r a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (SP r (Generator r a)) a
-> IO (Either (SP r (Generator r a)) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (SP r (Generator r a)) a
-> IO (Either (SP r (Generator r a)) a))
-> (a -> Either (SP r (Generator r a)) a)
-> a
-> IO (Either (SP r (Generator r a)) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either (SP r (Generator r a)) a
forall a b. b -> Either a b
Right
Generator r (a -> b)
m <*> :: 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
b -> Generator r b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Generator r b) -> b -> Generator r b
forall a b. (a -> b) -> a -> b
$! a -> b
f a
v
yield :: r -> Generator r ()
yield :: r -> Generator r ()
yield r
x = IO (Either (SP r (Generator r ())) ()) -> Generator r ()
forall r a. IO (Either (SP r (Generator r a)) a) -> Generator r a
Generator (IO (Either (SP r (Generator r ())) ()) -> Generator r ())
-> IO (Either (SP r (Generator r ())) ()) -> Generator r ()
forall a b. (a -> b) -> a -> b
$! Either (SP r (Generator r ())) ()
-> IO (Either (SP r (Generator r ())) ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (SP r (Generator r ())) ()
-> IO (Either (SP r (Generator r ())) ()))
-> Either (SP r (Generator r ())) ()
-> IO (Either (SP r (Generator r ())) ())
forall a b. (a -> b) -> a -> b
$! SP r (Generator r ()) -> Either (SP r (Generator r ())) ()
forall a b. a -> Either a b
Left (SP r (Generator r ()) -> Either (SP r (Generator r ())) ())
-> SP r (Generator r ()) -> Either (SP r (Generator r ())) ()
forall a b. (a -> b) -> a -> b
$! r -> Generator r () -> SP r (Generator r ())
forall a b. a -> b -> SP a b
SP r
x (() -> Generator r ()
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> Generator r ()) -> () -> Generator r ()
forall a b. (a -> b) -> a -> b
$! ())
fromGenerator :: Generator r a -> IO (InputStream r)
fromGenerator :: 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 <- IO (Either (SP r (Generator r a)) a)
-> IO (IORef (IO (Either (SP r (Generator r a)) a)))
forall a. a -> IO (IORef a)
newIORef IO (Either (SP r (Generator r a)) a)
m
IO (Maybe r) -> IO (InputStream r)
forall a. IO (Maybe a) -> IO (InputStream a)
makeInputStream (IO (Maybe r) -> IO (InputStream r))
-> IO (Maybe r) -> IO (InputStream r)
forall a b. (a -> b) -> a -> b
$! IORef (IO (Either (SP r (Generator r a)) a)) -> IO (Maybe r)
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 = IORef (IO (Either (SP r (Generator r a)) a))
-> IO (IO (Either (SP r (Generator r a)) a))
forall a. IORef a -> IO a
readIORef IORef (IO (Either (SP r (Generator r a)) a))
ref IO (IO (Either (SP r (Generator r a)) a))
-> (IO (Either (SP r (Generator r a)) a) -> IO (Maybe r))
-> IO (Maybe r)
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 IO (Either (SP r (Generator r a)) a)
-> (Either (SP r (Generator r a)) a -> IO (Maybe r))
-> IO (Maybe r)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (SP r (Generator r a) -> IO (Maybe r))
-> (a -> IO (Maybe r))
-> Either (SP r (Generator r a)) a
-> IO (Maybe r)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SP r (Generator r a) -> IO (Maybe r)
forall a. SP a (Generator r a) -> IO (Maybe a)
step a -> IO (Maybe r)
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
IORef (IO (Either (SP r (Generator r a)) a))
-> IO (Either (SP r (Generator r a)) a) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (IO (Either (SP r (Generator r a)) a))
ref (IO (Either (SP r (Generator r a)) a) -> IO ())
-> IO (Either (SP r (Generator r a)) a) -> IO ()
forall a b. (a -> b) -> a -> b
$! Generator r a -> IO (Either (SP r (Generator r a)) a)
forall r a. Generator r a -> IO (Either (SP r (Generator r a)) a)
unG Generator r a
gen
Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> IO (Maybe a)) -> Maybe a -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$! a -> Maybe a
forall a. a -> Maybe a
Just a
v
finish :: p -> m (Maybe a)
finish p
_ = Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
newtype Consumer c a = Consumer {
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 :: a -> Consumer c a
return = IO (Either (Maybe c -> Consumer c a) a) -> Consumer c a
forall c a. IO (Either (Maybe c -> Consumer c a) a) -> Consumer c a
Consumer (IO (Either (Maybe c -> Consumer c a) a) -> Consumer c a)
-> (a -> IO (Either (Maybe c -> Consumer c a) a))
-> a
-> Consumer c a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either (Maybe c -> Consumer c a) a
-> IO (Either (Maybe c -> Consumer c a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Maybe c -> Consumer c a) a
-> IO (Either (Maybe c -> Consumer c a) a))
-> (a -> Either (Maybe c -> Consumer c a) a)
-> a
-> IO (Either (Maybe c -> Consumer c a) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either (Maybe c -> Consumer c a) a
forall a b. b -> Either a b
Right
(Consumer IO (Either (Maybe c -> Consumer c a) a)
m) >>= :: Consumer c a -> (a -> Consumer c b) -> Consumer c b
>>= a -> Consumer c b
f = IO (Either (Maybe c -> Consumer c b) b) -> Consumer c b
forall c a. IO (Either (Maybe c -> Consumer c a) a) -> Consumer c a
Consumer (IO (Either (Maybe c -> Consumer c b) b) -> Consumer c b)
-> IO (Either (Maybe c -> Consumer c b) b) -> Consumer c b
forall a b. (a -> b) -> a -> b
$ IO (Either (Maybe c -> Consumer c a) a)
m IO (Either (Maybe c -> Consumer c a) a)
-> (Either (Maybe c -> Consumer c a) a
-> IO (Either (Maybe c -> Consumer c b) b))
-> IO (Either (Maybe c -> Consumer c b) b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((Maybe c -> Consumer c a)
-> IO (Either (Maybe c -> Consumer c b) b))
-> (a -> IO (Either (Maybe c -> Consumer c b) b))
-> Either (Maybe c -> Consumer c a) a
-> IO (Either (Maybe c -> Consumer c b) b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe c -> Consumer c a)
-> IO (Either (Maybe c -> Consumer c b) b)
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 = Either (a -> Consumer c b) b -> m (Either (a -> Consumer c b) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (a -> Consumer c b) b -> m (Either (a -> Consumer c b) b))
-> Either (a -> Consumer c b) b -> m (Either (a -> Consumer c b) b)
forall a b. (a -> b) -> a -> b
$! (a -> Consumer c b) -> Either (a -> Consumer c b) b
forall a b. a -> Either a b
Left ((a -> Consumer c b) -> Either (a -> Consumer c b) b)
-> (a -> Consumer c b) -> Either (a -> Consumer c b) b
forall a b. (a -> b) -> a -> b
$! (Consumer c a -> (a -> Consumer c b) -> Consumer c b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Consumer c b
f) (Consumer c a -> Consumer c b)
-> (a -> Consumer c a) -> a -> Consumer c b
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 = Consumer c b -> IO (Either (Maybe c -> Consumer c b) b)
forall c a. Consumer c a -> IO (Either (Maybe c -> Consumer c a) a)
unC (Consumer c b -> IO (Either (Maybe c -> Consumer c b) b))
-> Consumer c b -> IO (Either (Maybe c -> Consumer c b) b)
forall a b. (a -> b) -> a -> b
$ a -> Consumer c b
f a
v
instance MonadIO (Consumer c) where
liftIO :: IO a -> Consumer c a
liftIO = IO (Either (Maybe c -> Consumer c a) a) -> Consumer c a
forall c a. IO (Either (Maybe c -> Consumer c a) a) -> Consumer c a
Consumer (IO (Either (Maybe c -> Consumer c a) a) -> Consumer c a)
-> (IO a -> IO (Either (Maybe c -> Consumer c a) a))
-> IO a
-> Consumer c a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Either (Maybe c -> Consumer c a) a)
-> IO a -> IO (Either (Maybe c -> Consumer c a) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either (Maybe c -> Consumer c a) a
forall a b. b -> Either a b
Right
instance Functor (Consumer r) where
fmap :: (a -> b) -> Consumer r a -> Consumer r b
fmap a -> b
f (Consumer IO (Either (Maybe r -> Consumer r a) a)
m) = IO (Either (Maybe r -> Consumer r b) b) -> Consumer r b
forall c a. IO (Either (Maybe c -> Consumer c a) a) -> Consumer c a
Consumer (IO (Either (Maybe r -> Consumer r a) a)
m IO (Either (Maybe r -> Consumer r a) a)
-> (Either (Maybe r -> Consumer r a) a
-> IO (Either (Maybe r -> Consumer r b) b))
-> IO (Either (Maybe r -> Consumer r b) b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((Maybe r -> Consumer r a)
-> IO (Either (Maybe r -> Consumer r b) b))
-> (a -> IO (Either (Maybe r -> Consumer r b) b))
-> Either (Maybe r -> Consumer r a) a
-> IO (Either (Maybe r -> Consumer r b) b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe r -> Consumer r a)
-> IO (Either (Maybe r -> Consumer r b) b)
forall (m :: * -> *) (f :: * -> *) a b.
(Monad m, Functor f) =>
(a -> f a) -> m (Either (a -> f b) b)
step a -> IO (Either (Maybe r -> Consumer r b) b)
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 = Either (a -> f b) b -> m (Either (a -> f b) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (a -> f b) b -> m (Either (a -> f b) b))
-> Either (a -> f b) b -> m (Either (a -> f b) b)
forall a b. (a -> b) -> a -> b
$! (a -> f b) -> Either (a -> f b) b
forall a b. a -> Either a b
Left ((a -> f b) -> Either (a -> f b) b)
-> (a -> f b) -> Either (a -> f b) b
forall a b. (a -> b) -> a -> b
$! ((a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (f a -> f b) -> (a -> f a) -> a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f a
g
value :: a -> m (Either a b)
value a
v = Either a b -> m (Either a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a b -> m (Either a b)) -> Either a b -> m (Either a b)
forall a b. (a -> b) -> a -> b
$! b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> b -> Either a b
forall a b. (a -> b) -> a -> b
$! a -> b
f a
v
instance Applicative (Consumer r) where
pure :: a -> Consumer r a
pure = a -> Consumer r a
forall (m :: * -> *) a. Monad m => a -> m a
return
Consumer r (a -> b)
m <*> :: 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
b -> Consumer r b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Consumer r b) -> b -> Consumer r b
forall a b. (a -> b) -> a -> b
$! a -> b
f a
v
await :: Consumer r (Maybe r)
await :: Consumer r (Maybe r)
await = IO (Either (Maybe r -> Consumer r (Maybe r)) (Maybe r))
-> Consumer r (Maybe r)
forall c a. IO (Either (Maybe c -> Consumer c a) a) -> Consumer c a
Consumer (IO (Either (Maybe r -> Consumer r (Maybe r)) (Maybe r))
-> Consumer r (Maybe r))
-> IO (Either (Maybe r -> Consumer r (Maybe r)) (Maybe r))
-> Consumer r (Maybe r)
forall a b. (a -> b) -> a -> b
$ Either (Maybe r -> Consumer r (Maybe r)) (Maybe r)
-> IO (Either (Maybe r -> Consumer r (Maybe r)) (Maybe r))
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe r -> Consumer r (Maybe r))
-> Either (Maybe r -> Consumer r (Maybe r)) (Maybe r)
forall a b. a -> Either a b
Left Maybe r -> Consumer r (Maybe r)
forall (m :: * -> *) a. Monad m => a -> m a
return)
fromConsumer :: Consumer r a -> IO (OutputStream r)
fromConsumer :: Consumer r a -> IO (OutputStream r)
fromConsumer Consumer r a
c0 = Consumer r a -> IO (IORef (Consumer r a))
forall a. a -> IO (IORef a)
newIORef Consumer r a
c0 IO (IORef (Consumer r a))
-> (IORef (Consumer r a) -> IO (OutputStream r))
-> IO (OutputStream r)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe r -> IO ()) -> IO (OutputStream r)
forall a. (Maybe a -> IO ()) -> IO (OutputStream a)
makeOutputStream ((Maybe r -> IO ()) -> IO (OutputStream r))
-> (IORef (Consumer r a) -> Maybe r -> IO ())
-> IORef (Consumer r a)
-> IO (OutputStream r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef (Consumer r a) -> Maybe r -> IO ()
forall c b. IORef (Consumer c b) -> Maybe c -> IO ()
go
where
go :: IORef (Consumer c b) -> Maybe c -> IO ()
go IORef (Consumer c b)
ref Maybe c
mb = do
Consumer c b
c <- IORef (Consumer c b) -> IO (Consumer c b)
forall a. IORef a -> IO a
readIORef IORef (Consumer c b)
ref
Consumer c b
c' <- Consumer c b -> IO (Either (Maybe c -> Consumer c b) b)
forall c a. Consumer c a -> IO (Either (Maybe c -> Consumer c a) a)
unC Consumer c b
c IO (Either (Maybe c -> Consumer c b) b)
-> (Either (Maybe c -> Consumer c b) b -> IO (Consumer c b))
-> IO (Consumer c b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((Maybe c -> Consumer c b) -> IO (Consumer c b))
-> (b -> IO (Consumer c b))
-> Either (Maybe c -> Consumer c b) b
-> IO (Consumer c b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe c -> Consumer c b) -> IO (Consumer c b)
forall c a. (Maybe c -> Consumer c a) -> IO (Consumer c a)
step (IO (Consumer c b) -> b -> IO (Consumer c b)
forall a b. a -> b -> a
const (IO (Consumer c b) -> b -> IO (Consumer c b))
-> IO (Consumer c b) -> b -> IO (Consumer c b)
forall a b. (a -> b) -> a -> b
$! Consumer c b -> IO (Consumer c b)
forall (m :: * -> *) a. Monad m => a -> m a
return Consumer c b
c)
IORef (Consumer c b) -> Consumer c b -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Consumer c b)
ref Consumer c b
c'
where
force :: Consumer c a -> IO (Consumer c a)
force Consumer c a
c = do Either (Maybe c -> Consumer c a) a
e <- Consumer c a -> IO (Either (Maybe c -> Consumer c a) a)
forall c a. Consumer c a -> IO (Either (Maybe c -> Consumer c a) a)
unC Consumer c a
c
Consumer c a -> IO (Consumer c a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Consumer c a -> IO (Consumer c a))
-> Consumer c a -> IO (Consumer c a)
forall a b. (a -> b) -> a -> b
$! IO (Either (Maybe c -> Consumer c a) a) -> Consumer c a
forall c a. IO (Either (Maybe c -> Consumer c a) a) -> Consumer c a
Consumer (IO (Either (Maybe c -> Consumer c a) a) -> Consumer c a)
-> IO (Either (Maybe c -> Consumer c a) a) -> Consumer c a
forall a b. (a -> b) -> a -> b
$! Either (Maybe c -> Consumer c a) a
-> IO (Either (Maybe c -> Consumer c a) a)
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 = Consumer c a -> IO (Consumer c a)
forall c a. Consumer c a -> IO (Consumer c a)
force (Consumer c a -> IO (Consumer c a))
-> Consumer c a -> IO (Consumer c a)
forall a b. (a -> b) -> a -> b
$! Maybe c -> Consumer c a
g Maybe c
mb