{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module Jordan.FromJSON.Internal.Attoparsec where
import Control.Applicative (Alternative (..))
import Control.Monad (void, when)
import Data.Attoparsec.ByteString ((<?>))
import qualified Data.Attoparsec.ByteString as A
import qualified Data.Attoparsec.ByteString as AP
import qualified Data.Attoparsec.ByteString.Char8 as CH
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as B
import Data.Char (chr, digitToInt, isControl, isHexDigit, ord)
import Data.Functor (void, ($>))
import Data.Monoid (Alt (..))
import Data.Scientific (Scientific)
import qualified Data.Scientific as Sci
import qualified Data.Scientific as Scientific
import qualified Data.Text as Text
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Numeric (showHex)
skipSpace :: AP.Parser ()
skipSpace :: Parser ()
skipSpace = (Word8 -> Bool) -> Parser ()
AP.skipWhile Word8 -> Bool
isSpace Parser () -> String -> Parser ()
forall i a. Parser i a -> String -> Parser i a
<?> String
"skipped space"
where
isSpace :: Word8 -> Bool
isSpace = \case
Word8
32 -> Bool
True
Word8
10 -> Bool
True
Word8
13 -> Bool
True
Word8
9 -> Bool
True
Word8
_ -> Bool
False
lexeme :: AP.Parser a -> AP.Parser a
lexeme :: Parser a -> Parser a
lexeme Parser a
a = Parser a
a Parser a -> Parser () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipSpace
label :: String -> AP.Parser a -> AP.Parser a
label :: String -> Parser a -> Parser a
label String
l Parser a
p = Parser a
p Parser a -> String -> Parser a
forall i a. Parser i a -> String -> Parser i a
<?> String
l
parseAnyField :: AP.Parser ()
parseAnyField :: Parser ()
parseAnyField =
{-# SCC ignoredObjectField #-}
String -> Parser () -> Parser ()
forall a. String -> Parser a -> Parser a
label String
"ignored object field" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
Parser () -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ do
Parser () -> Parser ()
forall a. Parser a -> Parser a
lexeme Parser ()
parseJunkText
Parser ()
labelSep
Parser ()
anyDatum
objectEndWithJunk :: AP.Parser ()
objectEndWithJunk :: Parser ()
objectEndWithJunk = Parser ()
endObject Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ()
junkFieldAndEnd
where
junkFieldAndEnd :: Parser ()
junkFieldAndEnd = Parser () -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ do
Parser ()
comma
String -> Parser () -> Parser ()
forall a. String -> Parser a -> Parser a
label String
"ignored extra field at object end" Parser ()
parseAnyField
Parser ()
objectEndWithJunk
comma :: AP.Parser ()
comma :: Parser ()
comma = String -> Parser () -> Parser ()
forall a. String -> Parser a -> Parser a
label String
"comma character" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser ByteString ByteString -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString ByteString -> Parser ())
-> Parser ByteString ByteString -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser ByteString ByteString -> Parser ByteString ByteString
forall a. Parser a -> Parser a
lexeme (ByteString -> Parser ByteString ByteString
AP.string ByteString
",")
quotation :: AP.Parser ()
quotation :: Parser ()
quotation = String -> Parser () -> Parser ()
forall a. String -> Parser a -> Parser a
label String
"quotation mark" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser ByteString Word8 -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString Word8 -> Parser ())
-> Parser ByteString Word8 -> Parser ()
forall a b. (a -> b) -> a -> b
$ Word8 -> Parser ByteString Word8
AP.word8 Word8
34
parseJSONText :: AP.Parser Text.Text
parseJSONText :: Parser Text
parseJSONText = String -> Parser Text -> Parser Text
forall a. String -> Parser a -> Parser a
label String
"JSON text" (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ do
Parser ()
quotation
Parser Text
innerText
parseJunkText :: AP.Parser ()
parseJunkText :: Parser ()
parseJunkText = String -> Parser () -> Parser ()
forall a. String -> Parser a -> Parser a
label String
"Ignored JSON Text Literal" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ do
Parser ()
quotation
Parser ()
junkInnerText
{-# INLINE parseJunkText #-}
innerText :: AP.Parser Text.Text
innerText :: Parser Text
innerText = do
ByteString
chunk <- String
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a. String -> Parser a -> Parser a
label String
"Skipped text body" (Parser ByteString ByteString -> Parser ByteString ByteString)
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$
(Word8 -> Bool) -> Parser ByteString ByteString
AP.takeWhile ((Word8 -> Bool) -> Parser ByteString ByteString)
-> (Word8 -> Bool) -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$ \Word8
char -> Word8
char Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
92 Bool -> Bool -> Bool
&& Word8
char Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
34
Maybe Word8
l <- Parser (Maybe Word8)
AP.peekWord8
case Maybe Word8
l of
Maybe Word8
Nothing -> String -> Parser Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"string without end"
Just Word8
34 -> do
Parser ByteString Word8
AP.anyWord8
Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Parser Text) -> Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 ByteString
chunk
Just Word8
92 -> do
Parser ByteString Word8
AP.anyWord8
Text
r <- String -> Parser Text -> Parser Text
forall a. String -> Parser a -> Parser a
label String
"escape value" Parser Text
parseEscape
Text
rest <- Parser Text
innerText
Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Parser Text) -> Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 ByteString
chunk Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
r Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rest
Just Word8
_ -> String -> Parser Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Impossibe: Parsed until we parsed a '\\' or a '\"', yet next char was neither"
junkInnerText :: AP.Parser ()
junkInnerText :: Parser ()
junkInnerText =
{-# SCC ignoredTextBetweenQuotes #-}
do
(Word8 -> Bool) -> Parser ()
AP.skipWhile ((Word8 -> Bool) -> Parser ()) -> (Word8 -> Bool) -> Parser ()
forall a b. (a -> b) -> a -> b
$ \Word8
char -> Word8
char Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
92 Bool -> Bool -> Bool
&& Word8
char Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
34
!Maybe Word8
l <- Parser (Maybe Word8)
AP.peekWord8
case Maybe Word8
l of
Maybe Word8
Nothing -> String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"string without end"
Just Word8
34 -> Parser ByteString Word8
AP.anyWord8 Parser ByteString Word8 -> () -> Parser ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()
Just Word8
93 -> do
Parser ByteString Word8
AP.anyWord8
Parser Text
parseEscape
Parser ()
junkInnerText
Just Word8
_ -> String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Impossible: Skipped until we parsed a '\\' or a '\"', yet next char was neither"
{-# INLINE junkInnerText #-}
parseEscape :: AP.Parser Text.Text
parseEscape :: Parser Text
parseEscape =
Parser Text
quote
Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
backslash
Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
solidus
Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
backspace
Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
formfeed
Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
linefeed
Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
carriage
Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
tab
Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
escaped
where
backslash :: Parser Text
backslash = ByteString -> Parser ByteString ByteString
AP.string ByteString
"\\" Parser ByteString ByteString -> Text -> Parser Text
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text
"\\" Parser Text -> String -> Parser Text
forall i a. Parser i a -> String -> Parser i a
<?> String
"Backslash escape"
quote :: Parser Text
quote = ByteString -> Parser ByteString ByteString
AP.string ByteString
"\"" Parser ByteString ByteString -> Text -> Parser Text
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text
"\"" Parser Text -> String -> Parser Text
forall i a. Parser i a -> String -> Parser i a
<?> String
"Quote escape"
solidus :: Parser Text
solidus = ByteString -> Parser ByteString ByteString
AP.string ByteString
"/" Parser ByteString ByteString -> Text -> Parser Text
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text
"/" Parser Text -> String -> Parser Text
forall i a. Parser i a -> String -> Parser i a
<?> String
"Solidus escape"
backspace :: Parser Text
backspace = ByteString -> Parser ByteString ByteString
AP.string ByteString
"b" Parser ByteString ByteString -> Text -> Parser Text
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text
"\b" Parser Text -> String -> Parser Text
forall i a. Parser i a -> String -> Parser i a
<?> String
"Backspace escape"
formfeed :: Parser Text
formfeed = ByteString -> Parser ByteString ByteString
AP.string ByteString
"f" Parser ByteString ByteString -> Text -> Parser Text
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text
"\f" Parser Text -> String -> Parser Text
forall i a. Parser i a -> String -> Parser i a
<?> String
"Formfeed escape"
linefeed :: Parser Text
linefeed = ByteString -> Parser ByteString ByteString
AP.string ByteString
"n" Parser ByteString ByteString -> Text -> Parser Text
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text
"\n" Parser Text -> String -> Parser Text
forall i a. Parser i a -> String -> Parser i a
<?> String
"Linefeed escape"
carriage :: Parser Text
carriage = ByteString -> Parser ByteString ByteString
AP.string ByteString
"r" Parser ByteString ByteString -> Text -> Parser Text
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text
"\r" Parser Text -> String -> Parser Text
forall i a. Parser i a -> String -> Parser i a
<?> String
"Carriage escape"
tab :: Parser Text
tab = ByteString -> Parser ByteString ByteString
AP.string ByteString
"t" Parser ByteString ByteString -> Text -> Parser Text
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text
"\t" Parser Text -> String -> Parser Text
forall i a. Parser i a -> String -> Parser i a
<?> String
"Tab escape"
escaped :: Parser Text
escaped = String -> Parser Text -> Parser Text
forall a. String -> Parser a -> Parser a
label String
"UTF Code Escape" (Parser Text -> Parser Text) -> Parser Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ do
ByteString -> Parser ByteString ByteString
AP.string ByteString
"u"
Int
a <- Parser Int
parseHexDigit
Int
b <- Parser Int
parseHexDigit
Int
c <- Parser Int
parseHexDigit
Int
d <- Parser Int
parseHexDigit
let s :: Int
s = (((Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d
Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Parser Text) -> Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack [Int -> Char
chr Int
s]
parseHexDigit :: AP.Parser Int
parseHexDigit :: Parser Int
parseHexDigit = String -> Parser Int -> Parser Int
forall a. String -> Parser a -> Parser a
label String
"hex digit" (Char -> Int
digitToInt (Char -> Int) -> Parser ByteString Char -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString Char
CH.satisfy Char -> Bool
isHexDigit)
parseCharInText :: Char -> AP.Parser ()
parseCharInText :: Char -> Parser ()
parseCharInText Char
a = Char -> Parser ()
parseLit Char
a Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser ()
escaped Char
a
where
parseLit :: Char -> AP.Parser ()
parseLit :: Char -> Parser ()
parseLit = \case
Char
'\\' -> Parser ByteString ByteString -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString ByteString -> Parser ())
-> Parser ByteString ByteString -> Parser ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Parser ByteString ByteString
AP.string ByteString
"\\\\"
Char
'"' -> Parser ByteString ByteString -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString ByteString -> Parser ())
-> Parser ByteString ByteString -> Parser ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Parser ByteString ByteString
AP.string ByteString
"\\\""
Char
'/' -> Parser ByteString ByteString -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString ByteString -> Parser ())
-> Parser ByteString ByteString -> Parser ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Parser ByteString ByteString
AP.string ByteString
"/" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser ByteString ByteString
AP.string ByteString
"\\/"
Char
'\b' -> Parser ByteString ByteString -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString ByteString -> Parser ())
-> Parser ByteString ByteString -> Parser ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Parser ByteString ByteString
AP.string ByteString
"\\b"
Char
'\f' -> Parser ByteString ByteString -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString ByteString -> Parser ())
-> Parser ByteString ByteString -> Parser ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Parser ByteString ByteString
AP.string ByteString
"\\f"
Char
'\n' -> Parser ByteString ByteString -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString ByteString -> Parser ())
-> Parser ByteString ByteString -> Parser ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Parser ByteString ByteString
AP.string ByteString
"\\n"
Char
'\r' -> Parser ByteString ByteString -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString ByteString -> Parser ())
-> Parser ByteString ByteString -> Parser ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Parser ByteString ByteString
AP.string ByteString
"\\r"
Char
'\t' -> Parser ByteString ByteString -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString ByteString -> Parser ())
-> Parser ByteString ByteString -> Parser ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Parser ByteString ByteString
AP.string ByteString
"\\t"
Char
a -> if Char -> Bool
isControl Char
a then Parser ()
forall (f :: * -> *) a. Alternative f => f a
empty else Parser ByteString ByteString -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString ByteString -> Parser ())
-> Parser ByteString ByteString -> Parser ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Parser ByteString ByteString
AP.string (ByteString -> Parser ByteString ByteString)
-> ByteString -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Char -> Text
Text.singleton Char
a
escaped :: Char -> AP.Parser ()
escaped :: Char -> Parser ()
escaped Char
a = Parser ByteString ByteString -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString ByteString -> Parser ())
-> Parser ByteString ByteString -> Parser ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Parser ByteString ByteString
AP.string (ByteString -> Parser ByteString ByteString)
-> ByteString -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
withEscaped (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (Int -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showHex (Int -> String -> String) -> Int -> String -> String
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
a) []
withEscaped :: String -> String
withEscaped :: String -> String
withEscaped a :: String
a@[Char
_] = String
"\\u000" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
a
withEscaped a :: String
a@[Char
_, Char
_] = String
"\\u00" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
a
withEscaped a :: String
a@[Char
_, Char
_, Char
_] = String
"\\u0" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
a
withEscaped String
r = String
"\\u" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
r
mustBeEscaped :: Char -> Bool
mustBeEscaped :: Char -> Bool
mustBeEscaped = \case
Char
'\\' -> Bool
True
Char
'"' -> Bool
True
Char
'/' -> Bool
True
Char
'\b' -> Bool
True
Char
'\f' -> Bool
True
Char
'\n' -> Bool
True
Char
'\r' -> Bool
True
Char
'\t' -> Bool
True
Char
_ -> Bool
False
canParseDirectly :: Text.Text -> Bool
canParseDirectly :: Text -> Bool
canParseDirectly Text
t = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Char -> Bool -> Bool) -> Bool -> Text -> Bool
forall a. (Char -> a -> a) -> a -> Text -> a
Text.foldr (\Char
c Bool
v -> Bool
v Bool -> Bool -> Bool
|| Char -> Bool
mustBeEscaped Char
c) Bool
False Text
t
parseTextBody :: Text.Text -> AP.Parser ()
parseTextBody :: Text -> Parser ()
parseTextBody Text
text
| Text -> Bool
canParseDirectly Text
text = Parser ByteString ByteString -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ByteString -> Parser ByteString ByteString
A.string (Text -> ByteString
encodeUtf8 Text
text)) Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser ()
parseViaChars Text
text
| Bool
otherwise = Text -> Parser ()
parseViaChars Text
text
parseViaChars :: Text -> Parser ()
parseViaChars = (Char -> Parser () -> Parser ()) -> Parser () -> Text -> Parser ()
forall a. (Char -> a -> a) -> a -> Text -> a
Text.foldr (\Char
c Parser ()
a -> Char -> Parser ()
parseCharInText Char
c Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
a) (() -> Parser ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
objectKey :: Text.Text -> AP.Parser ()
objectKey :: Text -> Parser ()
objectKey Text
k = Parser () -> Parser ()
forall a. Parser a -> Parser a
lexeme (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ do
Parser ()
quotation
{-# SCC "knownObjectKeyBetweenQuotes" #-} Text -> Parser ()
parseTextBody Text
k
Parser ()
quotation
() -> Parser ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
startObject :: AP.Parser ()
startObject :: Parser ()
startObject =
String -> Parser () -> Parser ()
forall a. String -> Parser a -> Parser a
label String
"object starting brace ('{')" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
Parser () -> Parser ()
forall a. Parser a -> Parser a
lexeme (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
Parser ByteString Word8 -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString Word8 -> Parser ())
-> Parser ByteString Word8 -> Parser ()
forall a b. (a -> b) -> a -> b
$
Word8 -> Parser ByteString Word8
AP.word8 Word8
123
endObject :: AP.Parser ()
endObject :: Parser ()
endObject =
String -> Parser () -> Parser ()
forall a. String -> Parser a -> Parser a
label String
"object ending brace ('}')" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
Parser () -> Parser ()
forall a. Parser a -> Parser a
lexeme (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
Parser ByteString Word8 -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString Word8 -> Parser ())
-> Parser ByteString Word8 -> Parser ()
forall a b. (a -> b) -> a -> b
$
Word8 -> Parser ByteString Word8
AP.word8 Word8
125
inObjectBraces :: AP.Parser a -> AP.Parser a
inObjectBraces :: Parser a -> Parser a
inObjectBraces Parser a
interior = Parser ()
startObject Parser () -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
interior Parser a -> Parser () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
endObject
startArray :: AP.Parser ()
startArray :: Parser ()
startArray =
String -> Parser () -> Parser ()
forall a. String -> Parser a -> Parser a
label String
"array starting brace ('[')" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
Parser () -> Parser ()
forall a. Parser a -> Parser a
lexeme (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
Parser ByteString Word8 -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString Word8 -> Parser ())
-> Parser ByteString Word8 -> Parser ()
forall a b. (a -> b) -> a -> b
$
Word8 -> Parser ByteString Word8
AP.word8 Word8
91
endArray :: AP.Parser ()
endArray :: Parser ()
endArray =
String -> Parser () -> Parser ()
forall a. String -> Parser a -> Parser a
label String
"array ending brace (']')" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
Parser () -> Parser ()
forall a. Parser a -> Parser a
lexeme (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
Parser ByteString Word8 -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString Word8 -> Parser ())
-> Parser ByteString Word8 -> Parser ()
forall a b. (a -> b) -> a -> b
$
Word8 -> Parser ByteString Word8
AP.word8 Word8
93
labelSep :: AP.Parser ()
labelSep :: Parser ()
labelSep = String -> Parser () -> Parser ()
forall a. String -> Parser a -> Parser a
label String
"key-value separator (':')" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser ByteString ByteString -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString ByteString -> Parser ())
-> Parser ByteString ByteString -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser ByteString ByteString -> Parser ByteString ByteString
forall a. Parser a -> Parser a
lexeme (Parser ByteString ByteString -> Parser ByteString ByteString)
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Parser ByteString ByteString
AP.string ByteString
":"
anyDatum :: AP.Parser ()
anyDatum :: Parser ()
anyDatum =
Parser () -> Parser ()
forall a. Parser a -> Parser a
lexeme (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
{-# SCC "ignoredJSONValue" #-}
do
Maybe Word8
t <- Parser (Maybe Word8)
AP.peekWord8
case Maybe Word8
t of
Just Word8
102 -> Parser ByteString ByteString -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString ByteString -> Parser ())
-> Parser ByteString ByteString -> Parser ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Parser ByteString ByteString
AP.string ByteString
"false"
Just Word8
110 -> Parser ByteString ByteString -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString ByteString -> Parser ())
-> Parser ByteString ByteString -> Parser ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Parser ByteString ByteString
AP.string ByteString
"null"
Just Word8
116 -> Parser ByteString ByteString -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString ByteString -> Parser ())
-> Parser ByteString ByteString -> Parser ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Parser ByteString ByteString
AP.string ByteString
"true"
Just Word8
123 -> Parser ()
anyObject
Just Word8
34 -> Parser ()
parseJunkText
Just Word8
43 -> Parser ()
parseJunkNumber
Just Word8
45 -> Parser ()
parseJunkNumber
Just Word8
48 -> Parser ()
parseJunkNumber
Just Word8
49 -> Parser ()
parseJunkNumber
Just Word8
50 -> Parser ()
parseJunkNumber
Just Word8
51 -> Parser ()
parseJunkNumber
Just Word8
52 -> Parser ()
parseJunkNumber
Just Word8
53 -> Parser ()
parseJunkNumber
Just Word8
54 -> Parser ()
parseJunkNumber
Just Word8
55 -> Parser ()
parseJunkNumber
Just Word8
57 -> Parser ()
parseJunkNumber
Just Word8
59 -> Parser ()
parseJunkNumber
Just Word8
91 -> Parser ()
anyArray
Just Word8
_ -> String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not a valid starter of any JSON value"
Maybe Word8
Nothing -> String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"empty input"
{-# INLINE anyDatum #-}
anyArray :: AP.Parser ()
anyArray :: Parser ()
anyArray = String -> Parser () -> Parser ()
forall a. String -> Parser a -> Parser a
label String
"ignored array" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
Parser () -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ do
Parser ()
startArray
Parser ()
endArray Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ()
junkItems
where
junkItems :: Parser ()
junkItems = do
Parser ()
anyDatum
Parser ()
endArray Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ()
comma Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
junkItems)
parseJunkDecimalZero :: AP.Parser ()
parseJunkDecimalZero :: Parser ()
parseJunkDecimalZero = do
let zero :: Word8
zero = Word8
48
ByteString
digits <- (Word8 -> Bool) -> Parser ByteString ByteString
A.takeWhile1 Word8 -> Bool
CH.isDigit_w8
Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int
B.length ByteString
digits Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& ByteString -> Word8
B.unsafeHead ByteString
digits Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
zero) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
String -> Parser ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"leading zero"
parseJunkExponent :: AP.Parser ()
parseJunkExponent :: Parser ()
parseJunkExponent = String -> Parser () -> Parser ()
forall a. String -> Parser a -> Parser a
label String
"junk exponent" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ do
(Word8 -> Bool) -> Parser ByteString Word8
A.satisfy (\Word8
ex -> Word8
ex Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
101 Bool -> Bool -> Bool
|| Word8
ex Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
69)
(Word8 -> Bool) -> Parser ()
A.skipWhile (\Word8
ch -> Word8
ch Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
45 Bool -> Bool -> Bool
|| Word8
ch Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
43)
Parser ()
parseJunkDecimalZero
parseJunkNumber :: AP.Parser ()
parseJunkNumber :: Parser ()
parseJunkNumber = do
(Word8 -> Bool) -> Parser ()
A.skipWhile (\Word8
ch -> Word8
ch Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
45 Bool -> Bool -> Bool
|| Word8
ch Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
43)
Parser ()
parseJunkDecimalZero
Maybe Word8
dot <- Parser (Maybe Word8)
A.peekWord8
case Maybe Word8
dot of
Just Word8
46 -> Parser ByteString ByteString -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser ByteString ByteString -> Parser ())
-> Parser ByteString ByteString -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser ByteString Word8
A.anyWord8 Parser ByteString Word8
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Word8 -> Bool) -> Parser ByteString ByteString
A.takeWhile1 Word8 -> Bool
CH.isDigit_w8
Maybe Word8
_ -> () -> Parser ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Parser ()
parseJunkExponent Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> () -> Parser ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
data SP = SP !Integer {-# UNPACK #-} !Int
decimal0 :: AP.Parser Integer
decimal0 :: Parser Integer
decimal0 = do
let zero :: Word8
zero = Word8
48
ByteString
digits <- (Word8 -> Bool) -> Parser ByteString ByteString
A.takeWhile1 Word8 -> Bool
CH.isDigit_w8
if ByteString -> Int
B.length ByteString
digits Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& ByteString -> Word8
B.unsafeHead ByteString
digits Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
zero
then String -> Parser Integer
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"leading zero"
else Integer -> Parser Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Integer
bsToInteger ByteString
digits)
scientific :: AP.Parser Scientific
scientific :: Parser Scientific
scientific = do
let minus :: Word8
minus = Word8
45
plus :: Word8
plus = Word8
43
Word8
sign <- Parser ByteString Word8
A.peekWord8'
let !positive :: Bool
positive = Word8
sign Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
plus Bool -> Bool -> Bool
|| Word8
sign Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
minus
Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
sign Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
plus Bool -> Bool -> Bool
|| Word8
sign Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
minus) (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
Parser ByteString Word8 -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser ByteString Word8
A.anyWord8
Integer
n <- Parser Integer
decimal0
let f :: ByteString -> SP
f ByteString
fracDigits =
Integer -> Int -> SP
SP
((Integer -> Word8 -> Integer) -> Integer -> ByteString -> Integer
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl' Integer -> Word8 -> Integer
forall a a. (Integral a, Num a) => a -> a -> a
step Integer
n ByteString
fracDigits)
(Int -> Int
forall a. Num a => a -> a
negate (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
fracDigits)
step :: a -> a -> a
step a
a a
w = a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
10 a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
w a -> a -> a
forall a. Num a => a -> a -> a
- a
48)
Maybe Word8
dotty <- Parser (Maybe Word8)
A.peekWord8
SP Integer
c Int
e <- case Maybe Word8
dotty of
Just Word8
46 -> Parser ByteString Word8
A.anyWord8 Parser ByteString Word8
-> Parser ByteString SP -> Parser ByteString SP
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ByteString -> SP
f (ByteString -> SP)
-> Parser ByteString ByteString -> Parser ByteString SP
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser ByteString ByteString
A.takeWhile1 Word8 -> Bool
CH.isDigit_w8)
Maybe Word8
_ -> SP -> Parser ByteString SP
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Int -> SP
SP Integer
n Int
0)
let !signedCoeff :: Integer
signedCoeff
| Bool
positive = Integer
c
| Bool
otherwise = - Integer
c
let littleE :: Word8
littleE = Word8
101
bigE :: Word8
bigE = Word8
69
( (Word8 -> Bool) -> Parser ByteString Word8
A.satisfy (\Word8
ex -> Word8
ex Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
littleE Bool -> Bool -> Bool
|| Word8
ex Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
bigE)
Parser ByteString Word8 -> Parser Scientific -> Parser Scientific
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int -> Scientific) -> Parser Int -> Parser Scientific
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> Int -> Scientific
Scientific.scientific Integer
signedCoeff (Int -> Scientific) -> (Int -> Int) -> Int -> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+)) (Parser Int -> Parser Int
forall a. Num a => Parser a -> Parser a
CH.signed Parser Int
forall a. Integral a => Parser a
CH.decimal)
)
Parser Scientific -> Parser Scientific -> Parser Scientific
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Scientific -> Parser Scientific
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Int -> Scientific
Scientific.scientific Integer
signedCoeff Int
e)
{-# INLINE scientific #-}
bsToInteger :: B.ByteString -> Integer
bsToInteger :: ByteString -> Integer
bsToInteger ByteString
bs
| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
40 = Integer -> Int -> [Integer] -> Integer
valInteger Integer
10 Int
l [Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
48) | Word8
w <- ByteString -> [Word8]
B.unpack ByteString
bs]
| Bool
otherwise = ByteString -> Integer
bsToIntegerSimple ByteString
bs
where
l :: Int
l = ByteString -> Int
B.length ByteString
bs
bsToIntegerSimple :: B.ByteString -> Integer
bsToIntegerSimple :: ByteString -> Integer
bsToIntegerSimple = (Integer -> Word8 -> Integer) -> Integer -> ByteString -> Integer
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl' Integer -> Word8 -> Integer
forall a a. (Integral a, Num a) => a -> a -> a
step Integer
0
where
step :: a -> a -> a
step a
a a
b = a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
10 a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
b a -> a -> a
forall a. Num a => a -> a -> a
- a
48)
valInteger :: Integer -> Int -> [Integer] -> Integer
valInteger :: Integer -> Int -> [Integer] -> Integer
valInteger = Integer -> Int -> [Integer] -> Integer
go
where
go :: Integer -> Int -> [Integer] -> Integer
go :: Integer -> Int -> [Integer] -> Integer
go Integer
_ Int
_ [] = Integer
0
go Integer
_ Int
_ [Integer
d] = Integer
d
go Integer
b Int
l [Integer]
ds
| Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
40 = Integer
b' Integer -> Integer -> Integer
`seq` Integer -> Int -> [Integer] -> Integer
go Integer
b' Int
l' (Integer -> [Integer] -> [Integer]
forall a. Num a => a -> [a] -> [a]
combine Integer
b [Integer]
ds')
| Bool
otherwise = Integer -> [Integer] -> Integer
valSimple Integer
b [Integer]
ds
where
ds' :: [Integer]
ds' = if Int -> Bool
forall a. Integral a => a -> Bool
even Int
l then [Integer]
ds else Integer
0 Integer -> [Integer] -> [Integer]
forall a. a -> [a] -> [a]
: [Integer]
ds
b' :: Integer
b' = Integer
b Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
b
l' :: Int
l' = (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2
combine :: a -> [a] -> [a]
combine a
b (a
d1 : a
d2 : [a]
ds) = a
d a -> [a] -> [a]
`seq` (a
d a -> [a] -> [a]
forall a. a -> [a] -> [a]
: a -> [a] -> [a]
combine a
b [a]
ds)
where
d :: a
d = a
d1 a -> a -> a
forall a. Num a => a -> a -> a
* a
b a -> a -> a
forall a. Num a => a -> a -> a
+ a
d2
combine a
_ [] = []
combine a
_ [a
_] = String -> [a]
forall a. String -> a
errorWithoutStackTrace String
"this should not happen"
valSimple :: Integer -> [Integer] -> Integer
valSimple :: Integer -> [Integer] -> Integer
valSimple Integer
base = Integer -> [Integer] -> Integer
forall a. Integral a => Integer -> [a] -> Integer
go Integer
0
where
go :: Integer -> [a] -> Integer
go Integer
r [] = Integer
r
go Integer
r (a
d : [a]
ds) = Integer
r' Integer -> Integer -> Integer
`seq` Integer -> [a] -> Integer
go Integer
r' [a]
ds
where
r' :: Integer
r' = Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
base Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
d
number :: AP.Parser Scientific
number :: Parser Scientific
number = Parser Scientific
scientific
{-# INLINE number #-}
anyObject :: AP.Parser ()
anyObject :: Parser ()
anyObject =
{-# SCC ignoredJSONObject #-}
String -> Parser () -> Parser ()
forall a. String -> Parser a -> Parser a
label String
"ignored object" (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$
Parser () -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ do
Parser ()
startObject
Parser ()
endObject Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ()
junkField
where
junkField :: Parser ()
junkField = do
Parser ()
parseAnyField
Parser ()
endObject Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser ()
comma Parser () -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
junkField)
parseObjectField ::
Text.Text ->
AP.Parser a ->
AP.Parser a
parseObjectField :: Text -> Parser a -> Parser a
parseObjectField Text
t Parser a
f = do
Text -> Parser ()
objectKey Text
t
Parser ()
labelSep
Parser a -> Parser a
forall a. Parser a -> Parser a
lexeme Parser a
f
parseDictField ::
AP.Parser a ->
AP.Parser (Text.Text, a)
parseDictField :: Parser a -> Parser (Text, a)
parseDictField Parser a
p = do
Text
key <- Parser Text -> Parser Text
forall a. Parser a -> Parser a
lexeme Parser Text
parseJSONText
Parser ()
labelSep
a
val <- Parser a
p
(Text, a) -> Parser (Text, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
key, a
val)