{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

module Jordan.FromJSON.Internal.UnboxedReporting where

import Control.Applicative (Alternative (empty, (<|>)))
import Control.Applicative.Combinators (sepBy)
import Control.Monad (when)
import Data.Bifunctor
import qualified Data.ByteString as BS
import Data.ByteString.Unsafe as BS
import Data.Char (chr, isControl, ord)
import Data.Functor (void, ($>))
import qualified Data.Map.Strict as Map
import Data.Maybe (isJust)
import Data.Monoid (Alt (..))
import Data.Scientific (Scientific)
import qualified Data.Scientific as Scientific
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8', encodeUtf8)
import Data.Word (Word8)
import Debug.Trace (traceM)
import Jordan.FromJSON.Class
import Jordan.FromJSON.Internal.Attoparsec (bsToInteger)
import Jordan.FromJSON.Internal.Permutation
import Jordan.FromJSON.Internal.UnboxedParser as UP hiding (AccumE (..), AccumEL, AccumER)
import Jordan.Types.Internal.AccumE (AccumE (AccumE))
import Jordan.Types.JSONError
  ( JSONArrayError (..),
    JSONError
      ( ErrorBadArray,
        ErrorBadObject,
        ErrorBadTextConstant,
        ErrorBadType,
        ErrorInvalidJSON,
        ErrorMesage,
        ErrorNoValue
      ),
    JSONObjectError (..),
  )
import Jordan.Types.JSONType (JSONType (..))
import Numeric (showHex)

skipWithFailure :: JSONError -> Parser JSONError a
skipWithFailure :: JSONError -> Parser JSONError a
skipWithFailure JSONError
err =
  Parser JSONError JSONError -> Parser JSONError a
forall err a. Parser err err -> Parser err a
UP.asFailure (Parser JSONError JSONError -> Parser JSONError a)
-> Parser JSONError JSONError -> Parser JSONError a
forall a b. (a -> b) -> a -> b
$
    Parser JSONError ()
forall err. Monoid err => Parser err ()
skipAnything Parser JSONError () -> JSONError -> Parser JSONError JSONError
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> JSONError
err

lexeme :: Semigroup err => Parser err a -> Parser err a
lexeme :: Parser err a -> Parser err a
lexeme Parser err a
p = Parser err a
p Parser err a -> Parser err () -> Parser err a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser err ()
forall err. Parser err ()
UP.skipWhitespace
{-# INLINE lexeme #-}

jsonTypeFromWord :: Word8 -> Maybe JSONType
jsonTypeFromWord :: Word8 -> Maybe JSONType
jsonTypeFromWord Word8
jt
  | Word8
jt Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
34 = JSONType -> Maybe JSONType
forall (f :: * -> *) a. Applicative f => a -> f a
pure JSONType
JSONTypeText
  | Word8
jt Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
116 Bool -> Bool -> Bool
|| Word8
jt Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
102 = JSONType -> Maybe JSONType
forall (f :: * -> *) a. Applicative f => a -> f a
pure JSONType
JSONTypeBool
  | Word8
jt Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
110 = JSONType -> Maybe JSONType
forall (f :: * -> *) a. Applicative f => a -> f a
pure JSONType
JSONTypeNull
  | Word8
jt Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
48 Bool -> Bool -> Bool
&& Word8
jt Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
57 = JSONType -> Maybe JSONType
forall (f :: * -> *) a. Applicative f => a -> f a
pure JSONType
JSONTypeNumber
  | Word8
jt Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
45 = JSONType -> Maybe JSONType
forall (f :: * -> *) a. Applicative f => a -> f a
pure JSONType
JSONTypeNumber
  | Word8
jt Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
91 = JSONType -> Maybe JSONType
forall (f :: * -> *) a. Applicative f => a -> f a
pure JSONType
JSONTypeArray
  | Word8
jt Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
123 = JSONType -> Maybe JSONType
forall (f :: * -> *) a. Applicative f => a -> f a
pure JSONType
JSONTypeObject
  | Bool
otherwise = Maybe JSONType
forall a. Maybe a
Nothing
{-# INLINE jsonTypeFromWord #-}

peekJSONType :: (Monoid err) => Parser err JSONType
peekJSONType :: Parser err JSONType
peekJSONType = Parser err (Maybe JSONType) -> Parser err JSONType
forall err a. Parser err (Maybe a) -> Parser err a
UP.orFail (Word8 -> Maybe JSONType
jsonTypeFromWord (Word8 -> Maybe JSONType)
-> Parser err Word8 -> Parser err (Maybe JSONType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser err Word8
forall err. Parser err Word8
UP.peekWord)
{-# INLINE peekJSONType #-}

skipNullExpecting :: JSONType -> Parser JSONError a
skipNullExpecting :: JSONType -> Parser JSONError a
skipNullExpecting JSONType
jt =
  Parser JSONError JSONError -> Parser JSONError a
forall err a. Parser err err -> Parser err a
UP.asFailure (Parser JSONError JSONError -> Parser JSONError a)
-> Parser JSONError JSONError -> Parser JSONError a
forall a b. (a -> b) -> a -> b
$ Parser JSONError ()
forall err. Semigroup err => Parser err ()
nullParser Parser JSONError () -> JSONError -> Parser JSONError JSONError
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> JSONType -> JSONType -> JSONError
ErrorBadType JSONType
jt JSONType
JSONTypeNull

-- | Parse a NULL value.
nullParser :: Semigroup err => Parser err ()
nullParser :: Parser err ()
nullParser = Parser err () -> Parser err ()
forall err a. Semigroup err => Parser err a -> Parser err a
lexeme (Parser err () -> Parser err ()) -> Parser err () -> Parser err ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Parser err ()
forall err. ByteString -> Parser err ()
UP.parseChunk ByteString
"null" Parser err () -> () -> Parser err ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()
{-# INLINE nullParser #-}

skipBoolExpecting :: JSONType -> Parser JSONError a
skipBoolExpecting :: JSONType -> Parser JSONError a
skipBoolExpecting JSONType
jt =
  Parser JSONError JSONError -> Parser JSONError a
forall err a. Parser err err -> Parser err a
UP.asFailure (Parser JSONError JSONError -> Parser JSONError a)
-> Parser JSONError JSONError -> Parser JSONError a
forall a b. (a -> b) -> a -> b
$
    Parser JSONError Bool
forall err. Monoid err => Parser err Bool
boolParser Parser JSONError Bool -> JSONError -> Parser JSONError JSONError
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> JSONType -> JSONType -> JSONError
ErrorBadType JSONType
jt JSONType
JSONTypeBool
{-# INLINE skipBoolExpecting #-}

boolParser :: (Monoid err) => Parser err Bool
boolParser :: Parser err Bool
boolParser =
  Parser err Bool -> Parser err Bool
forall err a. Semigroup err => Parser err a -> Parser err a
lexeme (Parser err Bool -> Parser err Bool)
-> Parser err Bool -> Parser err Bool
forall a b. (a -> b) -> a -> b
$
    (ByteString -> Parser err ()
forall err. ByteString -> Parser err ()
UP.parseChunk ByteString
"true" Parser err () -> Bool -> Parser err Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True)
      Parser err Bool -> Parser err Bool -> Parser err Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ByteString -> Parser err ()
forall err. ByteString -> Parser err ()
UP.parseChunk ByteString
"false" Parser err () -> Bool -> Parser err Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
False)
{-# INLINE boolParser #-}

skipTextExpecting :: JSONType -> Parser JSONError a
skipTextExpecting :: JSONType -> Parser JSONError a
skipTextExpecting JSONType
jt =
  Parser JSONError JSONError -> Parser JSONError a
forall err a. Parser err err -> Parser err a
UP.asFailure (Parser JSONError JSONError -> Parser JSONError a)
-> Parser JSONError JSONError -> Parser JSONError a
forall a b. (a -> b) -> a -> b
$
    Parser JSONError Text
forall err. Monoid err => Parser err Text
textParser Parser JSONError Text -> JSONError -> Parser JSONError JSONError
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> JSONType -> JSONType -> JSONError
ErrorBadType JSONType
jt JSONType
JSONTypeText
{-# INLINE skipTextExpecting #-}

textParser :: (Monoid err) => Parser err T.Text
textParser :: Parser err Text
textParser = Parser err Text -> Parser err Text
forall err a. Semigroup err => Parser err a -> Parser err a
lexeme (Parser err Text -> Parser err Text)
-> Parser err Text -> Parser err Text
forall a b. (a -> b) -> a -> b
$ do
  Word8 -> Parser err ()
forall err. Word8 -> Parser err ()
UP.specificWord Word8
34
  Parser err Text
forall err. Monoid err => Parser err Text
parseAfterQuote
{-# INLINE textParser #-}

sepByVoid :: Alternative f => f a1 -> f a2 -> f ()
sepByVoid :: f a1 -> f a2 -> f ()
sepByVoid f a1
elem f a2
sep = f [()] -> f ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (f [()] -> f ()) -> f [()] -> f ()
forall a b. (a -> b) -> a -> b
$ f () -> f a2 -> f [()]
forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
sepBy (f a1 -> f ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void f a1
elem) f a2
sep
{-# INLINE sepByVoid #-}

skipNumber :: (Monoid err) => Parser err ()
skipNumber :: Parser err ()
skipNumber = Parser err Scientific -> Parser err ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser err Scientific
forall err. Monoid err => Parser err Scientific
scientific
{-# INLINE skipNumber #-}

skipNumberExpecting :: JSONType -> Parser JSONError a
skipNumberExpecting :: JSONType -> Parser JSONError a
skipNumberExpecting JSONType
jt =
  Parser JSONError JSONError -> Parser JSONError a
forall err a. Parser err err -> Parser err a
UP.asFailure (Parser JSONError JSONError -> Parser JSONError a)
-> Parser JSONError JSONError -> Parser JSONError a
forall a b. (a -> b) -> a -> b
$
    Parser JSONError ()
forall err. Monoid err => Parser err ()
skipNumber Parser JSONError () -> JSONError -> Parser JSONError JSONError
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> JSONType -> JSONType -> JSONError
ErrorBadType JSONType
jt JSONType
JSONTypeNumber

skipAnything :: Monoid err => Parser err ()
skipAnything :: Parser err ()
skipAnything = do
  Word8
r <- Parser err Word8
forall err. Parser err Word8
UP.peekWord
  if
      | Word8
r Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
110 -> Parser err () -> Parser err ()
forall err a. Semigroup err => Parser err a -> Parser err a
lexeme (Parser err () -> Parser err ()) -> Parser err () -> Parser err ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Parser err ()
forall err. ByteString -> Parser err ()
UP.parseChunk ByteString
"null"
      | Word8
r Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
116 -> Parser err () -> Parser err ()
forall err a. Semigroup err => Parser err a -> Parser err a
lexeme (Parser err () -> Parser err ()) -> Parser err () -> Parser err ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Parser err ()
forall err. ByteString -> Parser err ()
UP.parseChunk ByteString
"true" -- t -> true
      | Word8
r Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
102 -> Parser err () -> Parser err ()
forall err a. Semigroup err => Parser err a -> Parser err a
lexeme (Parser err () -> Parser err ()) -> Parser err () -> Parser err ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Parser err ()
forall err. ByteString -> Parser err ()
UP.parseChunk ByteString
"false"
      | Word8
r Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
34 -> Parser err Text -> Parser err ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser err Text
forall err. Monoid err => Parser err Text
textParser -- " -> text
      | Word8
r Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
123 -> Parser err ()
forall err. Monoid err => Parser err ()
skipObject -- { -> object
      | Word8
r Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
91 -> Parser err ()
forall err. Monoid err => Parser err ()
skipArray -- [ -> array
      | Word8
r Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
45 Bool -> Bool -> Bool
|| (Word8
r Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
48 Bool -> Bool -> Bool
&& Word8
r Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
57) -> Parser err ()
forall err. Monoid err => Parser err ()
skipNumber
      | Bool
otherwise -> (Parser err (Maybe ()) -> Parser err ()
forall err a. Parser err (Maybe a) -> Parser err a
orFail (Parser err (Maybe ()) -> Parser err ())
-> Parser err (Maybe ()) -> Parser err ()
forall a b. (a -> b) -> a -> b
$ Maybe () -> Parser err (Maybe ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ()
forall a. Maybe a
Nothing)
{-# INLINE skipAnything #-}

skipArray :: (Monoid err) => Parser err ()
skipArray :: Parser err ()
skipArray = do
  Parser err ()
forall err. Semigroup err => Parser err ()
startArray
  Parser err () -> Parser err () -> Parser err ()
forall (f :: * -> *) a1 a2. Alternative f => f a1 -> f a2 -> f ()
sepByVoid Parser err ()
forall err. Monoid err => Parser err ()
skipAnything Parser err ()
forall err. Semigroup err => Parser err ()
comma
  Parser err ()
forall err. Semigroup err => Parser err ()
endArray
{-# INLINE skipArray #-}

kvSep :: Semigroup err => Parser err ()
kvSep :: Parser err ()
kvSep = Parser err () -> Parser err ()
forall err a. Semigroup err => Parser err a -> Parser err a
lexeme (Parser err () -> Parser err ()) -> Parser err () -> Parser err ()
forall a b. (a -> b) -> a -> b
$ Word8 -> Parser err ()
forall err. Word8 -> Parser err ()
UP.specificWord Word8
58

skipAnyKV :: Monoid err => Parser err ()
skipAnyKV :: Parser err ()
skipAnyKV = do
  Parser err Text
forall err. Monoid err => Parser err Text
textParser
  Parser err ()
forall err. Semigroup err => Parser err ()
kvSep
  Parser err ()
forall err. Monoid err => Parser err ()
skipAnything

comma :: Semigroup err => Parser err ()
comma :: Parser err ()
comma = Parser err () -> Parser err ()
forall err a. Semigroup err => Parser err a -> Parser err a
lexeme (Parser err () -> Parser err ()) -> Parser err () -> Parser err ()
forall a b. (a -> b) -> a -> b
$ Word8 -> Parser err ()
forall err. Word8 -> Parser err ()
UP.specificWord Word8
44

skipObject :: Monoid err => Parser err ()
skipObject :: Parser err ()
skipObject = do
  Parser err () -> Parser err ()
forall err a. Semigroup err => Parser err a -> Parser err a
lexeme (Parser err () -> Parser err ()) -> Parser err () -> Parser err ()
forall a b. (a -> b) -> a -> b
$ Word8 -> Parser err ()
forall err. Word8 -> Parser err ()
UP.specificWord Word8
123
  Parser err () -> Parser err () -> Parser err ()
forall (f :: * -> *) a1 a2. Alternative f => f a1 -> f a2 -> f ()
sepByVoid Parser err ()
forall err. Monoid err => Parser err ()
skipAnyKV Parser err ()
forall err. Semigroup err => Parser err ()
comma
  Parser err () -> Parser err ()
forall err a. Semigroup err => Parser err a -> Parser err a
lexeme (Parser err () -> Parser err ()) -> Parser err () -> Parser err ()
forall a b. (a -> b) -> a -> b
$ Word8 -> Parser err ()
forall err. Word8 -> Parser err ()
UP.specificWord Word8
125
{-# INLINE skipObject #-}

failOnError :: (Monoid err) => Either a T.Text -> Parser err T.Text
failOnError :: Either a Text -> Parser err Text
failOnError = \case
  Left a
_ -> Parser err Text
forall err a. Parser err a
failParse
  Right Text
txt -> Text -> Parser err Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
txt

parseAfterQuote :: (Monoid err) => Parser err T.Text
parseAfterQuote :: Parser err Text
parseAfterQuote = do
  Either UnicodeException Text
chunk <- (Word8 -> Bool)
-> (ByteString -> Either UnicodeException Text)
-> Parser err (Either UnicodeException Text)
forall err a.
Semigroup err =>
(Word8 -> Bool) -> (ByteString -> a) -> Parser err a
UP.takeWord8Cont (\Word8
c -> Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
92 Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
34) ByteString -> Either UnicodeException Text
decodeUtf8'
  Text
decoded <- Either UnicodeException Text -> Parser err Text
forall err a. Monoid err => Either a Text -> Parser err Text
failOnError Either UnicodeException Text
chunk
  (Parser err () -> Parser err ()
forall err a. Semigroup err => Parser err a -> Parser err a
lexeme (Word8 -> Parser err ()
forall err. Word8 -> Parser err ()
specificWord Word8
34) Parser err () -> Text -> Parser err Text
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text
decoded) Parser err Text -> Parser err Text -> Parser err Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do
    Word8 -> Parser err ()
forall err. Word8 -> Parser err ()
specificWord Word8
92
    Text
escape <- Parser err Text
forall err. Monoid err => Parser err Text
parseEscape
    Text
res <- Parser err Text
forall err. Monoid err => Parser err Text
parseAfterQuote
    Text -> Parser err Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Parser err Text) -> Text -> Parser err Text
forall a b. (a -> b) -> a -> b
$ Text
decoded Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
escape Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
res
{-# INLINE parseAfterQuote #-}

hexDigit :: Semigroup err => Parser err Word8
hexDigit :: Parser err Word8
hexDigit = do
  Word8
r <- Parser err Word8
forall err. Parser err Word8
UP.word
  Parser err (Maybe Word8) -> Parser err Word8
forall err a. Parser err (Maybe a) -> Parser err a
orFail (Parser err (Maybe Word8) -> Parser err Word8)
-> Parser err (Maybe Word8) -> Parser err Word8
forall a b. (a -> b) -> a -> b
$
    if
        | Word8
r Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
48 Bool -> Bool -> Bool
&& Word8
r Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
57 -> Maybe Word8 -> Parser err (Maybe Word8)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Word8 -> Parser err (Maybe Word8))
-> Maybe Word8 -> Parser err (Maybe Word8)
forall a b. (a -> b) -> a -> b
$ Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Word8
r Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
48)
        | Word8
r Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
97 Bool -> Bool -> Bool
&& Word8
r Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
103 -> Maybe Word8 -> Parser err (Maybe Word8)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Word8 -> Parser err (Maybe Word8))
-> Maybe Word8 -> Parser err (Maybe Word8)
forall a b. (a -> b) -> a -> b
$ Word8 -> Maybe Word8
forall a. a -> Maybe a
Just ((Word8
r Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
97) Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
10)
        | Bool
otherwise -> Maybe Word8 -> Parser err (Maybe Word8)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Word8
forall a. Maybe a
Nothing
{-# INLINE hexDigit #-}

parseEscape :: (Monoid err) => UP.Parser err T.Text
parseEscape :: Parser err Text
parseEscape =
  Parser err Text
forall b err. IsString b => Parser err b
quote
    Parser err Text -> Parser err Text -> Parser err Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser err Text
forall b err. IsString b => Parser err b
backslash
    Parser err Text -> Parser err Text -> Parser err Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser err Text
forall b err. IsString b => Parser err b
solidus
    Parser err Text -> Parser err Text -> Parser err Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser err Text
forall b err. IsString b => Parser err b
backspace
    Parser err Text -> Parser err Text -> Parser err Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser err Text
forall b err. IsString b => Parser err b
formfeed
    Parser err Text -> Parser err Text -> Parser err Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser err Text
forall b err. IsString b => Parser err b
linefeed
    Parser err Text -> Parser err Text -> Parser err Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser err Text
forall b err. IsString b => Parser err b
carriage
    Parser err Text -> Parser err Text -> Parser err Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser err Text
forall b err. IsString b => Parser err b
tab
    Parser err Text -> Parser err Text -> Parser err Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser err Text
forall err. Semigroup err => Parser err Text
unicode
  where
    quote :: Parser err b
quote = Word8 -> Parser err ()
forall err. Word8 -> Parser err ()
specificWord Word8
34 Parser err () -> b -> Parser err b
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> b
"\""
    backslash :: Parser err b
backslash = Word8 -> Parser err ()
forall err. Word8 -> Parser err ()
specificWord Word8
92 Parser err () -> b -> Parser err b
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> b
"\\"
    solidus :: Parser err b
solidus = Word8 -> Parser err ()
forall err. Word8 -> Parser err ()
specificWord Word8
47 Parser err () -> b -> Parser err b
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> b
"/"
    backspace :: Parser err b
backspace = Word8 -> Parser err ()
forall err. Word8 -> Parser err ()
specificWord Word8
98 Parser err () -> b -> Parser err b
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> b
"\b"
    formfeed :: Parser err b
formfeed = Word8 -> Parser err ()
forall err. Word8 -> Parser err ()
specificWord Word8
102 Parser err () -> b -> Parser err b
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> b
"\f"
    linefeed :: Parser err b
linefeed = Word8 -> Parser err ()
forall err. Word8 -> Parser err ()
specificWord Word8
110 Parser err () -> b -> Parser err b
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> b
"\n"
    carriage :: Parser err b
carriage = Word8 -> Parser err ()
forall err. Word8 -> Parser err ()
specificWord Word8
114 Parser err () -> b -> Parser err b
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> b
"\r"
    tab :: Parser err b
tab = Word8 -> Parser err ()
forall err. Word8 -> Parser err ()
specificWord Word8
116 Parser err () -> b -> Parser err b
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> b
"\t"
    unicode :: Parser err Text
unicode = do
      Word8 -> Parser err ()
forall err. Word8 -> Parser err ()
specificWord Word8
117
      Word8
a <- Parser err Word8
forall err. Semigroup err => Parser err Word8
hexDigit
      Word8
b <- Parser err Word8
forall err. Semigroup err => Parser err Word8
hexDigit
      Word8
c <- Parser err Word8
forall err. Semigroup err => Parser err Word8
hexDigit
      Word8
d <- Parser err Word8
forall err. Semigroup err => Parser err Word8
hexDigit
      let res :: a
res = (((Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
a a -> a -> a
forall a. Num a => a -> a -> a
* a
16) a -> a -> a
forall a. Num a => a -> a -> a
+ Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b) a -> a -> a
forall a. Num a => a -> a -> a
* a
16 a -> a -> a
forall a. Num a => a -> a -> a
+ Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c) a -> a -> a
forall a. Num a => a -> a -> a
* a
16 a -> a -> a
forall a. Num a => a -> a -> a
+ Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
d
      Text -> Parser err Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Parser err Text) -> Text -> Parser err Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack [Int -> Char
chr Int
forall a. Num a => a
res]
{-# INLINE parseEscape #-}

parseCharInText :: Char -> Parser err ()
parseCharInText (Char
c :: Char) = Char -> Parser err ()
forall err. Monoid err => Char -> Parser err ()
parseLit Char
c Parser err () -> Parser err () -> Parser err ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser err ()
forall err. Char -> Parser err ()
escaped Char
c
  where
    parseLit :: Char -> Parser err ()
parseLit = \case
      Char
'\\' -> ByteString -> Parser err ()
forall err. ByteString -> Parser err ()
UP.parseChunk ByteString
"\\\\"
      Char
'"' -> ByteString -> Parser err ()
forall err. ByteString -> Parser err ()
UP.parseChunk ByteString
"\\\""
      Char
'/' -> ByteString -> Parser err ()
forall err. ByteString -> Parser err ()
UP.parseChunk ByteString
"/" Parser err () -> Parser err () -> Parser err ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Parser err ()
forall err. ByteString -> Parser err ()
UP.parseChunk ByteString
"\\/"
      Char
'\b' -> ByteString -> Parser err ()
forall err. ByteString -> Parser err ()
UP.parseChunk ByteString
"\\b"
      Char
'\f' -> ByteString -> Parser err ()
forall err. ByteString -> Parser err ()
UP.parseChunk ByteString
"\\f"
      Char
'\n' -> ByteString -> Parser err ()
forall err. ByteString -> Parser err ()
UP.parseChunk ByteString
"\\n"
      Char
'\r' -> ByteString -> Parser err ()
forall err. ByteString -> Parser err ()
UP.parseChunk ByteString
"\\r"
      Char
'\t' -> ByteString -> Parser err ()
forall err. ByteString -> Parser err ()
UP.parseChunk ByteString
"\\t"
      Char
a -> if Char -> Bool
isControl Char
a then Parser err ()
forall (f :: * -> *) a. Alternative f => f a
empty else ByteString -> Parser err ()
forall err. ByteString -> Parser err ()
UP.parseChunk (Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Char -> Text
T.singleton Char
a)
    escaped :: Char -> Parser err ()
escaped Char
c = ByteString -> Parser err ()
forall err. ByteString -> Parser err ()
UP.parseChunk (ByteString -> Parser err ()) -> ByteString -> Parser err ()
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text
"\\u" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> Text -> Text
T.justifyRight Int
4 Char
'0' (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex (Char -> Int
ord Char
c) String
forall a. Monoid a => a
mempty)
{-# INLINE parseCharInText #-}

parseSpecificKeyInQuotes :: Monoid err => T.Text -> Parser err ()
parseSpecificKeyInQuotes :: Text -> Parser err ()
parseSpecificKeyInQuotes Text
t = Word8 -> Parser err ()
forall err. Word8 -> Parser err ()
UP.specificWord Word8
34 Parser err () -> Parser err () -> Parser err ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser err ()
forall err. Monoid err => Text -> Parser err ()
parseSpecificKeyAfterQuote Text
t
{-# INLINE parseSpecificKeyInQuotes #-}

parseSpecificKeyAfterQuote :: Monoid err => T.Text -> Parser err ()
parseSpecificKeyAfterQuote :: Text -> Parser err ()
parseSpecificKeyAfterQuote Text
key = (Parser err ()
forall err. Monoid err => Parser err ()
parseRaw Parser err () -> Parser err () -> Parser err ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser err ()
forall err. Monoid err => Parser err ()
parseChars) Parser err () -> Parser err () -> Parser err ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser err () -> Parser err ()
forall err a. Semigroup err => Parser err a -> Parser err a
lexeme (Word8 -> Parser err ()
forall err. Word8 -> Parser err ()
UP.specificWord Word8
34)
  where
    parseChars :: Parser err ()
parseChars = (Char -> Parser err () -> Parser err ())
-> Parser err () -> Text -> Parser err ()
forall a. (Char -> a -> a) -> a -> Text -> a
T.foldr (\Char
c Parser err ()
a -> Char -> Parser err ()
forall err. Monoid err => Char -> Parser err ()
parseCharInText Char
c Parser err () -> Parser err () -> Parser err ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser err ()
a) (() -> Parser err ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) Text
key
    parseRaw :: Parser err ()
parseRaw =
      if Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Maybe Int
T.findIndex Char -> Bool
invalidTextChar Text
key
        then Parser err ()
forall (f :: * -> *) a. Alternative f => f a
empty
        else ByteString -> Parser err ()
forall err. ByteString -> Parser err ()
UP.parseChunk (Text -> ByteString
encodeUtf8 Text
key)

startBracket :: Semigroup err => Parser err ()
startBracket :: Parser err ()
startBracket = Parser err () -> Parser err ()
forall err a. Semigroup err => Parser err a -> Parser err a
lexeme (Parser err () -> Parser err ()) -> Parser err () -> Parser err ()
forall a b. (a -> b) -> a -> b
$ Word8 -> Parser err ()
forall err. Word8 -> Parser err ()
UP.specificWord Word8
123

endBracket :: Semigroup err => Parser err ()
endBracket :: Parser err ()
endBracket = Parser err () -> Parser err ()
forall err a. Semigroup err => Parser err a -> Parser err a
lexeme (Parser err () -> Parser err ()) -> Parser err () -> Parser err ()
forall a b. (a -> b) -> a -> b
$ Word8 -> Parser err ()
forall err. Word8 -> Parser err ()
UP.specificWord Word8
125

startArray :: Semigroup err => Parser err ()
startArray :: Parser err ()
startArray = Parser err () -> Parser err ()
forall err a. Semigroup err => Parser err a -> Parser err a
lexeme (Parser err () -> Parser err ()) -> Parser err () -> Parser err ()
forall a b. (a -> b) -> a -> b
$ Word8 -> Parser err ()
forall err. Word8 -> Parser err ()
UP.specificWord Word8
91

endArray :: Semigroup err => Parser err ()
endArray :: Parser err ()
endArray = Parser err () -> Parser err ()
forall err a. Semigroup err => Parser err a -> Parser err a
lexeme (Parser err () -> Parser err ()) -> Parser err () -> Parser err ()
forall a b. (a -> b) -> a -> b
$ Word8 -> Parser err ()
forall err. Word8 -> Parser err ()
UP.specificWord Word8
93

parseObjectKV :: Monoid err => T.Text -> Parser err b -> Parser err b
parseObjectKV :: Text -> Parser err b -> Parser err b
parseObjectKV Text
key Parser err b
v = do
  Parser err () -> Parser err ()
forall err a. Semigroup err => Parser err a -> Parser err a
lexeme (Parser err () -> Parser err ()) -> Parser err () -> Parser err ()
forall a b. (a -> b) -> a -> b
$ Text -> Parser err ()
forall err. Monoid err => Text -> Parser err ()
parseSpecificKeyInQuotes Text
key
  Parser err () -> Parser err ()
forall err a. Semigroup err => Parser err a -> Parser err a
lexeme (Parser err () -> Parser err ()) -> Parser err () -> Parser err ()
forall a b. (a -> b) -> a -> b
$ Word8 -> Parser err ()
forall err. Word8 -> Parser err ()
UP.specificWord Word8
58
  Parser err b
v

invalidTextChar :: Char -> Bool
invalidTextChar :: Char -> Bool
invalidTextChar Char
c =
  Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"'
    Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\'
    Bool -> Bool -> Bool
|| Char -> Bool
isControl Char
c

data SP = SP !Integer {-# UNPACK #-} !Int

-- A sub-quadratic algorithm for Integer. Pairs of adjacent radix b
-- digits are combined into a single radix b^2 digit. This process is
-- repeated until we are left with a single digit. This algorithm
-- performs well only on large inputs, so we use the simple algorithm
-- for smaller inputs.
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
        -- ensure that we have an even number of digits
        -- before we call combine:
        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"
{-# INLINE valInteger #-}

-- The following algorithm is only linear for types whose Num operations
-- are in constant time.
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
{-# INLINE valSimple #-}

isDigitWord8 :: Word8 -> Bool
isDigitWord8 :: Word8 -> Bool
isDigitWord8 Word8
c = Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
48 Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
57
{-# INLINE isDigitWord8 #-}

decimal0 :: Semigroup err => Parser err Integer
decimal0 :: Parser err Integer
decimal0 = do
  let zero :: p
zero = p
48
  ByteString
digits <- (Word8 -> Bool) -> Parser err ByteString
forall err.
Semigroup err =>
(Word8 -> Bool) -> Parser err ByteString
UP.takeWord8 Word8 -> Bool
isDigitWord8
  let !length :: Int
length = ByteString -> Int
BS.length ByteString
digits
  Bool -> Parser err () -> Parser err ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
length Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) Parser err ()
forall err a. Parser err a
UP.failParse
  if Int
length Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& ByteString -> Word8
BS.unsafeHead ByteString
digits Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
forall a. Num a => a
zero
    then Parser err Integer
forall err a. Parser err a
UP.failParse
    else Integer -> Parser err Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Integer
bsToInteger ByteString
digits)
{-# INLINE decimal0 #-}

scientific :: (Monoid err) => UP.Parser err Scientific
scientific :: Parser err Scientific
scientific = Parser err Scientific -> Parser err Scientific
forall err a. Semigroup err => Parser err a -> Parser err a
lexeme (Parser err Scientific -> Parser err Scientific)
-> Parser err Scientific -> Parser err Scientific
forall a b. (a -> b) -> a -> b
$ do
  let minus :: p
minus = p
45
      plus :: p
plus = p
43
  Word8
sign <- Parser err Word8
forall err. Parser err Word8
UP.peekWord
  let !positive :: Bool
positive = Word8
sign Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
forall a. Num a => a
plus Bool -> Bool -> Bool
|| Word8
sign Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
forall a. Num a => a
minus
  Bool -> Parser err () -> Parser err ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
sign Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
forall a. Num a => a
plus Bool -> Bool -> Bool
|| Word8
sign Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
forall a. Num a => a
minus) (Parser err () -> Parser err ()) -> Parser err () -> Parser err ()
forall a b. (a -> b) -> a -> b
$
    Parser err Word8 -> Parser err ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser err Word8
forall err. Parser err Word8
UP.word
  Integer
n <- Parser err Integer
forall err. Semigroup err => Parser err 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
BS.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
BS.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 err (Maybe Word8)
forall err. Parser err (Maybe Word8)
UP.peekWordMaybe
  SP Integer
c Int
e <- case Maybe Word8
dotty of
    Just Word8
46 -> Parser err Word8
forall err. Parser err Word8
UP.word Parser err Word8 -> Parser err SP -> Parser err SP
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Word8 -> Bool) -> (ByteString -> SP) -> Parser err SP
forall err a.
Semigroup err =>
(Word8 -> Bool) -> (ByteString -> a) -> Parser err a
UP.takeWord81Cont Word8 -> Bool
isDigitWord8 ByteString -> SP
f
    Maybe Word8
_ -> SP -> Parser err 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
  ( (Word8 -> Parser err ()
forall err. Word8 -> Parser err ()
UP.specificWord Word8
101 Parser err () -> Parser err () -> Parser err ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Word8 -> Parser err ()
forall err. Word8 -> Parser err ()
UP.specificWord Word8
69)
      Parser err () -> Parser err Scientific -> Parser err Scientific
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Int -> Scientific) -> Parser err Int -> Parser err 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 err Int -> Parser err Int
forall err a. (Monoid err, Num a) => Parser err a -> Parser err a
UP.signed ((Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> Parser err (Int, Int) -> Parser err Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser err (Int, Int)
forall err i. (Monoid err, Integral i) => Parser err (Int, i)
UP.parseIntegral))
    )
    Parser err Scientific
-> Parser err Scientific -> Parser err Scientific
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Scientific -> Parser err Scientific
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Int -> Scientific
Scientific.scientific Integer
signedCoeff Int
e)
{-# INLINE scientific #-}