{-# 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
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
showList :: [FieldLineStream] -> ShowS
$cshowList :: [FieldLineStream] -> ShowS
show :: FieldLineStream -> String
$cshow :: FieldLineStream -> String
showsPrec :: Int -> FieldLineStream -> ShowS
$cshowsPrec :: Int -> FieldLineStream -> ShowS
Show
fieldLineStreamEnd :: FieldLineStream
fieldLineStreamEnd :: FieldLineStream
fieldLineStreamEnd = ByteString -> FieldLineStream
FLSLast ByteString
forall a. Monoid a => a
mempty
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 bs :: ByteString
bs) = Maybe (Char, FieldLineStream) -> m (Maybe (Char, FieldLineStream))
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
Nothing -> Maybe (Char, FieldLineStream)
forall a. Maybe a
Nothing
Just (c :: Word8
c, bs' :: 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' (\bs'' :: ByteString
bs'' -> ByteString -> FieldLineStream
FLSLast ByteString
bs'') FieldLineStream
fieldLineStreamEnd)
uncons (FLSCons bs :: ByteString
bs s :: FieldLineStream
s) = Maybe (Char, FieldLineStream) -> m (Maybe (Char, FieldLineStream))
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
Nothing -> (Char, FieldLineStream) -> Maybe (Char, FieldLineStream)
forall a. a -> Maybe a
Just ('\n', FieldLineStream
s)
Just (c :: Word8
c, bs' :: 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' (\bs'' :: ByteString
bs'' -> ByteString -> FieldLineStream -> FieldLineStream
FLSCons ByteString
bs'' FieldLineStream
s) FieldLineStream
s)
unconsChar :: forall a. Word8 -> ByteString -> (ByteString -> a) -> a -> (Char, a)
unconsChar :: Word8 -> ByteString -> (ByteString -> a) -> a -> (Char, a)
unconsChar c0 :: Word8
c0 bs0 :: ByteString
bs0 f :: ByteString -> a
f next :: a
next
| Word8
c0 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= 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
<= 0xBF = (Char
replacementChar, ByteString -> a
f ByteString
bs0)
| Word8
c0 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xDF = (Char, a)
twoBytes
| Word8
c0 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xEF = Int -> Int -> ByteString -> Int -> (Char, a)
moreBytes 3 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
.&. 0xF)
| Word8
c0 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xF7 = Int -> Int -> ByteString -> Int -> (Char, a)
moreBytes 4 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
.&. 0x7)
| Word8
c0 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xFB = Int -> Int -> ByteString -> Int -> (Char, a)
moreBytes 5 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
.&. 0x3)
| Word8
c0 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= 0xFD = Int -> Int -> ByteString -> Int -> (Char, a)
moreBytes 6 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
.&. 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
$ "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
Nothing -> (Char
replacementChar, a
next)
Just (c1 :: Word8
c1, bs1 :: ByteString
bs1)
| Word8
c1 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0xC0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0x80 ->
if Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 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
.&. 0x1F) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 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
.&. 0x3F)
moreBytes :: Int -> Int -> ByteString -> Int -> (Char, a)
moreBytes :: Int -> Int -> ByteString -> Int -> (Char, a)
moreBytes 1 overlong :: Int
overlong bs' :: ByteString
bs' acc :: 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
<= 0x10FFFF, Int
acc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0xD800 Bool -> Bool -> Bool
|| 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 byteCount :: Int
byteCount overlong :: Int
overlong bs' :: ByteString
bs' acc :: Int
acc = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs' of
Nothing -> (Char
replacementChar, ByteString -> a
f ByteString
bs')
Just (cn :: Word8
cn, bs1 :: ByteString
bs1)
| Word8
cn Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. 0xC0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0x80 -> Int -> Int -> ByteString -> Int -> (Char, a)
moreBytes
(Int
byteCountInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)
Int
overlong
ByteString
bs1
((Int
acc Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` 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
.&. 0x3F)
| Bool
otherwise -> (Char
replacementChar, ByteString -> a
f ByteString
bs1)
replacementChar :: Char
replacementChar :: Char
replacementChar = '\xfffd'