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

{- | The packed form's writer: a 'Build' that writes each value's opcodes into one scratch buffer per
read as the walk reads it, and copies each finished release or file into a blob of its own. An
object's members are written in source order, and at the object's end they are copied behind their
count in key order, the first member under each key kept.
-}
module Ecluse.Core.Registry.Json.Writer (
    Writer,
    newWriter,
    Frame,
    sealValue,
    Pick (..),
    decodePicked,
    decodeWhole,
    replacedMember,
    discard,
) where

import Control.Monad.ST (ST)
import Data.Aeson (Value (..), toEncoding)
import Data.Aeson.Encoding (encodingToLazyByteString)
import Data.Aeson.Key qualified as Key
import Data.Aeson.KeyMap qualified as KeyMap
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as LBS
import Data.Map.Internal (Map (Bin, Tip))
import Data.Map.Strict qualified as Map
import Data.Primitive.Array (MutableArray, newArray, readArray, sizeofMutableArray, writeArray)
import Data.Primitive.Array qualified as Array
import Data.Primitive.ByteArray (ByteArray, copyMutableByteArray, indexByteArray, moveByteArray, writeByteArray)
import Data.Primitive.MutVar (MutVar, newMutVar, readMutVar, writeMutVar)
import Data.Primitive.PrimArray (MutablePrimArray, copyMutablePrimArray, getSizeofMutablePrimArray, newPrimArray, readPrimArray, setPrimArray, writePrimArray)
import Data.Primitive.PrimVar (PrimVar, newPrimVar, readPrimVar, writePrimVar)

import Ecluse.Core.Registry.Json.Intern (Entry, Name, entryIndex, entryString, entryText, foldName)
import Ecluse.Core.Registry.Json.Packed (Packed, TableStrings (..), decodeScalar, decodeWith, opArray, opFalse, opInline, opNull, opObject, opShared, opTrue, packed, packedBlob, readVarint, valueEnd, varintSize, writeVarint)
import Ecluse.Core.Registry.Json.Scratch (Scratch, copyOut, decimalLength, newScratch, putAt, putByte, putDecimal, putEncodedText, putPlainBytes, putRawBytes, putVarint, reserve, rewindTo, scratchBuffer, scratchCursor)
import Ecluse.Core.Registry.Json.Shape (Build (..), MemberKey (..))
import Ecluse.Core.Registry.Json.Walk (Steps)

{- | One read's scratch, and what an open object has recorded of each member: its key, where its
value's bytes lie, and which earlier member under the same table key it hides.
-}
data Writer st = Writer
    { forall st. Writer st -> Scratch st
writerScratch :: Scratch st
    , forall st. Writer st -> MutVar st (MutablePrimArray st Int)
writerSpans :: MutVar st (MutablePrimArray st Int)
    , forall st. Writer st -> MutVar st (MutableArray st Text)
writerKeys :: MutVar st (MutableArray st Text)
    , forall st. Writer st -> PrimVar st Int
writerTop :: PrimVar st Int
    , forall st. Writer st -> MutVar st (MutablePrimArray st Int)
writerSeen :: MutVar st (MutablePrimArray st Int)
    , forall st. Writer st -> MutVar st (MutableArray st Value)
writerStrings :: MutVar st (MutableArray st Value)
    , forall st. Writer st -> MutVar st (MutablePrimArray st Int)
writerOrder :: MutVar st (MutablePrimArray st Int)
    , forall st. Writer st -> PrimVar st Int
writerDepth :: PrimVar st Int
    , forall st. Writer st -> Maybe (Entry, Entry)
writerAdded :: Maybe (Entry, Entry)
    , forall st. Writer st -> MutablePrimArray st Int
writerMarks :: MutablePrimArray st Int
    , forall st. Writer st -> MutVar st (Maybe ByteArray)
writerReplaced :: MutVar st (Maybe ByteArray)
    }

{- | A writer for one read. Each top-level object also holds the given member, a table key and a
string, in place of its own under that key. An object read in 'Keep' mode keeps its own instead.
-}
newWriter :: Maybe (Entry, Entry) -> ST st (Writer st)
newWriter :: forall st. Maybe (Entry, Entry) -> ST st (Writer st)
newWriter Maybe (Entry, Entry)
added =
    Scratch st
-> MutVar st (MutablePrimArray st Int)
-> MutVar st (MutableArray st Text)
-> PrimVar st Int
-> MutVar st (MutablePrimArray st Int)
-> MutVar st (MutableArray st Value)
-> MutVar st (MutablePrimArray st Int)
-> PrimVar st Int
-> Maybe (Entry, Entry)
-> MutablePrimArray st Int
-> MutVar st (Maybe ByteArray)
-> Writer st
forall st.
Scratch st
-> MutVar st (MutablePrimArray st Int)
-> MutVar st (MutableArray st Text)
-> PrimVar st Int
-> MutVar st (MutablePrimArray st Int)
-> MutVar st (MutableArray st Value)
-> MutVar st (MutablePrimArray st Int)
-> PrimVar st Int
-> Maybe (Entry, Entry)
-> MutablePrimArray st Int
-> MutVar st (Maybe ByteArray)
-> Writer st
Writer
        (Scratch st
 -> MutVar st (MutablePrimArray st Int)
 -> MutVar st (MutableArray st Text)
 -> PrimVar st Int
 -> MutVar st (MutablePrimArray st Int)
 -> MutVar st (MutableArray st Value)
 -> MutVar st (MutablePrimArray st Int)
 -> PrimVar st Int
 -> Maybe (Entry, Entry)
 -> MutablePrimArray st Int
 -> MutVar st (Maybe ByteArray)
 -> Writer st)
-> ST st (Scratch st)
-> ST
     st
     (MutVar st (MutablePrimArray st Int)
      -> MutVar st (MutableArray st Text)
      -> PrimVar st Int
      -> MutVar st (MutablePrimArray st Int)
      -> MutVar st (MutableArray st Value)
      -> MutVar st (MutablePrimArray st Int)
      -> PrimVar st Int
      -> Maybe (Entry, Entry)
      -> MutablePrimArray st Int
      -> MutVar st (Maybe ByteArray)
      -> Writer st)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ST st (Scratch st)
forall st. Int -> ST st (Scratch st)
newScratch Int
1024
        ST
  st
  (MutVar st (MutablePrimArray st Int)
   -> MutVar st (MutableArray st Text)
   -> PrimVar st Int
   -> MutVar st (MutablePrimArray st Int)
   -> MutVar st (MutableArray st Value)
   -> MutVar st (MutablePrimArray st Int)
   -> PrimVar st Int
   -> Maybe (Entry, Entry)
   -> MutablePrimArray st Int
   -> MutVar st (Maybe ByteArray)
   -> Writer st)
-> ST st (MutVar st (MutablePrimArray st Int))
-> ST
     st
     (MutVar st (MutableArray st Text)
      -> PrimVar st Int
      -> MutVar st (MutablePrimArray st Int)
      -> MutVar st (MutableArray st Value)
      -> MutVar st (MutablePrimArray st Int)
      -> PrimVar st Int
      -> Maybe (Entry, Entry)
      -> MutablePrimArray st Int
      -> MutVar st (Maybe ByteArray)
      -> Writer st)
forall a b. ST st (a -> b) -> ST st a -> ST st b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> ST st (MutablePrimArray (PrimState (ST st)) Int)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray (Int
spanWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
32) ST st (MutablePrimArray st Int)
-> (MutablePrimArray st Int
    -> ST st (MutVar st (MutablePrimArray st Int)))
-> ST st (MutVar st (MutablePrimArray st Int))
forall a b. ST st a -> (a -> ST st b) -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MutablePrimArray st Int
-> ST st (MutVar st (MutablePrimArray st Int))
MutablePrimArray st Int
-> ST st (MutVar (PrimState (ST st)) (MutablePrimArray st Int))
forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar)
        ST
  st
  (MutVar st (MutableArray st Text)
   -> PrimVar st Int
   -> MutVar st (MutablePrimArray st Int)
   -> MutVar st (MutableArray st Value)
   -> MutVar st (MutablePrimArray st Int)
   -> PrimVar st Int
   -> Maybe (Entry, Entry)
   -> MutablePrimArray st Int
   -> MutVar st (Maybe ByteArray)
   -> Writer st)
-> ST st (MutVar st (MutableArray st Text))
-> ST
     st
     (PrimVar st Int
      -> MutVar st (MutablePrimArray st Int)
      -> MutVar st (MutableArray st Value)
      -> MutVar st (MutablePrimArray st Int)
      -> PrimVar st Int
      -> Maybe (Entry, Entry)
      -> MutablePrimArray st Int
      -> MutVar st (Maybe ByteArray)
      -> Writer st)
forall a b. ST st (a -> b) -> ST st a -> ST st b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Text -> ST st (MutableArray (PrimState (ST st)) Text)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
32 Text
"" ST st (MutableArray st Text)
-> (MutableArray st Text
    -> ST st (MutVar st (MutableArray st Text)))
-> ST st (MutVar st (MutableArray st Text))
forall a b. ST st a -> (a -> ST st b) -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MutableArray st Text -> ST st (MutVar st (MutableArray st Text))
MutableArray st Text
-> ST st (MutVar (PrimState (ST st)) (MutableArray st Text))
forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar)
        ST
  st
  (PrimVar st Int
   -> MutVar st (MutablePrimArray st Int)
   -> MutVar st (MutableArray st Value)
   -> MutVar st (MutablePrimArray st Int)
   -> PrimVar st Int
   -> Maybe (Entry, Entry)
   -> MutablePrimArray st Int
   -> MutVar st (Maybe ByteArray)
   -> Writer st)
-> ST st (PrimVar st Int)
-> ST
     st
     (MutVar st (MutablePrimArray st Int)
      -> MutVar st (MutableArray st Value)
      -> MutVar st (MutablePrimArray st Int)
      -> PrimVar st Int
      -> Maybe (Entry, Entry)
      -> MutablePrimArray st Int
      -> MutVar st (Maybe ByteArray)
      -> Writer st)
