module Data.Conduit.Binary
( sourceFile
, sourceHandle
, sourceIOHandle
, sourceFileRange
, sinkFile
, sinkHandle
, sinkIOHandle
, conduitFile
, isolate
, openFile
, head
, takeWhile
, dropWhile
, take
) where
import Prelude hiding (head, take, takeWhile, dropWhile)
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import Data.Conduit
import qualified Data.Conduit.List as CL
import Control.Exception (assert)
import Control.Monad (liftM)
import Control.Monad.IO.Class (liftIO)
import qualified System.IO as IO
import Control.Monad.Trans.Resource
( withIO, release, newRef, readRef, writeRef
)
import Data.Word (Word8)
#if CABAL_OS_WINDOWS
import qualified System.Win32File as F
#elif NO_HANDLES
import qualified System.PosixFile as F
#endif
openFile :: ResourceIO m
=> FilePath
-> IO.IOMode
-> ResourceT m IO.Handle
openFile fp mode = fmap snd $ withIO (IO.openBinaryFile fp mode) IO.hClose
sourceFile :: ResourceIO m
=> FilePath
-> Source m S.ByteString
sourceFile fp =
#if CABAL_OS_WINDOWS || NO_HANDLES
sourceIO (F.openRead fp)
F.close
(liftIO . F.read)
#else
sourceIOHandle (IO.openBinaryFile fp IO.ReadMode)
#endif
sourceHandle :: ResourceIO m
=> IO.Handle
-> Source m S.ByteString
sourceHandle h = Source $ return $ PreparedSource
{ sourcePull = do
bs <- liftIO (S.hGetSome h 4096)
if S.null bs
then return Closed
else return (Open bs)
, sourceClose = return ()
}
sourceIOHandle :: ResourceIO m
=> IO IO.Handle
-> Source m S.ByteString
sourceIOHandle alloc = sourceIO alloc IO.hClose
(\handle -> do
bs <- liftIO (S.hGetSome handle 4096)
if S.null bs
then return Closed
else return $ Open bs)
sinkHandle :: ResourceIO m
=> IO.Handle
-> Sink S.ByteString m ()
sinkHandle h = Sink $ return $ SinkData
{ sinkPush = \input -> liftIO (S.hPut h input) >> return Processing
, sinkClose = return ()
}
sinkIOHandle :: ResourceIO m
=> IO IO.Handle
-> Sink S.ByteString m ()
sinkIOHandle alloc = sinkIO alloc IO.hClose
(\handle bs -> liftIO (S.hPut handle bs) >> return Processing)
(const $ return ())
sourceFileRange :: ResourceIO m
=> FilePath
-> Maybe Integer
-> Maybe Integer
-> Source m S.ByteString
sourceFileRange fp offset count = Source $ do
(key, handle) <- withIO (IO.openBinaryFile fp IO.ReadMode) IO.hClose
case offset of
Nothing -> return ()
Just off -> liftIO $ IO.hSeek handle IO.AbsoluteSeek off
pull <-
case count of
Nothing -> return $ pullUnlimited handle key
Just c -> do
ic <- newRef c
return $ pullLimited ic handle key
return PreparedSource
{ sourcePull = pull
, sourceClose = release key
}
where
pullUnlimited handle key = do
bs <- liftIO $ S.hGetSome handle 4096
if S.null bs
then do
release key
return Closed
else return $ Open bs
pullLimited ic handle key = do
c <- fmap fromInteger $ readRef ic
bs <- liftIO $ S.hGetSome handle (min c 4096)
let c' = c S.length bs
assert (c' >= 0) $
if S.null bs
then do
release key
return Closed
else do
writeRef ic $ toInteger c'
return $ Open bs
sinkFile :: ResourceIO m
=> FilePath
-> Sink S.ByteString m ()
sinkFile fp = sinkIOHandle (IO.openBinaryFile fp IO.WriteMode)
conduitFile :: ResourceIO m
=> FilePath
-> Conduit S.ByteString m S.ByteString
conduitFile fp = conduitIO
(IO.openBinaryFile fp IO.WriteMode)
IO.hClose
(\handle bs -> do
liftIO $ S.hPut handle bs
return $ Producing [bs])
(const $ return [])
isolate :: Resource m
=> Int
-> Conduit S.ByteString m S.ByteString
isolate count0 = conduitState
count0
push
close
where
push 0 bs = return (0, Finished (Just bs) [])
push count bs = do
let (a, b) = S.splitAt count bs
let count' = count S.length a
return (count',
if count' == 0
then Finished (if S.null b then Nothing else Just b) (if S.null a then [] else [a])
else assert (S.null b) $ Producing [a])
close _ = return []
head :: Resource m => Sink S.ByteString m (Maybe Word8)
head = Sink $ return $ SinkData
{ sinkPush = \bs ->
case S.uncons bs of
Nothing -> return Processing
Just (w, bs') -> do
let lo = if S.null bs' then Nothing else Just bs'
return $ Done lo (Just w)
, sinkClose = return Nothing
}
takeWhile :: Resource m => (Word8 -> Bool) -> Conduit S.ByteString m S.ByteString
takeWhile p = Conduit $ return $ PreparedConduit
{ conduitPush = \bs -> do
let (x, y) = S.span p bs
return $
if S.null y
then Producing [x]
else Finished (Just y) (if S.null x then [] else [x])
, conduitClose = return []
}
dropWhile :: Resource m => (Word8 -> Bool) -> Sink S.ByteString m ()
dropWhile p = Sink $ return $ SinkData
{ sinkPush = \bs -> do
let bs' = S.dropWhile p bs
return $
if S.null bs'
then Processing
else Done (Just bs') ()
, sinkClose = return ()
}
take :: Resource m => Int -> Sink S.ByteString m L.ByteString
take n = L.fromChunks `liftM` (isolate n =$ CL.consume)