{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wall -Werror #-}

module Distribution.Parsec.FieldLineStream
  ( FieldLineStream (..)
  , fieldLineStreamFromString
  , fieldLineStreamFromBS
  , fieldLineStreamEnd
  ) where

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

import qualified Data.ByteString as BS
import Data.Text.Internal.Encoding.Utf8
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 -> FieldLineStream -> FieldLineStream
`FLSCons` FieldLineStream
s) FieldLineStream
s)

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 = DecoderResult -> ByteString -> (Char, a)
go (Word8 -> DecoderResult
utf8DecodeStart Word8
c0) ByteString
bs0
  where
    go :: DecoderResult -> ByteString -> (Char, a)
go DecoderResult
decoderResult ByteString
bs = case DecoderResult
decoderResult of
      Accept Char
ch -> (Char
ch, ByteString -> a
f ByteString
bs)
      DecoderResult
Reject -> (Char
replacementChar, ByteString -> a
f ByteString
bs)
      Incomplete DecoderState
state CodePoint
codePoint -> case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs of
        Maybe (Word8, ByteString)
Nothing -> (Char
replacementChar, a
next)
        Just (Word8
w, ByteString
bs') -> DecoderResult -> ByteString -> (Char, a)
go (Word8 -> DecoderState -> CodePoint -> DecoderResult
utf8DecodeContinue Word8
w DecoderState
state CodePoint
codePoint) ByteString
bs'

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