{-# LANGUAGE DeriveDataTypeable, RankNTypes #-}
module Data.Conduit.Text
(
Codec
, encode
, decode
, utf8
, utf16_le
, utf16_be
, utf32_le
, utf32_be
, ascii
, iso8859_1
, lines
, linesBounded
, TextException (..)
, takeWhile
, dropWhile
, take
, drop
, foldLines
, withLine
, CC.decodeUtf8
, CC.decodeUtf8Lenient
, CC.encodeUtf8
, detectUtf
) where
import Prelude hiding (head, drop, takeWhile, lines, zip, zip3, zipWith, zipWith3, take, dropWhile)
import qualified Control.Exception as Exc
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import Data.Char (ord)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Word (Word8)
import Data.Typeable (Typeable)
import Data.Conduit
import qualified Data.Conduit.List as CL
import qualified Data.Conduit.Combinators as CC
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Resource (MonadThrow, throwM)
import Control.Monad (unless)
import Data.Streaming.Text
data Codec = Codec
{ Codec -> Text
_codecName :: T.Text
, Codec -> Text -> (ByteString, Maybe (TextException, Text))
codecEncode
:: T.Text
-> (B.ByteString, Maybe (TextException, T.Text))
, Codec
-> ByteString
-> (Text, Either (TextException, ByteString) ByteString)
codecDecode
:: B.ByteString
-> (T.Text, Either
(TextException, B.ByteString)
B.ByteString)
}
| NewCodec T.Text (T.Text -> B.ByteString) (B.ByteString -> DecodeResult)
instance Show Codec where
showsPrec :: Int -> Codec -> ShowS
showsPrec Int
d Codec
c =
let (String
cnst, Text
name) = case Codec
c of
Codec Text
t Text -> (ByteString, Maybe (TextException, Text))
_ ByteString -> (Text, Either (TextException, ByteString) ByteString)
_ -> (String
"Codec ", Text
t)
NewCodec Text
t Text -> ByteString
_ ByteString -> DecodeResult
_ -> (String
"NewCodec ", Text
t)
in Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
cnst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows Text
name
lines :: Monad m => ConduitT T.Text T.Text m ()
lines :: forall (m :: * -> *). Monad m => ConduitT Text Text m ()
lines =
forall {m :: * -> *}.
Monad m =>
([Text] -> [Text]) -> ConduitT Text Text m ()
awaitText forall a. a -> a
id
where
awaitText :: ([Text] -> [Text]) -> ConduitT Text Text m ()
awaitText [Text] -> [Text]
front = forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
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} {i}.
Monad m =>
([a] -> [Text]) -> ConduitT i Text m ()
finish [Text] -> [Text]
front) (([Text] -> [Text]) -> Text -> ConduitT Text Text m ()
process [Text] -> [Text]
front)
finish :: ([a] -> [Text]) -> ConduitT i Text m ()
finish [a] -> [Text]
front =
let t :: Text
t = [Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ [a] -> [Text]
front []
in forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
t) (forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Text
t)
process :: ([Text] -> [Text]) -> Text -> ConduitT Text Text m ()
process [Text] -> [Text]
front Text
text =
let (Text
line, Text
rest) = (Char -> Bool) -> Text -> (Text, Text)
T.break (forall a. Eq a => a -> a -> Bool
== Char
'\n') Text
text
in case Text -> Maybe (Char, Text)
T.uncons Text
rest of
Just (Char
_, Text
rest') -> do
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ([Text] -> Text
T.concat forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
front [Text
line])
([Text] -> [Text]) -> Text -> ConduitT Text Text m ()
process forall a. a -> a
id Text
rest'
Maybe (Char, Text)
Nothing -> forall a. (?callStack::CallStack) => Bool -> a -> a
Exc.assert (Text
line forall a. Eq a => a -> a -> Bool
== Text
text) forall a b. (a -> b) -> a -> b
$ ([Text] -> [Text]) -> ConduitT Text Text m ()
awaitText forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
front forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
lineforall a. a -> [a] -> [a]
:)
linesBounded :: MonadThrow m => Int -> ConduitT T.Text T.Text m ()
linesBounded :: forall (m :: * -> *).
MonadThrow m =>
Int -> ConduitT Text Text m ()
linesBounded Int
maxLineLen =
forall {m :: * -> *}.
MonadThrow m =>
Int -> Text -> ConduitT Text Text m ()
awaitText Int
0 Text
T.empty
where
awaitText :: Int -> Text -> ConduitT Text Text m ()
awaitText Int
len Text
buf = forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
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 :: * -> *} {i}. Monad m => Text -> ConduitT i Text m ()
finish Text
buf) (Int -> Text -> Text -> ConduitT Text Text m ()
process Int
len Text
buf)
finish :: Text -> ConduitT i Text m ()
finish Text
buf = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
buf) (forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Text
buf)
process :: Int -> Text -> Text -> ConduitT Text Text m ()
process Int
len Text
buf Text
text =
let (Text
line, Text
rest) = (Char -> Bool) -> Text -> (Text, Text)
T.break (forall a. Eq a => a -> a -> Bool
== Char
'\n') Text
text
len' :: Int
len' = Int
len forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
line
in if Int
len' forall a. Ord a => a -> a -> Bool
> Int
maxLineLen
then forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Int -> TextException
LengthExceeded Int
maxLineLen)
else case Text -> Maybe (Char, Text)
T.uncons Text
rest of
Just (Char
_, Text
rest') ->
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Text
buf Text -> Text -> Text
`T.append` Text
line) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Text -> Text -> ConduitT Text Text m ()
process Int
0 Text
T.empty Text
rest'
Maybe (Char, Text)
_ ->
Int -> Text -> ConduitT Text Text m ()
awaitText Int
len' forall a b. (a -> b) -> a -> b
$ Text
buf Text -> Text -> Text
`T.append` Text
text
encode :: MonadThrow m => Codec -> ConduitT T.Text B.ByteString m ()
encode :: forall (m :: * -> *).
MonadThrow m =>
Codec -> ConduitT Text ByteString m ()
encode (NewCodec Text
_ Text -> ByteString
enc ByteString -> DecodeResult
_) = forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
CL.map Text -> ByteString
enc
encode Codec
codec = forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ConduitT a b m ()
CL.mapM forall a b. (a -> b) -> a -> b
$ \Text
t -> do
let (ByteString
bs, Maybe (TextException, Text)
mexc) = Codec -> Text -> (ByteString, Maybe (TextException, Text))
codecEncode Codec
codec Text
t
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs) (forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) Maybe (TextException, Text)
mexc
decodeNew
:: Monad m
=> (Int -> B.ByteString -> T.Text -> B.ByteString -> ConduitT B.ByteString T.Text m ())
-> t
-> Int
-> (B.ByteString -> DecodeResult)
-> ConduitT B.ByteString T.Text m ()
decodeNew :: forall (m :: * -> *) t.
Monad m =>
(Int
-> ByteString
-> Text
-> ByteString
-> ConduitT ByteString Text m ())
-> t
-> Int
-> (ByteString -> DecodeResult)
-> ConduitT ByteString Text m ()
decodeNew Int
-> ByteString
-> Text
-> ByteString
-> ConduitT ByteString Text m ()
onFailure t
_name =
Int
-> (ByteString -> DecodeResult) -> ConduitT ByteString Text m ()
loop
where
loop :: Int
-> (ByteString -> DecodeResult) -> ConduitT ByteString Text m ()
loop Int
consumed ByteString -> DecodeResult
dec =
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe ConduitT ByteString Text m ()
finish ByteString -> ConduitT ByteString Text m ()
go
where
finish :: ConduitT ByteString Text m ()
finish =
case ByteString -> DecodeResult
dec ByteString
B.empty of
DecodeResultSuccess Text
_ ByteString -> DecodeResult
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
DecodeResultFailure Text
t ByteString
rest -> Int
-> ByteString
-> Text
-> ByteString
-> ConduitT ByteString Text m ()
onFailure Int
consumed ByteString
B.empty Text
t ByteString
rest
{-# INLINE finish #-}
go :: ByteString -> ConduitT ByteString Text m ()
go ByteString
bs | ByteString -> Bool
B.null ByteString
bs = Int
-> (ByteString -> DecodeResult) -> ConduitT ByteString Text m ()
loop Int
consumed ByteString -> DecodeResult
dec
go ByteString
bs =
case ByteString -> DecodeResult
dec ByteString
bs of
DecodeResultSuccess Text
t ByteString -> DecodeResult
dec' -> do
let consumed' :: Int
consumed' = Int
consumed forall a. Num a => a -> a -> a
+ ByteString -> Int
B.length ByteString
bs
next :: ConduitT ByteString Text m ()
next = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
t) (forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Text
t)
Int
-> (ByteString -> DecodeResult) -> ConduitT ByteString Text m ()
loop Int
consumed' ByteString -> DecodeResult
dec'
in Int
consumed' seq :: forall a b. a -> b -> b
`seq` ConduitT ByteString Text m ()
next
DecodeResultFailure Text
t ByteString
rest -> Int
-> ByteString
-> Text
-> ByteString
-> ConduitT ByteString Text m ()
onFailure Int
consumed ByteString
bs Text
t ByteString
rest
decode :: MonadThrow m => Codec -> ConduitT B.ByteString T.Text m ()
decode :: forall (m :: * -> *).
MonadThrow m =>
Codec -> ConduitT ByteString Text m ()
decode (NewCodec Text
name Text -> ByteString
_ ByteString -> DecodeResult
start) =
forall (m :: * -> *) t.
Monad m =>
(Int
-> ByteString
-> Text
-> ByteString
-> ConduitT ByteString Text m ())
-> t
-> Int
-> (ByteString -> DecodeResult)
-> ConduitT ByteString Text m ()
decodeNew forall {m :: * -> *} {b}.
MonadThrow m =>
Int
-> ByteString -> Text -> ByteString -> ConduitT ByteString Text m b
onFailure Text
name Int
0 ByteString -> DecodeResult
start
where
onFailure :: Int
-> ByteString -> Text -> ByteString -> ConduitT ByteString Text m b
onFailure Int
consumed ByteString
bs Text
t ByteString
rest = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
T.null Text
t) (forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Text
t)
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover ByteString
rest
let consumed' :: Int
consumed' = Int
consumed forall a. Num a => a -> a -> a
+ ByteString -> Int
B.length ByteString
bs forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
rest
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ Text -> Int -> ByteString -> TextException
NewDecodeException Text
name Int
consumed' (Int -> ByteString -> ByteString
B.take Int
4 ByteString
rest)
{-# INLINE onFailure #-}
decode Codec
codec =
forall {m :: * -> *}.
MonadThrow m =>
(ByteString -> ByteString) -> ConduitT ByteString Text m ()
loop forall a. a -> a
id
where
loop :: (ByteString -> ByteString) -> ConduitT ByteString Text m ()
loop ByteString -> ByteString
front = forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
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 {t :: (* -> *) -> * -> *} {m :: * -> *}.
(MonadTrans t, Monad (t m), MonadThrow m) =>
(ByteString -> ByteString) -> t m ()
finish ByteString -> ByteString
front) ((ByteString -> ByteString)
-> ByteString -> ConduitT ByteString Text m ()
go ByteString -> ByteString
front)
finish :: (ByteString -> ByteString) -> t m ()
finish ByteString -> ByteString
front =
case ByteString -> Maybe (Word8, ByteString)
B.uncons forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
front ByteString
B.empty of
Maybe (Word8, ByteString)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (Word8
w, ByteString
_) -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ Codec -> Word8 -> TextException
DecodeException Codec
codec Word8
w
go :: (ByteString -> ByteString)
-> ByteString -> ConduitT ByteString Text m ()
go ByteString -> ByteString
front ByteString
bs' =
case Either (TextException, ByteString) ByteString
extra of
Left (TextException
exc, ByteString
_) -> forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM TextException
exc
Right ByteString
bs'' -> forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Text
text forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ByteString -> ByteString) -> ConduitT ByteString Text m ()
loop (ByteString -> ByteString -> ByteString
B.append ByteString
bs'')
where
(Text
text, Either (TextException, ByteString) ByteString
extra) = Codec
-> ByteString
-> (Text, Either (TextException, ByteString) ByteString)
codecDecode Codec
codec ByteString
bs
bs :: ByteString
bs = ByteString -> ByteString
front ByteString
bs'
data TextException = DecodeException Codec Word8
| EncodeException Codec Char
| LengthExceeded Int
| TextException Exc.SomeException
| NewDecodeException !T.Text !Int !B.ByteString
deriving Typeable
instance Show TextException where
show :: TextException -> String
show (DecodeException Codec
codec Word8
w) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Error decoding legacy Data.Conduit.Text codec "
, forall a. Show a => a -> String
show Codec
codec
, String
" when parsing byte: "
, forall a. Show a => a -> String
show Word8
w
]
show (EncodeException Codec
codec Char
c) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Error encoding legacy Data.Conduit.Text codec "
, forall a. Show a => a -> String
show Codec
codec
, String
" when parsing char: "
, forall a. Show a => a -> String
show Char
c
]
show (LengthExceeded Int
i) = String
"Data.Conduit.Text.linesBounded: line too long: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i
show (TextException SomeException
se) = String
"Data.Conduit.Text.TextException: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SomeException
se
show (NewDecodeException Text
codec Int
consumed ByteString
next) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Data.Conduit.Text.decode: Error decoding stream of "
, Text -> String
T.unpack Text
codec
, String
" bytes. Error encountered in stream at offset "
, forall a. Show a => a -> String
show Int
consumed
, String
". Encountered at byte sequence "
, forall a. Show a => a -> String
show ByteString
next
]
instance Exc.Exception TextException
utf8 :: Codec
utf8 :: Codec
utf8 = Text
-> (Text -> ByteString) -> (ByteString -> DecodeResult) -> Codec
NewCodec (String -> Text
T.pack String
"UTF-8") Text -> ByteString
TE.encodeUtf8 ByteString -> DecodeResult
Data.Streaming.Text.decodeUtf8
utf16_le :: Codec
utf16_le :: Codec
utf16_le = Text
-> (Text -> ByteString) -> (ByteString -> DecodeResult) -> Codec
NewCodec (String -> Text
T.pack String
"UTF-16-LE") Text -> ByteString
TE.encodeUtf16LE ByteString -> DecodeResult
decodeUtf16LE
utf16_be :: Codec
utf16_be :: Codec
utf16_be = Text
-> (Text -> ByteString) -> (ByteString -> DecodeResult) -> Codec
NewCodec (String -> Text
T.pack String
"UTF-16-BE") Text -> ByteString
TE.encodeUtf16BE ByteString -> DecodeResult
decodeUtf16BE
utf32_le :: Codec
utf32_le :: Codec
utf32_le = Text
-> (Text -> ByteString) -> (ByteString -> DecodeResult) -> Codec
NewCodec (String -> Text
T.pack String
"UTF-32-LE") Text -> ByteString
TE.encodeUtf32LE ByteString -> DecodeResult
decodeUtf32LE
utf32_be :: Codec
utf32_be :: Codec
utf32_be = Text
-> (Text -> ByteString) -> (ByteString -> DecodeResult) -> Codec
NewCodec (String -> Text
T.pack String
"UTF-32-BE") Text -> ByteString
TE.encodeUtf32BE ByteString -> DecodeResult
decodeUtf32BE
ascii :: Codec
ascii :: Codec
ascii = Text
-> (Text -> (ByteString, Maybe (TextException, Text)))
-> (ByteString
-> (Text, Either (TextException, ByteString) ByteString))
-> Codec
Codec Text
name Text -> (ByteString, Maybe (TextException, Text))
enc ByteString -> (Text, Either (TextException, ByteString) ByteString)
dec where
name :: Text
name = String -> Text
T.pack String
"ASCII"
enc :: Text -> (ByteString, Maybe (TextException, Text))
enc Text
text = (ByteString
bytes, Maybe (TextException, Text)
extra) where
(Text
safe, Text
unsafe) = (Char -> Bool) -> Text -> (Text, Text)
T.span (\Char
c -> Char -> Int
ord Char
c forall a. Ord a => a -> a -> Bool
<= Int
0x7F) Text
text
bytes :: ByteString
bytes = String -> ByteString
B8.pack (Text -> String
T.unpack Text
safe)
extra :: Maybe (TextException, Text)
extra = if Text -> Bool
T.null Text
unsafe
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just (Codec -> Char -> TextException
EncodeException Codec
ascii (Text -> Char
T.head Text
unsafe), Text
unsafe)
dec :: ByteString -> (Text, Either (TextException, ByteString) ByteString)
dec ByteString
bytes = (Text
text, Either (TextException, ByteString) ByteString
extra) where
(ByteString
safe, ByteString
unsafe) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.span (forall a. Ord a => a -> a -> Bool
<= Word8
0x7F) ByteString
bytes
text :: Text
text = String -> Text
T.pack (ByteString -> String
B8.unpack ByteString
safe)
extra :: Either (TextException, ByteString) ByteString
extra = if ByteString -> Bool
B.null ByteString
unsafe
then forall a b. b -> Either a b
Right ByteString
B.empty
else forall a b. a -> Either a b
Left (Codec -> Word8 -> TextException
DecodeException Codec
ascii ((?callStack::CallStack) => ByteString -> Word8
B.head ByteString
unsafe), ByteString
unsafe)
iso8859_1 :: Codec
iso8859_1 :: Codec
iso8859_1 = Text
-> (Text -> (ByteString, Maybe (TextException, Text)))
-> (ByteString
-> (Text, Either (TextException, ByteString) ByteString))
-> Codec
Codec Text
name Text -> (ByteString, Maybe (TextException, Text))
enc forall {a}. ByteString -> (Text, Either a ByteString)
dec where
name :: Text
name = String -> Text
T.pack String
"ISO-8859-1"
enc :: Text -> (ByteString, Maybe (TextException, Text))
enc Text
text = (ByteString
bytes, Maybe (TextException, Text)
extra) where
(Text
safe, Text
unsafe) = (Char -> Bool) -> Text -> (Text, Text)
T.span (\Char
c -> Char -> Int
ord Char
c forall a. Ord a => a -> a -> Bool
<= Int
0xFF) Text
text
bytes :: ByteString
bytes = String -> ByteString
B8.pack (Text -> String
T.unpack Text
safe)
extra :: Maybe (TextException, Text)
extra = if Text -> Bool
T.null Text
unsafe
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just (Codec -> Char -> TextException
EncodeException Codec
iso8859_1 (Text -> Char
T.head Text
unsafe), Text
unsafe)
dec :: ByteString -> (Text, Either a ByteString)
dec ByteString
bytes = (String -> Text
T.pack (ByteString -> String
B8.unpack ByteString
bytes), forall a b. b -> Either a b
Right ByteString
B.empty)
takeWhile :: Monad m
=> (Char -> Bool)
-> ConduitT T.Text T.Text m ()
takeWhile :: forall (m :: * -> *).
Monad m =>
(Char -> Bool) -> ConduitT Text Text m ()
takeWhile Char -> Bool
p =
ConduitT Text Text m ()
loop
where
loop :: ConduitT Text Text m ()
loop = forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
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 ()) Text -> ConduitT Text Text m ()
go
go :: Text -> ConduitT Text Text m ()
go Text
t =
case (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
p Text
t of
(Text
x, Text
y)
| Text -> Bool
T.null Text
y -> forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Text
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitT Text Text m ()
loop
| Bool
otherwise -> forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Text
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover Text
y
dropWhile :: Monad m
=> (Char -> Bool)
-> ConduitT T.Text o m ()
dropWhile :: forall (m :: * -> *) o.
Monad m =>
(Char -> Bool) -> ConduitT Text o m ()
dropWhile Char -> Bool
p =
forall {o}. ConduitT Text o m ()
loop
where
loop :: ConduitT Text o m ()
loop = forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
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 ()) Text -> ConduitT Text o m ()
go
go :: Text -> ConduitT Text o m ()
go Text
t
| Text -> Bool
T.null Text
x = ConduitT Text o m ()
loop
| Bool
otherwise = forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover Text
x
where
x :: Text
x = (Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
p Text
t
take :: Monad m => Int -> ConduitT T.Text T.Text m ()
take :: forall (m :: * -> *). Monad m => Int -> ConduitT Text Text m ()
take =
forall (m :: * -> *). Monad m => Int -> ConduitT Text Text m ()
loop
where
loop :: Int -> ConduitT Text Text m ()
loop Int
i = forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
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 ()) (Int -> Text -> ConduitT Text Text m ()
go Int
i)
go :: Int -> Text -> ConduitT Text Text m ()
go Int
i Text
t
| Int
diff forall a. Eq a => a -> a -> Bool
== Int
0 = forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Text
t
| Int
diff forall a. Ord a => a -> a -> Bool
< Int
0 =
let (Text
x, Text
y) = Int -> Text -> (Text, Text)
T.splitAt Int
i Text
t
in forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Text
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover Text
y
| Bool
otherwise = forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Text
t forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ConduitT Text Text m ()
loop Int
diff
where
diff :: Int
diff = Int
i forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
t
drop :: Monad m => Int -> ConduitT T.Text o m ()
drop :: forall (m :: * -> *) o. Monad m => Int -> ConduitT Text o m ()
drop =
forall (m :: * -> *) o. Monad m => Int -> ConduitT Text o m ()
loop
where
loop :: Int -> ConduitT Text o m ()
loop Int
i = forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
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 ()) (Int -> Text -> ConduitT Text o m ()
go Int
i)
go :: Int -> Text -> ConduitT Text o m ()
go Int
i Text
t
| Int
diff forall a. Eq a => a -> a -> Bool
== Int
0 = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Int
diff forall a. Ord a => a -> a -> Bool
< Int
0 = forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
i Text
t
| Bool
otherwise = Int -> ConduitT Text o m ()
loop Int
diff
where
diff :: Int
diff = Int
i forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
t
foldLines :: Monad m
=> (a -> ConduitM T.Text o m a)
-> a
-> ConduitT T.Text o m a
foldLines :: forall (m :: * -> *) a o.
Monad m =>
(a -> ConduitM Text o m a) -> a -> ConduitM Text o m a
foldLines a -> ConduitM Text o m a
f =
a -> ConduitM Text o m a
start
where
start :: a -> ConduitM Text o m a
start a
a = forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
CL.peek 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 a
a) (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ ConduitM Text o m a -> ConduitM Text o m a
loop forall a b. (a -> b) -> a -> b
$ a -> ConduitM Text o m a
f a
a)
loop :: ConduitM Text o m a -> ConduitM Text o m a
loop ConduitM Text o m a
consumer = do
a
a <- forall (m :: * -> *).
Monad m =>
(Char -> Bool) -> ConduitT Text Text m ()
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'\n') forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| do
a
a <- forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
CL.map ((Char -> Bool) -> Text -> Text
T.filter (forall a. Eq a => a -> a -> Bool
/= Char
'\r')) forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitM Text o m a
consumer
forall (m :: * -> *) i o. Monad m => ConduitT i o m ()
CL.sinkNull
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
forall (m :: * -> *) o. Monad m => Int -> ConduitT Text o m ()
drop Int
1
a -> ConduitM Text o m a
start a
a
withLine :: Monad m
=> ConduitT T.Text Void m a
-> ConduitT T.Text o m (Maybe a)
withLine :: forall (m :: * -> *) a o.
Monad m =>
ConduitT Text Void m a -> ConduitT Text o m (Maybe a)
withLine ConduitT Text Void m a
consumer = forall (m :: * -> *) a b o.
Monad m =>
ConduitT a Void m b -> ConduitT a o m b
toConsumer forall a b. (a -> b) -> a -> b
$ do
Maybe Text
mx <- forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
CL.peek
case Maybe Text
mx of
Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just Text
_ -> do
a
x <- forall (m :: * -> *).
Monad m =>
(Char -> Bool) -> ConduitT Text Text m ()
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'\n') forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| do
a
x <- forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
CL.map ((Char -> Bool) -> Text -> Text
T.filter (forall a. Eq a => a -> a -> Bool
/= Char
'\r')) forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT Text Void m a
consumer
forall (m :: * -> *) i o. Monad m => ConduitT i o m ()
CL.sinkNull
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
forall (m :: * -> *) o. Monad m => Int -> ConduitT Text o m ()
drop Int
1
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just a
x
detectUtf :: MonadThrow m => ConduitT B.ByteString T.Text m ()
detectUtf :: forall (m :: * -> *). MonadThrow m => ConduitT ByteString Text m ()
detectUtf =
forall {m :: * -> *}.
MonadThrow m =>
(ByteString -> ByteString) -> ConduitT ByteString Text m ()
go forall a. a -> a
id
where
go :: (ByteString -> ByteString) -> ConduitT ByteString Text m ()
go ByteString -> ByteString
front = forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
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 :: * -> *}.
MonadThrow m =>
(ByteString -> ByteString) -> ConduitT ByteString Text m ()
close ByteString -> ByteString
front) ((ByteString -> ByteString)
-> ByteString -> ConduitT ByteString Text m ()
push ByteString -> ByteString
front)
push :: (ByteString -> ByteString)
-> ByteString -> ConduitT ByteString Text m ()
push ByteString -> ByteString
front ByteString
bs'
| ByteString -> Int
B.length ByteString
bs forall a. Ord a => a -> a -> Bool
< Int
4 = (ByteString -> ByteString) -> ConduitT ByteString Text m ()
go forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
B.append ByteString
bs
| Bool
otherwise = forall {m :: * -> *}.
MonadThrow m =>
ByteString -> ConduitT ByteString Text m ()
leftDecode ByteString
bs
where bs :: ByteString
bs = ByteString -> ByteString
front ByteString
bs'
close :: (ByteString -> ByteString) -> ConduitT ByteString Text m ()
close ByteString -> ByteString
front = forall {m :: * -> *}.
MonadThrow m =>
ByteString -> ConduitT ByteString Text m ()
leftDecode forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
front ByteString
B.empty
leftDecode :: ByteString -> ConduitT ByteString Text m ()
leftDecode ByteString
bs = forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover ByteString
bsOut forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *).
MonadThrow m =>
Codec -> ConduitT ByteString Text m ()
decode Codec
codec
where
bsOut :: ByteString
bsOut = ByteString -> ByteString -> ByteString
B.append (Int -> ByteString -> ByteString
B.drop Int
toDrop ByteString
x) ByteString
y
(ByteString
x, ByteString
y) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
4 ByteString
bs
(Int
toDrop, Codec
codec) =
case ByteString -> [Word8]
B.unpack ByteString
x of
[Word8
0x00, Word8
0x00, Word8
0xFE, Word8
0xFF] -> (Int
4, Codec
utf32_be)
[Word8
0xFF, Word8
0xFE, Word8
0x00, Word8
0x00] -> (Int
4, Codec
utf32_le)
Word8
0xFE : Word8
0xFF: [Word8]
_ -> (Int
2, Codec
utf16_be)
Word8
0xFF : Word8
0xFE: [Word8]
_ -> (Int
2, Codec
utf16_le)
Word8
0xEF : Word8
0xBB: Word8
0xBF : [Word8]
_ -> (Int
3, Codec
utf8)
[Word8]
_ -> (Int
0, Codec
utf8)
{-# INLINE detectUtf #-}