forall a b. ST st (a -> b) -> ST st a -> ST st b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> ST st (PrimVar (PrimState (ST st)) Int)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
a -> m (PrimVar (PrimState m) a)
newPrimVar Int
0
        ST
  st
  (MutVar st (MutablePrimArray st Int)
   -> MutVar st (MutableArray st Value)
   -> MutVar st (MutablePrimArray st Int)
   -> PrimVar st Int
   -> Maybe (Entry, Entry)
   -> MutablePrimArray st Int
   -> MutVar st (Maybe ByteArray)
   -> Writer st)
-> ST st (MutVar st (MutablePrimArray st Int))
-> ST
     st
     (MutVar st (MutableArray st Value)
      -> MutVar st (MutablePrimArray st Int)
      -> PrimVar st Int
      -> Maybe (Entry, Entry)
      -> MutablePrimArray st Int
      -> MutVar st (Maybe ByteArray)
      -> Writer st)
forall a b. ST st (a -> b) -> ST st a -> ST st b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Int -> ST st (MutablePrimArray st Int)
forall st. Int -> Int -> ST st (MutablePrimArray st Int)
newFilled Int
256 (-Int
1) ST st (MutablePrimArray st Int)
-> (MutablePrimArray st Int
    -> ST st (MutVar st (MutablePrimArray st Int)))
-> ST st (MutVar st (MutablePrimArray st Int))
forall a b. ST st a -> (a -> ST st b) -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MutablePrimArray st Int
-> ST st (MutVar st (MutablePrimArray st Int))
MutablePrimArray st Int
-> ST st (MutVar (PrimState (ST st)) (MutablePrimArray st Int))
forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar)
        ST
  st
  (MutVar st (MutableArray st Value)
   -> MutVar st (MutablePrimArray st Int)
   -> PrimVar st Int
   -> Maybe (Entry, Entry)
   -> MutablePrimArray st Int
   -> MutVar st (Maybe ByteArray)
   -> Writer st)
-> ST st (MutVar st (MutableArray st Value))
-> ST
     st
     (MutVar st (MutablePrimArray st Int)
      -> PrimVar st Int
      -> Maybe (Entry, Entry)
      -> MutablePrimArray st Int
      -> MutVar st (Maybe ByteArray)
      -> Writer st)
forall a b. ST st (a -> b) -> ST st a -> ST st b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Value -> ST st (MutableArray (PrimState (ST st)) Value)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
256 Value
Null ST st (MutableArray st Value)
-> (MutableArray st Value
    -> ST st (MutVar st (MutableArray st Value)))
-> ST st (MutVar st (MutableArray st Value))
forall a b. ST st a -> (a -> ST st b) -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MutableArray st Value -> ST st (MutVar st (MutableArray st Value))
MutableArray st Value
-> ST st (MutVar (PrimState (ST st)) (MutableArray st Value))
forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar)
        ST
  st
  (MutVar st (MutablePrimArray st Int)
   -> PrimVar st Int
   -> Maybe (Entry, Entry)
   -> MutablePrimArray st Int
   -> MutVar st (Maybe ByteArray)
   -> Writer st)
-> ST st (MutVar st (MutablePrimArray st Int))
-> ST
     st
     (PrimVar st Int
      -> Maybe (Entry, Entry)
      -> MutablePrimArray st Int
      -> MutVar st (Maybe ByteArray)
      -> Writer st)
forall a b. ST st (a -> b) -> ST st a -> ST st b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> ST st (MutablePrimArray (PrimState (ST st)) Int)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
64 ST st (MutablePrimArray st Int)
-> (MutablePrimArray st Int
    -> ST st (MutVar st (MutablePrimArray st Int)))
-> ST st (MutVar st (MutablePrimArray st Int))
forall a b. ST st a -> (a -> ST st b) -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MutablePrimArray st Int
-> ST st (MutVar st (MutablePrimArray st Int))
MutablePrimArray st Int
-> ST st (MutVar (PrimState (ST st)) (MutablePrimArray st Int))
forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar)
        ST
  st
  (PrimVar st Int
   -> Maybe (Entry, Entry)
   -> MutablePrimArray st Int
   -> MutVar st (Maybe ByteArray)
   -> Writer st)
-> ST st (PrimVar st Int)
-> ST
     st
     (Maybe (Entry, Entry)
      -> MutablePrimArray st Int
      -> MutVar st (Maybe ByteArray)
      -> Writer st)
forall a b. ST st (a -> b) -> ST st a -> ST st b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> ST st (PrimVar (PrimState (ST st)) Int)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
a -> m (PrimVar (PrimState m) a)
newPrimVar Int
0
        ST
  st
  (Maybe (Entry, Entry)
   -> MutablePrimArray st Int
   -> MutVar st (Maybe ByteArray)
   -> Writer st)
-> ST st (Maybe (Entry, Entry))
-> ST
     st
     (MutablePrimArray st Int
      -> MutVar st (Maybe ByteArray) -> Writer st)
forall a b. ST st (a -> b) -> ST st a -> ST st b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Entry, Entry) -> ST st (Maybe (Entry, Entry))
forall a. a -> ST st a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Entry, Entry)
added
        ST
  st
  (MutablePrimArray st Int
   -> MutVar st (Maybe ByteArray) -> Writer st)
-> ST st (MutablePrimArray st Int)
-> ST st (MutVar st (Maybe ByteArray) -> Writer st)
forall a b. ST st (a -> b) -> ST st a -> ST st b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ST st (MutablePrimArray st Int)
forall st. ST st (MutablePrimArray st Int)
newMarks
        ST st (MutVar st (Maybe ByteArray) -> Writer st)
-> ST st (MutVar st (Maybe ByteArray)) -> ST st (Writer st)
forall a b. ST st (a -> b) -> ST st a -> ST st b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ByteArray
-> ST st (MutVar (PrimState (ST st)) (Maybe ByteArray))
forall (m :: * -> *) a.
PrimMonad m =>
a -> m (MutVar (PrimState m) a)
newMutVar Maybe ByteArray
forall a. Maybe a
Nothing

newFilled :: Int -> Int -> ST st (MutablePrimArray st Int)
newFilled :: forall st. Int -> Int -> ST st (MutablePrimArray st Int)
newFilled Int
size Int
value = do
    array <- Int -> ST st (MutablePrimArray (PrimState (ST st)) Int)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
size
    setPrimArray array 0 size value
    pure array

-- The marks: where the value the writer holds starts, and the span of the member the added member
-- replaced in it, or -1.
marksWidth, valueStart, replacedStart, replacedEnd :: Int
marksWidth :: Int
marksWidth = Int
3
valueStart :: Int
valueStart = Int
0
replacedStart :: Int
replacedStart = Int
1
replacedEnd :: Int
replacedEnd = Int
2

newMarks :: ST st (MutablePrimArray st Int)
newMarks :: forall st. ST st (MutablePrimArray st Int)
newMarks = do
    marks <- Int -> Int -> ST st (MutablePrimArray st Int)
forall st. Int -> Int -> ST st (MutablePrimArray st Int)
newFilled Int
marksWidth Int
0
    writePrimArray marks replacedStart (-1)
    pure marks

-- | An object being written: where its bytes start, and its first member's record.
data Frame = Frame !Int !Int

-- Spans are records of four integers: the key's table index or -1, where the value starts and ends,
-- and the member the key's earlier record pointed at.
spanWidth :: Int
spanWidth :: Int
spanWidth = Int
4

{- | A value the writer holds in its scratch, which a read passes on as a mark only. Each step runs
out of line, so a read's continuations hold the writer as one pointer.
-}
instance Build (Writer st) (ST st (Steps (ST st) s)) where
    type Built (Writer st) = ()
    type Fields (Writer st) = Frame
    type Items (Writer st) = Int
    sharedString :: Writer st
-> Entry
-> (Built (Writer st) -> ST st (Steps (ST st) s))
-> ST st (Steps (ST st) s)
sharedString Writer st
writer Entry
entry Built (Writer st) -> ST st (Steps (ST st) s)
next = Writer st -> Entry -> ST st ()
forall st. Writer st -> Entry -> ST st ()
writeShared Writer st
writer Entry
entry ST st () -> ST st (Steps (ST st) s) -> ST st (Steps (ST st) s)
forall a b. ST st a -> ST st b -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Built (Writer st) -> ST st (Steps (ST st) s)
next ()
    ownString :: Writer st
-> Name
-> (Built (Writer st) -> ST st (Steps (ST st) s))
-> ST st (Steps (ST st) s)
ownString Writer st
writer Name
name Built (Writer st) -> ST st (Steps (ST st) s)
next = Writer st -> Name -> ST st ()
forall st. Writer st -> Name -> ST st ()
writeOwn Writer st
writer Name
name ST st () -> ST st (Steps (ST st) s) -> ST st (Steps (ST st) s)
forall a b. ST st a -> ST st b -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Built (Writer st) -> ST st (Steps (ST st) s)
next ()
    integer :: Writer st
-> Int
-> (Built (Writer st) -> ST st (Steps (ST st) s))
-> ST st (Steps (ST st) s)
integer Writer st
writer Int
number Built (Writer st) -> ST st (Steps (ST st) s)
next = Writer st -> Int -> ST st ()
forall st. Writer st -> Int -> ST st ()
writeInteger Writer st
writer Int
number ST st () -> ST st (Steps (ST st) s) -> ST st (Steps (ST st) s)
forall a b. ST st a -> ST st b -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Built (Writer st) -> ST st (Steps (ST st) s)
next ()
    whole :: Writer st
-> Value
-> (Built (Writer st) -> ST st (Steps (ST st) s))
-> ST st (Steps (ST st) s)
whole Writer st
writer Value
value Built (Writer st) -> ST st (Steps (ST st) s)
next = Writer st -> Value -> ST st ()
forall st. Writer st -> Value -> ST st ()
writeWhole Writer st
writer Value
value ST st () -> ST st (Steps (ST st) s) -> ST st (Steps (ST st) s)
forall a b. ST st a -> ST st b -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Built (Writer st) -> ST st (Steps (ST st) s)
next ()
    emptyContainer :: Writer st
-> (Built (Writer st) -> ST st (Steps (ST st) s))
-> ST st (Steps (ST st) s)
emptyContainer Writer st
writer Built (Writer st) -> ST st (Steps (ST st) s)
next = Writer st -> ST st ()
forall st. Writer st -> ST st ()
writeEmptyArray Writer st
writer ST st () -> ST st (Steps (ST st) s) -> ST st (Steps (ST st) s)
forall a b. ST st a -> ST st b -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Built (Writer st) -> ST st (Steps (ST st) s)
next ()
    openObject :: Writer st
