-- | 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 CPP                        #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TypeSynonymInstances       #-}

module System.IO.Streams.Internal
  ( -- * Types
    SP(..)
  , StreamPair

    -- * About pushback
    -- $pushback

    -- * Input and output streams
  , InputStream(..)
  , OutputStream(..)

    -- * Primitive stream operations
  , read
  , unRead
  , peek
  , write
  , writeTo
  , atEOF

    -- * Building streams
  , makeInputStream
  , makeOutputStream
  , appendInputStream
  , concatInputStreams

    -- * Connecting streams
  , connect
  , connectTo
  , supply
  , supplyTo

    -- * Thread safety
  , lockingInputStream
  , lockingOutputStream

    -- * Utility streams
  , nullInput
  , nullOutput

    -- * Generator monad
  , Generator
  , fromGenerator
  , yield

    -- * Consumer monad
  , 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)


------------------------------------------------------------------------------
-- | A strict pair type.
data SP a b = SP !a !b
  deriving (Typeable)


------------------------------------------------------------------------------
-- | 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)@
--
data InputStream a = InputStream {
      InputStream a -> IO (Maybe a)
_read   :: IO (Maybe a)
    , InputStream a -> a -> IO ()
_unRead :: a -> IO ()
    } 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 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.)
--
data OutputStream a = OutputStream {
      OutputStream a -> Maybe a -> IO ()
_write :: Maybe a -> IO ()
    } 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 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 #-}


------------------------------------------------------------------------------
-- | 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 supplying 'Nothing'.
--
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 #-}


------------------------------------------------------------------------------
-- | Flipped version of 'write'.
--
-- /Since: 1.3.0.0./
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 #-}


------------------------------------------------------------------------------
-- | 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 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


------------------------------------------------------------------------------
-- | 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 :: 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


------------------------------------------------------------------------------
-- | 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 :: 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 #-}


------------------------------------------------------------------------------
-- | 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 :: 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 #-}


------------------------------------------------------------------------------
-- | 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 :: 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 #-}


------------------------------------------------------------------------------
-- | 'supply' with the arguments flipped.
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 #-}


------------------------------------------------------------------------------
-- | 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 :: 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 #-}


------------------------------------------------------------------------------
-- | Creates an 'OutputStream' from a value-consuming action.
--
-- (@makeOutputStream f@) runs the computation @f@ on each value fed to it.
--
-- Since version 1.2.0.0, 'makeOutputStream' also ensures that output streams
-- no longer receive data once EOF is received (i.e. you can now assume that
-- makeOutputStream will feed your function @Nothing@ at most once.)
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 #-}


------------------------------------------------------------------------------
-- | 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 :: 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 #-}


------------------------------------------------------------------------------
-- | 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 :: 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 #-}


------------------------------------------------------------------------------
-- | An empty 'InputStream' that yields 'Nothing' immediately.
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


------------------------------------------------------------------------------
-- | An empty 'OutputStream' that discards any input fed to it.
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' 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 :: 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' 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 :: [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


------------------------------------------------------------------------------
-- | Checks if an 'InputStream' is at end-of-stream.
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)


------------------------------------------------------------------------------
-- $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 :: 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 #-}

------------------------------------------------------------------------------
-- | The offset argument is ignored if present.
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


------------------------------------------------------------------------------
-- | The offset argument is ignored if present.
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


------------------------------------------------------------------------------
-- | Internal convenience synonym for a pair of input\/output streams.
type StreamPair a = SP (InputStream a) (OutputStream a)

-- | The offset argument is ignored if present.
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 }


------------------------------------------------------------------------------
-- | 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 {
      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


------------------------------------------------------------------------------
-- | 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 :: 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
$! ())


------------------------------------------------------------------------------
-- | Turns a 'Generator' into an 'InputStream'.
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