-- | JSON for the circuits ecosystem: the aeson contact, rebuilt on
-- "Circuit.Parser" combinators — 'decodeJson' parses, 'encodeJson' renders,
-- and the two are exact tree inverses.
--
-- Recursive descent over the @Uncons ByteString Char@ stream; string and
-- number payloads are captured as zero-copy slices ('bs') and converted
-- after recognition, so UTF-8 stays bytes until 'unescape' decodes it once.
--
-- Grammar notes: object and array tails commit on @,@ — a trailing comma
-- is a parse failure, not a short list. Numbers follow the JSON grammar
-- exactly (@-?(0|[1-9][0-9]*)(\\.[0-9]+)?([eE][+-]?[0-9]+)?@), leading
-- zeros rejected.
--
-- Two paths, one tree: this module is the combinator path ('decodeJson' is
-- the boundary); "Circuit.Parser.Json.Lexer" is the fast path, a flat
-- zero-copy token stream for when composition is not the point.
module Circuit.Parser.Json
  ( -- * The tree
    Json (..),

    -- * Parsing
    value,
    jstring,
    jnumber,
    ws,

    -- * Conversion
    bsToScientific,

    -- * Boundary
    decodeJson,
    encodeJson,

    -- * Fast path
    JsonToken (..),
    runJsonLexerBS,

    -- * Pieces
    unescape,
  )
where

import Circuit.Parser
import Circuit.Parser.Json.Lexer (JsonToken (..), runJsonLexerBS)
import Circuit.Parser.Json.Unescape (unescape)
import Circuit.Parser.Json.Value (Json (..))
import Control.Monad (void)
import Data.ByteString (ByteString)
import Data.ByteString qualified as B
import Data.ByteString.Builder (Builder, byteString, stringUtf8, toLazyByteString)
import Data.ByteString.Lazy qualified as BL
import Data.Char (isDigit, ord)
import Data.Functor (($>))
import Data.Functor.Identity (Identity)
import Data.Scientific (Scientific, base10Exponent, coefficient, scientific)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding (encodeUtf8)
import Data.Vector qualified as V
import Data.Word (Word8)
import Numeric (showHex)

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Data.ByteString.Char8 qualified as C
-- >>> import Data.Vector qualified as V

-- | JSON whitespace: space, newline, carriage return, tab. Nothing else.
ws :: Parser Identity ByteString Char ()
ws :: Parser Identity ByteString Char ()
ws = (Char -> Bool) -> Parser Identity ByteString Char ()
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s ()
skipWhile (\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
'\n' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t')

-- | Parse any JSON value, leading whitespace included.
value :: Parser Identity ByteString Char Json
value :: Parser Identity ByteString Char Json
value = Parser Identity ByteString Char ()
ws Parser Identity ByteString Char ()
-> Parser Identity ByteString Char Json
-> Parser Identity ByteString Char Json
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Identity ByteString Char Json
atom
  where
    atom :: Parser Identity ByteString Char Json
atom =
      Parser Identity ByteString Char Json
jobject
        Parser Identity ByteString Char Json
-> Parser Identity ByteString Char Json
-> Parser Identity ByteString Char Json
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Identity ByteString Char Json
jarray
        Parser Identity ByteString Char Json
-> Parser Identity ByteString Char Json
-> Parser Identity ByteString Char Json
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Json
JString (Text -> Json)
-> Parser Identity ByteString Char Text
-> Parser Identity ByteString Char Json
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Identity ByteString Char Text
jstring)
        Parser Identity ByteString Char Json
-> Parser Identity ByteString Char Json
-> Parser Identity ByteString Char Json
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Char] -> Parser Identity ByteString Char [Char]
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
[s] -> Parser m f s [s]
string [Char]
"true" Parser Identity ByteString Char [Char]
-> Json -> Parser Identity ByteString Char Json
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool -> Json
JBool Bool
True)
        Parser Identity ByteString Char Json
-> Parser Identity ByteString Char Json
-> Parser Identity ByteString Char Json
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Char] -> Parser Identity ByteString Char [Char]
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
[s] -> Parser m f s [s]
string [Char]
"false" Parser Identity ByteString Char [Char]
-> Json -> Parser Identity ByteString Char Json
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool -> Json
JBool Bool
False)
        Parser Identity ByteString Char Json