-> (Fields (Writer st) -> ST st (Steps (ST st) s))
-> ST st (Steps (ST st) s)
openObject Writer st
writer Fields (Writer st) -> ST st (Steps (ST st) s)
next = Writer st -> ST st Frame
forall st. Writer st -> ST st Frame
openFrame Writer st
writer ST st Frame
-> (Frame -> ST st (Steps (ST st) s)) -> ST st (Steps (ST st) s)
forall a b. ST st a -> (a -> ST st b) -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Fields (Writer st) -> ST st (Steps (ST st) s)
Frame -> ST st (Steps (ST st) s)
next
    beginMember :: Writer st
-> MemberKey
-> Fields (Writer st)
-> (Bool -> ST st (Steps (ST st) s))
-> ST st (Steps (ST st) s)
beginMember Writer st
writer MemberKey
key Fields (Writer st)
frame Bool -> ST st (Steps (ST st) s)
next = case MemberKey
key of
        SharedKey Entry
entry -> Writer st -> Entry -> Frame -> ST st Bool
forall st. Writer st -> Entry -> Frame -> ST st Bool
beginShared Writer st
writer Entry
entry Fields (Writer st)
Frame
frame ST st Bool
-> (Bool -> ST st (Steps (ST st) s)) -> ST st (Steps (ST st) s)
forall a b. ST st a -> (a -> ST st b) -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> ST st (Steps (ST st) s)
next
        OwnKey Key
_ -> Writer st -> ST st ()
forall st. Writer st -> ST st ()
beginOwn Writer st
writer ST st () -> ST st (Steps (ST st) s) -> ST st (Steps (ST st) s)
forall a b. ST st a -> ST st b -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ST st (Steps (ST st) s)
next Bool
False
    addMember :: Writer st
-> MemberKey
-> Built (Writer st)
-> Fields (Writer st)
-> (Fields (Writer st) -> ST st (Steps (ST st) s))
-> ST st (Steps (ST st) s)
addMember Writer st
writer MemberKey
key () Fields (Writer st)
frame Fields (Writer st) -> ST st (Steps (ST st) s)
next = case MemberKey
key of
        SharedKey Entry
entry -> Writer st -> Entry -> ST st ()
forall st. Writer st -> Entry -> ST st ()
endShared Writer st
writer Entry
entry ST st () -> ST st (Steps (ST st) s) -> ST st (Steps (ST st) s)
forall a b. ST st a -> ST st b -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Fields (Writer st) -> ST st (Steps (ST st) s)
next Fields (Writer st)
frame
        OwnKey Key
own -> Writer st -> Text -> ST st ()
forall st. Writer st -> Text -> ST st ()
endOwn Writer st
writer (Key -> Text
Key.toText Key
own) ST st () -> ST st (Steps (ST st) s) -> ST st (Steps (ST st) s)
forall a b. ST st a -> ST st b -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Fields (Writer st) -> ST st (Steps (ST st) s)
next Fields (Writer st)
frame
    dropValue :: Writer st
-> Built (Writer st)
-> ST st (Steps (ST st) s)
-> ST st (Steps (ST st) s)
dropValue Writer st
writer () ST st (Steps (ST st) s)
next = Writer st -> ST st ()
forall st. Writer st -> ST st ()
dropMember Writer st
writer ST st () -> ST st (Steps (ST st) s) -> ST st (Steps (ST st) s)
forall a b. ST st a -> ST st b -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ST st (Steps (ST st) s)
next
    closeObject :: Writer st
-> Fields (Writer st)
-> (Built (Writer st) -> ST st (Steps (ST st) s))
-> ST st (Steps (ST st) s)
closeObject Writer st
writer Fields (Writer st)
frame Built (Writer st) -> ST st (Steps (ST st) s)
next = Writer st -> Frame -> ST st ()
forall st. Writer st -> Frame -> ST st ()
finishFrame Writer st
writer Fields (Writer st)
Frame
frame ST st () -> ST st (Steps (ST st) s) -> ST st (Steps (ST st) s)
forall a b. ST st a -> ST st b -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Built (Writer st) -> ST st (Steps (ST st) s)
next ()
    openArray :: Writer st
-> (Items (Writer st) -> ST st (Steps (ST st) s))
-> ST st (Steps (ST st) s)
openArray Writer st
writer Items (Writer st) -> ST st (Steps (ST st) s)
next = Writer st -> ST st Int
forall st. Writer st -> ST st Int
openItems Writer st
writer ST st Int
-> (Int -> ST st (Steps (ST st) s)) -> ST st (Steps (ST st) s)
forall a b. ST st a -> (a -> ST st b) -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> ST st (Steps (ST st) s)
Items (Writer st) -> ST st (Steps (ST st) s)
next
    addItem :: Writer st
-> Built (Writer st)
-> Items (Writer st)
-> (Items (Writer st) -> ST st (Steps (ST st) s))
-> ST st (Steps (ST st) s)
addItem Writer st
_ () Items (Writer st)
start Items (Writer st) -> ST st (Steps (ST st) s)
next = Items (Writer st) -> ST st (Steps (ST st) s)
next Items (Writer st)
start
    closeArray :: Writer st
