{-# 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
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 forall a. Monoid a => a
mempty
fieldLineStreamFromString :: String -> FieldLineStream
fieldLineStreamFromString :: String -> FieldLineStream
fieldLineStreamFromString = ByteString -> FieldLineStream
FLSLast 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) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs of
Maybe (Word8, ByteString)
Nothing -> forall a. Maybe a
Nothing
Just (Word8
c, ByteString
bs') -> forall a. a -> Maybe a
Just (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) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs of
Maybe (Word8, ByteString)
Nothing -> forall a. a -> Maybe a
Just (Char
'\n', FieldLineStream
s)
Just (Word8
c, ByteString
bs') -> forall a. a -> Maybe a
Just (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)
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 forall a. Ord a => a -> a -> Bool
<= Word8
0x7F = (Int -> Char
chr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c0), ByteString -> a
f ByteString
bs0)
| Word8
c0 forall a. Ord a => a -> a -> Bool
<= Word8
0xBF = (Char
replacementChar, ByteString -> a
f ByteString
bs0)
| Word8
c0 forall a. Ord a => a -> a -> Bool
<= Word8
0xDF = (Char, a)
twoBytes
| Word8
c0 forall a. Ord a => a -> a -> Bool
<= Word8
0xEF = Int -> Int -> ByteString -> Int -> (Char, a)
moreBytes Int
3 Int
0x800 ByteString
bs0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word8
c0 forall a. Bits a => a -> a -> a
.&. Word8
0xF)
| Word8
c0 forall a. Ord a => a -> a -> Bool
<= Word8
0xF7 = Int -> Int -> ByteString -> Int -> (Char, a)
moreBytes Int
4 Int
0x10000 ByteString
bs0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word8
c0 forall a. Bits a => a -> a -> a
.&. Word8
0x7)
| Word8
c0 forall a. Ord a => a -> a -> Bool
<= Word8
0xFB = Int -> Int -> ByteString -> Int -> (Char, a)
moreBytes Int
5 Int
0x200000 ByteString
bs0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word8
c0 forall a. Bits a => a -> a -> a
.&. Word8
0x3)
| Word8
c0 forall a. Ord a => a -> a -> Bool
<= Word8
0xFD = Int -> Int -> ByteString -> Int -> (Char, a)
moreBytes Int
6 Int
0x4000000 ByteString
bs0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word8
c0 forall a. Bits a => a -> a -> a
.&. Word8
0x1)
| Bool
otherwise = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"not implemented " forall a. [a] -> [a] -> [a]
++ 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 forall a. Bits a => a -> a -> a
.&. Word8
0xC0 forall a. Eq a => a -> a -> Bool
== Word8
0x80 ->
if Int
d 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 = (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
c0 forall a. Bits a => a -> a -> a
.&. Word8
0x1F) forall a. Bits a => a -> Int -> a
`shiftL` Int
6) forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
c1 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 forall a. Ord a => a -> a -> Bool
<= Int
acc, Int
acc forall a. Ord a => a -> a -> Bool
<= Int
0x10FFFF, Int
acc forall a. Ord a => a -> a -> Bool
< Int
0xD800 Bool -> Bool -> Bool
|| Int
0xDFFF 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 forall a. Bits a => a -> a -> a
.&. Word8
0xC0 forall a. Eq a => a -> a -> Bool
== Word8
0x80 -> Int -> Int -> ByteString -> Int -> (Char, a)
moreBytes
(Int
byteCountforall a. Num a => a -> a -> a
-Int
1)
Int
overlong
ByteString
bs1
((Int
acc forall a. Bits a => a -> Int -> a
`shiftL` Int
6) forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
cn 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'