-> Parser Identity ByteString Char Json
-> Parser Identity ByteString Char Json
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ([Char] -> Parser Identity ByteString Char [Char]
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
[s] -> Parser m f s [s]
string [Char]
"null" Parser Identity ByteString Char [Char]
-> Json -> Parser Identity ByteString Char Json
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Json
JNull)
        Parser Identity ByteString Char Json
-> Parser Identity ByteString Char Json
-> Parser Identity ByteString Char Json
forall a.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
-> Parser Identity ByteString Char a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Scientific -> Json
JNumber (Scientific -> Json)
-> Parser Identity ByteString Char Scientific
-> Parser Identity ByteString Char Json
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Identity ByteString Char Scientific
jnumber)

-- | Parse a JSON string literal (quotes included) to 'Text'.
--
-- Recognition is byte-level — the raw slice between the quotes is captured
-- with escapes intact and decoded once by 'unescape'.
jstring :: Parser Identity ByteString Char Text
jstring :: Parser Identity ByteString Char Text
jstring = do
  _ <- Char -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
s -> Parser m f s s
char Char
'"'
  raw <- bs (skipMany (void (char '\\' *> anyToken) <|> void (satisfy isPlain)))
  _ <- char '"'
  either (const empty) pure (unescape raw)
  where
    isPlain :: Char -> Bool
isPlain 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
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
' '

-- | Parse a JSON number to 'Scientific'.
jnumber :: Parser Identity ByteString Char Scientific
jnumber :: Parser Identity ByteString Char Scientific
jnumber = ByteString -> Scientific
bsToScientific (ByteString -> Scientific)
-> Parser Identity ByteString Char ByteString
-> Parser Identity ByteString Char Scientific
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Identity ByteString Char ()
-> Parser Identity ByteString Char ByteString
forall (m :: * -> *) a.
Monad m =>
Parser m ByteString Char a -> Parser m ByteString Char ByteString
bs Parser Identity ByteString Char ()
numberRecog
  where
    numberRecog :: Parser Identity ByteString Char ()
numberRecog = do
      _ <- Parser Identity ByteString Char Char
