module Control.Pipe.Binary (
fileReader,
handleReader,
fileWriter,
handleWriter,
take,
takeWhile,
dropWhile,
lines,
bytes,
) where
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Pipe
import Control.Pipe.Exception
import Control.Pipe.Combinators (tryAwait, feed)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import Data.Monoid
import Data.Word
import System.IO
import Prelude hiding (take, takeWhile, dropWhile, lines, catch)
fileReader :: MonadIO m => FilePath -> Pipe () B.ByteString m ()
fileReader path = bracket
(liftIO $ openFile path ReadMode)
(liftIO . hClose)
handleReader
handleReader :: MonadIO m => Handle -> Pipe () B.ByteString m ()
handleReader h = go
where
go = do
eof <- lift . liftIO $ hIsEOF h
unless eof $ do
chunk <- lift . liftIO $ B.hGetSome h 4096
yield chunk
go
fileWriter :: MonadIO m => FilePath -> Pipe B.ByteString Void m r
fileWriter path = do
input <- await
feed input go
where
go = bracket
(liftIO $ openFile path WriteMode)
(liftIO . hClose)
handleWriter
handleWriter:: MonadIO m => Handle -> Pipe B.ByteString Void m r
handleWriter h = forever $ do
chunk <- await
lift . liftIO . B.hPut h $ chunk
take :: Monad m => Int -> Pipe B.ByteString B.ByteString m B.ByteString
take size = do
chunk <- await
let (chunk', leftover) = B.splitAt size chunk
yield chunk'
if B.null leftover
then take $ size B.length chunk'
else return leftover
takeWhile :: Monad m => (Word8 -> Bool) -> Pipe B.ByteString B.ByteString m B.ByteString
takeWhile p = go
where
go = do
chunk <- await
let (chunk', leftover) = B.span p chunk
unless (B.null chunk) $ yield chunk'
if B.null leftover
then go
else return leftover
dropWhile :: Monad m => (Word8 -> Bool) -> Pipe B.ByteString B.ByteString m r
dropWhile p = do
leftover <- takeWhile (not . p) >+> discard
yield leftover
idP
lines :: Monad m => Pipe B.ByteString B.ByteString m r
lines = go B.empty
where
go leftover = do
mchunk <- tryAwait
case mchunk of
Nothing | B.null leftover -> idP
Nothing -> yield leftover >> idP
Just chunk -> split chunk leftover
split chunk leftover
| B.null chunk = go leftover
| B.null rest = go (mappend leftover chunk)
| otherwise = yield (mappend leftover line) >>
split (B.drop 1 rest) mempty
where (line, rest) = B.breakByte 10 chunk
bytes :: Monad m => Pipe B.ByteString Word8 m r
bytes = forever $ await >>= B.foldl (\p c -> p >> yield c) (return ())