{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE RankNTypes #-}
module System.IO.Streams.Combinators
(
inputFoldM
, outputFoldM
, fold
, foldM
, fold_
, foldM_
, any
, all
, maximum
, minimum
, unfoldM
, map
, mapM
, mapM_
, mapMaybe
, contramap
, contramapM
, contramapM_
, contramapMaybe
, filter
, filterM
, filterOutput
, filterOutputM
, give
, take
, drop
, ignore
, zip
, zipWith
, zipWithM
, unzip
, intersperse
, skipToEof
, ignoreEof
, atEndOfInput
, atEndOfOutput
) where
import Control.Concurrent.MVar (newMVar, withMVar)
import Control.Monad (liftM, void, when)
import Control.Monad.IO.Class (liftIO)
import Data.Int (Int64)
import Data.IORef (IORef, atomicModifyIORef, modifyIORef, newIORef, readIORef, writeIORef)
import Data.Maybe (isJust)
import Prelude hiding (all, any, drop, filter, map, mapM, mapM_, maximum, minimum, read, take, unzip, zip, zipWith)
import System.IO.Streams.Internal (InputStream (..), OutputStream (..), fromGenerator, makeInputStream, makeOutputStream, read, unRead, write, yield)
outputFoldM :: (a -> b -> IO a)
-> a
-> OutputStream b
-> IO (OutputStream b, IO a)
outputFoldM :: (a -> b -> IO a)
-> a -> OutputStream b -> IO (OutputStream b, IO a)
outputFoldM f :: a -> b -> IO a
f initial :: a
initial stream :: OutputStream b
stream = do
IORef a
ref <- a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef a
initial
OutputStream b
os <- (Maybe b -> IO ()) -> IO (OutputStream b)
forall a. (Maybe a -> IO ()) -> IO (OutputStream a)
makeOutputStream (IORef a -> Maybe b -> IO ()
wr IORef a
ref)
(OutputStream b, IO a) -> IO (OutputStream b, IO a)
forall (m :: * -> *) a. Monad m => a -> m a
return (OutputStream b
os, IORef a -> IO a
fetch IORef a
ref)
where
wr :: IORef a -> Maybe b -> IO ()
wr _ Nothing = Maybe b -> OutputStream b -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write Maybe b
forall a. Maybe a
Nothing OutputStream b
stream
wr ref :: IORef a
ref mb :: Maybe b
mb@(Just x :: b
x) = do
!a
z <- IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
ref
!a
z' <- a -> b -> IO a
f a
z b
x
IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef a
ref a
z'
Maybe b -> OutputStream b -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write Maybe b
mb OutputStream b
stream
fetch :: IORef a -> IO a
fetch ref :: IORef a
ref = IORef a -> (a -> (a, a)) -> IO a
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef a
ref ((a -> (a, a)) -> IO a) -> (a -> (a, a)) -> IO a
forall a b. (a -> b) -> a -> b
$ \x :: a
x -> (a
initial, a
x)
inputFoldM :: (a -> b -> IO a)
-> a
-> InputStream b
-> IO (InputStream b, IO a)
inputFoldM :: (a -> b -> IO a) -> a -> InputStream b -> IO (InputStream b, IO a)
inputFoldM f :: a -> b -> IO a
f initial :: a
initial stream :: InputStream b
stream = do
IORef a
ref <- a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef a
initial
InputStream b
is <- IO (Maybe b) -> IO (InputStream b)
forall a. IO (Maybe a) -> IO (InputStream a)
makeInputStream (IORef a -> IO (Maybe b)
rd IORef a
ref)
(InputStream b, IO a) -> IO (InputStream b, IO a)
forall (m :: * -> *) a. Monad m => a -> m a
return (InputStream b
is, IORef a -> IO a
fetch IORef a
ref)
where
twiddle :: IORef a -> Maybe b -> IO (Maybe b)
twiddle _ Nothing = Maybe b -> IO (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
forall a. Maybe a
Nothing
twiddle ref :: IORef a
ref mb :: Maybe b
mb@(Just x :: b
x) = do
!a
z <- IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
ref
!a
z' <- a -> b -> IO a
f a
z b
x
IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef a
ref a
z'
Maybe b -> IO (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
mb
rd :: IORef a -> IO (Maybe b)
rd ref :: IORef a
ref = InputStream b -> IO (Maybe b)
forall a. InputStream a -> IO (Maybe a)
read InputStream b
stream IO (Maybe b) -> (Maybe b -> IO (Maybe b)) -> IO (Maybe b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IORef a -> Maybe b -> IO (Maybe b)
twiddle IORef a
ref
fetch :: IORef a -> IO a
fetch ref :: IORef a
ref = IORef a -> (a -> (a, a)) -> IO a
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef a
ref ((a -> (a, a)) -> IO a) -> (a -> (a, a)) -> IO a
forall a b. (a -> b) -> a -> b
$ \x :: a
x -> (a
initial, a
x)
fold :: (s -> a -> s)
-> s
-> InputStream a
-> IO s
fold :: (s -> a -> s) -> s -> InputStream a -> IO s
fold f :: s -> a -> s
f seed :: s
seed stream :: InputStream a
stream = s -> IO s
go s
seed
where
go :: s -> IO s
go !s
s = InputStream a -> IO (Maybe a)
forall a. InputStream a -> IO (Maybe a)
read InputStream a
stream IO (Maybe a) -> (Maybe a -> IO s) -> IO s
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO s -> (a -> IO s) -> Maybe a -> IO s
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (s -> IO s
forall (m :: * -> *) a. Monad m => a -> m a
return s
s) (s -> IO s
go (s -> IO s) -> (a -> s) -> a -> IO s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> a -> s
f s
s)
foldM :: (s -> a -> IO s)
-> s
-> InputStream a
-> IO s
foldM :: (s -> a -> IO s) -> s -> InputStream a -> IO s
foldM f :: s -> a -> IO s
f seed :: s
seed stream :: InputStream a
stream = s -> IO s
go s
seed
where
go :: s -> IO s
go !s
s = InputStream a -> IO (Maybe a)
forall a. InputStream a -> IO (Maybe a)
read InputStream a
stream IO (Maybe a) -> (Maybe a -> IO s) -> IO s
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO s -> (a -> IO s) -> Maybe a -> IO s
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (s -> IO s
forall (m :: * -> *) a. Monad m => a -> m a
return s
s) ((s -> IO s
go (s -> IO s) -> IO s -> IO s
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (IO s -> IO s) -> (a -> IO s) -> a -> IO s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> a -> IO s
f s
s)
fold_ :: (x -> a -> x)
-> x
-> (x -> s)
-> InputStream a
-> IO s
fold_ :: (x -> a -> x) -> x -> (x -> s) -> InputStream a -> IO s
fold_ op :: x -> a -> x
op seed :: x
seed done :: x -> s
done stream :: InputStream a
stream = (x -> s) -> IO x -> IO s
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM x -> s
done (x -> IO x
go x
seed)
where
go :: x -> IO x
go !x
s = InputStream a -> IO (Maybe a)
forall a. InputStream a -> IO (Maybe a)
read InputStream a
stream IO (Maybe a) -> (Maybe a -> IO x) -> IO x
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO x -> (a -> IO x) -> Maybe a -> IO x
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (x -> IO x
forall (m :: * -> *) a. Monad m => a -> m a
return x
s) (x -> IO x
go (x -> IO x) -> (a -> x) -> a -> IO x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> a -> x
op x
s)
foldM_ :: (x -> a -> IO x)
-> IO x
-> (x -> IO s)
-> InputStream a
-> IO s
foldM_ :: (x -> a -> IO x) -> IO x -> (x -> IO s) -> InputStream a -> IO s
foldM_ f :: x -> a -> IO x
f seed :: IO x
seed done :: x -> IO s
done stream :: InputStream a
stream = IO x
seed IO x -> (x -> IO s) -> IO s
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= x -> IO s
go
where
go :: x -> IO s
go !x
x = InputStream a -> IO (Maybe a)
forall a. InputStream a -> IO (Maybe a)
read InputStream a
stream IO (Maybe a) -> (Maybe a -> IO s) -> IO s
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO s -> (a -> IO s) -> Maybe a -> IO s
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (x -> IO s
done x
x) ((x -> IO s
go (x -> IO s) -> IO x -> IO s
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (IO x -> IO s) -> (a -> IO x) -> a -> IO s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> a -> IO x
f x
x)
any :: (a -> Bool) -> InputStream a -> IO Bool
any :: (a -> Bool) -> InputStream a -> IO Bool
any predicate :: a -> Bool
predicate stream :: InputStream a
stream = IO Bool
go
where
go :: IO Bool
go = do
Maybe a
mElem <- InputStream a -> IO (Maybe a)
forall a. InputStream a -> IO (Maybe a)
read InputStream a
stream
case Maybe a
mElem of
Nothing -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Just e :: a
e -> if a -> Bool
predicate a
e then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True else IO Bool
go
all :: (a -> Bool) -> InputStream a -> IO Bool
all :: (a -> Bool) -> InputStream a -> IO Bool
all predicate :: a -> Bool
predicate stream :: InputStream a
stream = IO Bool
go
where
go :: IO Bool
go = do
Maybe a
mElem <- InputStream a -> IO (Maybe a)
forall a. InputStream a -> IO (Maybe a)
read InputStream a
stream
case Maybe a
mElem of
Nothing -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Just e :: a
e -> if a -> Bool
predicate a
e then IO Bool
go else Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
maximum :: (Ord a) => InputStream a -> IO (Maybe a)
maximum :: InputStream a -> IO (Maybe a)
maximum stream :: InputStream a
stream = do
Maybe a
mElem0 <- InputStream a -> IO (Maybe a)
forall a. InputStream a -> IO (Maybe a)
read InputStream a
stream
case Maybe a
mElem0 of
Nothing -> Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
Just e :: a
e -> a -> IO (Maybe a)
go a
e
where
go :: a -> IO (Maybe a)
go oldElem :: a
oldElem = do
Maybe a
mElem <- InputStream a -> IO (Maybe a)
forall a. InputStream a -> IO (Maybe a)
read InputStream a
stream
case Maybe a
mElem of
Nothing -> Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
oldElem)
Just newElem :: a
newElem -> a -> IO (Maybe a)
go (a -> a -> a
forall a. Ord a => a -> a -> a
max a
oldElem a
newElem)
minimum :: (Ord a) => InputStream a -> IO (Maybe a)
minimum :: InputStream a -> IO (Maybe a)
minimum stream :: InputStream a
stream = do
Maybe a
mElem0 <- InputStream a -> IO (Maybe a)
forall a. InputStream a -> IO (Maybe a)
read InputStream a
stream
case Maybe a
mElem0 of
Nothing -> Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
Just e :: a
e -> a -> IO (Maybe a)
go a
e
where
go :: a -> IO (Maybe a)
go oldElem :: a
oldElem = do
Maybe a
mElem <- InputStream a -> IO (Maybe a)
forall a. InputStream a -> IO (Maybe a)
read InputStream a
stream
case Maybe a
mElem of
Nothing -> Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
oldElem)
Just newElem :: a
newElem -> a -> IO (Maybe a)
go (a -> a -> a
forall a. Ord a => a -> a -> a
min a
oldElem a
newElem)
unfoldM :: (b -> IO (Maybe (a, b))) -> b -> IO (InputStream a)
unfoldM :: (b -> IO (Maybe (a, b))) -> b -> IO (InputStream a)
unfoldM f :: b -> IO (Maybe (a, b))
f seed :: b
seed = Generator a () -> IO (InputStream a)
forall r a. Generator r a -> IO (InputStream r)
fromGenerator (b -> Generator a ()
go b
seed)
where
go :: b -> Generator a ()
go oldSeed :: b
oldSeed = do
Maybe (a, b)
m <- IO (Maybe (a, b)) -> Generator a (Maybe (a, b))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (b -> IO (Maybe (a, b))
f b
oldSeed)
case Maybe (a, b)
m of
Nothing -> () -> Generator a ()
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> Generator a ()) -> () -> Generator a ()
forall a b. (a -> b) -> a -> b
$! ()
Just (a :: a
a, newSeed :: b
newSeed) -> do
a -> Generator a ()
forall r. r -> Generator r ()
yield a
a
b -> Generator a ()
go b
newSeed
map :: (a -> b) -> InputStream a -> IO (InputStream b)
map :: (a -> b) -> InputStream a -> IO (InputStream b)
map f :: a -> b
f s :: InputStream a
s = IO (Maybe b) -> IO (InputStream b)
forall a. IO (Maybe a) -> IO (InputStream a)
makeInputStream IO (Maybe b)
g
where
g :: IO (Maybe b)
g = InputStream a -> IO (Maybe a)
forall a. InputStream a -> IO (Maybe a)
read InputStream a
s IO (Maybe a) -> (Maybe a -> IO (Maybe b)) -> IO (Maybe b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe b -> IO (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe b -> IO (Maybe b))
-> (Maybe a -> Maybe b) -> Maybe a -> IO (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f
mapM :: (a -> IO b) -> InputStream a -> IO (InputStream b)
mapM :: (a -> IO b) -> InputStream a -> IO (InputStream b)
mapM f :: a -> IO b
f s :: InputStream a
s = IO (Maybe b) -> IO (InputStream b)
forall a. IO (Maybe a) -> IO (InputStream a)
makeInputStream IO (Maybe b)
g
where
g :: IO (Maybe b)
g = do
Maybe b
mb <- InputStream a -> IO (Maybe a)
forall a. InputStream a -> IO (Maybe a)
read InputStream a
s IO (Maybe a) -> (Maybe a -> IO (Maybe b)) -> IO (Maybe b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Maybe b) -> (a -> IO (Maybe b)) -> Maybe a -> IO (Maybe b)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe b -> IO (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
forall a. Maybe a
Nothing)
(\x :: a
x -> (b -> Maybe b) -> IO b -> IO (Maybe b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM b -> Maybe b
forall a. a -> Maybe a
Just (IO b -> IO (Maybe b)) -> IO b -> IO (Maybe b)
forall a b. (a -> b) -> a -> b
$ a -> IO b
f a
x)
Maybe b -> IO (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
mb
mapM_ :: (a -> IO b) -> InputStream a -> IO (InputStream a)
mapM_ :: (a -> IO b) -> InputStream a -> IO (InputStream a)
mapM_ f :: a -> IO b
f s :: InputStream a
s = 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
$ do
Maybe a
mb <- 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
$! ()) (IO b -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO b -> IO ()) -> (a -> IO b) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO b
f) Maybe a
mb
Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
mb
mapMaybe :: (a -> Maybe b) -> InputStream a -> IO (InputStream b)
mapMaybe :: (a -> Maybe b) -> InputStream a -> IO (InputStream b)
mapMaybe f :: a -> Maybe b
f src :: InputStream a
src = IO (Maybe b) -> IO (InputStream b)
forall a. IO (Maybe a) -> IO (InputStream a)
makeInputStream IO (Maybe b)
g
where
g :: IO (Maybe b)
g = do
Maybe a
s <- InputStream a -> IO (Maybe a)
forall a. InputStream a -> IO (Maybe a)
read InputStream a
src
case Maybe a
s of
Nothing -> Maybe b -> IO (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
forall a. Maybe a
Nothing
Just x :: a
x ->
case a -> Maybe b
f a
x of
Nothing -> IO (Maybe b)
g
y :: Maybe b
y -> Maybe b -> IO (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
y
contramap :: (a -> b) -> OutputStream b -> IO (OutputStream a)
contramap :: (a -> b) -> OutputStream b -> IO (OutputStream a)
contramap f :: a -> b
f s :: OutputStream b
s = (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
$ (Maybe b -> OutputStream b -> IO ())
-> OutputStream b -> Maybe b -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Maybe b -> OutputStream b -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write OutputStream b
s (Maybe b -> IO ()) -> (Maybe a -> Maybe b) -> Maybe a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f
contramapM :: (a -> IO b) -> OutputStream b -> IO (OutputStream a)
contramapM :: (a -> IO b) -> OutputStream b -> IO (OutputStream a)
contramapM f :: a -> IO b
f s :: OutputStream b
s = (Maybe a -> IO ()) -> IO (OutputStream a)
forall a. (Maybe a -> IO ()) -> IO (OutputStream a)
makeOutputStream Maybe a -> IO ()
g
where
g :: Maybe a -> IO ()
g Nothing = Maybe b -> OutputStream b -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write Maybe b
forall a. Maybe a
Nothing OutputStream b
s
g (Just x :: a
x) = do
!b
y <- a -> IO b
f a
x
Maybe b -> OutputStream b -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write (b -> Maybe b
forall a. a -> Maybe a
Just b
y) OutputStream b
s
contramapM_ :: (a -> IO b) -> OutputStream a -> IO (OutputStream a)
contramapM_ :: (a -> IO b) -> OutputStream a -> IO (OutputStream a)
contramapM_ f :: a -> IO b
f s :: OutputStream a
s = (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
$ \mb :: Maybe a
mb -> do
()
_ <- 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 b -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO b -> IO ()) -> (a -> IO b) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO b
f) Maybe a
mb
Maybe a -> OutputStream a -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write Maybe a
mb OutputStream a
s
contramapMaybe :: (a -> Maybe b) -> OutputStream b -> IO (OutputStream a)
contramapMaybe :: (a -> Maybe b) -> OutputStream b -> IO (OutputStream a)
contramapMaybe f :: a -> Maybe b
f s :: OutputStream b
s = (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
$ Maybe a -> IO ()
g
where
g :: Maybe a -> IO ()
g Nothing = Maybe b -> OutputStream b -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write Maybe b
forall a. Maybe a
Nothing OutputStream b
s
g (Just a :: a
a) =
case a -> Maybe b
f a
a of
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
x :: Maybe b
x -> Maybe b -> OutputStream b -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write Maybe b
x OutputStream b
s
skipToEof :: InputStream a -> IO ()
skipToEof :: InputStream a -> IO ()
skipToEof str :: InputStream a
str = IO ()
go
where
go :: IO ()
go = InputStream a -> IO (Maybe a)
forall a. InputStream a -> IO (Maybe a)
read InputStream a
str IO (Maybe a) -> (Maybe a -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 ()
go)
{-# INLINE skipToEof #-}
filterM :: (a -> IO Bool)
-> InputStream a
-> IO (InputStream a)
filterM :: (a -> IO Bool) -> InputStream a -> IO (InputStream a)
filterM p :: a -> IO Bool
p src :: InputStream a
src = 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 IO (Maybe a)
prod a -> IO ()
pb
where
prod :: IO (Maybe a)
prod = InputStream a -> IO (Maybe a)
forall a. InputStream a -> IO (Maybe a)
read InputStream a
src IO (Maybe a) -> (Maybe a -> IO (Maybe a)) -> IO (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Maybe a) -> (a -> IO (Maybe a)) -> Maybe a -> IO (Maybe a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO (Maybe a)
forall a. IO (Maybe a)
eof a -> IO (Maybe a)
chunk
chunk :: a -> IO (Maybe a)
chunk s :: a
s = do
Bool
b <- a -> IO Bool
p a
s
if Bool
b then 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
s
else IO (Maybe a)
prod
eof :: IO (Maybe a)
eof = Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
pb :: a -> IO ()
pb s :: a
s = a -> InputStream a -> IO ()
forall a. a -> InputStream a -> IO ()
unRead a
s InputStream a
src
filter :: (a -> Bool)
-> InputStream a
-> IO (InputStream a)
filter :: (a -> Bool) -> InputStream a -> IO (InputStream a)
filter p :: a -> Bool
p src :: InputStream a
src = 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 IO (Maybe a)
prod a -> IO ()
pb
where
prod :: IO (Maybe a)
prod = InputStream a -> IO (Maybe a)
forall a. InputStream a -> IO (Maybe a)
read InputStream a
src IO (Maybe a) -> (Maybe a -> IO (Maybe a)) -> IO (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Maybe a) -> (a -> IO (Maybe a)) -> Maybe a -> IO (Maybe a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO (Maybe a)
forall a. IO (Maybe a)
eof a -> IO (Maybe a)
chunk
chunk :: a -> IO (Maybe a)
chunk s :: a
s = do
let b :: Bool
b = a -> Bool
p a
s
if Bool
b then 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
s
else IO (Maybe a)
prod
eof :: IO (Maybe a)
eof = Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
pb :: a -> IO ()
pb s :: a
s = a -> InputStream a -> IO ()
forall a. a -> InputStream a -> IO ()
unRead a
s InputStream a
src
intersperse :: a -> OutputStream a -> IO (OutputStream a)
intersperse :: a -> OutputStream a -> IO (OutputStream a)
intersperse sep :: a
sep os :: OutputStream a
os = Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False IO (IORef Bool)
-> (IORef Bool -> IO (OutputStream a)) -> IO (OutputStream a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe a -> IO ()) -> IO (OutputStream a)
forall a. (Maybe a -> IO ()) -> IO (OutputStream a)
makeOutputStream ((Maybe a -> IO ()) -> IO (OutputStream a))
-> (IORef Bool -> Maybe a -> IO ())
-> IORef Bool
-> IO (OutputStream a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef Bool -> Maybe a -> IO ()
f
where
f :: IORef Bool -> Maybe a -> IO ()
f _ Nothing = Maybe a -> OutputStream a -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write Maybe a
forall a. Maybe a
Nothing OutputStream a
os
f sendRef :: IORef Bool
sendRef s :: Maybe a
s = do
Bool
b <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
sendRef
IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
sendRef Bool
True
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe a -> OutputStream a -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write (a -> Maybe a
forall a. a -> Maybe a
Just a
sep) OutputStream a
os
Maybe a -> OutputStream a -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write Maybe a
s OutputStream a
os
zip :: InputStream a -> InputStream b -> IO (InputStream (a, b))
zip :: InputStream a -> InputStream b -> IO (InputStream (a, b))
zip src1 :: InputStream a
src1 src2 :: InputStream b
src2 = IO (Maybe (a, b)) -> IO (InputStream (a, b))
forall a. IO (Maybe a) -> IO (InputStream a)
makeInputStream IO (Maybe (a, b))
src
where
src :: IO (Maybe (a, b))
src = InputStream a -> IO (Maybe a)
forall a. InputStream a -> IO (Maybe a)
read InputStream a
src1 IO (Maybe a) -> (Maybe a -> IO (Maybe (a, b))) -> IO (Maybe (a, b))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IO (Maybe (a, b))
-> (a -> IO (Maybe (a, b))) -> Maybe a -> IO (Maybe (a, b))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe (a, b) -> IO (Maybe (a, b))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (a, b)
forall a. Maybe a
Nothing) ((a -> IO (Maybe (a, b))) -> Maybe a -> IO (Maybe (a, b)))
-> (a -> IO (Maybe (a, b))) -> Maybe a -> IO (Maybe (a, b))
forall a b. (a -> b) -> a -> b
$ \a :: a
a ->
InputStream b -> IO (Maybe b)
forall a. InputStream a -> IO (Maybe a)
read InputStream b
src2 IO (Maybe b) -> (Maybe b -> IO (Maybe (a, b))) -> IO (Maybe (a, b))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IO (Maybe (a, b))
-> (b -> IO (Maybe (a, b))) -> Maybe b -> IO (Maybe (a, b))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a -> InputStream a -> IO ()
forall a. a -> InputStream a -> IO ()
unRead a
a InputStream a
src1 IO () -> IO (Maybe (a, b)) -> IO (Maybe (a, b))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (a, b) -> IO (Maybe (a, b))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (a, b)
forall a. Maybe a
Nothing) ((b -> IO (Maybe (a, b))) -> Maybe b -> IO (Maybe (a, b)))
-> (b -> IO (Maybe (a, b))) -> Maybe b -> IO (Maybe (a, b))
forall a b. (a -> b) -> a -> b
$ \b :: b
b ->
Maybe (a, b) -> IO (Maybe (a, b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (a, b) -> IO (Maybe (a, b)))
-> Maybe (a, b) -> IO (Maybe (a, b))
forall a b. (a -> b) -> a -> b
$! (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just ((a, b) -> Maybe (a, b)) -> (a, b) -> Maybe (a, b)
forall a b. (a -> b) -> a -> b
$! (a
a, b
b)))
zipWith :: (a -> b -> c)
-> InputStream a
-> InputStream b
-> IO (InputStream c)
zipWith :: (a -> b -> c)
-> InputStream a -> InputStream b -> IO (InputStream c)
zipWith f :: a -> b -> c
f src1 :: InputStream a
src1 src2 :: InputStream b
src2 = IO (Maybe c) -> IO (InputStream c)
forall a. IO (Maybe a) -> IO (InputStream a)
makeInputStream IO (Maybe c)
src
where
src :: IO (Maybe c)
src = InputStream a -> IO (Maybe a)
forall a. InputStream a -> IO (Maybe a)
read InputStream a
src1 IO (Maybe a) -> (Maybe a -> IO (Maybe c)) -> IO (Maybe c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IO (Maybe c) -> (a -> IO (Maybe c)) -> Maybe a -> IO (Maybe c)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe c -> IO (Maybe c)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe c
forall a. Maybe a
Nothing) ((a -> IO (Maybe c)) -> Maybe a -> IO (Maybe c))
-> (a -> IO (Maybe c)) -> Maybe a -> IO (Maybe c)
forall a b. (a -> b) -> a -> b
$ \a :: a
a ->
InputStream b -> IO (Maybe b)
forall a. InputStream a -> IO (Maybe a)
read InputStream b
src2 IO (Maybe b) -> (Maybe b -> IO (Maybe c)) -> IO (Maybe c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IO (Maybe c) -> (b -> IO (Maybe c)) -> Maybe b -> IO (Maybe c)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a -> InputStream a -> IO ()
forall a. a -> InputStream a -> IO ()
unRead a
a InputStream a
src1 IO () -> IO (Maybe c) -> IO (Maybe c)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe c -> IO (Maybe c)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe c
forall a. Maybe a
Nothing) ((b -> IO (Maybe c)) -> Maybe b -> IO (Maybe c))
-> (b -> IO (Maybe c)) -> Maybe b -> IO (Maybe c)
forall a b. (a -> b) -> a -> b
$ \b :: b
b ->
Maybe c -> IO (Maybe c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe c -> IO (Maybe c)) -> Maybe c -> IO (Maybe c)
forall a b. (a -> b) -> a -> b
$! c -> Maybe c
forall a. a -> Maybe a
Just (c -> Maybe c) -> c -> Maybe c
forall a b. (a -> b) -> a -> b
$! a -> b -> c
f a
a b
b ) )
zipWithM :: (a -> b -> IO c)
-> InputStream a
-> InputStream b
-> IO (InputStream c)
zipWithM :: (a -> b -> IO c)
-> InputStream a -> InputStream b -> IO (InputStream c)
zipWithM f :: a -> b -> IO c
f src1 :: InputStream a
src1 src2 :: InputStream b
src2 = IO (Maybe c) -> IO (InputStream c)
forall a. IO (Maybe a) -> IO (InputStream a)
makeInputStream IO (Maybe c)
src
where
src :: IO (Maybe c)
src = InputStream a -> IO (Maybe a)
forall a. InputStream a -> IO (Maybe a)
read InputStream a
src1 IO (Maybe a) -> (Maybe a -> IO (Maybe c)) -> IO (Maybe c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IO (Maybe c) -> (a -> IO (Maybe c)) -> Maybe a -> IO (Maybe c)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe c -> IO (Maybe c)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe c
forall a. Maybe a
Nothing) ((a -> IO (Maybe c)) -> Maybe a -> IO (Maybe c))
-> (a -> IO (Maybe c)) -> Maybe a -> IO (Maybe c)
forall a b. (a -> b) -> a -> b
$ \a :: a
a ->
InputStream b -> IO (Maybe b)
forall a. InputStream a -> IO (Maybe a)
read InputStream b
src2 IO (Maybe b) -> (Maybe b -> IO (Maybe c)) -> IO (Maybe c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (IO (Maybe c) -> (b -> IO (Maybe c)) -> Maybe b -> IO (Maybe c)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a -> InputStream a -> IO ()
forall a. a -> InputStream a -> IO ()
unRead a
a InputStream a
src1 IO () -> IO (Maybe c) -> IO (Maybe c)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe c -> IO (Maybe c)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe c
forall a. Maybe a
Nothing) ((b -> IO (Maybe c)) -> Maybe b -> IO (Maybe c))
-> (b -> IO (Maybe c)) -> Maybe b -> IO (Maybe c)
forall a b. (a -> b) -> a -> b
$ \b :: b
b ->
a -> b -> IO c
f a
a b
b IO c -> (c -> IO (Maybe c)) -> IO (Maybe c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \c :: c
c -> Maybe c -> IO (Maybe c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe c -> IO (Maybe c)) -> Maybe c -> IO (Maybe c)
forall a b. (a -> b) -> a -> b
$! c -> Maybe c
forall a. a -> Maybe a
Just (c -> Maybe c) -> c -> Maybe c
forall a b. (a -> b) -> a -> b
$! c
c ) )
filterOutput :: (a -> Bool) -> OutputStream a -> IO (OutputStream a)
filterOutput :: (a -> Bool) -> OutputStream a -> IO (OutputStream a)
filterOutput p :: a -> Bool
p output :: OutputStream a
output = (Maybe a -> IO ()) -> IO (OutputStream a)
forall a. (Maybe a -> IO ()) -> IO (OutputStream a)
makeOutputStream Maybe a -> IO ()
chunk
where
chunk :: Maybe a -> IO ()
chunk Nothing = Maybe a -> OutputStream a -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write Maybe a
forall a. Maybe a
Nothing OutputStream a
output
chunk ch :: Maybe a
ch@(Just x :: a
x) = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a -> Bool
p a
x) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe a -> OutputStream a -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write Maybe a
ch OutputStream a
output
filterOutputM :: (a -> IO Bool) -> OutputStream a -> IO (OutputStream a)
filterOutputM :: (a -> IO Bool) -> OutputStream a -> IO (OutputStream a)
filterOutputM p :: a -> IO Bool
p output :: OutputStream a
output = (Maybe a -> IO ()) -> IO (OutputStream a)
forall a. (Maybe a -> IO ()) -> IO (OutputStream a)
makeOutputStream Maybe a -> IO ()
chunk
where
chunk :: Maybe a -> IO ()
chunk Nothing = Maybe a -> OutputStream a -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write Maybe a
forall a. Maybe a
Nothing OutputStream a
output
chunk ch :: Maybe a
ch@(Just x :: a
x) = do
Bool
b <- a -> IO Bool
p a
x
if Bool
b then Maybe a -> OutputStream a -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write Maybe a
ch OutputStream a
output else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$! ()
unzip :: forall a b . InputStream (a, b) -> IO (InputStream a, InputStream b)
unzip :: InputStream (a, b) -> IO (InputStream a, InputStream b)
unzip os :: InputStream (a, b)
os = do
MVar ()
lock <- () -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar (() -> IO (MVar ())) -> () -> IO (MVar ())
forall a b. (a -> b) -> a -> b
$! ()
IORef ([a] -> [a])
buf1 <- ([a] -> [a]) -> IO (IORef ([a] -> [a]))
forall a. a -> IO (IORef a)
newIORef [a] -> [a]
forall a. a -> a
id
IORef ([b] -> [b])
buf2 <- ([b] -> [b]) -> IO (IORef ([b] -> [b]))
forall a. a -> IO (IORef a)
newIORef [b] -> [b]
forall a. a -> a
id
InputStream a
is1 <- 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
$ MVar () -> IORef ([a] -> [a]) -> IORef ([b] -> [b]) -> IO (Maybe a)
forall b.
MVar b -> IORef ([a] -> [a]) -> IORef ([b] -> [b]) -> IO (Maybe a)
src1 MVar ()
lock IORef ([a] -> [a])
buf1 IORef ([b] -> [b])
buf2
InputStream b
is2 <- IO (Maybe b) -> IO (InputStream b)
forall a. IO (Maybe a) -> IO (InputStream a)
makeInputStream (IO (Maybe b) -> IO (InputStream b))
-> IO (Maybe b) -> IO (InputStream b)
forall a b. (a -> b) -> a -> b
$ MVar () -> IORef ([a] -> [a]) -> IORef ([b] -> [b]) -> IO (Maybe b)
forall b.
MVar b -> IORef ([a] -> [a]) -> IORef ([b] -> [b]) -> IO (Maybe b)
src2 MVar ()
lock IORef ([a] -> [a])
buf1 IORef ([b] -> [b])
buf2
(InputStream a, InputStream b) -> IO (InputStream a, InputStream b)
forall (m :: * -> *) a. Monad m => a -> m a
return (InputStream a
is1, InputStream b
is2)
where
twist :: (b, a) -> (a, b)
twist (a :: b
a,b :: a
b) = (a
b,b
a)
src1 :: MVar b -> IORef ([a] -> [a]) -> IORef ([b] -> [b]) -> IO (Maybe a)
src1 lock :: MVar b
lock aBuf :: IORef ([a] -> [a])
aBuf bBuf :: IORef ([b] -> [b])
bBuf = MVar b -> (b -> IO (Maybe a)) -> IO (Maybe a)
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar b
lock ((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
$ do
[a] -> [a]
dl <- IORef ([a] -> [a]) -> IO ([a] -> [a])
forall a. IORef a -> IO a
readIORef IORef ([a] -> [a])
aBuf
case [a] -> [a]
dl [] of
[] -> InputStream (a, b)
-> ((a, b) -> (a, b)) -> IORef ([b] -> [b]) -> IO (Maybe a)
forall a b x y.
InputStream (a, b)
-> ((a, b) -> (x, y)) -> IORef ([y] -> [y]) -> IO (Maybe x)
more InputStream (a, b)
os (a, b) -> (a, b)
forall a. a -> a
id IORef ([b] -> [b])
bBuf
(x :: a
x:xs :: [a]
xs) -> IORef ([a] -> [a]) -> ([a] -> [a]) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef ([a] -> [a])
aBuf ([a]
xs[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++) 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)
src2 :: MVar b -> IORef ([a] -> [a]) -> IORef ([b] -> [b]) -> IO (Maybe b)
src2 lock :: MVar b
lock aBuf :: IORef ([a] -> [a])
aBuf bBuf :: IORef ([b] -> [b])
bBuf = MVar b -> (b -> IO (Maybe b)) -> IO (Maybe b)
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar b
lock ((b -> IO (Maybe b)) -> IO (Maybe b))
-> (b -> IO (Maybe b)) -> IO (Maybe b)
forall a b. (a -> b) -> a -> b
$ IO (Maybe b) -> b -> IO (Maybe b)
forall a b. a -> b -> a
const (IO (Maybe b) -> b -> IO (Maybe b))
-> IO (Maybe b) -> b -> IO (Maybe b)
forall a b. (a -> b) -> a -> b
$ do
[b] -> [b]
dl <- IORef ([b] -> [b]) -> IO ([b] -> [b])
forall a. IORef a -> IO a
readIORef IORef ([b] -> [b])
bBuf
case [b] -> [b]
dl [] of
[] -> InputStream (a, b)
-> ((a, b) -> (b, a)) -> IORef ([a] -> [a]) -> IO (Maybe b)
forall a b x y.
InputStream (a, b)
-> ((a, b) -> (x, y)) -> IORef ([y] -> [y]) -> IO (Maybe x)
more InputStream (a, b)
os (a, b) -> (b, a)
forall b a. (b, a) -> (a, b)
twist IORef ([a] -> [a])
aBuf
(y :: b
y:ys :: [b]
ys) -> IORef ([b] -> [b]) -> ([b] -> [b]) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef ([b] -> [b])
bBuf ([b]
ys[b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
++) IO () -> IO (Maybe b) -> IO (Maybe b)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Maybe b -> IO (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe b -> IO (Maybe b)) -> Maybe b -> IO (Maybe b)
forall a b. (a -> b) -> a -> b
$! b -> Maybe b
forall a. a -> Maybe a
Just b
y)
more :: forall a b x y .
InputStream (a,b)
-> ((a,b) -> (x,y))
-> IORef ([y] -> [y])
-> IO (Maybe x)
more :: InputStream (a, b)
-> ((a, b) -> (x, y)) -> IORef ([y] -> [y]) -> IO (Maybe x)
more origs :: InputStream (a, b)
origs proj :: (a, b) -> (x, y)
proj buf :: IORef ([y] -> [y])
buf = InputStream (a, b) -> IO (Maybe (a, b))
forall a. InputStream a -> IO (Maybe a)
read InputStream (a, b)
origs IO (Maybe (a, b)) -> (Maybe (a, b) -> IO (Maybe x)) -> IO (Maybe x)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
IO (Maybe x)
-> ((a, b) -> IO (Maybe x)) -> Maybe (a, b) -> IO (Maybe x)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe x -> IO (Maybe x)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe x
forall a. Maybe a
Nothing)
(\x :: (a, b)
x -> do
let (a :: x
a, b :: y
b) = (a, b) -> (x, y)
proj (a, b)
x
IORef ([y] -> [y]) -> (([y] -> [y]) -> [y] -> [y]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef ([y] -> [y])
buf (([y] -> [y]) -> ([y] -> [y]) -> [y] -> [y]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (y
by -> [y] -> [y]
forall a. a -> [a] -> [a]
:))
Maybe x -> IO (Maybe x)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe x -> IO (Maybe x)) -> Maybe x -> IO (Maybe x)
forall a b. (a -> b) -> a -> b
$! x -> Maybe x
forall a. a -> Maybe a
Just x
a)
take :: Int64 -> InputStream a -> IO (InputStream a)
take :: Int64 -> InputStream a -> IO (InputStream a)
take k0 :: Int64
k0 input :: InputStream a
input = do
IORef Int64
kref <- Int64 -> IO (IORef Int64)
forall a. a -> IO (IORef a)
newIORef Int64
k0
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 Int64 -> IO (Maybe a)
forall a. (Ord a, Num a) => IORef a -> IO (Maybe a)
prod IORef Int64
kref) (IORef Int64 -> a -> IO ()
forall a. Num a => IORef a -> a -> IO ()
pb IORef Int64
kref)
where
prod :: IORef a -> IO (Maybe a)
prod kref :: IORef a
kref = do
!a
k <- IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
kref
if a
k a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= 0
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
m <- InputStream a -> IO (Maybe a)
forall a. InputStream a -> IO (Maybe a)
read InputStream a
input
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
m) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef a -> (a -> a) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef a
kref ((a -> a) -> IO ()) -> (a -> a) -> IO ()
forall a b. (a -> b) -> a -> b
$ \x :: a
x -> a
x a -> a -> a
forall a. Num a => a -> a -> a
- 1
Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
m
pb :: IORef a -> a -> IO ()
pb kref :: IORef a
kref !a
s = do
a -> InputStream a -> IO ()
forall a. a -> InputStream a -> IO ()
unRead a
s InputStream a
input
IORef a -> (a -> a) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef a
kref (a -> a -> a
forall a. Num a => a -> a -> a
+1)
drop :: Int64 -> InputStream a -> IO (InputStream a)
drop :: Int64 -> InputStream a -> IO (InputStream a)
drop k0 :: Int64
k0 input :: InputStream a
input = do
IORef Int64
kref <- Int64 -> IO (IORef Int64)
forall a. a -> IO (IORef a)
newIORef Int64
k0
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 Int64 -> IO (Maybe a)
forall a. (Ord a, Num a) => IORef a -> IO (Maybe a)
prod IORef Int64
kref) (IORef Int64 -> a -> IO ()
forall a. Num a => IORef a -> a -> IO ()
pb IORef Int64
kref)
where
prod :: IORef a -> IO (Maybe a)
prod kref :: IORef a
kref = do
!a
k <- IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
kref
if a
k a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= 0
then IORef a -> IO (Maybe a)
forall a. Num a => IORef a -> IO (Maybe a)
getInput IORef a
kref
else IORef a -> IO (Maybe a)
discard IORef a
kref
getInput :: IORef a -> IO (Maybe a)
getInput kref :: IORef a
kref = do
InputStream a -> IO (Maybe a)
forall a. InputStream a -> IO (Maybe a)
read InputStream a
input IO (Maybe a) -> (Maybe a -> IO (Maybe a)) -> IO (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Maybe a) -> (a -> IO (Maybe a)) -> Maybe a -> IO (Maybe a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing) (\c :: a
c -> do
IORef a -> (a -> a) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef a
kref (\x :: a
x -> a
x a -> a -> a
forall a. Num a => a -> a -> a
- 1)
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
c)
discard :: IORef a -> IO (Maybe a)
discard kref :: IORef a
kref = IORef a -> IO (Maybe a)
forall a. Num a => IORef a -> IO (Maybe a)
getInput IORef a
kref IO (Maybe a) -> (Maybe a -> IO (Maybe a)) -> IO (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Maybe a) -> (a -> IO (Maybe a)) -> Maybe a -> IO (Maybe a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing) (IO (Maybe a) -> a -> IO (Maybe a)
forall a b. a -> b -> a
const (IO (Maybe a) -> a -> IO (Maybe a))
-> IO (Maybe a) -> a -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ IORef a -> IO (Maybe a)
prod IORef a
kref)
pb :: IORef a -> a -> IO ()
pb kref :: IORef a
kref s :: a
s = do
a -> InputStream a -> IO ()
forall a. a -> InputStream a -> IO ()
unRead a
s InputStream a
input
IORef a -> (a -> a) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef a
kref (a -> a -> a
forall a. Num a => a -> a -> a
+1)
give :: Int64 -> OutputStream a -> IO (OutputStream a)
give :: Int64 -> OutputStream a -> IO (OutputStream a)
give k :: Int64
k output :: OutputStream a
output = Int64 -> IO (IORef Int64)
forall a. a -> IO (IORef a)
newIORef Int64
k IO (IORef Int64)
-> (IORef Int64 -> IO (OutputStream a)) -> IO (OutputStream a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe a -> IO ()) -> IO (OutputStream a)
forall a. (Maybe a -> IO ()) -> IO (OutputStream a)
makeOutputStream ((Maybe a -> IO ()) -> IO (OutputStream a))
-> (IORef Int64 -> Maybe a -> IO ())
-> IORef Int64
-> IO (OutputStream a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef Int64 -> Maybe a -> IO ()
forall a. (Ord a, Num a) => IORef a -> Maybe a -> IO ()
chunk
where
chunk :: IORef a -> Maybe a -> IO ()
chunk ref :: IORef a
ref = 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
$! ()) ((a -> IO ()) -> Maybe a -> IO ())
-> (a -> IO ()) -> Maybe a -> IO ()
forall a b. (a -> b) -> a -> b
$ \x :: a
x -> do
!a
n <- IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
ref
if a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= 0
then () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$! ()
else do
IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef a
ref (a -> IO ()) -> a -> IO ()
forall a b. (a -> b) -> a -> b
$! a
n a -> a -> a
forall a. Num a => a -> a -> a
- 1
Maybe a -> OutputStream a -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write (a -> Maybe a
forall a. a -> Maybe a
Just a
x) OutputStream a
output
ignore :: Int64 -> OutputStream a -> IO (OutputStream a)
ignore :: Int64 -> OutputStream a -> IO (OutputStream a)
ignore k :: Int64
k output :: OutputStream a
output = Int64 -> IO (IORef Int64)
forall a. a -> IO (IORef a)
newIORef Int64
k IO (IORef Int64)
-> (IORef Int64 -> IO (OutputStream a)) -> IO (OutputStream a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe a -> IO ()) -> IO (OutputStream a)
forall a. (Maybe a -> IO ()) -> IO (OutputStream a)
makeOutputStream ((Maybe a -> IO ()) -> IO (OutputStream a))
-> (IORef Int64 -> Maybe a -> IO ())
-> IORef Int64
-> IO (OutputStream a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef Int64 -> Maybe a -> IO ()
forall a. (Ord a, Num a) => IORef a -> Maybe a -> IO ()
chunk
where
chunk :: IORef a -> Maybe a -> IO ()
chunk ref :: IORef a
ref = 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
$! ()) ((a -> IO ()) -> Maybe a -> IO ())
-> (a -> IO ()) -> Maybe a -> IO ()
forall a b. (a -> b) -> a -> b
$ \x :: a
x -> do
!a
n <- IORef a -> IO a
forall a. IORef a -> IO a
readIORef IORef a
ref
if a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> 0
then IORef a -> a -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef a
ref (a -> IO ()) -> a -> IO ()
forall a b. (a -> b) -> a -> b
$! a
n a -> a -> a
forall a. Num a => a -> a -> a
- 1
else Maybe a -> OutputStream a -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write (a -> Maybe a
forall a. a -> Maybe a
Just a
x) OutputStream a
output
ignoreEof :: OutputStream a -> IO (OutputStream a)
ignoreEof :: OutputStream a -> IO (OutputStream a)
ignoreEof s :: OutputStream a
s = OutputStream a -> IO (OutputStream a)
forall (m :: * -> *) a. Monad m => a -> m a
return (OutputStream a -> IO (OutputStream a))
-> OutputStream a -> IO (OutputStream a)
forall a b. (a -> b) -> a -> b
$ (Maybe a -> IO ()) -> OutputStream a
forall a. (Maybe a -> IO ()) -> OutputStream a
OutputStream Maybe a -> IO ()
f
where
f :: Maybe a -> IO ()
f Nothing = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$! ()
f x :: Maybe a
x = Maybe a -> OutputStream a -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write Maybe a
x OutputStream a
s
atEndOfInput :: IO b -> InputStream a -> IO (InputStream a)
atEndOfInput :: IO b -> InputStream a -> IO (InputStream a)
atEndOfInput m :: IO b
m is :: InputStream a
is = 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 IO (Maybe a)
prod a -> IO ()
pb
where
prod :: IO (Maybe a)
prod = InputStream a -> IO (Maybe a)
forall a. InputStream a -> IO (Maybe a)
read InputStream a
is IO (Maybe a) -> (Maybe a -> IO (Maybe a)) -> IO (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Maybe a) -> (a -> IO (Maybe a)) -> Maybe a -> IO (Maybe a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO (Maybe a)
forall a. IO (Maybe a)
eof (Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> IO (Maybe a)) -> (a -> Maybe a) -> a -> IO (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just)
eof :: IO (Maybe a)
eof = IO b -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void IO b
m 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
forall a. Maybe a
Nothing
pb :: a -> IO ()
pb s :: a
s = a -> InputStream a -> IO ()
forall a. a -> InputStream a -> IO ()
unRead a
s InputStream a
is
atEndOfOutput :: IO b -> OutputStream a -> IO (OutputStream a)
atEndOfOutput :: IO b -> OutputStream a -> IO (OutputStream a)
atEndOfOutput m :: IO b
m os :: OutputStream a
os = (Maybe a -> IO ()) -> IO (OutputStream a)
forall a. (Maybe a -> IO ()) -> IO (OutputStream a)
makeOutputStream Maybe a -> IO ()
f
where
f :: Maybe a -> IO ()
f Nothing = Maybe a -> OutputStream a -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write Maybe a
forall a. Maybe a
Nothing OutputStream a
os IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO b -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void IO b
m
f x :: Maybe a
x = Maybe a -> OutputStream a -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
write Maybe a
x OutputStream a
os