-> Parser Identity ByteString Char (Maybe Char)
forall (m :: * -> *) f s a.
(Monad m, Uncons f s) =>
Parser m f s a -> Parser m f s (Maybe a)
optional (Char -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
s -> Parser m f s s
char Char
'-')
      _ <- void (char '0') <|> (satisfy (\Char
c -> Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'1' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9') *> skipWhile isDigit)
      _ <- optional (char '.' *> digits1)
      _ <- optional (void (char 'e' <|> char 'E') *> optional (void (char '+' <|> char '-')) *> digits1)
      pure ()
    digits1 :: Parser Identity ByteString Char ()
digits1 = (Char -> Bool) -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s s
satisfy Char -> Bool
isDigit Parser Identity ByteString Char Char
-> Parser Identity ByteString Char ()
-> Parser Identity ByteString Char ()
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Identity ByteString Char ()
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s ()
skipWhile Char -> Bool
isDigit

-- | Convert a recognised JSON number slice to 'Scientific'.
--
-- The slice is trusted to match the JSON number grammar (this is what
-- 'jnumber' recognises); anything else is garbage in, garbage out.
--
-- >>> bsToScientific (C.pack "123")
-- 123.0
--
-- >>> bsToScientific (C.pack "-0.5")
-- -0.5
--
-- >>> bsToScientific (C.pack "1e-3")
-- 1.0e-3
bsToScientific :: ByteString -> Scientific
bsToScientific :: ByteString -> Scientific
bsToScientific ByteString
s0 = Integer -> Int -> Scientific
scientific Integer
signedCoef (Int
expN Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
fracD)
  where
    (Bool
neg, ByteString
s1) = case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
s0 of
      Just (Word8
45, ByteString
r) -> (Bool
True, ByteString
r) -- '-'
      Maybe (Word8, ByteString)
_ -> (Bool
False, ByteString
s0)
    (ByteString
intD, ByteString
s2) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.span Word8 -> Bool
isDigitW ByteString
s1
    (ByteString
fracD, ByteString
s3) = case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
s2 of
      Just (Word8
46, ByteString
r) -> (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.span Word8 -> Bool
isDigitW ByteString
r -- '.'
      Maybe (Word8, ByteString)
_ -> (ByteString
B.empty, ByteString
s2)
    expN :: Int
expN = case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
s3 of
      Just (Word8
_, ByteString
r) -> ByteString -> Int
signedInt ByteString
r -- 'e' or 'E', then [+-]?digits
      Maybe (Word8, ByteString)
Nothing -> Int
0
    coef :: Integer
coef = ByteString -> Integer
digitsToInteger ByteString
intD Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ ByteString -> Int
B.length ByteString
fracD Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ ByteString -> Integer
digitsToInteger ByteString
fracD
    signedCoef :: Integer
signedCoef = if Bool
neg then Integer -> Integer
forall a. Num a => a -> a
negate Integer
coef else Integer
coef

-- | Parse a JSON document: a value, optional trailing whitespace, and
-- nothing else.
--
-- Failure is a flat @Left@ — the combinator runner backtracks to the
-- original stream, so there is no honest offset to report. For offsets,
-- tokenize first with "Circuit.Parser.Json.Lexer".
--
-- >>> decodeJson (C.pack "{\"a\": [1, true, null]}")
-- Right (JObject [("a",JArray [JNumber 1.0,JBool True,JNull])])
--
-- >>> decodeJson (C.pack "  \"a\\nb\"  ")
-- Right (JString "a\nb")
--
-- >>> decodeJson (C.pack "[1,]")
-- Left "invalid JSON"
--
-- >>> decodeJson (C.pack "01")
-- Left "invalid JSON"
decodeJson :: ByteString -> Either String Json
decodeJson :: ByteString -> Either [Char] Json
decodeJson ByteString
s = case Parser Identity ByteString Char Json
-> ByteString -> These Json ByteString
forall {k} f (s :: k) a. Parser Identity f s a -> f -> These a f
runParserIdentity (Parser Identity ByteString Char Json
value Parser Identity ByteString Char Json
-> Parser Identity ByteString Char ()
-> Parser Identity ByteString Char Json
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Identity ByteString Char ()
ws Parser Identity ByteString Char Json
-> Parser Identity ByteString Char ()
-> Parser Identity ByteString Char Json
forall a b.
Parser Identity ByteString Char a
-> Parser Identity ByteString Char b
-> Parser Identity ByteString Char a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Identity ByteString Char ()
forall (m :: * -> *) f s. (Monad m, Uncons f s) => Parser m f s ()
endOfInput) ByteString
s of
  This Json
j -> Json -> Either [Char] Json
forall a b. b -> Either a b
Right Json
j
  These Json
j ByteString
_ -> Json -> Either [Char] Json
forall a b. b -> Either a b
Right Json
j
  That ByteString
_ -> [Char] -> Either [Char] Json
forall a b. a -> Either a b
Left [Char]
"invalid JSON"

-- | Render a JSON document, compact (no insignificant whitespace).
--
-- The other half of the boundary: 'decodeJson' and 'encodeJson' are exact
-- tree inverses —
--
-- > decodeJson (encodeJson j) == Right j
--
-- >>> decodeJson (encodeJson (JObject [("a", JArray (V.fromList [JNumber 1, JBool True, JNull]))]))
-- Right (JObject [("a",JArray [JNumber 1.0,JBool True,JNull])])
--
-- >>> decodeJson (encodeJson (JString "a\nb"))
-- Right (JString "a\nb")
--
-- >>> decodeJson (encodeJson (JObject []))
-- Right (JObject [])
--
-- Numbers render in a form the parser reads back to the /same/
-- 'Scientific' (its equality is structural): zero exponent renders the
-- bare coefficient (@10@), a positive exponent renders coefficient and
-- exponent (@1e1@, not @10@), and a negative exponent renders the decimal
-- point positionally, keeping every fractional digit (@1.50@, @0.0015@).
-- Object pairs render in tree order; duplicate keys are preserved, as
-- they are in the tree.
--
-- >>> encodeJson (JObject [("a", JArray (V.fromList [JNumber 1, JBool True, JNull]))])
-- "{\"a\":[1,true,null]}"
--
-- >>> encodeJson (JString "a\nb")
-- "\"a\\nb\""
encodeJson :: Json -> ByteString
encodeJson :: Json -> ByteString
encodeJson = LazyByteString -> ByteString
BL.toStrict (LazyByteString -> ByteString)
-> (Json -> LazyByteString) -> Json -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyByteString
toLazyByteString (Builder -> LazyByteString)
-> (Json -> Builder) -> Json -> LazyByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Json -> Builder
go
  where
    go :: Json -> Builder
go Json
JNull = [Char] -> Builder
stringUtf8 [Char]
"null"
    go (JBool Bool
b) = [Char] -> Builder
stringUtf8 (if Bool
b then [Char]
"true" else [Char]
"false")
    go (JNumber Scientific
n) = Scientific -> Builder
scientificJson Scientific
n
    go (JString Text
t) = Text -> Builder
textJson Text
t
    go (JArray Vector Json
xs) = Char -> Char -> [Builder] -> Builder
comma Char
'[' Char
']' (Json -> Builder
go (Json -> Builder) -> [Json] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector Json -> [Json]
forall a. Vector a -> [a]
V.toList Vector Json
xs)
    go (JObject [(Text, Json)]
ps) = Char -> Char -> [Builder] -> Builder
comma Char
'{' Char
'}' ((Text, Json) -> Builder
pair ((Text, Json) -> Builder) -> [(Text, Json)] -> [Builder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Json)]
ps)
    pair :: (Text, Json) -> Builder
pair (Text
k, Json
v) = Text -> Builder
textJson Text
k Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
stringUtf8 [Char]
":" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Json -> Builder
go Json
v
    comma :: Char -> Char -> [Builder] -> Builder
comma Char
open Char
close [Builder]
xs =
      [Char] -> Builder
stringUtf8 [Char
open] Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Builder -> [Builder] -> [Builder]
forall {t}. t -> [t] -> [t]
intersperseB ([Char] -> Builder
stringUtf8 [Char]
",") [Builder]
xs) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
stringUtf8 [Char
close]
    intersperseB :: t -> [t] -> [t]
intersperseB t
_ [] = []
    intersperseB t
_ [t
x] = [t
x]
    intersperseB t
s (t
x : [t]
xs) = t
x t -> [t] -> [t]
forall {t}. t -> [t] -> [t]
: t
s t -> [t] -> [t]
forall {t}. t -> [t] -> [t]
: t -> [t] -> [t]
intersperseB t
s [t]
xs

-- | A JSON string literal: quotes, @\"@, @\\@ and control characters
-- escaped (short forms where the grammar has them, @\\u00XX@ otherwise);
-- everything else raw UTF-8.
textJson :: Text -> Builder
textJson :: Text -> Builder
textJson Text
t = [Char] -> Builder
stringUtf8 [Char]
"\"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString (Text -> ByteString
encodeUtf8 ((Char -> Text) -> Text -> Text
T.concatMap Char -> Text
esc Text
t)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Char] -> Builder
stringUtf8 [Char]
"\""
  where
    esc :: Char -> Text
