-- SPDX-FileCopyrightText: 2026 Alexandra de Wit
--
-- SPDX-License-Identifier: MIT
{-# LANGUAGE TypeFamilies #-}

{- | Retained-value shapes for the token walk, and the reader that builds each value once. A shape
reads what the matching "Ecluse.Core.Registry.JsonStream" combinator reads, and interns keys and
strings by the bytes the lexer read unless its mode keeps them as read. A 'Build' says what the
reader builds: aeson's tree, or the packed form a full read writes.
-}
module Ecluse.Core.Registry.Json.Shape (
    Shape (..),
    Members,
    namedMembers,
    everyMember,
    knownMembers,
    Mode (..),
    MemberKey (..),
    Build (..),
    Trees (..),
    readShape,
) where

import Data.Aeson (Value (..))
import Data.Aeson.Key qualified as Key
import Data.Aeson.KeyMap qualified as KeyMap
import Data.HashMap.Strict qualified as HashMap
import Data.JsonStream.CLexer (unescapeText)
import Data.JsonStream.TokenParser (Element (..), TokenResult (..))
import Data.Vector qualified as V

import Ecluse.Core.Registry.Json.Intern (Entry, InternTable, Interned (..), Name (Plain), decodedName, entryKeeps, entryString, entryText, internName, nameBytes, nameText)
import Ecluse.Core.Registry.Json.Walk (Walk (..), isString, memberName, nestingLimit, readString, skipFrom, tooDeep, withElement)

{- | What to retain of one value. Each budget is the structural depth left, and a value read with
none left is skipped and fails the read.
-}
data Shape
    = -- | A scalar as read, or an empty array for a container.
      Scalar !Int
    | -- | The whole value.
      Generic !Int
    | -- | An object's members, or the fallback shape for any other value.
      ObjectWith !Int Members Shape
    | -- | An array's items, or the fallback shape for any other value.
      ArrayWith !Int Shape Shape
    | -- | A string, or the other shape for any other value.
      StringOr !Int Shape
    | -- | An object's members, or the given value for any other value.
      ObjectOr Value Members
    | -- | The shape, charged against a budget of its own.
      Checked !Int Shape

-- | Which members of an object are retained, and with what shape.
data Members = Members (HashMap.HashMap ByteString (Key.Key, Shape)) (Maybe Shape)

-- | Retain only the named members. The first entry for a name wins.
namedMembers :: [(Text, Shape)] -> Members
namedMembers :: [(Text, Shape)] -> Members
namedMembers [(Text, Shape)]
entries = HashMap ByteString (Key, Shape) -> Maybe Shape -> Members
Members (((Key, Shape) -> (Key, Shape) -> (Key, Shape))
-> [(ByteString, (Key, Shape))] -> HashMap ByteString (Key, Shape)
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
HashMap.fromListWith (\(Key, Shape)
_ (Key, Shape)
earlier -> (Key, Shape)
earlier) [(Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
name, (Text -> Key
Key.fromText Text
name, Shape
shape)) | (Text
name, Shape
shape) <- [(Text, Shape)]
entries]) Maybe Shape
forall a. Maybe a
Nothing

-- | Retain every member with one shape.
everyMember :: Shape -> Members
everyMember :: Shape -> Members
everyMember = HashMap ByteString (Key, Shape) -> Maybe Shape -> Members
Members HashMap ByteString (Key, Shape)
forall a. Monoid a => a
mempty (Maybe Shape -> Members)
-> (Shape -> Maybe Shape) -> Shape -> Members
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Shape -> Maybe Shape
forall a. a -> Maybe a
Just

-- | Retain every member with one shape, sharing the key of each listed name.
knownMembers :: [Text] -> Shape -> Members
knownMembers :: [Text] -> Shape -> Members
knownMembers [Text]
names Shape
shape = HashMap ByteString (Key, Shape) -> Maybe Shape -> Members
Members ([(ByteString, (Key, Shape))] -> HashMap ByteString (Key, Shape)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList [(Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
name, (Text -> Key
Key.fromText Text
name, Shape
shape)) | Text
name <- [Text]
names]) (Shape -> Maybe Shape
forall a. a -> Maybe a
Just Shape
shape)

-- | Whether a value's keys and strings go through the document's table or keep their own copies.
data Mode = Share | Keep

-- | A member's key: the table's entry, or a key with its own copy.
data MemberKey = SharedKey !Entry | OwnKey !Key.Key

-- The key's text.
memberText :: MemberKey -> Text
memberText :: MemberKey -> Text
memberText = \case
    SharedKey Entry
entry -> Entry -> Text
entryText Entry
entry
    OwnKey Key
key -> Key -> Text
Key.toText Key
key
{-# INLINE memberText #-}

{- | What a read builds, one value at a time, each step handing its result to a continuation. An
object's members arrive in source order, and a repeated key's value is read and then dropped.
-}
class (Walk r) => Build b r where
    -- | A finished value.
    type Built b

    -- | An object being read.
    type Fields b

    -- | An array being read.
    type Items b

    -- | A string the document's table shares.
    sharedString :: b -> Entry -> (Built b -> r) -> r

    -- | A string with a copy of its own.
    ownString :: b -> Name -> (Built b -> r) -> r

    -- | An integer the lexer read whole.
    integer :: b -> Int -> (Built b -> r) -> r

    -- | A number, boolean, null or fallback value, taken whole.
    whole :: b -> Value -> (Built b -> r) -> r

    -- | The empty array a scalar shape keeps for a container it skips.
    emptyContainer :: b -> (Built b -> r) -> r

    -- | An object begins.
    openObject :: b -> (Fields b -> r) -> r

    -- | A member under the key begins, and whether the object already holds the key.
    beginMember :: b -> MemberKey -> Fields b -> (Bool -> r) -> r

    -- | The member begun last ends with its value.
    addMember :: b -> MemberKey -> Built b -> Fields b -> (Fields b -> r) -> r

    -- | Forget the member begun last, whose key the object already holds.
    dropValue :: b -> Built b -> r -> r

    -- | Finish an object.
    closeObject :: b -> Fields b -> (Built b -> r) -> r

    -- | An array begins.
    openArray :: b -> (Items b -> r) -> r

    -- | An item of the array ends.
    addItem :: b -> Built b -> Items b -> (Items b -> r) -> r

    -- | Finish an array of the given item count.
    closeArray :: b -> Int -> Items b -> (Built b -> r) -> r

-- | Build aeson's tree.
data Trees = Trees

instance (Walk r) => Build Trees r where
    type Built Trees = Value
    type Fields Trees = KeyMap.KeyMap Value
    type Items Trees = [Value]
    sharedString :: Trees -> Entry -> (Built Trees -> r) -> r
sharedString Trees
_ Entry
entry Built Trees -> r
next = Built Trees -> r
next (Entry -> Value
entryString Entry
entry)
    ownString :: Trees -> Name -> (Built Trees -> r) -> r
ownString Trees
_ Name
name Built Trees -> r
next = Built Trees -> r
next (Text -> Value
String (Name -> Text
nameText Name
name))
    integer :: Trees -> Int -> (Built Trees -> r) -> r
integer Trees
_ Int
number Built Trees -> r
next = let !value :: Value
value = Scientific -> Value
Number (Int -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
number) in Built Trees -> r
next Value
Built Trees
value
    whole :: Trees -> Value -> (Built Trees -> r) -> r
whole Trees
_ Value
value Built Trees -> r
next = Built Trees -> r
next Value
Built Trees
value
    emptyContainer :: Trees -> (Built Trees -> r) -> r
emptyContainer Trees
_ Built Trees -> r
next = Built Trees -> r
next Value
Built Trees
emptyArray
    openObject :: Trees -> (Fields Trees -> r) -> r
openObject Trees
_ Fields Trees -> r
next = Fields Trees -> r
next KeyMap Value
Fields Trees
forall v. KeyMap v
KeyMap.empty
    beginMember :: Trees -> MemberKey -> Fields Trees -> (Bool -> r) -> r
beginMember Trees
_ MemberKey
key Fields Trees
fields Bool -> r
next = Bool -> r
next (Key -> KeyMap Value -> Bool
forall a. Key -> KeyMap a -> Bool
KeyMap.member (Text -> Key
Key.fromText (MemberKey -> Text
memberText MemberKey
key)) KeyMap Value
Fields Trees
fields)
    addMember :: Trees
-> MemberKey
-> Built Trees
-> Fields Trees
-> (Fields Trees -> r)
-> r
addMember Trees
_ MemberKey
key Built Trees
value Fields Trees
fields Fields Trees -> r
next = Fields Trees -> r
next (Key -> Value -> KeyMap Value -> KeyMap Value
forall v. Key -> v -> KeyMap v -> KeyMap v
KeyMap.insert (Text -> Key
Key.fromText (MemberKey -> Text
memberText MemberKey
key)) Value
Built Trees
value KeyMap Value
Fields Trees
fields)
    dropValue :: Trees -> Built Trees -> r -> r
dropValue Trees
_ Built Trees
_ r
next = r
next
    closeObject :: Trees -> Fields Trees -> (Built Trees -> r) -> r
closeObject Trees
_ Fields Trees
fields Built Trees -> r
next = Built Trees -> r
next (KeyMap Value -> Value
Object KeyMap Value
Fields Trees
fields)
    openArray :: Trees -> (Items Trees -> r) -> r
openArray Trees
_ Items Trees -> r
next = Items Trees -> r
next []
    addItem :: Trees -> Built Trees -> Items Trees -> (Items Trees -> r) -> r
addItem Trees
_ Built Trees
value Items Trees
values Items Trees -> r
next = Items Trees -> r
next (Value
Built Trees
value Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
Items Trees
values)
    closeArray :: Trees -> Int -> Items Trees -> (Built Trees -> r) -> r
closeArray Trees
_ Int
count Items Trees
values Built Trees -> r
next = let !array :: Value
array = Array -> Value
Array (Int -> [Value] -> Array
forall a. Int -> [a] -> Vector a
V.fromListN Int
count ([Value] -> [Value]
forall a. [a] -> [a]
reverse [Value]
Items Trees
values)) in Built Trees -> r
next Value
Built Trees
array
    {-# INLINE sharedString #-}
    {-# INLINE ownString #-}
    {-# INLINE integer #-}
    {-# INLINE whole #-}
    {-# INLINE emptyContainer #-}
    {-# INLINE openObject #-}
    {-# INLINE beginMember #-}
    {-# INLINE addMember #-}
    {-# INLINE dropValue #-}
    {-# INLINE closeObject #-}
    {-# INLINE openArray #-}
    {-# INLINE addItem #-}
    {-# INLINE closeArray #-}

-- | Read the value starting at the element and build it once.
readShape :: (Build b r) => b -> Shape -> Mode -> InternTable -> Element -> TokenResult -> (Built b -> InternTable -> TokenResult -> r) -> r
readShape :: forall b r.
Build b r =>
b
-> Shape
-> Mode
-> InternTable
-> Element
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> r
readShape b
build = b
-> Int
-> Bool
-> Shape
-> Mode
-> InternTable
-> Element
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> r
forall b r.
Build b r =>
b
-> Int
-> Bool
-> Shape
-> Mode
-> InternTable
-> Element
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> r
readAt b
build Int
0 Bool
False
{-# INLINEABLE readShape #-}

-- json-stream races a skip of a container an alternative rejects, whose lexer failure beats a nesting
-- failure. open counts levels inside the outermost raced container, and raced marks a raced value.
readAt :: (Build b r) => b -> Int -> Bool -> Shape -> Mode -> InternTable -> Element -> TokenResult -> (Built b -> InternTable -> TokenResult -> r) -> r
readAt :: forall b r.
Build b r =>
b
-> Int
-> Bool
-> Shape
-> Mode
-> InternTable
-> Element
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> r
readAt b
build Int
open Bool
raced Shape
shape Mode
mode InternTable
table Element
element TokenResult
rest Built b -> InternTable -> TokenResult -> r
next = case Shape
shape of
    Scalar Int
budget
        | Int
budget Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 -> Int -> Element -> TokenResult -> r
forall r. Walk r => Int -> Element -> TokenResult -> r
tooDeepAt Int
open Element
element TokenResult
rest
        | Bool
otherwise -> b
-> Mode
-> InternTable
-> Element
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> (TokenResult -> r)
-> r
forall b r.
Build b r =>
b
-> Mode
-> InternTable
-> Element
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> (TokenResult -> r)
-> r
readScalar b
build Mode
mode InternTable
table Element
element TokenResult
rest Built b -> InternTable -> TokenResult -> r
next (\TokenResult
after -> b -> (Built b -> r) -> r
forall b r. Build b r => b -> (Built b -> r) -> r
emptyContainer b
build (\Built b
value -> Built b -> InternTable -> TokenResult -> r
next Built b
value InternTable
table TokenResult
after))
    Generic Int
budget
        | Int
budget Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 -> Int -> Element -> TokenResult -> r
forall r. Walk r => Int -> Element -> TokenResult -> r
tooDeepAt Int
open Element
element TokenResult
rest
        | Bool
otherwise -> case Element
element of
            Element
ObjectBegin -> b
-> Int
-> Members
-> Mode
-> InternTable
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> r
forall b r.
Build b r =>
b
-> Int
-> Members
-> Mode
-> InternTable
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> r
readObject b
build (Bool -> Int
entering Bool
raced) (Shape -> Members
everyMember (Int -> Shape
Generic (Int
budget Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))) Mode
mode InternTable
table TokenResult
rest Built b -> InternTable -> TokenResult -> r
next
            Element
ArrayBegin -> b
-> Int
-> Shape
-> Mode
-> InternTable
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> r
forall b r.
Build b r =>
b
-> Int
-> Shape
-> Mode
-> InternTable
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> r
readArray b
build (Bool -> Int
entering Bool
True) (Int -> Shape
Generic (Int
budget Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Mode
mode InternTable
table TokenResult
rest Built b -> InternTable -> TokenResult -> r
next
            Element
_ -> b
-> Mode
-> InternTable
-> Element
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> (TokenResult -> r)
-> r
forall b r.
Build b r =>
b
-> Mode
-> InternTable
-> Element
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> (TokenResult -> r)
-> r
readScalar b
build Mode
mode InternTable
table Element
element TokenResult
rest Built b -> InternTable -> TokenResult -> r
next (\TokenResult
_ -> Text -> r
forall r. Walk r => Text -> r
failWith Text
"unexpected container")
    ObjectWith Int
budget Members
members Shape
fallback
        | Int
budget Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 -> Int -> Element -> TokenResult -> r
forall r. Walk r => Int -> Element -> TokenResult -> r
tooDeepAt Int
open Element
element TokenResult
rest
        | Element
ObjectBegin <- Element
element -> b
-> Int
-> Members
-> Mode
-> InternTable
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> r
forall b r.
Build b r =>
b
-> Int
-> Members
-> Mode
-> InternTable
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> r
readObject b
build (Bool -> Int
entering Bool
raced) Members
members Mode
mode InternTable
table TokenResult
rest Built b -> InternTable -> TokenResult -> r
next
        | Bool
otherwise -> b
-> Int
-> Bool
-> Shape
-> Mode
-> InternTable
-> Element
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> r
forall b r.
Build b r =>
b
-> Int
-> Bool
-> Shape
-> Mode
-> InternTable
-> Element
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> r
readAt b
build Int
open Bool
True Shape
fallback Mode
mode InternTable
table Element
element TokenResult
rest Built b -> InternTable -> TokenResult -> r
next
    ArrayWith Int
budget Shape
item Shape
fallback
        | Int
budget Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 -> Int -> Element -> TokenResult -> r
forall r. Walk r => Int -> Element -> TokenResult -> r
tooDeepAt Int
open Element
element TokenResult
rest
        | Element
ArrayBegin <- Element
element -> b
-> Int
-> Shape
-> Mode
-> InternTable
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> r
forall b r.
Build b r =>
b
-> Int
-> Shape
-> Mode
-> InternTable
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> r
readArray b
build (Bool -> Int
entering Bool
raced) Shape
item Mode
mode InternTable
table TokenResult
rest Built b -> InternTable -> TokenResult -> r
next
        | Bool
otherwise -> b
-> Int
-> Bool
-> Shape
-> Mode
-> InternTable
-> Element
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> r
forall b r.
Build b r =>
b
-> Int
-> Bool
-> Shape
-> Mode
-> InternTable
-> Element
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> r
readAt b
build Int
open Bool
True Shape
fallback Mode
mode InternTable
table Element
element TokenResult
rest Built b -> InternTable -> TokenResult -> r
next
    StringOr Int
budget Shape
other
        | Int
budget Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 -> Int -> Element -> TokenResult -> r
forall r. Walk r => Int -> Element -> TokenResult -> r
tooDeepAt Int
open Element
element TokenResult
rest
        | Element -> Bool
isString Element
element -> Element -> TokenResult -> (Name -> TokenResult -> r) -> r
forall r.
Walk r =>
Element -> TokenResult -> (Name -> TokenResult -> r) -> r
readString Element
element TokenResult
rest (b
-> Mode
-> InternTable
-> (Built b -> InternTable -> TokenResult -> r)
-> Name
-> TokenResult
-> r
forall b r.
Build b r =>
b
-> Mode
-> InternTable
-> (Built b -> InternTable -> TokenResult -> r)
-> Name
-> TokenResult
-> r
string b
build Mode
mode InternTable
table Built b -> InternTable -> TokenResult -> r
next)
        | Bool
otherwise -> b
-> Int
-> Bool
-> Shape
-> Mode
-> InternTable
-> Element
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> r
forall b r.
Build b r =>
b
-> Int
-> Bool
-> Shape
-> Mode
-> InternTable
-> Element
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> r
readAt b
build Int
open Bool
True Shape
other Mode
mode InternTable
table Element
element TokenResult
rest Built b -> InternTable -> TokenResult -> r
next
    ObjectOr Value
fallback Members
members
        | Element
ObjectBegin <- Element
element -> b
-> Int
-> Members
-> Mode
-> InternTable
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> r
forall b r.
Build b r =>
b
-> Int
-> Members
-> Mode
-> InternTable
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> r
readObject b
build (Bool -> Int
entering Bool
raced) Members
members Mode
mode InternTable
table TokenResult
rest Built b -> InternTable -> TokenResult -> r
next
        | Bool
otherwise -> Element -> TokenResult -> (TokenResult -> r) -> r
forall r.
Walk r =>
Element -> TokenResult -> (TokenResult -> r) -> r
skipFrom Element
element TokenResult
rest (\TokenResult
after -> b -> Value -> (Built b -> r) -> r
forall b r. Build b r => b -> Value -> (Built b -> r) -> r
whole b
build Value
fallback (\Built b
value -> Built b -> InternTable -> TokenResult -> r
next Built b
value InternTable
table TokenResult
after))
    Checked Int
budget Shape
inner
        | Int
budget Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 -> Int -> Element -> TokenResult -> r
forall r. Walk r => Int -> Element -> TokenResult -> r
tooDeepAt Int
open Element
element TokenResult
rest
        | Bool
otherwise -> b
-> Int
-> Bool
-> Shape
-> Mode
-> InternTable
-> Element
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> r
forall b r.
Build b r =>
b
-> Int
-> Bool
-> Shape
-> Mode
-> InternTable
-> Element
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> r
readAt b
build Int
open Bool
raced Shape
inner Mode
mode InternTable
table Element
element TokenResult
rest Built b -> InternTable -> TokenResult -> r
next
  where
    entering :: Bool -> Int
entering Bool
racing
        | Int
open Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int
open Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        | Bool
racing = Int
1
        | Bool
otherwise = Int
0
{-# INLINEABLE readAt #-}

-- Skip the value, then fail on the nesting limit, unless a parallel skip has already failed further on.
tooDeepAt :: (Walk r) => Int -> Element -> TokenResult -> r
tooDeepAt :: forall r. Walk r => Int -> Element -> TokenResult -> r
tooDeepAt Int
open Element
element TokenResult
rest
    | Int
open Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Element -> TokenResult -> (TokenResult -> r) -> r
forall r.
Walk r =>
Element -> TokenResult -> (TokenResult -> r) -> r
skipFrom Element
element TokenResult
rest (Int -> TokenResult -> r
forall r. Walk r => Int -> TokenResult -> r
raceFailure Int
open)
    | Bool
otherwise = Element -> TokenResult -> r
forall r. Walk r => Element -> TokenResult -> r
tooDeep Element
element TokenResult
rest
{-# INLINEABLE tooDeepAt #-}

raceFailure :: (Walk r) => Int -> TokenResult -> r
raceFailure :: forall r. Walk r => Int -> TokenResult -> r
raceFailure !Int
level TokenResult
tokens = case TokenResult
tokens of
    TokenResult
TokFailed -> Text -> r
forall r. Walk r => Text -> r
failWith Text
"the JSON lexer failed"
    TokMoreData ByteString -> TokenResult
_ -> Text -> r
forall r. Walk r => Text -> r
failWith Text
nestingLimit
    PartialResult Element
element TokenResult
rest -> case Element
element of
        ArrayEnd ByteString
_ -> TokenResult -> r
closed TokenResult
rest
        ObjectEnd ByteString
_ -> TokenResult -> r
closed TokenResult
rest
        Element
ArrayBegin -> Int -> TokenResult -> r
forall r. Walk r => Int -> TokenResult -> r
raceFailure (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) TokenResult
rest
        Element
ObjectBegin -> Int -> TokenResult -> r
forall r. Walk r => Int -> TokenResult -> r
raceFailure (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) TokenResult
rest
        StringContent ByteString
_ -> TokenResult -> r
longString TokenResult
rest
        StringEnd ByteString
_ -> Text -> r
forall r. Walk r => Text -> r
failWith Text
"unexpected end of string"
        Element
_ -> Int -> TokenResult -> r
forall r. Walk r => Int -> TokenResult -> r
raceFailure Int
level TokenResult
rest
  where
    closed :: TokenResult -> r
closed TokenResult
rest
        | Int
level Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 = Text -> r
forall r. Walk r => Text -> r
failWith Text
nestingLimit
        | Bool
otherwise = Int -> TokenResult -> r
forall r. Walk r => Int -> TokenResult -> r
raceFailure (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) TokenResult
rest
    longString :: TokenResult -> r
longString = \case
        TokenResult
TokFailed -> Text -> r
forall r. Walk r => Text -> r
failWith Text
"the JSON lexer failed"
        TokMoreData ByteString -> TokenResult
_ -> Text -> r
forall r. Walk r => Text -> r
failWith Text
nestingLimit
        PartialResult (StringContent ByteString
_) TokenResult
rest -> TokenResult -> r
longString TokenResult
rest
        PartialResult (StringEnd ByteString
_) TokenResult
rest -> Int -> TokenResult -> r
forall r. Walk r => Int -> TokenResult -> r
raceFailure Int
level TokenResult
rest
        PartialResult Element
_ TokenResult
_ -> Text -> r
forall r. Walk r => Text -> r
failWith Text
"unexpected token in a string"
{-# INLINEABLE raceFailure #-}

-- json-stream's scalar parsers: a container is skipped and handed to the last continuation.
readScalar :: (Build b r) => b -> Mode -> InternTable -> Element -> TokenResult -> (Built b -> InternTable -> TokenResult -> r) -> (TokenResult -> r) -> r
readScalar :: forall b r.
Build b r =>
b
-> Mode
-> InternTable
-> Element
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> (TokenResult -> r)
-> r
readScalar b
build Mode
mode InternTable
table Element
element TokenResult
rest Built b -> InternTable -> TokenResult -> r
next TokenResult -> r
container = case Element
element of
    JInteger CLong
number -> b -> Int -> (Built b -> r) -> r
forall b r. Build b r => b -> Int -> (Built b -> r) -> r
integer b
build (CLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
number) (\Built b
value -> Built b -> InternTable -> TokenResult -> r
next Built b
value InternTable
table TokenResult
rest)
    JValue (String Text
text) -> b
-> Mode
-> InternTable
-> (Built b -> InternTable -> TokenResult -> r)
-> Name
-> TokenResult
-> r
forall b r.
Build b r =>
b
-> Mode
-> InternTable
-> (Built b -> InternTable -> TokenResult -> r)
-> Name
-> TokenResult
-> r
string b
build Mode
mode InternTable
table Built b -> InternTable -> TokenResult -> r
next (Text -> Name
decodedName Text
text) TokenResult
rest
    JValue Value
value -> b -> Value -> (Built b -> r) -> r
forall b r. Build b r => b -> Value -> (Built b -> r) -> r
whole b
build Value
value (\Built b
built -> Built b -> InternTable -> TokenResult -> r
next Built b
built InternTable
table TokenResult
rest)
    Element
ObjectBegin -> Element -> TokenResult -> (TokenResult -> r) -> r
forall r.
Walk r =>
Element -> TokenResult -> (TokenResult -> r) -> r
skipFrom Element
element TokenResult
rest TokenResult -> r
container
    Element
ArrayBegin -> Element -> TokenResult -> (TokenResult -> r) -> r
forall r.
Walk r =>
Element -> TokenResult -> (TokenResult -> r) -> r
skipFrom Element
element TokenResult
rest TokenResult -> r
container
    Element
_
        | Element -> Bool
isString Element
element -> Element -> TokenResult -> (Name -> TokenResult -> r) -> r
forall r.
Walk r =>
Element -> TokenResult -> (Name -> TokenResult -> r) -> r
readString Element
element TokenResult
rest (b
-> Mode
-> InternTable
-> (Built b -> InternTable -> TokenResult -> r)
-> Name
-> TokenResult
-> r
forall b r.
Build b r =>
b
-> Mode
-> InternTable
-> (Built b -> InternTable -> TokenResult -> r)
-> Name
-> TokenResult
-> r
string b
build Mode
mode InternTable
table Built b -> InternTable -> TokenResult -> r
next)
        | Bool
otherwise -> Text -> r
forall r. Walk r => Text -> r
failWith Text
"unexpected token where a value belongs"
{-# INLINEABLE readScalar #-}

-- The table's shared copy of a string, or a copy of its own when the mode keeps it.
string :: (Build b r) => b -> Mode -> InternTable -> (Built b -> InternTable -> TokenResult -> r) -> Name -> TokenResult -> r
string :: forall b r.
Build b r =>
b
-> Mode
-> InternTable
-> (Built b -> InternTable -> TokenResult -> r)
-> Name
-> TokenResult
-> r
string b
build Mode
mode InternTable
table Built b -> InternTable -> TokenResult -> r
next Name
name TokenResult
after = case Mode
mode of
    Mode
Keep -> b -> Name -> (Built b -> r) -> r
forall b r. Build b r => b -> Name -> (Built b -> r) -> r
ownString b
build Name
name (\Built b
value -> Built b -> InternTable -> TokenResult -> r
next Built b
value InternTable
table TokenResult
after)
    Mode
Share -> case Name -> InternTable -> Interned
internName Name
name InternTable
table of
        Interned Entry
entry InternTable
held -> b -> Entry -> (Built b -> r) -> r
forall b r. Build b r => b -> Entry -> (Built b -> r) -> r
sharedString b
build Entry
entry (\Built b
value -> Built b -> InternTable -> TokenResult -> r
next Built b
value InternTable
held TokenResult
after)
{-# INLINE string #-}

-- The first member under a key wins, as in json-stream. A repeat is read where json-stream reads it,
-- then dropped, and nothing it holds enters the table.
readObject :: (Build b r) => b -> Int -> Members -> Mode -> InternTable -> TokenResult -> (Built b -> InternTable -> TokenResult -> r) -> r
readObject :: forall b r.
Build b r =>
b
-> Int
-> Members
-> Mode
-> InternTable
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> r
readObject b
build Int
open (Members HashMap ByteString (Key, Shape)
named Maybe Shape
other) Mode
mode InternTable
table0 TokenResult
tokens0 Built b -> InternTable -> TokenResult -> r
next = b -> (Fields b -> r) -> r
forall b r. Build b r => b -> (Fields b -> r) -> r
openObject b
build (\Fields b
fields0 -> InternTable -> Fields b -> TokenResult -> r
loop InternTable
table0 Fields b
fields0 TokenResult
tokens0)
  where
    loop :: InternTable -> Fields b -> TokenResult -> r
loop InternTable
table !Fields b
fields TokenResult
tokens = case TokenResult
tokens of
        PartialResult (ObjectEnd ByteString
_) TokenResult
rest -> b -> Fields b -> (Built b -> r) -> r
forall b r. Build b r => b -> Fields b -> (Built b -> r) -> r
closeObject b
build Fields b
fields (\Built b
built -> Built b -> InternTable -> TokenResult -> r
next Built b
built InternTable
table TokenResult
rest)
        PartialResult (StringRaw ByteString
bytes Bool
True ByteString
_) TokenResult
rest -> InternTable -> Fields b -> Name -> TokenResult -> r
member InternTable
table Fields b
fields (ByteString -> Name
Plain ByteString
bytes) TokenResult
rest
        TokenResult
_ -> TokenResult -> (Element -> TokenResult -> r) -> r
forall r.
Walk r =>
TokenResult -> (Element -> TokenResult -> r) -> r
withElement TokenResult
tokens ((Element -> TokenResult -> r) -> r)
-> (Element -> TokenResult -> r) -> r
forall a b. (a -> b) -> a -> b
$ \Element
element TokenResult
rest -> case Element
element of
            ObjectEnd ByteString
_ -> b -> Fields b -> (Built b -> r) -> r
forall b r. Build b r => b -> Fields b -> (Built b -> r) -> r
closeObject b
build Fields b
fields (\Built b
built -> Built b -> InternTable -> TokenResult -> r
next Built b
built InternTable
table TokenResult
rest)
            Element
_ -> Element
-> TokenResult
-> (Name -> TokenResult -> r)
-> (TokenResult -> r)
-> r
forall r.
Walk r =>
Element
-> TokenResult
-> (Name -> TokenResult -> r)
-> (TokenResult -> r)
-> r
memberName Element
element TokenResult
rest (InternTable -> Fields b -> Name -> TokenResult -> r
member InternTable
table Fields b
fields) (InternTable -> Fields b -> TokenResult -> r
loop InternTable
table Fields b
fields)
    member :: InternTable -> Fields b -> Name -> TokenResult -> r
member InternTable
table Fields b
fields Name
name TokenResult
rest = case ByteString -> HashMap ByteString (Key, Shape) -> Maybe (Key, Shape)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (Name -> ByteString
nameBytes Name
name) HashMap ByteString (Key, Shape)
named of
        Just (Key
shared, Shape
shape) -> InternTable
-> Fields b -> Name -> Maybe Key -> Shape -> TokenResult -> r
value InternTable
table Fields b
fields Name
name (Key -> Maybe Key
forall a. a -> Maybe a
Just Key
shared) Shape
shape TokenResult
rest
        Maybe (Key, Shape)
Nothing -> case Maybe Shape
other of
            Just Shape
shape -> InternTable
-> Fields b -> Name -> Maybe Key -> Shape -> TokenResult -> r
value InternTable
table Fields b
fields Name
name Maybe Key
forall a. Maybe a
Nothing Shape
shape TokenResult
rest
            Maybe Shape
Nothing -> TokenResult -> (Element -> TokenResult -> r) -> r
forall r.
Walk r =>
TokenResult -> (Element -> TokenResult -> r) -> r
withElement TokenResult
rest ((Element -> TokenResult -> r) -> r)
-> (Element -> TokenResult -> r) -> r
forall a b. (a -> b) -> a -> b
$ \Element
element TokenResult
afterKey -> Element -> TokenResult -> (TokenResult -> r) -> r
forall r.
Walk r =>
Element -> TokenResult -> (TokenResult -> r) -> r
skipFrom Element
element TokenResult
afterKey (InternTable -> Fields b -> TokenResult -> r
loop InternTable
table Fields b
fields)
    -- A shared key goes through the table, and a key the table keeps holds its value as read.
    value :: InternTable
-> Fields b -> Name -> Maybe Key -> Shape -> TokenResult -> r
value InternTable
table Fields b
fields Name
name Maybe Key
shared Shape
shape TokenResult
rest = case Mode
mode of
        Mode
Keep -> MemberKey -> Mode -> InternTable -> r
keyed (Key -> MemberKey
OwnKey (Key -> Maybe Key -> Key
forall a. a -> Maybe a -> a
fromMaybe (Text -> Key
Key.fromText (Name -> Text
nameText Name
name)) Maybe Key
shared)) Mode
Keep InternTable
table
        Mode
Share -> case Name -> InternTable -> Interned
internName Name
name InternTable
table of
            Interned Entry
entry InternTable
held -> MemberKey -> Mode -> InternTable -> r
keyed (Entry -> MemberKey
SharedKey Entry
entry) (if Entry -> Bool
entryKeeps Entry
entry then Mode
Keep else Mode
Share) InternTable
held
      where
        keyed :: MemberKey -> Mode -> InternTable -> r
keyed MemberKey
key !Mode
valueMode InternTable
held = b -> MemberKey -> Fields b -> (Bool -> r) -> r
forall b r.
Build b r =>
b -> MemberKey -> Fields b -> (Bool -> r) -> r
beginMember b
build MemberKey
key Fields b
fields ((Bool -> r) -> r) -> (Bool -> r) -> r
forall a b. (a -> b) -> a -> b
$ \ !Bool
repeated ->
            if Bool
repeated
                then TokenResult -> (Element -> TokenResult -> r) -> r
forall r.
Walk r =>
TokenResult -> (Element -> TokenResult -> r) -> r
withElement TokenResult
rest ((Element -> TokenResult -> r) -> r)
-> (Element -> TokenResult -> r) -> r
forall a b. (a -> b) -> a -> b
$ \Element
element TokenResult
afterKey ->
                    b
-> Direct -> InternTable -> (Built b -> InternTable -> r) -> r -> r
forall b r.
Build b r =>
b
-> Direct -> InternTable -> (Built b -> InternTable -> r) -> r -> r
withDirect b
build (Shape -> Mode -> InternTable -> Element -> Direct
direct Shape
shape Mode
Keep InternTable
table Element
element) InternTable
table (\Built b
ignored InternTable
_ -> b -> Built b -> r -> r
forall b r. Build b r => b -> Built b -> r -> r
dropValue b
build Built b
ignored (InternTable -> Fields b -> TokenResult -> r
loop InternTable
table Fields b
fields TokenResult
afterKey)) (r -> r) -> r -> r
forall a b. (a -> b) -> a -> b
$
                        b
-> Int
-> Bool
-> Shape
-> Mode
-> InternTable
-> Element
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> r
forall b r.
Build b r =>
b
-> Int
-> Bool
-> Shape
-> Mode
-> InternTable
-> Element
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> r
readAt b
build Int
open Bool
False Shape
shape Mode
Keep InternTable
table Element
element TokenResult
afterKey (\Built b
ignored InternTable
_ -> b -> Built b -> r -> r
forall b r. Build b r => b -> Built b -> r -> r
dropValue b
build Built b
ignored (r -> r) -> (TokenResult -> r) -> TokenResult -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InternTable -> Fields b -> TokenResult -> r
loop InternTable
table Fields b
fields)
                else TokenResult -> (Element -> TokenResult -> r) -> r
forall r.
Walk r =>
TokenResult -> (Element -> TokenResult -> r) -> r
withElement TokenResult
rest ((Element -> TokenResult -> r) -> r)
-> (Element -> TokenResult -> r) -> r
forall a b. (a -> b) -> a -> b
$ \Element
element TokenResult
afterKey ->
                    b
-> Direct -> InternTable -> (Built b -> InternTable -> r) -> r -> r
forall b r.
Build b r =>
b
-> Direct -> InternTable -> (Built b -> InternTable -> r) -> r -> r
withDirect b
build (Shape -> Mode -> InternTable -> Element -> Direct
direct Shape
shape Mode
valueMode InternTable
held Element
element) InternTable
held (\Built b
field InternTable
table' -> b -> MemberKey -> Built b -> Fields b -> (Fields b -> r) -> r
forall b r.
Build b r =>
b -> MemberKey -> Built b -> Fields b -> (Fields b -> r) -> r
addMember b
build MemberKey
key Built b
field Fields b
fields (\Fields b
fields' -> InternTable -> Fields b -> TokenResult -> r
loop InternTable
table' Fields b
fields' TokenResult
afterKey)) (r -> r) -> r -> r
forall a b. (a -> b) -> a -> b
$
                        b
-> Int
-> Bool
-> Shape
-> Mode
-> InternTable
-> Element
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> r
forall b r.
Build b r =>
b
-> Int
-> Bool
-> Shape
-> Mode
-> InternTable
-> Element
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> r
readAt b
build Int
open Bool
False Shape
shape Mode
valueMode InternTable
held Element
element TokenResult
afterKey ((Built b -> InternTable -> TokenResult -> r) -> r)
-> (Built b -> InternTable -> TokenResult -> r) -> r
forall a b. (a -> b) -> a -> b
$ \Built b
field InternTable
table' TokenResult
afterValue ->
                            b -> MemberKey -> Built b -> Fields b -> (Fields b -> r) -> r
forall b r.
Build b r =>
b -> MemberKey -> Built b -> Fields b -> (Fields b -> r) -> r
addMember b
build MemberKey
key Built b
field Fields b
fields (\Fields b
fields' -> InternTable -> Fields b -> TokenResult -> r
loop InternTable
table' Fields b
fields' TokenResult
afterValue)
        {-# INLINE keyed #-}
{-# INLINEABLE readObject #-}

readArray :: (Build b r) => b -> Int -> Shape -> Mode -> InternTable -> TokenResult -> (Built b -> InternTable -> TokenResult -> r) -> r
readArray :: forall b r.
Build b r =>
b
-> Int
-> Shape
-> Mode
-> InternTable
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> r
readArray b
build Int
open Shape
item Mode
mode InternTable
table0 TokenResult
tokens0 Built b -> InternTable -> TokenResult -> r
next = b -> (Items b -> r) -> r
forall b r. Build b r => b -> (Items b -> r) -> r
openArray b
build (\Items b
items0 -> InternTable -> Int -> Items b -> TokenResult -> r
loop InternTable
table0 Int
0 Items b
items0 TokenResult
tokens0)
  where
    loop :: InternTable -> Int -> Items b -> TokenResult -> r
loop InternTable
table !Int
count Items b
items TokenResult
tokens = TokenResult -> (Element -> TokenResult -> r) -> r
forall r.
Walk r =>
TokenResult -> (Element -> TokenResult -> r) -> r
withElement TokenResult
tokens ((Element -> TokenResult -> r) -> r)
-> (Element -> TokenResult -> r) -> r
forall a b. (a -> b) -> a -> b
$ \Element
element TokenResult
rest -> case Element
element of
        ArrayEnd ByteString
_ -> b -> Int -> Items b -> (Built b -> r) -> r
forall b r. Build b r => b -> Int -> Items b -> (Built b -> r) -> r
closeArray b
build Int
count Items b
items (\Built b
array -> Built b -> InternTable -> TokenResult -> r
next Built b
array InternTable
table TokenResult
rest)
        Element
_ ->
            b
-> Direct -> InternTable -> (Built b -> InternTable -> r) -> r -> r
forall b r.
Build b r =>
b
-> Direct -> InternTable -> (Built b -> InternTable -> r) -> r -> r
withDirect b
build (Shape -> Mode -> InternTable -> Element -> Direct
direct Shape
item Mode
mode InternTable
table Element
element) InternTable
table (\Built b
field InternTable
table' -> b -> Built b -> Items b -> (Items b -> r) -> r
forall b r.
Build b r =>
b -> Built b -> Items b -> (Items b -> r) -> r
addItem b
build Built b
field Items b
items (\Items b
items' -> InternTable -> Int -> Items b -> TokenResult -> r
loop InternTable
table' (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Items b
items' TokenResult
rest)) (r -> r) -> r -> r
forall a b. (a -> b) -> a -> b
$
                b
-> Int
-> Bool
-> Shape
-> Mode
-> InternTable
-> Element
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> r
forall b r.
Build b r =>
b
-> Int
-> Bool
-> Shape
-> Mode
-> InternTable
-> Element
-> TokenResult
-> (Built b -> InternTable -> TokenResult -> r)
-> r
readAt b
build Int
open Bool
False Shape
item Mode
mode InternTable
table Element
element TokenResult
rest ((Built b -> InternTable -> TokenResult -> r) -> r)
-> (Built b -> InternTable -> TokenResult -> r) -> r
forall a b. (a -> b) -> a -> b
$ \Built b
field InternTable
table' TokenResult
afterValue ->
                    b -> Built b -> Items b -> (Items b -> r) -> r
forall b r.
Build b r =>
b -> Built b -> Items b -> (Items b -> r) -> r
addItem b
build Built b
field Items b
items (\Items b
items' -> InternTable -> Int -> Items b -> TokenResult -> r
loop InternTable
table' (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Items b
items' TokenResult
afterValue)
{-# INLINEABLE readArray #-}

-- A complete scalar token's value under a shape, when the shape takes it without reading further.
data Direct
    = DirectShared !Entry !InternTable
    | DirectOwn !Name
    | DirectInteger !Int
    | DirectWhole !Value
    | Indirect

-- Build a complete scalar token's value, or read the value on when the token does not complete it.
withDirect :: (Build b r) => b -> Direct -> InternTable -> (Built b -> InternTable -> r) -> r -> r
withDirect :: forall b r.
Build b r =>
b
-> Direct -> InternTable -> (Built b -> InternTable -> r) -> r -> r
withDirect b
build Direct
scalar InternTable
table Built b -> InternTable -> r
next r
indirect = case Direct
scalar of
    DirectShared Entry
entry InternTable
held -> b -> Entry -> (Built b -> r) -> r
forall b r. Build b r => b -> Entry -> (Built b -> r) -> r
sharedString b
build Entry
entry (Built b -> InternTable -> r
`next` InternTable
held)
    DirectOwn Name
name -> b -> Name -> (Built b -> r) -> r
forall b r. Build b r => b -> Name -> (Built b -> r) -> r
ownString b
build Name
name (Built b -> InternTable -> r
`next` InternTable
table)
    DirectInteger Int
number -> b -> Int -> (Built b -> r) -> r
forall b r. Build b r => b -> Int -> (Built b -> r) -> r
integer b
build Int
number (Built b -> InternTable -> r
`next` InternTable
table)
    DirectWhole Value
value -> b -> Value -> (Built b -> r) -> r
forall b r. Build b r => b -> Value -> (Built b -> r) -> r
whole b
build Value
value (Built b -> InternTable -> r
`next` InternTable
table)
    Direct
Indirect -> r
indirect
{-# INLINE withDirect #-}

direct :: Shape -> Mode -> InternTable -> Element -> Direct
direct :: Shape -> Mode -> InternTable -> Element -> Direct
direct Shape
shape Mode
mode InternTable
table Element
element = case Shape
shape of
    Scalar Int
budget | Int
budget Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> Mode -> InternTable -> Element -> Direct
scalarToken Mode
mode InternTable
table Element
element
    Generic Int
budget | Int
budget Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> Mode -> InternTable -> Element -> Direct
scalarToken Mode
mode InternTable
table Element
element
    ObjectWith Int
budget Members
_ Shape
fallback | Int
budget Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> Shape -> Mode -> InternTable -> Element -> Direct
direct Shape
fallback Mode
mode InternTable
table Element
element
    ArrayWith Int
budget Shape
_ Shape
fallback | Int
budget Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> Shape -> Mode -> InternTable -> Element -> Direct
direct Shape
fallback Mode
mode InternTable
table Element
element
    StringOr Int
budget Shape
other
        | Int
budget Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> case Element
element of
            StringRaw{} -> Mode -> InternTable -> Element -> Direct
scalarToken Mode
mode InternTable
table Element
element
            JValue (String Text
_) -> Mode -> InternTable -> Element -> Direct
scalarToken Mode
mode InternTable
table Element
element
            Element
_ -> Shape -> Mode -> InternTable -> Element -> Direct
direct Shape
other Mode
mode InternTable
table Element
element
    ObjectOr Value
fallback Members
_ -> case Element
element of
        StringRaw{} -> Value -> Direct
DirectWhole Value
fallback
        JValue Value
_ -> Value -> Direct
DirectWhole Value
fallback
        JInteger CLong
_ -> Value -> Direct
DirectWhole Value
fallback
        Element
_ -> Direct
Indirect
    Checked Int
budget Shape
inner | Int
budget Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> Shape -> Mode -> InternTable -> Element -> Direct
direct Shape
inner Mode
mode InternTable
table Element
element
    Shape
_ -> Direct
Indirect

scalarToken :: Mode -> InternTable -> Element -> Direct
scalarToken :: Mode -> InternTable -> Element -> Direct
scalarToken Mode
mode InternTable
table = \case
    StringRaw ByteString
bytes Bool
True ByteString
_ -> Name -> Direct
direct' (ByteString -> Name
Plain ByteString
bytes)
    StringRaw ByteString
bytes Bool
False ByteString
_ -> (UnicodeException -> Direct)
-> (Text -> Direct) -> Either UnicodeException Text -> Direct
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Direct -> UnicodeException -> Direct
forall a b. a -> b -> a
const Direct
Indirect) (Name -> Direct
direct' (Name -> Direct) -> (Text -> Name) -> Text -> Direct
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Name
decodedName) (ByteString -> Either UnicodeException Text
unescapeText ByteString
bytes)
    JValue (String Text
text) -> Name -> Direct
direct' (Text -> Name
decodedName Text
text)
    JValue Value
scalar -> Value -> Direct
DirectWhole Value
scalar
    JInteger CLong
number -> Int -> Direct
DirectInteger (CLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
number)
    Element
_ -> Direct
Indirect
  where
    direct' :: Name -> Direct
direct' Name
name = case Mode
mode of
        Mode
Keep -> Name -> Direct
DirectOwn Name
name
        Mode
Share -> case Name -> InternTable -> Interned
internName Name
name InternTable
table of
            Interned Entry
entry InternTable
held -> Entry -> InternTable -> Direct
DirectShared Entry
entry InternTable
held

emptyArray :: Value
emptyArray :: Value
emptyArray = Array -> Value
Array Array
forall a. Monoid a => a
mempty