{-# LANGUAGE CPP, RankNTypes #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Data.Conduit.Binary
(
CC.sourceFile
, CC.sourceHandle
, CC.sourceHandleUnsafe
, CC.sourceIOHandle
, sourceFileRange
, sourceHandleRange
, sourceHandleRangeWithBuffer
, CC.withSourceFile
, CC.sinkFile
, CC.sinkFileCautious
, CC.sinkTempFile
, CC.sinkSystemTempFile
, CC.sinkHandle
, CC.sinkIOHandle
, CC.sinkHandleBuilder
, CC.sinkHandleFlush
, CC.withSinkFile
, CC.withSinkFileBuilder
, CC.withSinkFileCautious
, conduitFile
, conduitHandle
, sourceLbs
, head
, dropWhile
, take
, drop
, sinkCacheLength
, sinkLbs
, mapM_
, sinkStorable
, sinkStorableEx
, isolate
, takeWhile
, Data.Conduit.Binary.lines
) where
import qualified Data.Conduit.Combinators as CC
import Prelude hiding (head, take, drop, takeWhile, dropWhile, mapM_)
import qualified Data.ByteString as S
import Data.ByteString.Unsafe (unsafeUseAsCString)
import qualified Data.ByteString.Lazy as L
import Data.Conduit
import Data.Conduit.List (sourceList, consume)
import Control.Exception (assert, finally)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO, MonadIO)
import Control.Monad.Trans.Resource (allocate, release, MonadThrow (..))
import Control.Monad.Trans.Class (lift)
import qualified System.IO as IO
import Data.Word (Word8, Word64)
#if (__GLASGOW_HASKELL__ < 710)
import Control.Applicative ((<$>))
#endif
import System.Directory (getTemporaryDirectory, removeFile)
import Data.ByteString.Lazy.Internal (defaultChunkSize)
import Data.ByteString.Internal (ByteString (PS), accursedUnutterablePerformIO)
import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
import Foreign.ForeignPtr (touchForeignPtr)
import Foreign.Ptr (plusPtr, castPtr)
import Foreign.Storable (Storable, peek, sizeOf)
import Control.Monad.Trans.Resource (MonadResource)
import Control.Exception (Exception)
import Data.Typeable (Typeable)
import Foreign.Ptr (Ptr)
#ifndef ALLOW_UNALIGNED_ACCESS
import Foreign.Marshal (alloca, copyBytes)
#endif
sourceFileRange :: MonadResource m
=> FilePath
-> Maybe Integer
-> Maybe Integer
-> ConduitT i S.ByteString m ()
sourceFileRange :: FilePath
-> Maybe Integer -> Maybe Integer -> ConduitT i ByteString m ()
sourceFileRange FilePath
fp Maybe Integer
offset Maybe Integer
count = IO Handle
-> (Handle -> IO ())
-> (Handle -> ConduitT i ByteString m ())
-> ConduitT i ByteString m ()
forall (m :: * -> *) a i o r.
MonadResource m =>
IO a -> (a -> IO ()) -> (a -> ConduitT i o m r) -> ConduitT i o m r
bracketP
(FilePath -> IOMode -> IO Handle
IO.openBinaryFile FilePath
fp IOMode
IO.ReadMode)
Handle -> IO ()
IO.hClose
(\Handle
h -> Handle
-> Maybe Integer -> Maybe Integer -> ConduitT i ByteString m ()
forall (m :: * -> *) i.
MonadIO m =>
Handle
-> Maybe Integer -> Maybe Integer -> ConduitT i ByteString m ()
sourceHandleRange Handle
h Maybe Integer
offset Maybe Integer
count)
sourceHandleRange :: MonadIO m
=> IO.Handle
-> Maybe Integer
-> Maybe Integer
-> ConduitT i S.ByteString m ()
sourceHandleRange :: Handle
-> Maybe Integer -> Maybe Integer -> ConduitT i ByteString m ()
sourceHandleRange Handle
handle Maybe Integer
offset Maybe Integer
count =
Handle
-> Maybe Integer
-> Maybe Integer
-> Int
-> ConduitT i ByteString m ()
forall (m :: * -> *) i.
MonadIO m =>
Handle
-> Maybe Integer
-> Maybe Integer
-> Int
-> ConduitT i ByteString m ()
sourceHandleRangeWithBuffer Handle
handle Maybe Integer
offset Maybe Integer
count Int
defaultChunkSize
sourceHandleRangeWithBuffer :: MonadIO m
=> IO.Handle
-> Maybe Integer
-> Maybe Integer
-> Int
-> ConduitT i S.ByteString m ()
sourceHandleRangeWithBuffer :: Handle
-> Maybe Integer
-> Maybe Integer
-> Int
-> ConduitT i ByteString m ()
sourceHandleRangeWithBuffer Handle
handle Maybe Integer
offset Maybe Integer
count Int
buffer = do
case Maybe Integer
offset of
Maybe Integer
Nothing -> () -> ConduitT i ByteString m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Integer
off -> IO () -> ConduitT i ByteString m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ConduitT i ByteString m ())
-> IO () -> ConduitT i ByteString m ()
forall a b. (a -> b) -> a -> b
$ Handle -> SeekMode -> Integer -> IO ()
IO.hSeek Handle
handle SeekMode
IO.AbsoluteSeek Integer
off
case Maybe Integer
count of
Maybe Integer
Nothing -> ConduitT i ByteString m ()
forall i. ConduitT i ByteString m ()
pullUnlimited
Just Integer
c -> Int -> ConduitT i ByteString m ()
forall (m :: * -> *) i.
MonadIO m =>
Int -> ConduitT i ByteString m ()
pullLimited (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
c)
where
pullUnlimited :: ConduitT i ByteString m ()
pullUnlimited = do
ByteString
bs <- IO ByteString -> ConduitT i ByteString m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ConduitT i ByteString m ByteString)
-> IO ByteString -> ConduitT i ByteString m ByteString
forall a b. (a -> b) -> a -> b
$ Handle -> Int -> IO ByteString
S.hGetSome Handle
handle Int
buffer
if ByteString -> Bool
S.null ByteString
bs
then () -> ConduitT i ByteString m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else do
ByteString -> ConduitT i ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
bs
ConduitT i ByteString m ()
pullUnlimited
pullLimited :: Int -> ConduitT i ByteString m ()
pullLimited Int
c = do
ByteString
bs <- IO ByteString -> ConduitT i ByteString m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ConduitT i ByteString m ByteString)
-> IO ByteString -> ConduitT i ByteString m ByteString
forall a b. (a -> b) -> a -> b
$ Handle -> Int -> IO ByteString
S.hGetSome Handle
handle (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
c Int
buffer)
let c' :: Int
c' = Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
S.length ByteString
bs
Bool -> ConduitT i ByteString m () -> ConduitT i ByteString m ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
c' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (ConduitT i ByteString m () -> ConduitT i ByteString m ())
-> ConduitT i ByteString m () -> ConduitT i ByteString m ()
forall a b. (a -> b) -> a -> b
$
if ByteString -> Bool
S.null ByteString
bs
then () -> ConduitT i ByteString m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else do
ByteString -> ConduitT i ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
bs
Int -> ConduitT i ByteString m ()
pullLimited Int
c'
conduitFile :: MonadResource m
=> FilePath
-> ConduitT S.ByteString S.ByteString m ()
conduitFile :: FilePath -> ConduitT ByteString ByteString m ()
conduitFile FilePath
fp = IO Handle
-> (Handle -> IO ())
-> (Handle -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall (m :: * -> *) a i o r.
MonadResource m =>
IO a -> (a -> IO ()) -> (a -> ConduitT i o m r) -> ConduitT i o m r
bracketP
(FilePath -> IOMode -> IO Handle
IO.openBinaryFile FilePath
fp IOMode
IO.WriteMode)
Handle -> IO ()
IO.hClose
Handle -> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
MonadIO m =>
Handle -> ConduitT ByteString ByteString m ()
conduitHandle
conduitHandle :: MonadIO m => IO.Handle -> ConduitT S.ByteString S.ByteString m ()
conduitHandle :: Handle -> ConduitT ByteString ByteString m ()
conduitHandle Handle
h = (ByteString -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
awaitForever ((ByteString -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ())
-> (ByteString -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ \ByteString
bs -> IO () -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> ByteString -> IO ()
S.hPut Handle
h ByteString
bs) ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
bs
isolate :: Monad m
=> Int
-> ConduitT S.ByteString S.ByteString m ()
isolate :: Int -> ConduitT ByteString ByteString m ()
isolate =
Int -> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
Monad m =>
Int -> ConduitT ByteString ByteString m ()
loop
where
loop :: Int -> ConduitT ByteString ByteString m ()
loop Int
0 = () -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
loop Int
count = do
Maybe ByteString
mbs <- ConduitT ByteString ByteString m (Maybe ByteString)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await
case Maybe ByteString
mbs of
Maybe ByteString
Nothing -> () -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ByteString
bs -> do
let (ByteString
a, ByteString
b) = Int -> ByteString -> (ByteString, ByteString)
S.splitAt Int
count ByteString
bs
case Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
S.length ByteString
a of
Int
0 -> do
Bool
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
S.null ByteString
b) (ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ConduitT ByteString ByteString m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover ByteString
b
ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
a
Int
count' -> Bool
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (ByteString -> Bool
S.null ByteString
b) (ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
a ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ConduitT ByteString ByteString m ()
loop Int
count'
head :: Monad m => ConduitT S.ByteString o m (Maybe Word8)
head :: ConduitT ByteString o m (Maybe Word8)
head = do
Maybe ByteString
mbs <- ConduitT ByteString o m (Maybe ByteString)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await
case Maybe ByteString
mbs of
Maybe ByteString
Nothing -> Maybe Word8 -> ConduitT ByteString o m (Maybe Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Word8
forall a. Maybe a
Nothing
Just ByteString
bs ->
case ByteString -> Maybe (Word8, ByteString)
S.uncons ByteString
bs of
Maybe (Word8, ByteString)
Nothing -> ConduitT ByteString o m (Maybe Word8)
forall (m :: * -> *) o.
Monad m =>
ConduitT ByteString o m (Maybe Word8)
head
Just (Word8
w, ByteString
bs') -> ByteString -> ConduitT ByteString o m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover ByteString
bs' ConduitT ByteString o m ()
-> ConduitT ByteString o m (Maybe Word8)
-> ConduitT ByteString o m (Maybe Word8)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Word8 -> ConduitT ByteString o m (Maybe Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
w)
takeWhile :: Monad m => (Word8 -> Bool) -> ConduitT S.ByteString S.ByteString m ()
takeWhile :: (Word8 -> Bool) -> ConduitT ByteString ByteString m ()
takeWhile Word8 -> Bool
p =
ConduitT ByteString ByteString m ()
loop
where
loop :: ConduitT ByteString ByteString m ()
loop = ConduitT ByteString ByteString m (Maybe ByteString)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await ConduitT ByteString ByteString m (Maybe ByteString)
-> (Maybe ByteString -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitT ByteString ByteString m ()
-> (ByteString -> ConduitT ByteString ByteString m ())
-> Maybe ByteString
-> ConduitT ByteString ByteString m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ByteString -> ConduitT ByteString ByteString m ()
go
go :: ByteString -> ConduitT ByteString ByteString m ()
go ByteString
bs
| ByteString -> Bool
S.null ByteString
x = ConduitT ByteString ByteString m ()
next
| Bool
otherwise = ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
x ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitT ByteString ByteString m ()
next
where
next :: ConduitT ByteString ByteString m ()
next = if ByteString -> Bool
S.null ByteString
y then ConduitT ByteString ByteString m ()
loop else ByteString -> ConduitT ByteString ByteString m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover ByteString
y
(ByteString
x, ByteString
y) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
S.span Word8 -> Bool
p ByteString
bs
dropWhile :: Monad m => (Word8 -> Bool) -> ConduitT S.ByteString o m ()
dropWhile :: (Word8 -> Bool) -> ConduitT ByteString o m ()
dropWhile Word8 -> Bool
p =
ConduitT ByteString o m ()
forall o. ConduitT ByteString o m ()
loop
where
loop :: ConduitT ByteString o m ()
loop = do
Maybe ByteString
mbs <- ConduitT ByteString o m (Maybe ByteString)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await
case (Word8 -> Bool) -> ByteString -> ByteString
S.dropWhile Word8 -> Bool
p (ByteString -> ByteString) -> Maybe ByteString -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
mbs of
Maybe ByteString
Nothing -> () -> ConduitT ByteString o m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ByteString
bs
| ByteString -> Bool
S.null ByteString
bs -> ConduitT ByteString o m ()
loop
| Bool
otherwise -> ByteString -> ConduitT ByteString o m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover ByteString
bs
take :: Monad m => Int -> ConduitT S.ByteString o m L.ByteString
take :: Int -> ConduitT ByteString o m ByteString
take Int
0 = ByteString -> ConduitT ByteString o m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
L.empty
take Int
n0 = Int
-> ([ByteString] -> [ByteString])
-> ConduitT ByteString o m ByteString
forall (m :: * -> *) o.
Monad m =>
Int
-> ([ByteString] -> [ByteString])
-> ConduitT ByteString o m ByteString
go Int
n0 [ByteString] -> [ByteString]
forall a. a -> a
id
where
go :: Int
-> ([ByteString] -> [ByteString])
-> ConduitT ByteString o m ByteString
go Int
n [ByteString] -> [ByteString]
front =
ConduitT ByteString o m (Maybe ByteString)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await ConduitT ByteString o m (Maybe ByteString)
-> (Maybe ByteString -> ConduitT ByteString o m ByteString)
-> ConduitT ByteString o m ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitT ByteString o m ByteString
-> (ByteString -> ConduitT ByteString o m ByteString)
-> Maybe ByteString
-> ConduitT ByteString o m ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ByteString -> ConduitT ByteString o m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ConduitT ByteString o m ByteString)
-> ByteString -> ConduitT ByteString o m ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
L.fromChunks ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
front []) ByteString -> ConduitT ByteString o m ByteString
go'
where
go' :: ByteString -> ConduitT ByteString o m ByteString
go' ByteString
bs =
case ByteString -> Int
S.length ByteString
bs Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
n of
Ordering
LT -> Int
-> ([ByteString] -> [ByteString])
-> ConduitT ByteString o m ByteString
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
S.length ByteString
bs) ([ByteString] -> [ByteString]
front ([ByteString] -> [ByteString])
-> ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString
bsByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:))
Ordering
EQ -> ByteString -> ConduitT ByteString o m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ConduitT ByteString o m ByteString)
-> ByteString -> ConduitT ByteString o m ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
L.fromChunks ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
front [ByteString
bs]
Ordering
GT ->
let (ByteString
x, ByteString
y) = Int -> ByteString -> (ByteString, ByteString)
S.splitAt Int
n ByteString
bs
in Bool
-> ConduitT ByteString o m ByteString
-> ConduitT ByteString o m ByteString
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
S.null ByteString
y) (ConduitT ByteString o m ByteString
-> ConduitT ByteString o m ByteString)
-> ConduitT ByteString o m ByteString
-> ConduitT ByteString o m ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ConduitT ByteString o m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover ByteString
y ConduitT ByteString o m ()
-> ConduitT ByteString o m ByteString
-> ConduitT ByteString o m ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> ConduitT ByteString o m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> ByteString
L.fromChunks ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
front [ByteString
x])
drop :: Monad m => Int -> ConduitT S.ByteString o m ()
drop :: Int -> ConduitT ByteString o m ()
drop Int
0 = () -> ConduitT ByteString o m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
drop Int
n0 = Int -> ConduitT ByteString o m ()
forall (m :: * -> *) o.
Monad m =>
Int -> ConduitT ByteString o m ()
go Int
n0
where
go :: Int -> ConduitT ByteString o m ()
go Int
n =
ConduitT ByteString o m (Maybe ByteString)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await ConduitT ByteString o m (Maybe ByteString)
-> (Maybe ByteString -> ConduitT ByteString o m ())
-> ConduitT ByteString o m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitT ByteString o m ()
-> (ByteString -> ConduitT ByteString o m ())
-> Maybe ByteString
-> ConduitT ByteString o m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> ConduitT ByteString o m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ByteString -> ConduitT ByteString o m ()
go'
where
go' :: ByteString -> ConduitT ByteString o m ()
go' ByteString
bs =
case ByteString -> Int
S.length ByteString
bs Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
n of
Ordering
LT -> Int -> ConduitT ByteString o m ()
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
S.length ByteString
bs)
Ordering
EQ -> () -> ConduitT ByteString o m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Ordering
GT ->
let y :: ByteString
y = Int -> ByteString -> ByteString
S.drop Int
n ByteString
bs
in Bool -> ConduitT ByteString o m () -> ConduitT ByteString o m ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
S.null ByteString
y) (ConduitT ByteString o m () -> ConduitT ByteString o m ())
-> ConduitT ByteString o m () -> ConduitT ByteString o m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> ConduitT ByteString o m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover ByteString
y ConduitT ByteString o m ()
-> ConduitT ByteString o m () -> ConduitT ByteString o m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> ConduitT ByteString o m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
lines :: Monad m => ConduitT S.ByteString S.ByteString m ()
lines :: ConduitT ByteString ByteString m ()
lines =
[ByteString] -> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
Monad m =>
[ByteString] -> ConduitT ByteString ByteString m ()
loop []
where
loop :: [ByteString] -> ConduitT ByteString ByteString m ()
loop [ByteString]
acc = ConduitT ByteString ByteString m (Maybe ByteString)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await ConduitT ByteString ByteString m (Maybe ByteString)
-> (Maybe ByteString -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitT ByteString ByteString m ()
-> (ByteString -> ConduitT ByteString ByteString m ())
-> Maybe ByteString
-> ConduitT ByteString ByteString m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([ByteString] -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) i.
Monad m =>
[ByteString] -> ConduitT i ByteString m ()
finish [ByteString]
acc) ([ByteString] -> ByteString -> ConduitT ByteString ByteString m ()
go [ByteString]
acc)
finish :: [ByteString] -> ConduitT i ByteString m ()
finish [ByteString]
acc =
let final :: ByteString
final = [ByteString] -> ByteString
S.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
acc
in Bool -> ConduitT i ByteString m () -> ConduitT i ByteString m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
S.null ByteString
final) (ByteString -> ConduitT i ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
final)
go :: [ByteString] -> ByteString -> ConduitT ByteString ByteString m ()
go [ByteString]
acc ByteString
more =
case ByteString -> Maybe (Word8, ByteString)
S.uncons ByteString
second of
Just (Word8
_, ByteString
second') -> ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ([ByteString] -> ByteString
S.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString
firstByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
acc) ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [ByteString] -> ByteString -> ConduitT ByteString ByteString m ()
go [] ByteString
second'
Maybe (Word8, ByteString)
Nothing -> [ByteString] -> ConduitT ByteString ByteString m ()
loop ([ByteString] -> ConduitT ByteString ByteString m ())
-> [ByteString] -> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ ByteString
moreByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
acc
where
(ByteString
first, ByteString
second) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
S.break (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
10) ByteString
more
sourceLbs :: Monad m => L.ByteString -> ConduitT i S.ByteString m ()
sourceLbs :: ByteString -> ConduitT i ByteString m ()
sourceLbs = [ByteString] -> ConduitT i ByteString m ()
forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
sourceList ([ByteString] -> ConduitT i ByteString m ())
-> (ByteString -> [ByteString])
-> ByteString
-> ConduitT i ByteString m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
L.toChunks
sinkCacheLength :: (MonadResource m1, MonadResource m2)
=> ConduitT S.ByteString o m1 (Word64, ConduitT i S.ByteString m2 ())
sinkCacheLength :: ConduitT ByteString o m1 (Word64, ConduitT i ByteString m2 ())
sinkCacheLength = do
FilePath
tmpdir <- IO FilePath -> ConduitT ByteString o m1 FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
getTemporaryDirectory
(ReleaseKey
releaseKey, (FilePath
fp, Handle
h)) <- IO (FilePath, Handle)
-> ((FilePath, Handle) -> IO ())
-> ConduitT ByteString o m1 (ReleaseKey, (FilePath, Handle))
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate
(FilePath -> FilePath -> IO (FilePath, Handle)
IO.openBinaryTempFile FilePath
tmpdir FilePath
"conduit.cache")
(\(FilePath
fp, Handle
h) -> Handle -> IO ()
IO.hClose Handle
h IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally` FilePath -> IO ()
removeFile FilePath
fp)
Word64
len <- Handle -> ConduitT ByteString o m1 Word64
forall (m :: * -> *) o.
MonadResource m =>
Handle -> ConduitT ByteString o m Word64
sinkHandleLen Handle
h
IO () -> ConduitT ByteString o m1 ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ConduitT ByteString o m1 ())
-> IO () -> ConduitT ByteString o m1 ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
IO.hClose Handle
h
(Word64, ConduitT i ByteString m2 ())
-> ConduitT ByteString o m1 (Word64, ConduitT i ByteString m2 ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
len, FilePath -> ConduitT i ByteString m2 ()
forall (m :: * -> *) i.
MonadResource m =>
FilePath -> ConduitT i ByteString m ()
CC.sourceFile FilePath
fp ConduitT i ByteString m2 ()
-> ConduitT i ByteString m2 () -> ConduitT i ByteString m2 ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReleaseKey -> ConduitT i ByteString m2 ()
forall (m :: * -> *). MonadIO m => ReleaseKey -> m ()
release ReleaseKey
releaseKey)
where
sinkHandleLen :: MonadResource m => IO.Handle -> ConduitT S.ByteString o m Word64
sinkHandleLen :: Handle -> ConduitT ByteString o m Word64
sinkHandleLen Handle
h =
Word64 -> ConduitT ByteString o m Word64
forall (m :: * -> *) t o.
(MonadIO m, Num t) =>
t -> ConduitT ByteString o m t
loop Word64
0
where
loop :: t -> ConduitT ByteString o m t
loop t
x =
ConduitT ByteString o m (Maybe ByteString)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await ConduitT ByteString o m (Maybe ByteString)
-> (Maybe ByteString -> ConduitT ByteString o m t)
-> ConduitT ByteString o m t
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConduitT ByteString o m t
-> (ByteString -> ConduitT ByteString o m t)
-> Maybe ByteString
-> ConduitT ByteString o m t
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (t -> ConduitT ByteString o m t
forall (m :: * -> *) a. Monad m => a -> m a
return t
x) ByteString -> ConduitT ByteString o m t
go
where
go :: ByteString -> ConduitT ByteString o m t
go ByteString
bs = do
IO () -> ConduitT ByteString o m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ConduitT ByteString o m ())
-> IO () -> ConduitT ByteString o m ()
forall a b. (a -> b) -> a -> b
$ Handle -> ByteString -> IO ()
S.hPut Handle
h ByteString
bs
t -> ConduitT ByteString o m t
loop (t -> ConduitT ByteString o m t) -> t -> ConduitT ByteString o m t
forall a b. (a -> b) -> a -> b
$ t
x t -> t -> t
forall a. Num a => a -> a -> a
+ Int -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
S.length ByteString
bs)
sinkLbs :: Monad m => ConduitT S.ByteString o m L.ByteString
sinkLbs :: ConduitT ByteString o m ByteString
sinkLbs = ([ByteString] -> ByteString)
-> ConduitT ByteString o m [ByteString]
-> ConduitT ByteString o m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ByteString] -> ByteString
L.fromChunks ConduitT ByteString o m [ByteString]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
consume
mapM_BS :: Monad m => (Word8 -> m ()) -> S.ByteString -> m ()
mapM_BS :: (Word8 -> m ()) -> ByteString -> m ()
mapM_BS Word8 -> m ()
f (PS ForeignPtr Word8
fptr Int
offset Int
len) = do
let start :: Ptr b
start = ForeignPtr Word8 -> Ptr Word8
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
fptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset
end :: Ptr b
end = Ptr Any
forall b. Ptr b
start Ptr Any -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len
loop :: Ptr Word8 -> m ()
loop Ptr Word8
ptr
| Ptr Word8
ptr Ptr Word8 -> Ptr Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Ptr Word8
forall b. Ptr b
end = IO () -> ()
forall a. IO a -> a
accursedUnutterablePerformIO (ForeignPtr Word8 -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr Word8
fptr) () -> m () -> m ()
`seq` () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = do
Word8 -> m ()
f (IO Word8 -> Word8
forall a. IO a -> a
accursedUnutterablePerformIO (Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
ptr))
Ptr Word8 -> m ()
loop (Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1)
Ptr Word8 -> m ()
loop Ptr Word8
forall b. Ptr b
start
{-# INLINE mapM_BS #-}
mapM_ :: Monad m => (Word8 -> m ()) -> ConduitT S.ByteString o m ()
mapM_ :: (Word8 -> m ()) -> ConduitT ByteString o m ()
mapM_ Word8 -> m ()
f = (ByteString -> ConduitT ByteString o m ())
-> ConduitT ByteString o m ()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
awaitForever (m () -> ConduitT ByteString o m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ConduitT ByteString o m ())
-> (ByteString -> m ()) -> ByteString -> ConduitT ByteString o m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> m ()) -> ByteString -> m ()
forall (m :: * -> *).
Monad m =>
(Word8 -> m ()) -> ByteString -> m ()
mapM_BS Word8 -> m ()
f)
{-# INLINE mapM_ #-}
sinkStorable :: (Monad m, Storable a) => ConduitT S.ByteString o m (Maybe a)
sinkStorable :: ConduitT ByteString o m (Maybe a)
sinkStorable = (a -> Maybe a)
-> ConduitT ByteString o m (Maybe a)
-> ConduitT ByteString o m (Maybe a)
forall (m :: * -> *) a b o.
(Monad m, Storable a) =>
(a -> b) -> ConduitT ByteString o m b -> ConduitT ByteString o m b
sinkStorableHelper a -> Maybe a
forall a. a -> Maybe a
Just (Maybe a -> ConduitT ByteString o m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing)
sinkStorableEx :: (MonadThrow m, Storable a) => ConduitT S.ByteString o m a
sinkStorableEx :: ConduitT ByteString o m a
sinkStorableEx = (a -> a) -> ConduitT ByteString o m a -> ConduitT ByteString o m a
forall (m :: * -> *) a b o.
(Monad m, Storable a) =>
(a -> b) -> ConduitT ByteString o m b -> ConduitT ByteString o m b
sinkStorableHelper a -> a
forall a. a -> a
id (SinkStorableException -> ConduitT ByteString o m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM SinkStorableException
SinkStorableInsufficientBytes)
sinkStorableHelper :: forall m a b o. (Monad m, Storable a)
=> (a -> b)
-> (ConduitT S.ByteString o m b)
-> ConduitT S.ByteString o m b
sinkStorableHelper :: (a -> b) -> ConduitT ByteString o m b -> ConduitT ByteString o m b
sinkStorableHelper a -> b
wrap ConduitT ByteString o m b
failure = do
ConduitT ByteString o m b
start
where
size :: Int
size = a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. (?callStack::CallStack) => a
undefined :: a)
start :: ConduitT ByteString o m b
start = do
Maybe ByteString
mbs <- ConduitT ByteString o m (Maybe ByteString)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await
case Maybe ByteString
mbs of
Maybe ByteString
Nothing -> ConduitT ByteString o m b
failure
Just ByteString
bs
| ByteString -> Bool
S.null ByteString
bs -> ConduitT ByteString o m b
start
| Bool
otherwise ->
case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ByteString -> Int
S.length ByteString
bs) Int
size of
Ordering
LT -> do
ByteString -> ConduitT ByteString o m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover ByteString
bs
ByteString
lbs <- Int -> ConduitT ByteString o m ByteString
forall (m :: * -> *) o.
Monad m =>
Int -> ConduitT ByteString o m ByteString
take Int
size
let bs' :: ByteString
bs' = [ByteString] -> ByteString
S.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
L.toChunks ByteString
lbs
case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ByteString -> Int
S.length ByteString
bs') Int
size of
Ordering
LT -> do
ByteString -> ConduitT ByteString o m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover ByteString
bs'
ConduitT ByteString o m b
failure
Ordering
EQ -> ByteString -> ConduitT ByteString o m b
forall (m :: * -> *). Monad m => ByteString -> m b
process ByteString
bs'
Ordering
GT -> Bool -> ConduitT ByteString o m b -> ConduitT ByteString o m b
forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
False (ByteString -> ConduitT ByteString o m b
forall (m :: * -> *). Monad m => ByteString -> m b
process ByteString
bs')
Ordering
EQ -> ByteString -> ConduitT ByteString o m b
forall (m :: * -> *). Monad m => ByteString -> m b
process ByteString
bs
Ordering
GT -> do
let (ByteString
x, ByteString
y) = Int -> ByteString -> (ByteString, ByteString)
S.splitAt Int
size ByteString
bs
ByteString -> ConduitT ByteString o m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover ByteString
y
ByteString -> ConduitT ByteString o m b
forall (m :: * -> *). Monad m => ByteString -> m b
process ByteString
x
process :: ByteString -> m b
process ByteString
bs = b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$! a -> b
wrap (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$! IO a -> a
forall a. IO a -> a
accursedUnutterablePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$!
ByteString -> (CString -> IO a) -> IO a
forall a. ByteString -> (CString -> IO a) -> IO a
unsafeUseAsCString ByteString
bs (a -> Ptr a -> IO a
safePeek a
forall a. (?callStack::CallStack) => a
undefined (Ptr a -> IO a) -> (CString -> Ptr a) -> CString -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr)
safePeek :: a -> Ptr a -> IO a
#ifdef ALLOW_UNALIGNED_ACCESS
safePeek :: a -> Ptr a -> IO a
safePeek a
_ = Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek
#else
safePeek val ptr = alloca (\t -> copyBytes t ptr (sizeOf val) >> peek t)
#endif
{-# INLINE sinkStorableHelper #-}
data SinkStorableException = SinkStorableInsufficientBytes
deriving (Int -> SinkStorableException -> ShowS
[SinkStorableException] -> ShowS
SinkStorableException -> FilePath
(Int -> SinkStorableException -> ShowS)
-> (SinkStorableException -> FilePath)
-> ([SinkStorableException] -> ShowS)
-> Show SinkStorableException
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SinkStorableException] -> ShowS
$cshowList :: [SinkStorableException] -> ShowS
show :: SinkStorableException -> FilePath
$cshow :: SinkStorableException -> FilePath
showsPrec :: Int -> SinkStorableException -> ShowS
$cshowsPrec :: Int -> SinkStorableException -> ShowS
Show, Typeable)
instance Exception SinkStorableException