{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Fast imperative JSON tokenizer over strict 'ByteString'.
--
-- Complementary to the combinator path in "Circuit.Parser.Json": it trades
-- compositionality for raw speed — a single 'unsafeIndex' pass emitting
-- zero-copy slices. Structural tokens only; validation (number grammar,
-- escape legality, nesting) belongs to the layer above.
module Circuit.Parser.Json.Lexer
  ( -- * Tokens
    JsonToken (..),

    -- * Running
    runJsonLexerBS,
  )
where

import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.ByteString.Unsafe qualified as BSU
import Data.Word (Word8)

-- $setup
-- >>> import Data.ByteString.Char8 qualified as C

-- | A flat JSON structural token. 'TString' and 'TNumber' payloads are
-- zero-copy slices of the input; a 'TString' keeps its escapes intact.
data JsonToken
  = TBraceOpen
  | TBraceClose
  | TBrackOpen
  | TBrackClose
  | TComma
  | TColon
  | TString ByteString
  | TNumber ByteString
  | TTrue
  | TFalse
  | TNull
  deriving (JsonToken -> JsonToken -> Bool
(JsonToken -> JsonToken -> Bool)
-> (JsonToken -> JsonToken -> Bool) -> Eq JsonToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JsonToken -> JsonToken -> Bool
== :: JsonToken -> JsonToken -> Bool
$c/= :: JsonToken -> JsonToken -> Bool
/= :: JsonToken -> JsonToken -> Bool
Eq, Int -> JsonToken -> ShowS
[JsonToken] -> ShowS
JsonToken -> [Char]
(Int -> JsonToken -> ShowS)
-> (JsonToken -> [Char])
-> ([JsonToken] -> ShowS)
-> Show JsonToken
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JsonToken -> ShowS
showsPrec :: Int -> JsonToken -> ShowS
$cshow :: JsonToken -> [Char]
show :: JsonToken -> [Char]
$cshowList :: [JsonToken] -> ShowS
showList :: [JsonToken] -> ShowS
Show)

-- | Tokenize a strict 'ByteString'.
--
-- On failure, returns the byte offset and a message.
--
-- >>> runJsonLexerBS (C.pack "{\"a\": [1, true]}")
-- Right [TBraceOpen,TString "a",TColon,TBrackOpen,TNumber "1",TComma,TTrue,TBrackClose,TBraceClose]
--
-- >>> runJsonLexerBS (C.pack "[1")
-- Right [TBrackOpen,TNumber "1"]
--
-- >>> runJsonLexerBS (C.pack "\"ab")
-- Left (3,"unterminated string")
--
-- >>> runJsonLexerBS (C.pack "nul")
-- Left (0,"bad literal")
--
-- >>> runJsonLexerBS (C.pack "@")
-- Left (0,"unexpected byte 64")
runJsonLexerBS :: ByteString -> Either (Int, String) [JsonToken]
runJsonLexerBS :: ByteString -> Either (Int, [Char]) [JsonToken]
runJsonLexerBS ByteString
bs = Int -> Either (Int, [Char]) [JsonToken]
go Int
0
  where
    !len :: Int
len = ByteString -> Int
BS.length ByteString
bs
    go :: Int -> Either (Int, [Char]) [JsonToken]
go !Int
i
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = [JsonToken] -> Either (Int, [Char]) [JsonToken]
forall a b. b -> Either a b
Right []
      | Bool
otherwise = case ByteString -> Int -> Word8
BSU.unsafeIndex ByteString
bs Int
i of
          Word8
w
            | Word8 -> Bool
isSpaceW Word8
w -> Int -> Either (Int, [Char]) [JsonToken]
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          Word8
0x7B -> JsonToken -> Int -> Either (Int, [Char]) [JsonToken]
emit JsonToken
TBraceOpen Int
i -- {
          Word8
0x7D -> JsonToken -> Int -> Either (Int, [Char]) [JsonToken]
emit JsonToken
TBraceClose Int
i -- }
          Word8
0x5B -> JsonToken -> Int -> Either (Int, [Char]) [JsonToken]
emit JsonToken
TBrackOpen Int
i -- [
          Word8
0x5D -> JsonToken -> Int -> Either (Int, [Char]) [JsonToken]
emit JsonToken
TBrackClose Int
i -- ]
          Word8
0x2C -> JsonToken -> Int -> Either (Int, [Char]) [JsonToken]
emit JsonToken
TComma Int
i -- ,
          Word8
0x3A -> JsonToken -> Int -> Either (Int, [Char]) [JsonToken]
emit JsonToken
TColon Int
i -- :
          Word8
0x22 -> Int -> Either (Int, [Char]) [JsonToken]
stringAt (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) -- "
          Word8
0x74 -> Int -> ByteString -> JsonToken -> Either (Int, [Char]) [JsonToken]
literalAt Int
i ByteString
"rue" JsonToken
TTrue -- t
          Word8
0x66 -> Int -> ByteString -> JsonToken -> Either (Int, [Char]) [JsonToken]
literalAt Int
i ByteString
"alse" JsonToken
TFalse -- f
          Word8
0x6E -> Int -> ByteString -> JsonToken -> Either (Int, [Char]) [JsonToken]
literalAt Int
i ByteString
"ull" JsonToken
TNull -- n
          Word8
w
            | Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x2D Bool -> Bool -> Bool
|| Word8 -> Bool
isDigitW Word8
w -> Int -> Either (Int, [Char]) [JsonToken]
numberAt Int
i
            | Bool
otherwise -> (Int, [Char]) -> Either (Int, [Char]) [JsonToken]
forall a b. a -> Either a b
Left (Int
i, [Char]
"unexpected byte " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
w)
    emit :: JsonToken -> Int -> Either (Int, [Char]) [JsonToken]
emit JsonToken
t Int
i = (JsonToken
t JsonToken -> [JsonToken] -> [JsonToken]
forall a. a -> [a] -> [a]
:) ([JsonToken] -> [JsonToken])
-> Either (Int, [Char]) [JsonToken]
-> Either (Int, [Char]) [JsonToken]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Either (Int, [Char]) [JsonToken]
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    -- i points just past the opening quote
    stringAt :: Int -> Either (Int, [Char]) [JsonToken]
stringAt !Int
i = case Int -> Maybe Int
stringEnd Int
i of
      Maybe Int
Nothing -> (Int, [Char]) -> Either (Int, [Char]) [JsonToken]
forall a b. a -> Either a b
Left (Int
len, [Char]
"unterminated string")
      Just Int
j -> (ByteString -> JsonToken
TString (Int -> Int -> ByteString
slice Int
i Int
j) JsonToken -> [JsonToken] -> [JsonToken]
forall a. a -> [a] -> [a]
:) ([JsonToken] -> [JsonToken])
-> Either (Int, [Char]) [JsonToken]
-> Either (Int, [Char]) [JsonToken]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Either (Int, [Char]) [JsonToken]
go (Int
j Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    -- index of the closing quote (backslash skips the next byte), or end
    stringEnd :: Int -> Maybe Int
stringEnd !Int
i
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = Maybe Int
forall a. Maybe a
Nothing
      | Bool
otherwise = case ByteString -> Int -> Word8
BSU.unsafeIndex ByteString
bs Int
i of
          Word8
0x5C -> if Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len then Maybe Int
forall a. Maybe a
Nothing else Int -> Maybe Int
stringEnd (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
          Word8
0x22 -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
          Word8
_ -> Int -> Maybe Int
stringEnd (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    numberAt :: Int -> Either (Int, [Char]) [JsonToken]
numberAt !Int
i =
      let !j :: Int
j = Int -> Int
numberEnd Int
i
       in (ByteString -> JsonToken
TNumber (Int -> Int -> ByteString
slice Int
i Int
j) JsonToken -> [JsonToken] -> [JsonToken]
forall a. a -> [a] -> [a]
:) ([JsonToken] -> [JsonToken])
-> Either (Int, [Char]) [JsonToken]
-> Either (Int, [Char]) [JsonToken]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Either (Int, [Char]) [JsonToken]
go Int
j
    numberEnd :: Int -> Int
numberEnd !Int
i
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len = Int
i
      | Bool
otherwise =
          let w :: Word8
w = ByteString -> Int -> Word8
BSU.unsafeIndex ByteString
bs Int
i
           in if Word8 -> Bool
isDigitW Word8
w Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x2D Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x2B Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x2E Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x65 Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x45
                then Int -> Int
numberEnd (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                else Int
i
    -- i points at the literal's first byte; rest is the remaining bytes
    literalAt :: Int -> ByteString -> JsonToken -> Either (Int, [Char]) [JsonToken]
literalAt !Int
i ByteString
rest JsonToken
t
      | Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
BS.length ByteString
rest Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
len Bool -> Bool -> Bool
&& Int -> ByteString -> ByteString
BSU.unsafeTake (ByteString -> Int
BS.length ByteString
rest) (Int -> ByteString -> ByteString
BSU.unsafeDrop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ByteString
bs) ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
rest =
          (JsonToken
t JsonToken -> [JsonToken] -> [JsonToken]
forall a. a -> [a] -> [a]
:) ([JsonToken] -> [JsonToken])
-> Either (Int, [Char]) [JsonToken]
-> Either (Int, [Char]) [JsonToken]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Either (Int, [Char]) [JsonToken]
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
BS.length ByteString
rest)
      | Bool
otherwise = (Int, [Char]) -> Either (Int, [Char]) [JsonToken]
forall a b. a -> Either a b
Left (Int
i, [Char]
"bad literal")
    slice :: Int -> Int -> ByteString
slice Int
s Int
e = Int -> ByteString -> ByteString
BSU.unsafeTake (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s) (Int -> ByteString -> ByteString
BSU.unsafeDrop Int
s ByteString
bs)

isSpaceW :: Word8 -> Bool
isSpaceW :: Word8 -> Bool
isSpaceW Word8
w = Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x20 Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x0A Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x0D Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x09

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