-> Int
-> Items (Writer st)
-> (Built (Writer st) -> ST st (Steps (ST st) s))
-> ST st (Steps (ST st) s)
closeArray Writer st
writer Int
count Items (Writer st)
start Built (Writer st) -> ST st (Steps (ST st) s)
next = Writer st -> Int -> Int -> ST st ()
forall st. Writer st -> Int -> Int -> ST st ()
finishItems Writer st
writer Int
count Int
Items (Writer st)
start ST st () -> ST st (Steps (ST st) s) -> ST st (Steps (ST st) s)
forall a b. ST st a -> ST st b -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Built (Writer st) -> ST st (Steps (ST st) s)
next ()
    {-# 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 #-}

writeShared :: Writer st -> Entry -> ST st ()
writeShared :: forall st. Writer st -> Entry -> ST st ()
writeShared Writer st
writer Entry
entry = do
    Writer st -> Entry -> ST st ()
forall st. Writer st -> Entry -> ST st ()
register Writer st
writer Entry
entry
    Scratch st -> Word8 -> ST st ()
forall st. Scratch st -> Word8 -> ST st ()
putByte (Writer st -> Scratch st
forall st. Writer st -> Scratch st
writerScratch Writer st
writer) Word8
opShared
    Scratch st -> Int -> ST st ()
forall st. Scratch st -> Int -> ST st ()
putVarint (Writer st -> Scratch st
forall st. Writer st -> Scratch st
writerScratch Writer st
writer) (Entry -> Int
entryIndex Entry
entry)
{-# OPAQUE writeShared #-}

writeOwn :: Writer st -> Name -> ST st ()
writeOwn :: forall st. Writer st -> Name -> ST st ()
writeOwn Writer st
writer = (ByteString -> ST st ()) -> (Text -> ST st ()) -> Name -> ST st ()
forall a. (ByteString -> a) -> (Text -> a) -> Name -> a
foldName (Scratch st -> ByteString -> ST st ()
forall st. Scratch st -> ByteString -> ST st ()
putOwnBytes (Writer st -> Scratch st
forall st. Writer st -> Scratch st
writerScratch Writer st
writer)) (Scratch st -> Text -> ST st ()
forall st. Scratch st -> Text -> ST st ()
putOwnText (Writer st -> Scratch st
forall st. Writer st -> Scratch st
writerScratch Writer st
writer))
{-# OPAQUE writeOwn #-}

writeInteger :: Writer st -> Int -> ST st ()
writeInteger :: forall st. Writer st -> Int -> ST st ()
writeInteger Writer st
writer Int
number = do
    let scratch :: Scratch st
scratch = Writer st -> Scratch st
forall st. Writer st -> Scratch st
writerScratch Writer st
writer
    Scratch st -> Word8 -> ST st ()
forall st. Scratch st -> Word8 -> ST st ()
putByte Scratch st
scratch Word8
opInline
    Scratch st -> Int -> ST st ()
forall st. Scratch st -> Int -> ST st ()
putVarint Scratch st
scratch (Int -> Int
decimalLength Int
number)
    Scratch st -> Int -> ST st ()
forall st. Scratch st -> Int -> ST st ()
putDecimal Scratch st
scratch Int
number
{-# OPAQUE writeInteger #-}

writeWhole :: Writer st -> Value -> ST st ()
writeWhole :: forall st. Writer st -> Value -> ST st ()
writeWhole Writer st
writer = Scratch st -> Value -> ST st ()
forall st. Scratch st -> Value -> ST st ()
putWhole (Writer st -> Scratch st
forall st. Writer st -> Scratch st
writerScratch Writer st
writer)
{-# OPAQUE writeWhole #-}

writeEmptyArray :: Writer st -> ST st ()
writeEmptyArray :: forall st. Writer st -> ST st ()
writeEmptyArray Writer st
writer = do
    Scratch st -> Word8 -> ST st ()
forall st. Scratch st -> Word8 -> ST st ()
putByte (Writer st -> Scratch st
forall st. Writer st -> Scratch st
writerScratch Writer st
writer) Word8
opArray
    Scratch st -> Word8 -> ST st ()
forall st. Scratch st -> Word8 -> ST st ()
putByte (Writer st -> Scratch st
forall st. Writer st -> Scratch st
writerScratch Writer st
writer) Word8
0
{-# OPAQUE writeEmptyArray #-}

openFrame :: Writer st -> ST st Frame
openFrame :: forall st. Writer st -> ST st Frame
openFrame Writer st
writer = do
    start <- Scratch st -> ST st Int
forall st. Scratch st -> ST st Int
scratchCursor (Writer st -> Scratch st
forall st. Writer st -> Scratch st
writerScratch Writer st
writer)
    base <- readPrimVar (writerTop writer)
    depth <- readPrimVar (writerDepth writer)
    writePrimVar (writerDepth writer) (depth + 1)
    pure (Frame start base)
{-# OPAQUE openFrame #-}

-- Reserve the member's record from where its value starts, and say whether the frame already holds the key.
beginShared :: Writer st -> Entry -> Frame -> ST st Bool
beginShared :: forall st. Writer st -> Entry -> Frame -> ST st Bool
beginShared Writer st
writer Entry
entry (Frame Int
_ Int
base) = do
    Writer st -> ST st ()
forall st. Writer st -> ST st ()
reserveMember Writer st
writer
    at <- Writer st -> Int -> ST st Int
forall st. Writer st -> Int -> ST st Int
seenAt Writer st
writer (Entry -> Int
entryIndex Entry
entry)
    pure $! at >= base
{-# OPAQUE beginShared #-}

beginOwn :: Writer st -> ST st ()
beginOwn :: forall st. Writer st -> ST st ()
beginOwn = Writer st -> ST st ()
forall st. Writer st -> ST st ()
reserveMember
{-# OPAQUE beginOwn #-}

-- Complete the member's record under a table key, hiding any earlier record of the key.
endShared :: Writer st -> Entry -> ST st ()
endShared :: forall st. Writer st -> Entry -> ST st ()
endShared Writer st
writer Entry
entry = do
    Writer st -> Entry -> ST st ()
forall st. Writer st -> Entry -> ST st ()
register Writer st
writer Entry
entry
    top <- PrimVar (PrimState (ST st)) Int -> ST st Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> m a
readPrimVar (Writer st -> PrimVar st Int
forall st. Writer st -> PrimVar st Int
writerTop Writer st
writer)
    let !member = Int
top Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    earlier <- seenAt writer (entryIndex entry)
    setSeen writer (entryIndex entry) member
    completeMember writer member (entryIndex entry) earlier (entryText entry)
{-# OPAQUE endShared #-}

endOwn :: Writer st -> Text -> ST st ()
endOwn :: forall st. Writer st -> Text -> ST st ()
endOwn Writer st
writer Text
text = do
    top <- PrimVar (PrimState (ST st)) Int -> ST st Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> m a
readPrimVar (Writer st -> PrimVar st Int
forall st. Writer st -> PrimVar st Int
writerTop Writer st
writer)
    completeMember writer (top - 1) (-1) (-1) text
{-# OPAQUE endOwn #-}

-- Forget the member begun last, and every byte of its value.
dropMember :: Writer st -> ST st ()
dropMember :: forall st. Writer st -> ST st ()
dropMember Writer st
writer = do
    top <- PrimVar (PrimState (ST st)) Int -> ST st Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> m a
readPrimVar (Writer st -> PrimVar st Int
forall st. Writer st -> PrimVar st Int
writerTop Writer st
writer)
    spans <- readMutVar (writerSpans writer)
    readPrimArray spans (spanWidth * (top - 1) + 1) >>= rewindTo (writerScratch writer)
    writePrimVar (writerTop writer) (top - 1)
{-# OPAQUE dropMember #-}

finishFrame :: Writer st -> Frame -> ST st ()
finishFrame :: forall st. Writer st -> Frame -> ST st ()
finishFrame Writer st
writer Frame
frame = do
    depth <- PrimVar (PrimState (ST st)) Int -> ST st Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> m a
readPrimVar (Writer st -> PrimVar st Int
forall st. Writer st -> PrimVar st Int
writerDepth Writer st
writer)
    writePrimVar (writerDepth writer) (depth - 1)
    when (depth == 1) (traverse_ (addTopMember writer frame) (writerAdded writer))
    closeFrame writer frame (depth == 1)
{-# OPAQUE finishFrame #-}

openItems :: Writer st -> ST st Int
openItems :: forall st. Writer st -> ST st Int
openItems Writer st
writer = do
    depth <- PrimVar (PrimState (ST st)) Int -> ST st Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> m a
readPrimVar (Writer st -> PrimVar st Int
forall st. Writer st -> PrimVar st Int
writerDepth Writer st
writer)
    writePrimVar (writerDepth writer) (depth + 1)
    scratchCursor (writerScratch writer)
{-# OPAQUE openItems #-}

finishItems :: Writer st -> Int -> Int -> ST st ()
finishItems :: forall st. Writer st -> Int -> Int -> ST st ()
finishItems Writer st
writer Int
count Int
start = do
    depth <- PrimVar (PrimState (ST st)) Int -> ST st Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> m a
readPrimVar (Writer st -> PrimVar st Int
forall st. Writer st -> PrimVar st Int
writerDepth Writer st
writer)
    writePrimVar (writerDepth writer) (depth - 1)
    closeItems writer count start
{-# OPAQUE finishItems #-}

putOwnBytes :: Scratch st -> ByteString -> ST st ()
putOwnBytes :: forall st. Scratch st -> ByteString -> ST st ()
putOwnBytes Scratch st
scratch ByteString
bytes = do
    Scratch st -> Word8 -> ST st ()
forall st. Scratch st -> Word8 -> ST st ()
putByte Scratch st
scratch Word8
opInline
    Scratch st -> Int -> ST st ()
forall st. Scratch st -> Int -> ST st ()
putVarint Scratch st
scratch (ByteString -> Int
BS.length ByteString
bytes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
    Scratch st -> ByteString -> ST st ()
forall st. Scratch st -> ByteString -> ST st ()
putPlainBytes Scratch st
scratch ByteString
bytes

putOwnText :: Scratch st -> Text -> ST st ()
putOwnText :: forall st. Scratch st -> Text -> ST st ()
putOwnText Scratch st
scratch Text
text = Scratch st -> Word8 -> ST st ()
forall st. Scratch st -> Word8 -> ST st ()
putByte Scratch st
scratch Word8
opInline ST st () -> ST st () -> ST st ()
forall a b. ST st a -> ST st b -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Scratch st -> (Int -> Int) -> Text -> ST st ()
forall st. Scratch st -> (Int -> Int) -> Text -> ST st ()
putEncodedText Scratch st
scratch Int -> Int
forall a. a -> a
id Text
text

-- The tag of an object key written in full: its encoded length, doubled and odd. A table key's is even.
ownKey :: Int -> Int
ownKey :: Int -> Int
ownKey Int
len = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

-- A value taken whole: aeson's bytes for a number, and object keys of their own.
putWhole :: Scratch st -> Value -> ST st ()
putWhole :: forall st. Scratch st -> Value -> ST st ()
putWhole Scratch st
scratch = \case
    Value
Null -> Scratch st -> Word8 -> ST st ()
forall st. Scratch st -> Word8 -> ST st ()
putByte Scratch st
scratch Word8
opNull
    Bool Bool
False -> Scratch st -> Word8 -> ST st ()
forall st. Scratch st -> Word8 -> ST st ()
putByte Scratch st
scratch Word8
opFalse
    Bool Bool
True -> Scratch st -> Word8 -> ST st ()
forall st. Scratch st -> Word8 -> ST st ()
putByte Scratch st
scratch Word8
opTrue
    String Text
text -> Scratch st -> Text -> ST st ()
forall st. Scratch st -> Text -> ST st ()
putOwnText Scratch st
scratch Text
text
    number :: Value
number@(Number Scientific
_) -> do
        let bytes :: ByteString
bytes = LazyByteString -> ByteString
LBS.toStrict (Encoding' Value -> LazyByteString
forall a. Encoding' a -> LazyByteString
encodingToLazyByteString (Value -> Encoding' Value
forall a. ToJSON a => a -> Encoding' Value
toEncoding Value
number))
        Scratch st -> Word8 -> ST st ()
forall st. Scratch st -> Word8 -> ST st ()
putByte Scratch st
scratch Word8
opInline
        Scratch st -> Int -> ST st ()
forall st. Scratch st -> Int -> ST st ()
putVarint Scratch st
scratch (ByteString -> Int
BS.length ByteString
bytes)
        Scratch st -> ByteString -> ST st ()
forall st. Scratch st -> ByteString -> ST st ()
putRawBytes Scratch st
scratch ByteString
bytes
    Object Object
fields -> do
        Scratch st -> Word8 -> ST st ()
forall st. Scratch st -> Word8 -> ST st ()
putByte Scratch st
scratch Word8
opObject
        Scratch st -> Int -> ST st ()
forall st. Scratch st -> Int -> ST st ()
putVarint Scratch st
scratch (Object -> Int
forall v. KeyMap v -> Int
KeyMap.size Object
fields)
        [(Key, Value)] -> ((Key, Value) -> ST st ()) -> ST st ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KeyMap.toAscList Object
fields) (((Key, Value) -> ST st ()) -> ST st ())
-> ((Key, Value) -> ST st ()) -> ST st ()
forall a b. (a -> b) -> a -> b
$ \(Key
key, Value
value) -> do
            Scratch st -> (Int -> Int) -> Text -> ST st ()
forall st. Scratch st -> (Int -> Int) -> Text -> ST st ()
putEncodedText Scratch st
scratch Int -> Int
ownKey (Key -> Text
Key.toText Key
key)
            Scratch st -> Value -> ST st ()
forall st. Scratch st -> Value -> ST st ()
putWhole Scratch st
scratch Value
value
    Array Array
values -> do
        Scratch st -> Word8 -> ST st ()
forall st. Scratch st -> Word8 -> ST st ()
putByte Scratch st
scratch Word8
opArray
        Scratch st -> Int -> ST st ()
forall st. Scratch st -> Int -> ST st ()
putVarint Scratch st
scratch (Array -> Int
forall a. Vector a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Array
values)
        (Value -> ST st ()) -> Array -> ST st ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Scratch st -> Value -> ST st ()
forall st. Scratch st -> Value -> ST st ()
putWhole Scratch st
scratch) Array
values

-- Record the table string a blob is about to refer to. A slot no string has claimed holds null.
register :: Writer st -> Entry -> ST st ()
register :: forall st. Writer st -> Entry -> ST st ()
register Writer st
writer Entry
entry = do
    let index :: Int
index = Entry -> Int
entryIndex Entry
entry
    strings <- MutVar (PrimState (ST st)) (MutableArray st Value)
-> ST st (MutableArray st Value)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar (Writer st -> MutVar st (MutableArray st Value)
forall st. Writer st -> MutVar st (MutableArray st Value)
writerStrings Writer st
writer)
    if index < sizeofMutableArray strings
        then writeArray strings index (entryString entry)
        else do
            grown <- newArray (max (index + 1) (2 * sizeofMutableArray strings)) Null
            Array.copyMutableArray grown 0 strings 0 (sizeofMutableArray strings)
            writeArray grown index (entryString entry)
            writeMutVar (writerStrings writer) grown
{-# INLINE register #-}

-- The member that last recorded the table key, or -1.
seenAt :: Writer st -> Int -> ST st Int
seenAt :: forall st. Writer st -> Int -> ST st Int
seenAt Writer st
writer Int
index = do
    seen <- MutVar (PrimState (ST st)) (MutablePrimArray st Int)
-> ST st (MutablePrimArray st Int)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar (Writer st -> MutVar st (MutablePrimArray st Int)
forall st. Writer st -> MutVar st (MutablePrimArray st Int)
writerSeen Writer st
writer)
    size <- getSizeofMutablePrimArray seen
    if index < size then readPrimArray seen index else pure (-1)
{-# INLINE seenAt #-}

setSeen :: Writer st -> Int -> Int -> ST st ()
setSeen :: forall st. Writer st -> Int -> Int -> ST st ()
setSeen Writer st
writer Int
index Int
value = do
    seen <- MutVar (PrimState (ST st)) (MutablePrimArray st Int)
-> ST st (MutablePrimArray st Int)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar (Writer st -> MutVar st (MutablePrimArray st Int)
forall st. Writer st -> MutVar st (MutablePrimArray st Int)
writerSeen Writer st
writer)
    size <- getSizeofMutablePrimArray seen
    if index < size
        then writePrimArray seen index value
        else do
            grown <- newFilled (max (index + 1) (2 * size)) (-1)
            copyMutablePrimArray grown 0 seen 0 size
            writePrimArray grown index value
            writeMutVar (writerSeen writer) grown

-- Reserve a member record that starts at the cursor.
reserveMember :: Writer st -> ST st ()
reserveMember :: forall st. Writer st -> ST st ()
reserveMember Writer st
writer = do
    top <- PrimVar (PrimState (ST st)) Int -> ST st Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> m a
readPrimVar (Writer st -> PrimVar st Int
forall st. Writer st -> PrimVar st Int
writerTop Writer st
writer)
    spans <- readMutVar (writerSpans writer)
    size <- getSizeofMutablePrimArray spans
    spans' <-
        if spanWidth * (top + 1) <= size
            then pure spans
            else do
                grown <- newPrimArray (2 * size)
                copyMutablePrimArray grown 0 spans 0 size
                writeMutVar (writerSpans writer) grown
                pure grown
    keys <- readMutVar (writerKeys writer)
    when (top >= sizeofMutableArray keys) $ do
        grown <- newArray (2 * sizeofMutableArray keys) ""
        Array.copyMutableArray grown 0 keys 0 (sizeofMutableArray keys)
        writeMutVar (writerKeys writer) grown
    scratchCursor (writerScratch writer) >>= writePrimArray spans' (spanWidth * top + 1)
    writePrimVar (writerTop writer) (top + 1)

-- Complete a reserved record: its key's table index or -1, the record the key hides, and its key's text.
completeMember :: Writer st -> Int -> Int -> Int -> Text -> ST st ()
completeMember :: forall st. Writer st -> Int -> Int -> Int -> Text -> ST st ()
completeMember Writer st
writer Int
member Int
index Int
earlier Text
text = do
    spans <- MutVar (PrimState (ST st)) (MutablePrimArray st Int)
-> ST st (MutablePrimArray st Int)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar (Writer st -> MutVar st (MutablePrimArray st Int)
forall st. Writer st -> MutVar st (MutablePrimArray st Int)
writerSpans Writer st
writer)
    keys <- readMutVar (writerKeys writer)
    end <- scratchCursor (writerScratch writer)
    writePrimArray spans (spanWidth * member) index
    writePrimArray spans (spanWidth * member + 2) end
    writePrimArray spans (spanWidth * member + 3) earlier
    writeArray keys member text

-- The added member, written after the object's members, replaces any member under its key.
addTopMember :: Writer st -> Frame -> (Entry, Entry) -> ST st ()
addTopMember :: forall st. Writer st -> Frame -> (Entry, Entry) -> ST st ()
addTopMember Writer st
writer (Frame Int
_ Int
base) (Entry
key, Entry
value) = do
    earlier <- Writer st -> Int -> ST st Int
forall st. Writer st -> Int -> ST st Int
seenAt Writer st
writer (Entry -> Int
entryIndex Entry
key)
    if earlier >= base
        then do
            let scratch = Writer st -> Scratch st
forall st. Writer st -> Scratch st
writerScratch Writer st
writer
            start <- scratchCursor scratch
            writeShared writer value
            end <- scratchCursor scratch
            spans <- readMutVar (writerSpans writer)
            readPrimArray spans (spanWidth * earlier + 1) >>= writePrimArray (writerMarks writer) replacedStart
            readPrimArray spans (spanWidth * earlier + 2) >>= writePrimArray (writerMarks writer) replacedEnd
            writePrimArray spans (spanWidth * earlier + 1) start
            writePrimArray spans (spanWidth * earlier + 2) end
        else do
            writePrimArray (writerMarks writer) replacedStart (-1)
            reserveMember writer >> writeShared writer value >> endShared writer key

{- Copy the object's members behind its count in key order, the first member under each key kept,
and forget their records. A nested object moves to its start, and a top-level one stays past it. -}
closeFrame :: Writer st -> Frame -> Bool -> ST st ()
closeFrame :: forall st. Writer st -> Frame -> Bool -> ST st ()
closeFrame Writer st
writer (Frame Int
start Int
base) Bool
topLevel = do
    let scratch :: Scratch st
scratch = Writer st -> Scratch st
forall st. Writer st -> Scratch st
writerScratch Writer st
writer
    top <- PrimVar (PrimState (ST st)) Int -> ST st Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> m a
readPrimVar (Writer st -> PrimVar st Int
forall st. Writer st -> PrimVar st Int
writerTop Writer st
writer)
    let count = Int
top Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
base
    keys <- readMutVar (writerKeys writer)
    order <- sortedSpans writer keys base count
    kept <- firstUnderEachKey keys order count
    spans <- readMutVar (writerSpans writer)
    output <- scratchCursor scratch
    putByte scratch opObject
    putVarint scratch kept
    copyMembers scratch keys spans order kept 0
    if topLevel
        then writePrimArray (writerMarks writer) valueStart output
        else do
            end <- scratchCursor scratch
            buffer <- scratchBuffer scratch
            moveByteArray buffer start buffer output (end - output)
            rewindTo scratch (start + end - output)
    restoreSeen writer spans base (top - 1)
    writePrimVar (writerTop writer) base

-- Write the kept members from the position on, each key before its value.
copyMembers :: Scratch st -> MutableArray st Text -> MutablePrimArray st Int -> MutablePrimArray st Int -> Int -> Int -> ST st ()
copyMembers :: forall st.
Scratch st
-> MutableArray st Text
-> MutablePrimArray st Int
-> MutablePrimArray st Int
-> Int
-> Int
-> ST st ()
copyMembers Scratch st
scratch MutableArray st Text
keys MutablePrimArray st Int
spans MutablePrimArray st Int
order Int
kept !Int
position = Bool -> ST st () -> ST st ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
position Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
kept) (ST st () -> ST st ()) -> ST st () -> ST st ()
forall a b. (a -> b) -> a -> b
$ do
    member <- MutablePrimArray (PrimState (ST st)) Int -> Int -> ST st Int
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
readPrimArray MutablePrimArray st Int
MutablePrimArray (PrimState (ST st)) Int
order Int
position
    index <- readPrimArray spans (spanWidth * member)
    from <- readPrimArray spans (spanWidth * member + 1)
    to <- readPrimArray spans (spanWidth * member + 2)
    if index >= 0
        then putVarint scratch (2 * index)
        else do
            readArray keys member >>= putEncodedText scratch ownKey
    putAt scratch (to - from) $ \MutableByteArray st
buffer Int
at -> MutableByteArray (PrimState (ST st))
-> Int
-> MutableByteArray (PrimState (ST st))
-> Int
-> Int
-> ST st ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
copyMutableByteArray MutableByteArray st
MutableByteArray (PrimState (ST st))
buffer Int
at MutableByteArray st
MutableByteArray (PrimState (ST st))
buffer Int
from (Int
to Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
from) ST st () -> Int -> ST st Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
at Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
to Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
from)
    copyMembers scratch keys spans order kept (position + 1)

-- Point each table key an object recorded back at the record it hid, latest record first.
restoreSeen :: Writer st -> MutablePrimArray st Int -> Int -> Int -> ST st ()
restoreSeen :: forall st.
Writer st -> MutablePrimArray st Int -> Int -> Int -> ST st ()
restoreSeen Writer st
writer MutablePrimArray st Int
spans Int
base !Int
member = Bool -> ST st () -> ST st ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
member Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
base) (ST st () -> ST st ()) -> ST st () -> ST st ()
forall a b. (a -> b) -> a -> b
$ do
    index <- MutablePrimArray (PrimState (ST st)) Int -> Int -> ST st Int
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
readPrimArray MutablePrimArray st Int
MutablePrimArray (PrimState (ST st)) Int
spans (Int
spanWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
member)
    when (index >= 0) (readPrimArray spans (spanWidth * member + 3) >>= setSeen writer index)
    restoreSeen writer spans base (member - 1)

-- The object's spans in key order, ties in source order, in the order workspace's first slots.
sortedSpans :: Writer st -> MutableArray st Text -> Int -> Int -> ST st (MutablePrimArray st Int)
sortedSpans :: forall st.
Writer st
-> MutableArray st Text
-> Int
-> Int
-> ST st (MutablePrimArray st Int)
sortedSpans Writer st
writer MutableArray st Text
keys Int
base Int
count = do
    order <- MutVar (PrimState (ST st)) (MutablePrimArray st Int)
-> ST st (MutablePrimArray st Int)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar (Writer st -> MutVar st (MutablePrimArray st Int)
forall st. Writer st -> MutVar st (MutablePrimArray st Int)
writerOrder Writer st
writer)
    size <- getSizeofMutablePrimArray order
    work <-
        if 2 * count <= size
            then pure order
            else do
                grown <- newPrimArray (4 * count)
                writeMutVar (writerOrder writer) grown
                pure grown
    fillOrder work base count 0
    sortRuns keys work count 0
    final <- mergeRuns keys work count sortedRun 0
    when (final /= 0) (copyMutablePrimArray work 0 work count count)
    pure work

fillOrder :: MutablePrimArray st Int -> Int -> Int -> Int -> ST st ()
fillOrder :: forall st. MutablePrimArray st Int -> Int -> Int -> Int -> ST st ()
fillOrder MutablePrimArray st Int
work Int
base Int
count !Int
position = Bool -> ST st () -> ST st ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
position Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
count) (ST st () -> ST st ()) -> ST st () -> ST st ()
forall a b. (a -> b) -> a -> b
$ do
    MutablePrimArray (PrimState (ST st)) Int -> Int -> Int -> ST st ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray st Int
MutablePrimArray (PrimState (ST st)) Int
work Int
position (Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
position)
    MutablePrimArray st Int -> Int -> Int -> Int -> ST st ()
forall st. MutablePrimArray st Int -> Int -> Int -> Int -> ST st ()
fillOrder MutablePrimArray st Int
work Int
base Int
count (Int
position Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- Whether the first member's key sorts after the second's.
sortsAfter :: MutableArray st Text -> Int -> Int -> ST st Bool
sortsAfter :: forall st. MutableArray st Text -> Int -> Int -> ST st Bool
sortsAfter MutableArray st Text
keys Int
a Int
b = do
    left <- MutableArray (PrimState (ST st)) Text -> Int -> ST st Text
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> m a
readArray MutableArray st Text
MutableArray (PrimState (ST st)) Text
keys Int
a
    right <- readArray keys b
    pure $! left > right
{-# INLINE sortsAfter #-}

-- The run each insertion sort orders before the runs merge.
sortedRun :: Int
sortedRun :: Int
sortedRun = Int
16

-- Sort each run of the first slots by insertion, from the run starting at the position on.
sortRuns :: MutableArray st Text -> MutablePrimArray st Int -> Int -> Int -> ST st ()
sortRuns :: forall st.
MutableArray st Text
-> MutablePrimArray st Int -> Int -> Int -> ST st ()
sortRuns MutableArray st Text
keys MutablePrimArray st Int
work Int
count !Int
from = Bool -> ST st () -> ST st ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
from Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
count) (ST st () -> ST st ()) -> ST st () -> ST st ()
forall a b. (a -> b) -> a -> b
$ do
    MutableArray st Text
-> MutablePrimArray st Int -> Int -> Int -> Int -> ST st ()
forall st.
MutableArray st Text
-> MutablePrimArray st Int -> Int -> Int -> Int -> ST st ()
insertRun MutableArray st Text
keys MutablePrimArray st Int
work Int
from (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
count (Int
from Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sortedRun)) (Int
from Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    MutableArray st Text
-> MutablePrimArray st Int -> Int -> Int -> ST st ()
forall st.
MutableArray st Text
-> MutablePrimArray st Int -> Int -> Int -> ST st ()
sortRuns MutableArray st Text
keys MutablePrimArray st Int
work Int
count (Int
from Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
sortedRun)

insertRun :: MutableArray st Text -> MutablePrimArray st Int -> Int -> Int -> Int -> ST st ()
insertRun :: forall st.
MutableArray st Text
-> MutablePrimArray st Int -> Int -> Int -> Int -> ST st ()
insertRun MutableArray st Text
keys MutablePrimArray st Int
work Int
from Int
to !Int
position = Bool -> ST st () -> ST st ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
position Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
to) (ST st () -> ST st ()) -> ST st () -> ST st ()
forall a b. (a -> b) -> a -> b
$ do
    item <- MutablePrimArray (PrimState (ST st)) Int -> Int -> ST st Int
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
readPrimArray MutablePrimArray st Int
MutablePrimArray (PrimState (ST st)) Int
work Int
position
    shiftInto keys work from item position
    insertRun keys work from to (position + 1)

-- Move later items up until the item's slot is found, and put it there.
shiftInto :: MutableArray st Text -> MutablePrimArray st Int -> Int -> Int -> Int -> ST st ()
shiftInto :: forall st.
MutableArray st Text
-> MutablePrimArray st Int -> Int -> Int -> Int -> ST st ()
shiftInto MutableArray st Text
keys MutablePrimArray st Int
work Int
from Int
item !Int
at
    | Int
at Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
from = MutablePrimArray (PrimState (ST st)) Int -> Int -> Int -> ST st ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray st Int
MutablePrimArray (PrimState (ST st)) Int
work Int
at Int
item
    | Bool
otherwise = do
        previous <- MutablePrimArray (PrimState (ST st)) Int -> Int -> ST st Int
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
readPrimArray MutablePrimArray st Int
MutablePrimArray (PrimState (ST st)) Int
work (Int
at Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        after <- sortsAfter keys previous item
        if after
            then writePrimArray work at previous >> shiftInto keys work from item (at - 1)
            else writePrimArray work at item

{- Merge runs of doubling width, alternating between the first half of the workspace and the second,
and return the half that holds the result. -}
mergeRuns :: MutableArray st Text -> MutablePrimArray st Int -> Int -> Int -> Int -> ST st Int
mergeRuns :: forall st.
MutableArray st Text
-> MutablePrimArray st Int -> Int -> Int -> Int -> ST st Int
mergeRuns MutableArray st Text
keys MutablePrimArray st Int
work Int
count !Int
width !Int
source
    | Int
width Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
count = Int -> ST st Int
forall a. a -> ST st a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
source
    | Bool
otherwise = do
        let target :: Int
target = if Int
source Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
count else Int
0
        MutableArray st Text
-> MutablePrimArray st Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> ST st ()
forall st.
MutableArray st Text
-> MutablePrimArray st Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> ST st ()
mergePairs MutableArray st Text
keys MutablePrimArray st Int
work Int
count Int
width Int
source Int
target Int
0
        MutableArray st Text
-> MutablePrimArray st Int -> Int -> Int -> Int -> ST st Int
forall st.
MutableArray st Text
-> MutablePrimArray st Int -> Int -> Int -> Int -> ST st Int
mergeRuns MutableArray st Text
keys MutablePrimArray st Int
work Int
count (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width) Int
target

mergePairs :: MutableArray st Text -> MutablePrimArray st Int -> Int -> Int -> Int -> Int -> Int -> ST st ()
mergePairs :: forall st.
MutableArray st Text
-> MutablePrimArray st Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> ST st ()
mergePairs MutableArray st Text
keys MutablePrimArray st Int
work Int
count Int
width Int
source Int
target !Int
from = Bool -> ST st () -> ST st ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
from Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
count) (ST st () -> ST st ()) -> ST st () -> ST st ()
forall a b. (a -> b) -> a -> b
$ do
    let middle :: Int
middle = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
count (Int
from Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
width)
        end :: Int
end = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
count (Int
from Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width)
    MutableArray st Text
-> MutablePrimArray st Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> ST st ()
forall st.
MutableArray st Text
-> MutablePrimArray st Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> ST st ()
mergeTwo MutableArray st Text
keys MutablePrimArray st Int
work (Int
source Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
middle) (Int
source Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
end) (Int
source Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
from) (Int
source Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
middle) (Int
target Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
from)
    MutableArray st Text
-> MutablePrimArray st Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> ST st ()
forall st.
MutableArray st Text
-> MutablePrimArray st Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> ST st ()
mergePairs MutableArray st Text
keys MutablePrimArray st Int
work Int
count Int
width Int
source Int
target (Int
from Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
width)

-- Merge the left run from i up to its end with the right run from j up to its end, into out on.
mergeTwo :: MutableArray st Text -> MutablePrimArray st Int -> Int -> Int -> Int -> Int -> Int -> ST st ()
mergeTwo :: forall st.
MutableArray st Text
-> MutablePrimArray st Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> ST st ()
mergeTwo MutableArray st Text
keys MutablePrimArray st Int
work !Int
leftEnd !Int
rightEnd !Int
i !Int
j !Int
out
    | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
leftEnd = Int -> Int -> ST st ()
copyRange Int
j Int
rightEnd
    | Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
rightEnd = Int -> Int -> ST st ()
copyRange Int
i Int
leftEnd
    | Bool
otherwise = do
        a <- MutablePrimArray (PrimState (ST st)) Int -> Int -> ST st Int
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
readPrimArray MutablePrimArray st Int
MutablePrimArray (PrimState (ST st)) Int
work Int
i
        b <- readPrimArray work j
        after <- sortsAfter keys a b
        if after
            then writePrimArray work out b >> mergeTwo keys work leftEnd rightEnd i (j + 1) (out + 1)
            else writePrimArray work out a >> mergeTwo keys work leftEnd rightEnd (i + 1) j (out + 1)
  where
    copyRange :: Int -> Int -> ST st ()
copyRange Int
from Int
to = Bool -> ST st () -> ST st ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
to Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
from) (MutablePrimArray (PrimState (ST st)) Int
-> Int
-> MutablePrimArray (PrimState (ST st)) Int
-> Int
-> Int
-> ST st ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a
-> Int -> MutablePrimArray (PrimState m) a -> Int -> Int -> m ()
copyMutablePrimArray MutablePrimArray st Int
MutablePrimArray (PrimState (ST st)) Int
work Int
out MutablePrimArray st Int
MutablePrimArray (PrimState (ST st)) Int
work Int
from (Int
to Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
from))

-- Keep the first member under each key at the front of the order, and count them.
firstUnderEachKey :: MutableArray st Text -> MutablePrimArray st Int -> Int -> ST st Int
firstUnderEachKey :: forall st.
MutableArray st Text -> MutablePrimArray st Int -> Int -> ST st Int
firstUnderEachKey MutableArray st Text
keys MutablePrimArray st Int
order Int
count
    | Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Int -> ST st Int
forall a. a -> ST st a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
    | Bool
otherwise = do
        leading <- MutablePrimArray (PrimState (ST st)) Int -> Int -> ST st Int
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
readPrimArray MutablePrimArray st Int
MutablePrimArray (PrimState (ST st)) Int
order Int
0
        firstKey <- readArray keys leading
        keepFirsts keys order count 1 1 firstKey

keepFirsts :: MutableArray st Text -> MutablePrimArray st Int -> Int -> Int -> Int -> Text -> ST st Int
keepFirsts :: forall st.
MutableArray st Text
-> MutablePrimArray st Int
-> Int
-> Int
-> Int
-> Text
-> ST st Int
keepFirsts MutableArray st Text
keys MutablePrimArray st Int
order Int
count !Int
position !Int
kept Text
lastKey
    | Int
position Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
count = Int -> ST st Int
forall a. a -> ST st a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
kept
    | Bool
otherwise = do
        member <- MutablePrimArray (PrimState (ST st)) Int -> Int -> ST st Int
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
readPrimArray MutablePrimArray st Int
MutablePrimArray (PrimState (ST st)) Int
order Int
position
        key <- readArray keys member
        if key == lastKey
            then keepFirsts keys order count (position + 1) kept lastKey
            else writePrimArray order kept member >> keepFirsts keys order count (position + 1) (kept + 1) key

-- Put the array's count in front of its items.
closeItems :: Writer st -> Int -> Int -> ST st ()
closeItems :: forall st. Writer st -> Int -> Int -> ST st ()
closeItems Writer st
writer Int
count Int
start = do
    let scratch :: Scratch st
scratch = Writer st -> Scratch st
forall st. Writer st -> Scratch st
writerScratch Writer st
writer
        header :: Int
header = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
varintSize Int
count
    end <- Scratch st -> ST st Int
forall st. Scratch st -> ST st Int
scratchCursor Scratch st
scratch
    reserve scratch header $ \MutableByteArray st
buffer Int
_ -> do
        MutableByteArray (PrimState (ST st))
-> Int
-> MutableByteArray (PrimState (ST st))
-> Int
-> Int
-> ST st ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
moveByteArray MutableByteArray st
MutableByteArray (PrimState (ST st))
buffer (Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
header) MutableByteArray st
MutableByteArray (PrimState (ST st))
buffer Int
start (Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start)
        MutableByteArray (PrimState (ST st)) -> Int -> Word8 -> ST st ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray st
MutableByteArray (PrimState (ST st))
buffer Int
start Word8
opArray
        ST st Int -> ST st ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Int -> MutableByteArray st -> Int -> ST st Int
forall st. Int -> MutableByteArray st -> Int -> ST st Int
writeVarint Int
count MutableByteArray st
buffer (Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
    rewindTo scratch (end + header)

{- | Copy the value the writer holds into a packed value, and empty the scratch for the next one. Its
hole is the string at the path of member names, when the value holds one there.
-}
sealValue :: Writer st -> [Text] -> ST st Packed
sealValue :: forall st. Writer st -> [Text] -> ST st Packed
sealValue Writer st
writer [Text]
path = do
    let scratch :: Scratch st
scratch = Writer st -> Scratch st
forall st. Writer st -> Scratch st
writerScratch Writer st
writer
        marks :: MutablePrimArray st Int
marks = Writer st -> MutablePrimArray st Int
forall st. Writer st -> MutablePrimArray st Int
writerMarks Writer st
writer
    start <- MutablePrimArray (PrimState (ST st)) Int -> Int -> ST st Int
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
readPrimArray MutablePrimArray st Int
MutablePrimArray (PrimState (ST st)) Int
marks Int
valueStart
    end <- scratchCursor scratch
    blob <- copyOut scratch start end
    from <- readPrimArray marks replacedStart
    to <- readPrimArray marks replacedEnd
    replaced <- if from >= 0 then Just <$> copyOut scratch from to else pure Nothing
    discard writer
    writeMutVar (writerReplaced writer) replaced
    hole <- holeAt writer blob path 0
    pure (packed blob hole)

-- | Forget the value the writer holds, and the member its top-level object replaced.
discard :: Writer st -> ST st ()
discard :: forall st. Writer st -> ST st ()
discard Writer st
writer = do
    Scratch st -> Int -> ST st ()
forall st. Scratch st -> Int -> ST st ()
rewindTo (Writer st -> Scratch st
forall st. Writer st -> Scratch st
writerScratch Writer st
writer) Int
0
    MutablePrimArray (PrimState (ST st)) Int -> Int -> Int -> ST st ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray (Writer st -> MutablePrimArray st Int
forall st. Writer st -> MutablePrimArray st Int
writerMarks Writer st
writer) Int
valueStart Int
0
    MutablePrimArray (PrimState (ST st)) Int -> Int -> Int -> ST st ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray (Writer st -> MutablePrimArray st Int
forall st. Writer st -> MutablePrimArray st Int
writerMarks Writer st
writer) Int
replacedStart (-Int
1)
    MutVar (PrimState (ST st)) (Maybe ByteArray)
-> Maybe ByteArray -> ST st ()
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> a -> m ()
writeMutVar (Writer st -> MutVar st (Maybe ByteArray)
forall st. Writer st -> MutVar st (Maybe ByteArray)
writerReplaced Writer st
writer) Maybe ByteArray
forall a. Maybe a
Nothing

{- | The member the added member replaced in the value sealed last, as read, or nothing when that
value held none or the writer discarded a value since.
-}
replacedMember :: Writer st -> ST st (Maybe Value)
replacedMember :: forall st. Writer st -> ST st (Maybe Value)
replacedMember Writer st
writer = MutVar (PrimState (ST st)) (Maybe ByteArray)
-> ST st (Maybe ByteArray)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar (Writer st -> MutVar st (Maybe ByteArray)
forall st. Writer st -> MutVar st (Maybe ByteArray)
writerReplaced Writer st
writer) ST st (Maybe ByteArray)
-> (Maybe ByteArray -> ST st (Maybe Value)) -> ST st (Maybe Value)
forall a b. ST st a -> (a -> ST st b) -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ByteArray -> ST st Value)
-> Maybe ByteArray -> ST st (Maybe Value)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (\ByteArray
blob -> Int -> ST st (PrimVar (PrimState (ST st)) Int)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
a -> m (PrimVar (PrimState m) a)
newPrimVar Int
0 ST st (PrimVar st Int)
-> (PrimVar st Int -> ST st Value) -> ST st Value
forall a b. ST st a -> (a -> ST st b) -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Writer st -> ByteArray -> PrimVar st Int -> ST st Value
forall (t :: * -> *) st.
TableStrings t =>
t st -> ByteArray -> PrimVar st Int -> ST st Value
decodeWith Writer st
writer ByteArray
blob)

-- Where the string at the path of member names starts, or -1.
holeAt :: Writer st -> ByteArray -> [Text] -> Int -> ST st Int
holeAt :: forall st. Writer st -> ByteArray -> [Text] -> Int -> ST st Int
holeAt Writer st
writer ByteArray
blob [Text]
path Int
position = case [Text]
path of
    []
        | Word8
code Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
opShared -> Int -> ST st Int
forall a. a -> ST st a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
position
        | Word8
code Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
opInline, Bool
stringAt -> Int -> ST st Int
forall a. a -> ST st a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
position
        | Bool
otherwise -> Int -> ST st Int
forall a. a -> ST st a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (-Int
1)
    Text
name : [Text]
rest
        | Word8
code Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
opObject -> Int -> ST st Int
forall a. a -> ST st a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (-Int
1)
        | Bool
otherwise -> case ByteArray -> Int -> (# Int, Int #)
readVarint ByteArray
blob (Int
position Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) of
            (# Int
count, Int
next #) -> Int -> Int -> ST st Int
search Int
count Int
next
      where
        search :: Int -> Int -> ST st Int
search !Int
remaining !Int
at
            | Int
remaining Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Int -> ST st Int
forall a. a -> ST st a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (-Int
1)
            | Bool
otherwise = Writer st
-> ByteArray -> Int -> (Text -> Int -> ST st Int) -> ST st Int
forall st a.
Writer st
-> ByteArray -> Int -> (Text -> Int -> ST st a) -> ST st a
keyAt Writer st
writer ByteArray
blob Int
at ((Text -> Int -> ST st Int) -> ST st Int)
-> (Text -> Int -> ST st Int) -> ST st Int
forall a b. (a -> b) -> a -> b
$ \Text
key Int
valueAt ->
                if Text
key Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name then Writer st -> ByteArray -> [Text] -> Int -> ST st Int
forall st. Writer st -> ByteArray -> [Text] -> Int -> ST st Int
holeAt Writer st
writer ByteArray
blob [Text]
rest Int
valueAt else Int -> Int -> ST st Int
search (Int
remaining Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (ByteArray -> Int -> Int
valueEnd ByteArray
blob Int
valueAt)
  where
    code :: Word8
code = ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
blob Int
position :: Word8
    stringAt :: Bool
stringAt = case ByteArray -> Int -> (# Int, Int #)
readVarint ByteArray
blob (Int
position Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) of (# Int
_, Int
next #) -> (ByteArray -> Int -> Word8
forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
blob Int
next :: Word8) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x22

-- A member's key text and where its value starts.
keyAt :: Writer st -> ByteArray -> Int -> (Text -> Int -> ST st a) -> ST st a
keyAt :: forall st a.
Writer st
-> ByteArray -> Int -> (Text -> Int -> ST st a) -> ST st a
keyAt Writer st
writer ByteArray
blob Int
at Text -> Int -> ST st a
next = case ByteArray -> Int -> (# Int, Int #)
readVarint ByteArray
blob Int
at of
    (# Int
tagged, Int
after #)
        | Int -> Bool
forall a. Integral a => a -> Bool
even Int
tagged -> do
            strings <- MutVar (PrimState (ST st)) (MutableArray st Value)
-> ST st (MutableArray st Value)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar (Writer st -> MutVar st (MutableArray st Value)
forall st. Writer st -> MutVar st (MutableArray st Value)
writerStrings Writer st
writer)
            string <- readArray strings (tagged `div` 2)
            next (stringText string) after
        | Bool
otherwise -> case ByteArray -> Int -> Int -> Value
decodeScalar ByteArray
blob Int
after (Int
tagged Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) of
            String Text
text -> Text -> Int -> ST st a
next Text
text (Int
after Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tagged Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
            Value
_ -> Text -> Int -> ST st a
next Text
"" (Int
after Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tagged Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
{-# INLINE keyAt #-}

-- | Which parts of a packed value a decode needs: all of it, or the named members of an object.
data Pick = Whole | Only [(Text, Pick)]

{- | The parts of a packed value the pick names, as aeson's tree sharing the read's strings. A value
that is not an object where the pick names members decodes whole.
-}
decodePicked :: Writer st -> Pick -> Packed -> ST st Value
decodePicked :: forall st. Writer st -> Pick -> Packed -> ST st Value
decodePicked Writer st
writer Pick
pick Packed
value = Int -> ST st (PrimVar (PrimState (ST st)) Int)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
a -> m (PrimVar (PrimState m) a)
newPrimVar Int
0 ST st (PrimVar st Int)
-> (PrimVar st Int -> ST st Value) -> ST st Value
forall a b. ST st a -> (a -> ST st b) -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Writer st -> Pick -> ByteArray -> PrimVar st Int -> ST st Value
forall st.
Writer st -> Pick -> ByteArray -> PrimVar st Int -> ST st Value
decodePart Writer st
writer Pick
pick (Packed -> ByteArray
packedBlob Packed
value)

decodePart :: Writer st -> Pick -> ByteArray -> PrimVar st Int -> ST st Value
decodePart :: forall st.
Writer st -> Pick -> ByteArray -> PrimVar st Int -> ST st Value
decodePart Writer st
writer Pick
pick ByteArray
blob PrimVar st Int
at = case Pick
pick of
    Pick
Whole -> Writer st -> ByteArray -> PrimVar st Int -> ST st Value
forall (t :: * -> *) st.
TableStrings t =>
t st -> ByteArray -> PrimVar st Int -> ST st Value
decodeWith Writer st
writer ByteArray
blob PrimVar st Int
at
    Only [(Text, Pick)]
picks -> do
        position <- PrimVar (PrimState (ST st)) Int -> ST st Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> m a
readPrimVar PrimVar st Int
PrimVar (PrimState (ST st)) Int
at
        if (indexByteArray blob position :: Word8) /= opObject
            then decodeWith writer blob at
            else case readVarint blob (position + 1) of
                (# Int
count, Int
members #) -> do
                    wanted <- Writer st
-> [(Text, Pick)] -> ByteArray -> Int -> Int -> Int -> ST st Int
forall st.
Writer st
-> [(Text, Pick)] -> ByteArray -> Int -> Int -> Int -> ST st Int
countPicked Writer st
writer [(Text, Pick)]
picks ByteArray
blob Int
count Int
members Int
0
                    writePrimVar at members
                    picked <- buildPicked writer picks blob at wanted
                    writePrimVar at (valueEnd blob position)
                    pure $! Object (KeyMap.fromMap picked)

-- How many of the object's members, from the position on, the pick names.
countPicked :: Writer st -> [(Text, Pick)] -> ByteArray -> Int -> Int -> Int -> ST st Int
countPicked :: forall st.
Writer st
-> [(Text, Pick)] -> ByteArray -> Int -> Int -> Int -> ST st Int
countPicked Writer st
writer [(Text, Pick)]
picks ByteArray
blob !Int
remaining !Int
position !Int
found
    | Int
remaining Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Int -> ST st Int
forall a. a -> ST st a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
found
    | Bool
otherwise = Writer st
-> ByteArray -> Int -> (Text -> Int -> ST st Int) -> ST st Int
forall st a.
Writer st
-> ByteArray -> Int -> (Text -> Int -> ST st a) -> ST st a
keyAt Writer st
writer ByteArray
blob Int
position ((Text -> Int -> ST st Int) -> ST st Int)
-> (Text -> Int -> ST st Int) -> ST st Int
forall a b. (a -> b) -> a -> b
$ \Text
text Int
valueAt ->
        Writer st
-> [(Text, Pick)] -> ByteArray -> Int -> Int -> Int -> ST st Int
forall st.
Writer st
-> [(Text, Pick)] -> ByteArray -> Int -> Int -> Int -> ST st Int
countPicked Writer st
writer [(Text, Pick)]
picks ByteArray
blob (Int
remaining Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (ByteArray -> Int -> Int
valueEnd ByteArray
blob Int
valueAt) (if Maybe Pick -> Bool
forall a. Maybe a -> Bool
isJust (Text -> [(Text, Pick)] -> Maybe Pick
pickFor Text
text [(Text, Pick)]
picks) then Int
found Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 else Int
found)

-- The next picked members, the given number of them, as a balanced map built in key order.
buildPicked :: Writer st -> [(Text, Pick)] -> ByteArray -> PrimVar st Int -> Int -> ST st (Map.Map Key.Key Value)
buildPicked :: forall st.
Writer st
-> [(Text, Pick)]
-> ByteArray
-> PrimVar st Int
-> Int
-> ST st (Map Key Value)
buildPicked Writer st
writer [(Text, Pick)]
picks ByteArray
blob PrimVar st Int
at !Int
count
    | Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Map Key Value -> ST st (Map Key Value)
forall a. a -> ST st a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Key Value
forall k a. Map k a
Tip
    | Bool
otherwise = do
        let before :: Int
before = (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
        left <- Writer st
-> [(Text, Pick)]
-> ByteArray
-> PrimVar st Int
-> Int
-> ST st (Map Key Value)
forall st.
Writer st
-> [(Text, Pick)]
-> ByteArray
-> PrimVar st Int
-> Int
-> ST st (Map Key Value)
buildPicked Writer st
writer [(Text, Pick)]
picks ByteArray
blob PrimVar st Int
at Int
before
        position <- readPrimVar at
        member <- nextPicked writer picks blob at position
        right <- buildPicked writer picks blob at (count - 1 - before)
        pure $! case member of (Key
name, Value
value) -> Int
-> Key -> Value -> Map Key Value -> Map Key Value -> Map Key Value
forall k a. Int -> k -> a -> Map k a -> Map k a -> Map k a
Bin Int
count Key
name Value
value Map Key Value
left Map Key Value
right

pickFor :: Text -> [(Text, Pick)] -> Maybe Pick
pickFor :: Text -> [(Text, Pick)] -> Maybe Pick
pickFor Text
text = ((Text, Pick) -> Pick) -> Maybe (Text, Pick) -> Maybe Pick
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, Pick) -> Pick
forall a b. (a, b) -> b
snd (Maybe (Text, Pick) -> Maybe Pick)
-> ([(Text, Pick)] -> Maybe (Text, Pick))
-> [(Text, Pick)]
-> Maybe Pick
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Pick) -> Bool) -> [(Text, Pick)] -> Maybe (Text, Pick)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
text) (Text -> Bool) -> ((Text, Pick) -> Text) -> (Text, Pick) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Pick) -> Text
forall a b. (a, b) -> a
fst)

-- The next member the pick names, skipping the others.
nextPicked :: Writer st -> [(Text, Pick)] -> ByteArray -> PrimVar st Int -> Int -> ST st (Key.Key, Value)
nextPicked :: forall st.
Writer st
-> [(Text, Pick)]
-> ByteArray
-> PrimVar st Int
-> Int
-> ST st (Key, Value)
nextPicked Writer st
writer [(Text, Pick)]
picks ByteArray
blob PrimVar st Int
at !Int
position = Writer st
-> ByteArray
-> Int
-> (Text -> Int -> ST st (Key, Value))
-> ST st (Key, Value)
forall st a.
Writer st
-> ByteArray -> Int -> (Text -> Int -> ST st a) -> ST st a
keyAt Writer st
writer ByteArray
blob Int
position ((Text -> Int -> ST st (Key, Value)) -> ST st (Key, Value))
-> (Text -> Int -> ST st (Key, Value)) -> ST st (Key, Value)
forall a b. (a -> b) -> a -> b
$ \Text
text Int
valueAt -> case Text -> [(Text, Pick)] -> Maybe Pick
pickFor Text
text [(Text, Pick)]
picks of
    Just Pick
pick -> do
        PrimVar (PrimState (ST st)) Int -> Int -> ST st ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> a -> m ()
writePrimVar PrimVar st Int
PrimVar (PrimState (ST st)) Int
at Int
valueAt
        member <- Writer st -> Pick -> ByteArray -> PrimVar st Int -> ST st Value
forall st.
Writer st -> Pick -> ByteArray -> PrimVar st Int -> ST st Value
decodePart Writer st
writer Pick
pick ByteArray
blob PrimVar st Int
at
        pure (Key.fromText text, member)
    Maybe Pick
Nothing -> Writer st
-> [(Text, Pick)]
-> ByteArray
-> PrimVar st Int
-> Int
-> ST st (Key, Value)
forall st.
Writer st
-> [(Text, Pick)]
-> ByteArray
-> PrimVar st Int
-> Int
-> ST st (Key, Value)
nextPicked Writer st
writer [(Text, Pick)]
picks ByteArray
blob PrimVar st Int
at (ByteArray -> Int -> Int
valueEnd ByteArray
blob Int
valueAt)

-- | A packed value decoded whole, sharing the read's strings.
decodeWhole :: Writer st -> Packed -> ST st Value
decodeWhole :: forall st. Writer st -> Packed -> ST st Value
decodeWhole Writer st
writer Packed
value = Int -> ST st (PrimVar (PrimState (ST st)) Int)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
a -> m (PrimVar (PrimState m) a)
newPrimVar Int
0 ST st (PrimVar st Int)
-> (PrimVar st Int -> ST st Value) -> ST st Value
forall a b. ST st a -> (a -> ST st b) -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Writer st -> ByteArray -> PrimVar st Int -> ST st Value
forall (t :: * -> *) st.
TableStrings t =>
t st -> ByteArray -> PrimVar st Int -> ST st Value
decodeWith Writer st
writer (Packed -> ByteArray
packedBlob Packed
value)

-- A decode reads the read's own entries, so decoded strings share the typed view's texts.
instance TableStrings Writer where
    tableValue :: forall st. Writer st -> Int -> ST st Value
tableValue Writer st
writer Int
index = do
        strings <- MutVar (PrimState (ST st)) (MutableArray st Value)
-> ST st (MutableArray st Value)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar (Writer st -> MutVar st (MutableArray st Value)
forall st. Writer st -> MutVar st (MutableArray st Value)
writerStrings Writer st
writer)
        readArray strings index
    tableKey :: forall st. Writer st -> Int -> ST st Key
tableKey Writer st
writer Int
index = do
        strings <- MutVar (PrimState (ST st)) (MutableArray st Value)
-> ST st (MutableArray st Value)
forall (m :: * -> *) a.
PrimMonad m =>
MutVar (PrimState m) a -> m a
readMutVar (Writer st -> MutVar st (MutableArray st Value)
forall st. Writer st -> MutVar st (MutableArray st Value)
writerStrings Writer st
writer)
        string <- readArray strings index
        pure $! Key.fromText (stringText string)

-- A registered string's text. Every slot a blob refers to holds a string.
stringText :: Value -> Text
stringText :: Value -> Text
stringText = \case
    String Text
text -> Text
text
    Value
_ -> Text
""