    {-# LANGUAGE FlexibleInstances     #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE OverloadedStrings     #-}
    {-# LANGUAGE ScopedTypeVariables   #-}
    {-# OPTIONS_GHC -Wall -Werror #-}
    module Distribution.Parsec.FieldLineStream (
        FieldLineStream (..),
        fieldLineStreamFromString,
        fieldLineStreamFromBS,
        fieldLineStreamEnd,
        ) where

    import Data.Bits
    import Data.ByteString             (ByteString)
    import Distribution.Compat.Prelude
    import Distribution.Utils.Generic  (toUTF8BS)
    import Prelude ()

    import qualified Data.ByteString as BS
    import qualified Text.Parsec     as Parsec

    -- | This is essentially a lazy bytestring, but chunks are glued with newline @\'\\n\'@.
    data FieldLineStream
        = FLSLast !ByteString
        | FLSCons {-# UNPACK #-} !ByteString FieldLineStream
      deriving Int -> FieldLineStream -> ShowS
    [FieldLineStream] -> ShowS
    FieldLineStream -> String
    (Int -> FieldLineStream -> ShowS)
    -> (FieldLineStream -> String)
    -> ([FieldLineStream] -> ShowS)
    -> Show FieldLineStream
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> FieldLineStream -> ShowS
    showsPrec :: Int -> FieldLineStream -> ShowS
    $cshow :: FieldLineStream -> String
    show :: FieldLineStream -> String
    $cshowList :: [FieldLineStream] -> ShowS
    showList :: [FieldLineStream] -> ShowS
    Show

    fieldLineStreamEnd :: FieldLineStream
    fieldLineStreamEnd :: FieldLineStream
    fieldLineStreamEnd = ByteString -> FieldLineStream
    FLSLast ByteString
    forall a. Monoid a => a
    mempty

    -- | Convert 'String' to 'FieldLineStream'.
    --
    -- /Note:/ inefficient!
    fieldLineStreamFromString :: String -> FieldLineStream
    fieldLineStreamFromString :: String -> FieldLineStream
    fieldLineStreamFromString = ByteString -> FieldLineStream
    FLSLast (ByteString -> FieldLineStream)
    -> (String -> ByteString) -> String -> FieldLineStream
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ByteString
    toUTF8BS

    fieldLineStreamFromBS :: ByteString -> FieldLineStream
    fieldLineStreamFromBS :: ByteString -> FieldLineStream
    fieldLineStreamFromBS = ByteString -> FieldLineStream
    FLSLast

    instance Monad m => Parsec.Stream FieldLineStream m Char where
        uncons :: FieldLineStream -> m (Maybe (Char, FieldLineStream))
    uncons (FLSLast ByteString
    bs) = Maybe (Char, FieldLineStream) -> m (Maybe (Char, FieldLineStream))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Char, FieldLineStream)
     -> m (Maybe (Char, FieldLineStream)))
    -> Maybe (Char, FieldLineStream)
    -> m (Maybe (Char, FieldLineStream))
    forall a b. (a -> b) -> a -> b
    $ case ByteString -> Maybe (Word8, ByteString)
    BS.uncons ByteString
    bs of
            Maybe (Word8, ByteString)
    Nothing       -> Maybe (Char, FieldLineStream)
    forall a. Maybe a
    Nothing
            Just (Word8
    c, ByteString
    bs') -> (Char, FieldLineStream) -> Maybe (Char, FieldLineStream)
    forall a. a -> Maybe a
    Just (Word8
    -> ByteString
    -> (ByteString -> FieldLineStream)
    -> FieldLineStream
    -> (Char, FieldLineStream)
    forall a.
    Word8 -> ByteString -> (ByteString -> a) -> a -> (Char, a)
    unconsChar Word8
    c ByteString
    bs' (\ByteString
    bs'' -> ByteString -> FieldLineStream
    FLSLast ByteString
    bs'') FieldLineStream
    fieldLineStreamEnd)

        uncons (FLSCons ByteString
    bs FieldLineStream
    s) = Maybe (Char, FieldLineStream) -> m (Maybe (Char, FieldLineStream))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Char, FieldLineStream)
     -> m (Maybe (Char, FieldLineStream)))
    -> Maybe (Char, FieldLineStream)
    -> m (Maybe (Char, FieldLineStream))
    forall a b. (a -> b) -> a -> b
    $ case ByteString -> Maybe (Word8, ByteString)
    BS.uncons ByteString
    bs of
            -- as lines are glued with '\n', we return '\n' here!
            Maybe (Word8, ByteString)
    Nothing -> (Char, FieldLineStream) -> Maybe (Char, FieldLineStream)
    forall a. a -> Maybe a
    Just (Char
    '\n', FieldLineStream
    s)
            Just (Word8
    c, ByteString
    bs') -> (Char, FieldLineStream) -> Maybe (Char, FieldLineStream)
    forall a. a -> Maybe a
    Just (Word8
    -> ByteString
    -> (ByteString -> FieldLineStream)
    -> FieldLineStream
    -> (Char, FieldLineStream)
    forall a.
    Word8 -> ByteString -> (ByteString -> a) -> a -> (Char, a)
    unconsChar Word8
    c ByteString
    bs' (\ByteString
    bs'' -> ByteString -> FieldLineStream -> FieldLineStream
    FLSCons ByteString
    bs'' FieldLineStream
    s) FieldLineStream
    s)

    -- Based on implementation 'decodeStringUtf8'
    unconsChar :: forall a. Word8 -> ByteString -> (ByteString -> a) -> a -> (Char, a)
    unconsChar :: forall a.
    Word8 -> ByteString -> (ByteString -> a) -> a -> (Char, a)
    unconsChar Word8
    c0 ByteString
    bs0 ByteString -> a
    f a
    next
        | Word8
    c0 Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Word8
    0x7F = (Int -> Char
    chr (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    c0), ByteString -> a
    f ByteString
    bs0)
        | Word8
    c0 Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Word8
    0xBF = (Char
    replacementChar, ByteString -> a
    f ByteString
    bs0)
        | Word8
    c0 Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Word8
    0xDF = (Char, a)
    twoBytes
        | Word8
    c0 Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Word8
    0xEF = Int -> Int -> ByteString -> Int -> (Char, a)
    moreBytes Int
    3 Int
    0x800     ByteString
    bs0 (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Int) -> Word8 -> Int
    forall a b. (a -> b) -> a -> b
    $ Word8
    c0 Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .&. Word8
    0xF)
        | Word8
    c0 Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Word8
    0xF7 = Int -> Int -> ByteString -> Int -> (Char, a)
    moreBytes Int
    4 Int
    0x10000   ByteString
    bs0 (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Int) -> Word8 -> Int
    forall a b. (a -> b) -> a -> b
    $ Word8
    c0 Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .&. Word8
    0x7)
        | Word8
    c0 Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Word8
    0xFB = Int -> Int -> ByteString -> Int -> (Char, a)
    moreBytes Int
    5 Int
    0x200000  ByteString
    bs0 (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Int) -> Word8 -> Int
    forall a b. (a -> b) -> a -> b
    $ Word8
    c0 Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .&. Word8
    0x3)
        | Word8
    c0 Word8 -> Word8 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Word8
    0xFD = Int -> Int -> ByteString -> Int -> (Char, a)
    moreBytes Int
    6 Int
    0x4000000 ByteString
    bs0 (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8 -> Int) -> Word8 -> Int
    forall a b. (a -> b) -> a -> b
    $ Word8
    c0 Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .&. Word8
    0x1)
        | Bool
    otherwise = String -> (Char, a)
    forall a. HasCallStack => String -> a
    error (String -> (Char, a)) -> String -> (Char, a)
    forall a b. (a -> b) -> a -> b
    $ String
    "not implemented " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Word8 -> String
    forall a. Show a => a -> String
    show Word8
    c0
      where
        twoBytes :: (Char, a)
    twoBytes = case ByteString -> Maybe (Word8, ByteString)
    BS.uncons ByteString
    bs0 of
            Maybe (Word8, ByteString)
    Nothing -> (Char
    replacementChar, a
    next)
            Just (Word8
    c1, ByteString
    bs1)
                | Word8
    c1 Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .&. Word8
    0xC0 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    0x80 ->
                    if Int
    d Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    0x80
                    then  (Int -> Char
    chr Int
    d, ByteString -> a
    f ByteString
    bs1)
                    else  (Char
    replacementChar, ByteString -> a
    f ByteString
    bs1)
                | Bool
    otherwise -> (Char
    replacementChar, ByteString -> a
    f ByteString
    bs1)
              where
                d :: Int
    d = (Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8
    c0 Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .&. Word8
    0x1F) Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    6) Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .|. Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Word8
    c1 Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .&. Word8
    0x3F)

        moreBytes :: Int -> Int -> ByteString -> Int -> (Char, a)
        moreBytes :: Int -> Int -> ByteString -> Int -> (Char, a)
    moreBytes Int
    1 Int
    overlong ByteString
    bs' Int
    acc
            | Int
    overlong Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    acc, Int
    acc Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0x10FFFF, Int
    acc Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0xD800 Bool -> Bool -> Bool
    || Int
    0xDFFF Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    acc
                = (Int -> Char
    chr Int
    acc, ByteString -> a
    f ByteString
    bs')
            | Bool
    otherwise
                = (Char
    replacementChar, ByteString -> a
    f ByteString
    bs')

        moreBytes Int
    byteCount Int
    overlong ByteString
    bs' Int
    acc = case ByteString -> Maybe (Word8, ByteString)
    BS.uncons ByteString
    bs' of
            Maybe (Word8, ByteString)
    Nothing                   -> (Char
    replacementChar, ByteString -> a
    f ByteString
    bs')
            Just (Word8
    cn, ByteString
    bs1)
                | Word8
    cn Word8 -> Word8 -> Word8
    forall a. Bits a => a -> a -> a
    .&. Word8
    0xC0 Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    0x80 -> Int -> Int -> ByteString -> Int -> (Char, a)
    moreBytes
                    (Int
    byteCountInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1)
                    Int
    overlong
                    ByteString
    bs1
                    ((Int
    acc Int -> Int -> Int
    forall a. Bits a => a -> Int -> a
    `shiftL` Int
    6) Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .|. Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    cn Int -> Int -> Int
    forall a. Bits a => a -> a -> a
    .&. Int
    0x3F)
                | Bool
    otherwise           -> (Char
    replacementChar, ByteString -> a
    f ByteString
    bs1)

    replacementChar :: Char
    replacementChar :: Char
    replacementChar = Char
    '\xfffd'