    {-# LANGUAGE DeriveDataTypeable, RankNTypes #-}
    -- | /NOTE/ It is recommended to start using "Data.Conduit.Combinators" instead
    -- of this module.
    --
    -- Copyright: 2011 Michael Snoyman, 2010-2011 John Millikin
    -- License: MIT
    --
    -- Handle streams of text.
    --
    -- Parts of this code were taken from enumerator and adapted for conduits.
    --
    -- For many purposes, it's recommended to use the conduit-combinators library,
    -- which provides a more complete set of functions.
    module Data.Conduit.Text
        (

        -- * Text codecs
          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

    -- | A specific character encoding.
    --
    -- Since 0.3.0
    data Codec = Codec
        { _codecName :: T.Text
        , codecEncode
            :: T.Text
            -> (B.ByteString, Maybe (TextException, T.Text))
        , 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 d c =
            let (cnst, name) = case c of
                    Codec t _ _    -> ("Codec ", t)
                    NewCodec t _ _ -> ("NewCodec ", t)
            in showParen (d > 10) $ showString cnst . shows name

    -- | Emit each line separately
    --
    -- Since 0.4.1
    lines :: Monad m => ConduitT T.Text T.Text m ()
    lines =
        awaitText id
      where
        awaitText front = await >>= maybe (finish front) (process front)

        finish front =
          let t = T.concat $ front []
           in unless (T.null t) (yield t)

        process front text =
          let (line, rest) = T.break (== '\n') text
          in  case T.uncons rest of
                Just (_, rest') -> do
                  yield (T.concat $ front [line])
                  process id rest'
                Nothing -> Exc.assert (line == text) $ awaitText $ front . (line:)

    -- | Variant of the lines function with an integer parameter.
    -- The text length of any emitted line
    -- never exceeds the value of the parameter. Whenever
    -- this is about to happen a LengthExceeded exception
    -- is thrown. This function should be used instead
    -- of the lines function whenever we are dealing with
    -- user input (e.g. a file upload) because we can't be sure that
    -- user input won't have extraordinarily large lines which would
    -- require large amounts of memory if consumed.
    linesBounded :: MonadThrow m => Int -> ConduitT T.Text T.Text m ()
    linesBounded maxLineLen =
        awaitText 0 T.empty
      where
        awaitText len buf = await >>= maybe (finish buf) (process len buf)

        finish buf = unless (T.null buf) (yield buf)

        process len buf text =
          let (line, rest) = T.break (== '\n') text
              len' = len + T.length line
          in  if len' > maxLineLen
                then lift $ throwM (LengthExceeded maxLineLen)
                else case T.uncons rest of
                       Just (_, rest') ->
                         yield (buf `T.append` line) >> process 0 T.empty rest'
                       _ ->
                         awaitText len' $ buf `T.append` text

    -- | Convert text into bytes, using the provided codec. If the codec is
    -- not capable of representing an input character, an exception will be thrown.
    --
    -- Since 0.3.0
    encode :: MonadThrow m => Codec -> ConduitT T.Text B.ByteString m ()
    encode (NewCodec _ enc _) = CL.map enc
    encode codec = CL.mapM $ \t -> do
        let (bs, mexc) = codecEncode codec t
        maybe (return bs) (throwM . fst) 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 onFailure _name =
        loop
      where
        loop consumed dec =
            await >>= maybe finish go
          where
            finish =
                case dec B.empty of
                    DecodeResultSuccess _ _ -> return ()
                    DecodeResultFailure t rest -> onFailure consumed B.empty t rest
            {-# INLINE finish #-}

            go bs | B.null bs = loop consumed dec
            go bs =
                case dec bs of
                    DecodeResultSuccess t dec' -> do
                        let consumed' = consumed + B.length bs
                            next = do
                                unless (T.null t) (yield t)
                                loop consumed' dec'
                         in consumed' `seq` next
                    DecodeResultFailure t rest -> onFailure consumed bs t rest

    -- | Convert bytes into text, using the provided codec. If the codec is
    -- not capable of decoding an input byte sequence, an exception will be thrown.
    --
    -- Since 0.3.0
    decode :: MonadThrow m => Codec -> ConduitT B.ByteString T.Text m ()
    decode (NewCodec name _ start) =
        decodeNew onFailure name 0 start
      where
        onFailure consumed bs t rest = do
            unless (T.null t) (yield t)
            leftover rest -- rest will never be null, no need to check
            let consumed' = consumed + B.length bs - B.length rest
            throwM $ NewDecodeException name consumed' (B.take 4 rest)
        {-# INLINE onFailure #-}
    decode codec =
        loop id
      where
        loop front = await >>= maybe (finish front) (go front)

        finish front =
            case B.uncons $ front B.empty of
                Nothing -> return ()
                Just (w, _) -> lift $ throwM $ DecodeException codec w

        go front bs' =
            case extra of
                Left (exc, _) -> lift $ throwM exc
                Right bs'' -> yield text >> loop (B.append bs'')
          where
            (text, extra) = codecDecode codec bs
            bs = front bs'

    -- |
    -- Since 0.3.0
    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 (DecodeException codec w) = concat
            [ "Error decoding legacy Data.Conduit.Text codec "
            , show codec
            , " when parsing byte: "
            , show w
            ]
        show (EncodeException codec c) = concat
            [ "Error encoding legacy Data.Conduit.Text codec "
            , show codec
            , " when parsing char: "
            , show c
            ]
        show (LengthExceeded i) = "Data.Conduit.Text.linesBounded: line too long: " ++ show i
        show (TextException se) = "Data.Conduit.Text.TextException: " ++ show se
        show (NewDecodeException codec consumed next) = concat
            [ "Data.Conduit.Text.decode: Error decoding stream of "
            , T.unpack codec
            , " bytes. Error encountered in stream at offset "
            , show consumed
            , ". Encountered at byte sequence "
            , show next
            ]
    instance Exc.Exception TextException

    -- |
    -- Since 0.3.0
    utf8 :: Codec
    utf8 = NewCodec (T.pack "UTF-8") TE.encodeUtf8 Data.Streaming.Text.decodeUtf8

    -- |
    -- Since 0.3.0
    utf16_le :: Codec
    utf16_le = NewCodec (T.pack "UTF-16-LE") TE.encodeUtf16LE decodeUtf16LE

    -- |
    -- Since 0.3.0
    utf16_be :: Codec
    utf16_be = NewCodec (T.pack "UTF-16-BE") TE.encodeUtf16BE decodeUtf16BE

    -- |
    -- Since 0.3.0
    utf32_le :: Codec
    utf32_le = NewCodec (T.pack "UTF-32-LE") TE.encodeUtf32LE decodeUtf32LE

    -- |
    -- Since 0.3.0
    utf32_be :: Codec
    utf32_be = NewCodec (T.pack "UTF-32-BE") TE.encodeUtf32BE decodeUtf32BE

    -- |
    -- Since 0.3.0
    ascii :: Codec
    ascii = Codec name enc dec where
        name = T.pack "ASCII"
        enc text = (bytes, extra) where
            (safe, unsafe) = T.span (\c -> ord c <= 0x7F) text
            bytes = B8.pack (T.unpack safe)
            extra = if T.null unsafe
                then Nothing
                else Just (EncodeException ascii (T.head unsafe), unsafe)

        dec bytes = (text, extra) where
            (safe, unsafe) = B.span (<= 0x7F) bytes
            text = T.pack (B8.unpack safe)
            extra = if B.null unsafe
                then Right B.empty
                else Left (DecodeException ascii (B.head unsafe), unsafe)

    -- |
    -- Since 0.3.0
    iso8859_1 :: Codec
    iso8859_1 = Codec name enc dec where
        name = T.pack "ISO-8859-1"
        enc text = (bytes, extra) where
            (safe, unsafe) = T.span (\c -> ord c <= 0xFF) text
            bytes = B8.pack (T.unpack safe)
            extra = if T.null unsafe
                then Nothing
                else Just (EncodeException iso8859_1 (T.head unsafe), unsafe)

        dec bytes = (T.pack (B8.unpack bytes), Right B.empty)

    -- |
    --
    -- Since 1.0.8
    takeWhile :: Monad m
              => (Char -> Bool)
              -> ConduitT T.Text T.Text m ()
    takeWhile p =
        loop
      where
        loop = await >>= maybe (return ()) go
        go t =
            case T.span p t of
                (x, y)
                    | T.null y -> yield x >> loop
                    | otherwise -> yield x >> leftover y

    -- |
    --
    -- Since 1.0.8
    dropWhile :: Monad m
              => (Char -> Bool)
              -> ConduitT T.Text o m ()
    dropWhile p =
        loop
      where
        loop = await >>= maybe (return ()) go
        go t
            | T.null x = loop
            | otherwise = leftover x
          where
            x = T.dropWhile p t

    -- |
    --
    -- Since 1.0.8
    take :: Monad m => Int -> ConduitT T.Text T.Text m ()
    take =
        loop
      where
        loop i = await >>= maybe (return ()) (go i)
        go i t
            | diff == 0 = yield t
            | diff < 0 =
                let (x, y) = T.splitAt i t
                 in yield x >> leftover y
            | otherwise = yield t >> loop diff
          where
            diff = i - T.length t

    -- |
    --
    -- Since 1.0.8
    drop :: Monad m => Int -> ConduitT T.Text o m ()
    drop =
        loop
      where
        loop i = await >>= maybe (return ()) (go i)
        go i t
            | diff == 0 = return ()
            | diff < 0 = leftover $ T.drop i t
            | otherwise = loop diff
          where
            diff = i - T.length t

    -- |
    --
    -- Since 1.0.8
    foldLines :: Monad m
              => (a -> ConduitM T.Text o m a)
              -> a
              -> ConduitT T.Text o m a
    foldLines f =
        start
      where
        start a = CL.peek >>= maybe (return a) (const $ loop $ f a)

        loop consumer = do
            a <- takeWhile (/= '\n') .| do
                a <- CL.map (T.filter (/= '\r')) .| consumer
                CL.sinkNull
                return a
            drop 1
            start a

    -- |
    --
    -- Since 1.0.8
    withLine :: Monad m
             => ConduitT T.Text Void m a
             -> ConduitT T.Text o m (Maybe a)
    withLine consumer = toConsumer $ do
        mx <- CL.peek
        case mx of
            Nothing -> return Nothing
            Just _ -> do
                x <- takeWhile (/= '\n') .| do
                    x <- CL.map (T.filter (/= '\r')) .| consumer
                    CL.sinkNull
                    return x
                drop 1
                return $ Just x

    -- | Automatically determine which UTF variant is being used. This function
    -- checks for BOMs, removing them as necessary. It defaults to assuming UTF-8.
    --
    -- Since 1.1.9
    detectUtf :: MonadThrow m => ConduitT B.ByteString T.Text m ()
    detectUtf =
        go id
      where
        go front = await >>= maybe (close front) (push front)

        push front bs'
            | B.length bs < 4 = go $ B.append bs
            | otherwise       = leftDecode bs
          where bs = front bs'

        close front = leftDecode $ front B.empty

        leftDecode bs = leftover bsOut >> decode codec
          where
            bsOut = B.append (B.drop toDrop x) y
            (x, y) = B.splitAt 4 bs
            (toDrop, codec) =
                case B.unpack x of
                    [0x00, 0x00, 0xFE, 0xFF] -> (4, utf32_be)
                    [0xFF, 0xFE, 0x00, 0x00] -> (4, utf32_le)
                    0xFE : 0xFF: _           -> (2, utf16_be)
                    0xFF : 0xFE: _           -> (2, utf16_le)
                    0xEF : 0xBB: 0xBF : _    -> (3, utf8)
                    _                        -> (0, utf8) -- Assuming UTF-8
    {-# INLINE detectUtf #-}