esc Char
c = [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ case Char
c of
      Char
'"' -> [Char]
"\\\""
      Char
'\\' -> [Char]
"\\\\"
      Char
'\b' -> [Char]
"\\b"
      Char
'\f' -> [Char]
"\\f"
      Char
'\n' -> [Char]
"\\n"
      Char
'\r' -> [Char]
"\\r"
      Char
'\t' -> [Char]
"\\t"
      Char
_
        | Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x20 -> [Char]
"\\u" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char] -> [Char]
pad (Int -> [Char] -> [Char]
forall a. Integral a => a -> [Char] -> [Char]
showHex (Char -> Int
ord Char
c) [Char]
"")
        | Bool
otherwise -> [Char
c]
    pad :: [Char] -> [Char]
pad [Char]
h = Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
h) Char
'0' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
h

-- | A JSON number, rendered to invert 'jnumber' structurally (see
-- 'encodeJson').
scientificJson :: Scientific -> Builder
scientificJson :: Scientific -> Builder
scientificJson Scientific
n = [Char] -> Builder
stringUtf8 [Char]
rendered
  where
    c :: Integer
c = Scientific -> Integer
coefficient Scientific
n
    e :: Int
e = Scientific -> Int
base10Exponent Scientific
n
    rendered :: [Char]
rendered
      | Int
e Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
c
      | Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
