{-# LANGUAGE BangPatterns #-}
module System.IO.Streams.List
(
fromList
, toList
, outputToList
, writeList
, chunkList
, chunkListWith
, concatLists
, listOutputStream
) where
import Control.Concurrent.MVar (modifyMVar, modifyMVar_, newMVar)
import Control.Monad.IO.Class (MonadIO (..))
import Data.IORef (newIORef, readIORef, writeIORef)
import Prelude hiding (read)
import System.IO.Streams.Internal (InputStream, OutputStream, await, connect, fromConsumer, fromGenerator, makeInputStream, read, write, yield)
fromList :: [c] -> IO (InputStream c)
fromList :: forall c. [c] -> IO (InputStream c)
fromList [c]
inp = forall a. a -> IO (IORef a)
newIORef [c]
inp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. IO (Maybe a) -> IO (InputStream a)
makeInputStream forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. IORef [a] -> IO (Maybe a)
f
where
f :: IORef [a] -> IO (Maybe a)
f IORef [a]
ref = forall a. IORef a -> IO a
readIORef IORef [a]
ref forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[a]
l ->
case [a]
l of
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
(a
x:[a]
xs) -> forall a. IORef a -> a -> IO ()
writeIORef IORef [a]
ref [a]
xs forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
x)
{-# INLINE fromList #-}
listOutputStream :: IO (OutputStream c, IO [c])
listOutputStream :: forall c. IO (OutputStream c, IO [c])
listOutputStream = do
MVar ([c] -> [c])
r <- forall a. a -> IO (MVar a)
newMVar forall a. a -> a
id
OutputStream c
c <- forall r a. Consumer r a -> IO (OutputStream r)
fromConsumer forall a b. (a -> b) -> a -> b
$ forall {a} {c}. MVar ([a] -> c) -> Consumer a ()
consumer MVar ([c] -> [c])
r
forall (m :: * -> *) a. Monad m => a -> m a
return (OutputStream c
c, forall {a}. MVar ([a] -> [a]) -> IO [a]
flush MVar ([c] -> [c])
r)
where
consumer :: MVar ([a] -> c) -> Consumer a ()
consumer MVar ([a] -> c)
r = Consumer a ()
go
where
go :: Consumer a ()
go = forall r. Consumer r (Maybe r)
await forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! ()) forall a b. (a -> b) -> a -> b
$ \a
c -> do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_ MVar ([a] -> c)
r forall a b. (a -> b) -> a -> b
$ \[a] -> c
dl -> forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> c
dl forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
cforall a. a -> [a] -> [a]
:))
Consumer a ()
go)
flush :: MVar ([a] -> [a]) -> IO [a]
flush MVar ([a] -> [a])
r = forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar ([a] -> [a])
r forall a b. (a -> b) -> a -> b
$ \[a] -> [a]
dl -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> a
id, [a] -> [a]
dl [])
{-# INLINE listOutputStream #-}
toList :: InputStream a -> IO [a]
toList :: forall a. InputStream a -> IO [a]
toList InputStream a
is = forall a b. (OutputStream a -> IO b) -> IO [a]
outputToList (forall a. InputStream a -> OutputStream a -> IO ()
connect InputStream a
is)
{-# INLINE toList #-}
outputToList :: (OutputStream a -> IO b) -> IO [a]
outputToList :: forall a b. (OutputStream a -> IO b) -> IO [a]
outputToList OutputStream a -> IO b
f = do
(OutputStream a
os, IO [a]
getList) <- forall c. IO (OutputStream c, IO [c])
listOutputStream
b
_ <- OutputStream a -> IO b
f OutputStream a
os
IO [a]
getList
{-# INLINE outputToList #-}
writeList :: [a] -> OutputStream a -> IO ()
writeList :: forall a. [a] -> OutputStream a -> IO ()
writeList [a]
xs OutputStream a
os = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Maybe a -> OutputStream a -> IO ()
write OutputStream a
os forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) [a]
xs
{-# INLINE writeList #-}
chunkList :: Int
-> InputStream a
-> IO (InputStream [a])
chunkList :: forall a. Int -> InputStream a -> IO (InputStream [a])
chunkList Int
n InputStream a
input = if Int
n forall a. Ord a => a -> a -> Bool
<= Int
0
then forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"chunkList: bad size: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
n
else forall r a. Generator r a -> IO (InputStream r)
fromGenerator forall a b. (a -> b) -> a -> b
$ Int -> ([a] -> [a]) -> Generator [a] ()
go Int
n forall a. a -> a
id
where
go :: Int -> ([a] -> [a]) -> Generator [a] ()
go !Int
k [a] -> [a]
dl | Int
k forall a. Ord a => a -> a -> Bool
<= Int
0 = forall r. r -> Generator r ()
yield ([a] -> [a]
dl []) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ([a] -> [a]) -> Generator [a] ()
go Int
n forall a. a -> a
id
| Bool
otherwise = do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. InputStream a -> IO (Maybe a)
read InputStream a
input) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe Generator [a] ()
finish a -> Generator [a] ()
chunk
where
finish :: Generator [a] ()
finish = let l :: [a]
l = [a] -> [a]
dl []
in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
l then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! () else forall r. r -> Generator r ()
yield [a]
l
chunk :: a -> Generator [a] ()
chunk a
x = Int -> ([a] -> [a]) -> Generator [a] ()
go (Int
k forall a. Num a => a -> a -> a
- Int
1) ([a] -> [a]
dl forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
xforall a. a -> [a] -> [a]
:))
chunkListWith :: (a -> Int -> Bool)
-> InputStream a
-> IO (InputStream [a])
chunkListWith :: forall a.
(a -> Int -> Bool) -> InputStream a -> IO (InputStream [a])
chunkListWith a -> Int -> Bool
p InputStream a
input =
forall r a. Generator r a -> IO (InputStream r)
fromGenerator forall a b. (a -> b) -> a -> b
$ Maybe a -> Int -> ([a] -> [a]) -> Generator [a] ()
go forall a. Maybe a
Nothing Int
0 forall a. a -> a
id
where
go :: Maybe a -> Int -> ([a] -> [a]) -> Generator [a] ()
go Maybe a
v !Int
k [a] -> [a]
dl
| Just a
x <- Maybe a
v, a -> Int -> Bool
p a
x Int
k = forall r. r -> Generator r ()
yield ([a] -> [a]
dl []) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe a -> Int -> ([a] -> [a]) -> Generator [a] ()
go forall a. Maybe a
Nothing Int
0 forall a. a -> a
id
| Bool
otherwise = do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. InputStream a -> IO (Maybe a)
read InputStream a
input) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe Generator [a] ()
finish a -> Generator [a] ()
chunk
where
finish :: Generator [a] ()
finish =
let l :: [a]
l = [a] -> [a]
dl []
in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
l
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! ()
else forall r. r -> Generator r ()
yield [a]
l
chunk :: a -> Generator [a] ()
chunk a
x = Maybe a -> Int -> ([a] -> [a]) -> Generator [a] ()
go (forall a. a -> Maybe a
Just a
x) (Int
k forall a. Num a => a -> a -> a
+ Int
1) ([a] -> [a]
dl forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
x forall a. a -> [a] -> [a]
:))
concatLists :: InputStream [a] -> IO (InputStream a)
concatLists :: forall a. InputStream [a] -> IO (InputStream a)
concatLists InputStream [a]
input = forall r a. Generator r a -> IO (InputStream r)
fromGenerator Generator a ()
go
where
go :: Generator a ()
go = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. InputStream a -> IO (Maybe a)
read InputStream [a]
input) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! ()) [a] -> Generator a ()
chunk
chunk :: [a] -> Generator a ()
chunk [a]
l = forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (forall a b. (a -> b) -> [a] -> [b]
map forall r. r -> Generator r ()
yield [a]
l) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Generator a ()
go