c [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"e" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
e
      | Bool
otherwise = [Char]
sign [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
digitsWithPoint
    sign :: [Char]
sign = if Integer
c Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 then [Char]
"-" else [Char]
""
    ds :: [Char]
ds = Integer -> [Char]
forall a. Show a => a -> [Char]
show (Integer -> Integer
forall a. Num a => a -> a
abs Integer
c)
    p :: Int
p = [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
ds Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
e -- digits before the point
    digitsWithPoint :: [Char]
digitsWithPoint
      | Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
p [Char]
ds [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
"." [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
p [Char]
ds
      | Bool
otherwise = [Char]
"0." [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate (Int -> Int
forall a. Num a => a -> a
negate Int
p) Char
'0' [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
ds

-- * internals

jobject :: Parser Identity ByteString Char Json
jobject :: Parser Identity ByteString Char Json
jobject = do
  _ <- Char -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
s -> Parser m f s s
char Char
'{'
  _ <- ws
  (char '}' $> JObject []) <|> obj
  where
    obj :: Parser Identity ByteString Char Json
obj = do
      p <- Parser Identity ByteString Char (Text, Json)
pair
      _ <- ws
      JObject <$> tail' [p]
    pair :: Parser Identity ByteString Char (Text, Json)
pair = do
      k <- Parser Identity ByteString Char Text
jstring
      _ <- ws
      _ <- char ':'
      v <- value
      pure (k, v)
    tail' :: [(Text, Json)] -> Parser Identity ByteString Char [(Text, Json)]
tail' [(Text, Json)]
acc = do
      c <- (Char -> Bool) -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s s
satisfy (\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
'}')
      case c of
        Char
',' -> do
          _ <- Parser Identity ByteString Char ()
ws
          p <- pair
          _ <- ws
          tail' (p : acc)
        Char
_ -> [(Text, Json)] -> Parser Identity ByteString Char [(Text, Json)]
forall a. a -> Parser Identity ByteString Char a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Text, Json)] -> [(Text, Json)]
forall a. [a] -> [a]
reverse [(Text, Json)]
acc)

jarray :: Parser Identity ByteString Char Json
jarray :: Parser Identity ByteString Char Json
jarray = do
  _ <- Char -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s, Eq s) =>
s -> Parser m f s s
char Char
'['
  _ <- ws
  (char ']' $> JArray V.empty) <|> arr
  where
    arr :: Parser Identity ByteString Char Json
arr = do
      x <- Parser Identity ByteString Char Json
value
      _ <- ws
      JArray . V.fromList <$> tail' [x]
    tail' :: [Json] -> Parser Identity ByteString Char [Json]
tail' [Json]
acc = do
      c <- (Char -> Bool) -> Parser Identity ByteString Char Char
forall (m :: * -> *) f s.
(Monad m, Uncons f s) =>
(s -> Bool) -> Parser m f s s
satisfy (\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
']')
      case c of
        Char
',' -> do
          x <- Parser Identity ByteString Char Json
value
          _ <- ws
          tail' (x : acc)
        Char
_ -> [Json] -> Parser Identity ByteString Char [Json]
forall a. a -> Parser Identity ByteString Char a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Json] -> [Json]
forall a. [a] -> [a]
reverse [Json]
acc)

isDigitW :: Word8 -> Bool
isDigitW :: Word8 -> Bool
isDigitW Word8
w = Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0x30 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0x39

digitsToInteger :: ByteString -> Integer
digitsToInteger :: ByteString -> Integer
digitsToInteger = (Integer -> Word8 -> Integer) -> Integer -> ByteString -> Integer
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl' (\Integer
acc Word8
w -> Integer
acc Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 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
0x30)) Integer
0

-- | @[+-]?digits@ to Int. Trusted input.
signedInt :: ByteString -> Int
signedInt :: ByteString -> Int
signedInt ByteString
s = case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
s of
  Just (Word8
43, ByteString
r) -> ByteString -> Int
digitsToInt ByteString
r -- '+'
  Just (Word8
45, ByteString
r) -> Int -> Int
forall a. Num a => a -> a
negate (ByteString -> Int
digitsToInt ByteString
r) -- '-'
  Maybe (Word8, ByteString)
_ -> ByteString -> Int
digitsToInt ByteString
s
  where
    digitsToInt :: ByteString -> Int
digitsToInt = (Int -> Word8 -> Int) -> Int -> ByteString -> Int
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl' (\Int
acc Word8
w -> Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
0x30)) Int
0