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

{- | The packed form: one table per document holding the bytes aeson writes for each shared string,
and one opcode blob per retained value. A render copies those bytes into a buffer of the output's
exact length, so no string is escaped again. A value holds at most one hole: a URL string that a
render may rebase onto a per-request prefix, keeping the URL's file name.
-}
module Ecluse.Core.Registry.Json.Packed (
    -- * Encoded strings
    encodeString,
    encodedLength,
    writeEncoded,
    plain,
    quote,

    -- * The format
    opNull,
    opFalse,
    opTrue,
    opShared,
    opObject,
    opArray,
    opInline,
    varintSize,
    readVarint,
    writeVarint,
    valueEnd,

    -- * The document table
    DocTable,
    docTable,
    tableResident,

    -- * Packed values
    Packed,
    packed,
    packedBlob,
    packedBytes,
    packedResident,
    withoutHole,

    -- * Rendering
    UrlPrefix,
    urlPrefix,
    Piece (..),
    Pieces (..),
    RenderPlan (..),
    renderPlan,
    planValue,
    planResident,

    -- * Reading back
    TableStrings (..),
    decodeWith,
    decodeKeyWith,
    decodeScalar,
    packedValue,
) where

import Control.Monad.ST (ST, runST)
import Data.Aeson (Value (..), eitherDecodeStrict)
import Data.Aeson.Encoding (encodingToLazyByteString)
import Data.Aeson.Encoding qualified as Encoding
import Data.Aeson.Key qualified as Key
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Bits (shiftL, shiftR, (.&.), (.|.))
import Data.ByteString qualified as BS
import Data.ByteString.Internal qualified as BSI
import Data.ByteString.Short qualified as SBS
import Data.ByteString.Unsafe qualified as BSU
import Data.Map.Internal (Map (Bin, Tip))
import Data.Map.Strict qualified as Map
import Data.Primitive.ByteArray (ByteArray, MutableByteArray, copyByteArray, copyByteArrayToAddr, createByteArray, indexByteArray, sizeofByteArray, writeByteArray)
import Data.Primitive.PrimArray (PrimArray, indexPrimArray, newPrimArray, runPrimArray, sizeofPrimArray, writePrimArray)
import Data.Primitive.PrimVar (PrimVar, newPrimVar, readPrimVar, writePrimVar)
import Data.Primitive.SmallArray (SmallArray, indexSmallArray, sizeofSmallArray)
import Data.Scientific (Scientific, normalize, scientific)
import Data.Scientific qualified as Scientific
import Data.Text.Array qualified as TA
import Data.Text.Internal qualified as TI
import Data.Vector qualified as V
import Foreign.Marshal.Utils (copyBytes)
import Foreign.Ptr (Ptr, castPtr, plusPtr)
import Foreign.Storable (pokeByteOff)

import Ecluse.Core.Text (textStorageBytes)

-- | The bytes aeson writes for a string, quotes included: 'encodedLength' of them.
encodeString :: Text -> ByteString
encodeString :: Text -> ByteString
encodeString text :: Text
text@(TI.Text Array
array Int
offset Int
len)
    | Text -> Bool
plain Text
text = Int -> (Ptr Word8 -> IO ()) -> ByteString
BSI.unsafeCreate (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
target -> do
        Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
target Int
0 Word8
quote
        Ptr Word8 -> Array -> Int -> Int -> IO ()
forall (m :: * -> *).
PrimMonad m =>
Ptr Word8 -> Array -> Int -> Int -> m ()
copyByteArrayToAddr (Ptr Word8
target Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1) Array
array Int
offset Int
len
        Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
target (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8
quote
    | Bool
otherwise = ShortByteString -> ByteString
SBS.fromShort (Array -> ShortByteString
SBS.ShortByteString (Int -> (forall s. MutableByteArray s -> ST s ()) -> Array
createByteArray (Text -> Int
encodedLength Text
text) (\MutableByteArray s
target -> ST s Int -> ST s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Text -> MutableByteArray s -> Int -> ST s Int
forall st. Text -> MutableByteArray st -> Int -> ST st Int
writeEncoded Text
text MutableByteArray s
target Int
0))))

-- | The length of 'encodeString', from the escape 'writeEncoded' writes for each byte.
encodedLength :: Text -> Int
encodedLength :: Text -> Int
encodedLength (TI.Text Array
array Int
offset Int
len) = Int -> Int -> Int
go Int
offset Int
2
  where
    end :: Int
end = Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len
    go :: Int -> Int -> Int
go !Int
i !Int
total
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end = Int
total
        | Bool
otherwise = Int -> Int -> Int
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
total Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Escape -> Int
escapeWidth (Word8 -> Escape
escapeOf (Array -> Int -> Word8
TA.unsafeIndex Array
array Int
i)))

-- | Whether aeson writes the string's bytes as they are: no backslash, quote or byte below a space.
plain :: Text -> Bool
plain :: Text -> Bool
plain (TI.Text Array
array Int
offset Int
len) = Int -> Bool
go Int
offset
  where
    end :: Int
end = Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len
    go :: Int -> Bool
go !Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end = Bool
True
        | Bool
otherwise = case Word8 -> Escape
escapeOf (Array -> Int -> Word8
TA.unsafeIndex Array
array Int
i) of
            Escape
Verbatim -> Int -> Bool
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            Escape
_ -> Bool
False

-- | Write 'encodeString' at an offset, and return the offset after it.
writeEncoded :: Text -> MutableByteArray st -> Int -> ST st Int
writeEncoded :: forall st. Text -> MutableByteArray st -> Int -> ST st Int
writeEncoded text :: Text
text@(TI.Text Array
array Int
offset Int
len) MutableByteArray st
target Int
at
    | Text -> Bool
plain Text
text = do
        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))
target Int
at Word8
quote
        MutableByteArray (PrimState (ST st))
-> Int -> Array -> Int -> Int -> ST st ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> Array -> Int -> Int -> m ()
copyByteArray MutableByteArray st
MutableByteArray (PrimState (ST st))
target (Int
at Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Array
array Int
offset Int
len
        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))
target (Int
at Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8
quote
        Int -> ST st Int
forall a. a -> ST st a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
at Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
    | Bool
otherwise = do
        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))
target Int
at Word8
quote
        end <- Array -> Int -> Int -> MutableByteArray st -> Int -> ST st Int
forall st.
Array -> Int -> Int -> MutableByteArray st -> Int -> ST st Int
escapeFrom Array
array Int
offset (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len) MutableByteArray st
target (Int
at Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        writeByteArray target end quote
        pure (end + 1)

{- aeson's escape for one byte of a string: the byte as it is, a backslash and a letter for a
backslash, a quote, a newline, a return or a tab, and a lower-case hexadecimal code below a space. -}
data Escape = Verbatim | Named !Word8 | Coded

escapeOf :: Word8 -> Escape
escapeOf :: Word8 -> Escape
escapeOf Word8
byte
    | Word8
byte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x5c = Word8 -> Escape
Named Word8
0x5c
    | Word8
byte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x22 = Word8 -> Escape
Named Word8
0x22
    | Word8
byte Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0x20 = Escape
Verbatim
    | Word8
byte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x0a = Word8 -> Escape
Named Word8
0x6e
    | Word8
byte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x0d = Word8 -> Escape
Named Word8
0x72
    | Word8
byte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x09 = Word8 -> Escape
Named Word8
0x74
    | Bool
otherwise = Escape
Coded
{-# INLINE escapeOf #-}

escapeWidth :: Escape -> Int
escapeWidth :: Escape -> Int
escapeWidth = \case
    Escape
Verbatim -> Int
1
    Named Word8
_ -> Int
2
    Escape
Coded -> Int
6
{-# INLINE escapeWidth #-}

escapeFrom :: TA.Array -> Int -> Int -> MutableByteArray st -> Int -> ST st Int
escapeFrom :: forall st.
Array -> Int -> Int -> MutableByteArray st -> Int -> ST st Int
escapeFrom Array
array !Int
from !Int
to MutableByteArray st
target !Int
at
    | Int
from Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
to = Int -> ST st Int
forall a. a -> ST st a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
at
    | Bool
otherwise = case Word8 -> Escape
escapeOf Word8
byte of
        Escape
Verbatim -> 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))
target Int
at Word8
byte ST st () -> ST st Int -> ST st Int
forall a b. ST st a -> ST st b -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST st Int
next Int
1
        Named Word8
letter -> do
            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))
target Int
at (Word8
0x5c :: Word8)
            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))
target (Int
at Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word8
letter
            Int -> ST st Int
next Int
2
        Escape
Coded -> do
            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))
target Int
at (Word8
0x5c :: Word8)
            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))
target (Int
at Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Word8
0x75 :: Word8)
            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))
target (Int
at Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Word8
0x30 :: Word8)
            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))
target (Int
at Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) (Word8
0x30 :: Word8)
            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))
target (Int
at Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) (Word8 -> Word8
hexDigit (Word8
byte Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
4))
            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))
target (Int
at Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5) (Word8 -> Word8
hexDigit (Word8
byte Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x0f))
            Int -> ST st Int
next Int
6
  where
    byte :: Word8
byte = Array -> Int -> Word8
TA.unsafeIndex Array
array Int
from
    next :: Int -> ST st Int
next Int
width = Array -> Int -> Int -> MutableByteArray st -> Int -> ST st Int
forall st.
Array -> Int -> Int -> MutableByteArray st -> Int -> ST st Int
escapeFrom Array
array (Int
from Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
to MutableByteArray st
target (Int
at Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
width)

hexDigit :: Word8 -> Word8
hexDigit :: Word8 -> Word8
hexDigit Word8
digit
    | Word8
digit Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
10 = Word8
0x30 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
digit
    | Bool
otherwise = Word8
0x57 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
digit

-- | The quote byte that opens and closes a string's encoding.
quote :: Word8
quote :: Word8
quote = Word8
0x22

{- | Each value's first byte. A table index, a count, or an inline length and aeson's bytes follow. A
member key is twice its table index, or twice its inline length plus one followed by its bytes.
-}
opNull, opFalse, opTrue, opShared, opObject, opArray, opInline :: Word8
opNull :: Word8
opNull = Word8
0
opFalse :: Word8
opFalse = Word8
1
opTrue :: Word8
opTrue = Word8
2
opShared :: Word8
opShared = Word8
3
opObject :: Word8
opObject = Word8
4
opArray :: Word8
opArray = Word8
5
opInline :: Word8
opInline = Word8
6

-- | The bytes a varint of the integer takes.
varintSize :: Int -> Int
varintSize :: Int -> Int
varintSize Int
n
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x80 = Int
1
    | Bool
otherwise = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
varintSize (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
0x80)

-- | The varint at a position, and the position after it.
readVarint :: ByteArray -> Int -> (# Int, Int #)
readVarint :: Array -> Int -> (# Int, Int #)
readVarint Array
blob = Int -> Int -> Int -> (# Int, Int #)
forall {t}. (Bits t, Num t) => t -> Int -> Int -> (# t, Int #)
go Int
0 Int
0
  where
    go :: t -> Int -> Int -> (# t, Int #)
go !t
acc !Int
shift !Int
i =
        let byte :: Word8
byte = Array -> Int -> Word8
forall a. Prim a => Array -> Int -> a
indexByteArray Array
blob Int
i :: Word8
            acc' :: t
acc' = t
acc t -> t -> t
forall a. Bits a => a -> a -> a
.|. (Word8 -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8
byte Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x7f) t -> Int -> t
forall a. Bits a => a -> Int -> a
`shiftL` Int
shift)
         in if Word8
byte Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
0x80 then (# t
acc', Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 #) else t -> Int -> Int -> (# t, Int #)
go t
acc' (Int
shift Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
{-# INLINE readVarint #-}

-- | Write the integer's varint at an offset, and return the offset after it.
writeVarint :: Int -> MutableByteArray st -> Int -> ST st Int
writeVarint :: forall st. Int -> MutableByteArray st -> Int -> ST st Int
writeVarint !Int
n MutableByteArray st
buffer !Int
at
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x80 = 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
at (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n :: Word8) ST st () -> ST st Int -> ST st Int
forall a b. ST st a -> ST st b -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST st Int
forall a. a -> ST st a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
at Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    | Bool
otherwise = 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
at (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x7f) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
0x80 :: Word8) ST st () -> ST st Int -> ST st Int
forall a b. ST st a -> ST st b -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> MutableByteArray st -> Int -> ST st Int
forall st. Int -> MutableByteArray st -> Int -> ST st Int
writeVarint (Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
7) MutableByteArray st
buffer (Int
at Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- | The position after the value that starts at a position.
valueEnd :: ByteArray -> Int -> Int
valueEnd :: Array -> Int -> Int
valueEnd Array
blob Int
position = case Array -> Int -> Word8
forall a. Prim a => Array -> Int -> a
indexByteArray Array
blob Int
position :: Word8 of
    Word8
byte
        | Word8
byte Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
opTrue -> Int
position Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        | Word8
byte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
opShared -> case Array -> Int -> (# Int, Int #)
readVarint Array
blob (Int
position Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) of (# Int
_, Int
next #) -> Int
next
        | Word8
byte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
opObject -> case Array -> Int -> (# Int, Int #)
readVarint Array
blob (Int
position Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) of (# Int
count, Int
next #) -> Int -> Int -> Int
forall {t}. (Ord t, Num t) => t -> Int -> Int
members Int
count Int
next
        | Word8
byte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
opArray -> case Array -> Int -> (# Int, Int #)
readVarint Array
blob (Int
position Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) of (# Int
count, Int
next #) -> Int -> Int -> Int
forall {t}. (Ord t, Num t) => t -> Int -> Int
items Int
count Int
next
        | Bool
otherwise -> case Array -> Int -> (# Int, Int #)
readVarint Array
blob (Int
position Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) of (# Int
len, Int
next #) -> Int
next Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len
  where
    members :: t -> Int -> Int
members !t
count !Int
at
        | t
count t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0 = Int
at
        | Bool
otherwise = case Array -> Int -> (# Int, Int #)
readVarint Array
blob Int
at of
            (# Int
tagged, Int
next #) -> t -> Int -> Int
members (t
count t -> t -> t
forall a. Num a => a -> a -> a
- t
1) (Array -> Int -> Int
valueEnd Array
blob (if Int -> Bool
forall a. Integral a => a -> Bool
even Int
tagged then Int
next else Int
next 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))
    items :: t -> Int -> Int
items !t
count !Int
at
        | t
count t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0 = Int
at
        | Bool
otherwise = t -> Int -> Int
items (t
count t -> t -> t
forall a. Num a => a -> a -> a
- t
1) (Array -> Int -> Int
valueEnd Array
blob Int
at)

-- | One document's shared strings, back to back as aeson writes them, and where each begins.
data DocTable = DocTable !ByteArray !(PrimArray Int)
    deriving stock (DocTable -> DocTable -> Bool
(DocTable -> DocTable -> Bool)
-> (DocTable -> DocTable -> Bool) -> Eq DocTable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DocTable -> DocTable -> Bool
== :: DocTable -> DocTable -> Bool
$c/= :: DocTable -> DocTable -> Bool
/= :: DocTable -> DocTable -> Bool
Eq, Int -> DocTable -> ShowS
[DocTable] -> ShowS
DocTable -> String
(Int -> DocTable -> ShowS)
-> (DocTable -> String) -> ([DocTable] -> ShowS) -> Show DocTable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DocTable -> ShowS
showsPrec :: Int -> DocTable -> ShowS
$cshow :: DocTable -> String
show :: DocTable -> String
$cshowList :: [DocTable] -> ShowS
showList :: [DocTable] -> ShowS
Show)

-- | Lay out the table from its strings in index order.
docTable :: SmallArray Text -> DocTable
docTable :: SmallArray Text -> DocTable
docTable SmallArray Text
strings = Array -> PrimArray Int -> DocTable
DocTable Array
arena PrimArray Int
offsets
  where
    count :: Int
count = SmallArray Text -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray Text
strings
    offsets :: PrimArray Int
offsets = (forall s. ST s (MutablePrimArray s Int)) -> PrimArray Int
forall a. (forall s. ST s (MutablePrimArray s a)) -> PrimArray a
runPrimArray ((forall s. ST s (MutablePrimArray s Int)) -> PrimArray Int)
-> (forall s. ST s (MutablePrimArray s Int)) -> PrimArray Int
forall a b. (a -> b) -> a -> b
$ do
        target <- Int -> ST s (MutablePrimArray (PrimState (ST s)) Int)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        let fill !Int
index !Int
offset = do
                MutablePrimArray (PrimState m) Int -> Int -> Int -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray MutablePrimArray s Int
MutablePrimArray (PrimState m) Int
target Int
index Int
offset
                Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
count) (Int -> Int -> m ()
fill (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
encodedLength (SmallArray Text -> Int -> Text
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray Text
strings Int
index)))
        fill 0 0
        pure target
    arena :: Array
arena = Int -> (forall s. MutableByteArray s -> ST s ()) -> Array
createByteArray (PrimArray Int -> Int -> Int
forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray Int
offsets Int
count) (MutableByteArray s -> Int -> ST s ()
forall {st}. MutableByteArray st -> Int -> ST st ()
`placeFrom` Int
0)
    placeFrom :: MutableByteArray st -> Int -> ST st ()
placeFrom MutableByteArray st
target !Int
index = Bool -> ST st () -> ST st ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
index 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
        ST st Int -> ST st ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Text -> MutableByteArray st -> Int -> ST st Int
forall st. Text -> MutableByteArray st -> Int -> ST st Int
writeEncoded (SmallArray Text -> Int -> Text
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray Text
strings Int
index) MutableByteArray st
target (PrimArray Int -> Int -> Int
forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray Int
offsets Int
index))
        MutableByteArray st -> Int -> ST st ()
placeFrom MutableByteArray st
target (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- | The heap bytes the table holds: its record, and its two arrays with their headers.
tableResident :: DocTable -> Int
tableResident :: DocTable -> Int
tableResident (DocTable Array
arena PrimArray Int
offsets) = Int
24 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
arrayResident (Array -> Int
sizeofByteArray Array
arena) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
arrayResident (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* PrimArray Int -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Int
offsets)

-- The heap bytes of a byte array with the given payload: a two-word header and the payload in whole words.
arrayResident :: Int -> Int
arrayResident :: Int -> Int
arrayResident Int
size = Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* ((Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8)

-- Where a table string's encoding starts in the arena, and its length. An index past the table has
-- length -1, which a render refuses, so a damaged blob never reads outside the arena.
tableEntry :: DocTable -> Int -> (# Int, Int #)
tableEntry :: DocTable -> Int -> (# Int, Int #)
tableEntry (DocTable Array
_ PrimArray Int
offsets) Int
index
    | Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= PrimArray Int -> Int
forall a. Prim a => PrimArray a -> Int
sizeofPrimArray PrimArray Int
offsets = (# Int
0, -Int
1 #)
    | Bool
otherwise =
        let start :: Int
start = PrimArray Int -> Int -> Int
forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray Int
offsets Int
index
         in (# Int
start, PrimArray Int -> Int -> Int
forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray Int
offsets (Int
index Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
start #)
{-# INLINE tableEntry #-}

tableArena :: DocTable -> ByteArray
tableArena :: DocTable -> Array
tableArena (DocTable Array
arena PrimArray Int
_) = Array
arena

-- | One retained value: its opcodes, and where its hole's string starts, or -1.
data Packed = Packed !ByteArray !Int
    deriving stock (Packed -> Packed -> Bool
(Packed -> Packed -> Bool)
-> (Packed -> Packed -> Bool) -> Eq Packed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Packed -> Packed -> Bool
== :: Packed -> Packed -> Bool
$c/= :: Packed -> Packed -> Bool
/= :: Packed -> Packed -> Bool
Eq, Int -> Packed -> ShowS
[Packed] -> ShowS
Packed -> String
(Int -> Packed -> ShowS)
-> (Packed -> String) -> ([Packed] -> ShowS) -> Show Packed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Packed -> ShowS
showsPrec :: Int -> Packed -> ShowS
$cshow :: Packed -> String
show :: Packed -> String
$cshowList :: [Packed] -> ShowS
showList :: [Packed] -> ShowS
Show)

-- | A value from its opcodes and the position of its hole, or -1 for none.
packed :: ByteArray -> Int -> Packed
packed :: Array -> Int -> Packed
packed = Array -> Int -> Packed
Packed

-- | The value's opcodes.
packedBlob :: Packed -> ByteArray
packedBlob :: Packed -> Array
packedBlob (Packed Array
blob Int
_) = Array
blob

-- | The bytes the value holds itself, outside its table.
packedBytes :: Packed -> Int
packedBytes :: Packed -> Int
packedBytes (Packed Array
blob Int
_) = Array -> Int
sizeofByteArray Array
blob

-- | The heap bytes the value holds itself: its record, and its blob with the array's header.
packedResident :: Packed -> Int
packedResident :: Packed -> Int
packedResident Packed
value = Int
24 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
arrayResident (Packed -> Int
packedBytes Packed
value)

-- | The value with no hole, so every render writes it as read.
withoutHole :: Packed -> Packed
withoutHole :: Packed -> Packed
withoutHole (Packed Array
blob Int
_) = Array -> Int -> Packed
Packed Array
blob (-Int
1)

-- The encoded length of the value at a position, or -1 when it names a string the table lacks, and
-- the position after it.
encodedAt :: DocTable -> ByteArray -> Int -> (# Int, Int #)
encodedAt :: DocTable -> Array -> Int -> (# Int, Int #)
encodedAt DocTable
table Array
blob Int
position = case Array -> Int -> Word8
forall a. Prim a => Array -> Int -> a
indexByteArray Array
blob Int
position :: Word8 of
    Word8
byte
        | Word8
byte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
opNull -> (# Int
4, Int
position Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 #)
        | Word8
byte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
opFalse -> (# Int
5, Int
position Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 #)
        | Word8
byte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
opTrue -> (# Int
4, Int
position Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 #)
        | Word8
byte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
opShared -> case Array -> Int -> (# Int, Int #)
readVarint Array
blob (Int
position Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) of
            (# Int
index, Int
next #) -> case DocTable -> Int -> (# Int, Int #)
tableEntry DocTable
table Int
index of (# Int
_, Int
len #) -> (# Int
len, Int
next #)
        | Word8
byte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
opObject -> case Array -> Int -> (# Int, Int #)
readVarint Array
blob (Int
position Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) of
            (# Int
count, Int
next #) -> Int -> Int -> Int -> (# Int, Int #)
forall {t}. (Ord t, Num t) => t -> Int -> Int -> (# Int, Int #)
members Int
count Int
next (Int -> Int
separators Int
count)
        | Word8
byte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
opArray -> case Array -> Int -> (# Int, Int #)
readVarint Array
blob (Int
position Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) of
            (# Int
count, Int
next #) -> Int -> Int -> Int -> (# Int, Int #)
forall {t}. (Ord t, Num t) => t -> Int -> Int -> (# Int, Int #)
items Int
count Int
next (Int -> Int
separators Int
count)
        | Bool
otherwise -> case Array -> Int -> (# Int, Int #)
readVarint Array
blob (Int
position Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) of (# Int
len, Int
next #) -> (# Int
len, Int
next Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len #)
  where
    members :: t -> Int -> Int -> (# Int, Int #)
members !t
count !Int
at !Int
total
        | t
count t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0 = (# Int
total, Int
at #)
        | Bool
otherwise = case Array -> Int -> (# Int, Int #)
readVarint Array
blob Int
at of
            (# Int
tagged, Int
next #)
                | Int -> Bool
forall a. Integral a => a -> Bool
even Int
tagged -> case DocTable -> Int -> (# Int, Int #)
tableEntry DocTable
table (Int
tagged Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) of
                    (# Int
_, Int
keyLen #)
                        | Int
keyLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> (# -Int
1, Int
next #)
                        | Bool
otherwise -> t -> Int -> Int -> Int -> (# Int, Int #)
member t
count Int
next (Int
keyLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
total
                | Bool
otherwise -> t -> Int -> Int -> Int -> (# Int, Int #)
member t
count (Int
next 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) (Int
tagged Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
total
    member :: t -> Int -> Int -> Int -> (# Int, Int #)
member !t
count !Int
at !Int
keyed !Int
total = case DocTable -> Array -> Int -> (# Int, Int #)
encodedAt DocTable
table Array
blob Int
at of
        (# Int
len, Int
after #)
            | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> (# -Int
1, Int
after #)
            | Bool
otherwise -> t -> Int -> Int -> (# Int, Int #)
members (t
count t -> t -> t
forall a. Num a => a -> a -> a
- t
1) Int
after (Int
total Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
keyed Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len)
    items :: t -> Int -> Int -> (# Int, Int #)
items !t
count !Int
at !Int
total
        | t
count t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0 = (# Int
total, Int
at #)
        | Bool
otherwise = case DocTable -> Array -> Int -> (# Int, Int #)
encodedAt DocTable
table Array
blob Int
at of
            (# Int
len, Int
after #)
                | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> (# -Int
1, Int
after #)
                | Bool
otherwise -> t -> Int -> Int -> (# Int, Int #)
items (t
count t -> t -> t
forall a. Num a => a -> a -> a
- t
1) Int
after (Int
total Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len)

-- Two brackets and a comma between each pair of members or items.
separators :: Int -> Int
separators :: Int -> Int
separators Int
count = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

-- The array holding the scalar at a position, where its encoding starts and how long it is, and the
-- position after it in the blob.
scalarSource :: DocTable -> ByteArray -> Int -> (# ByteArray, Int, Int, Int #)
scalarSource :: DocTable -> Array -> Int -> (# Array, Int, Int, Int #)
scalarSource DocTable
table Array
blob Int
position
    | (Array -> Int -> Word8
forall a. Prim a => Array -> Int -> a
indexByteArray Array
blob Int
position :: Word8) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
opShared = case Array -> Int -> (# Int, Int #)
readVarint Array
blob (Int
position Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) of
        (# Int
index, Int
next #) -> case DocTable -> Int -> (# Int, Int #)
tableEntry DocTable
table Int
index of (# Int
start, Int
len #) -> (# DocTable -> Array
tableArena DocTable
table, Int
start, Int
len, Int
next #)
    | Bool
otherwise = case Array -> Int -> (# Int, Int #)
readVarint Array
blob (Int
position Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) of
        (# Int
len, Int
next #) -> (# Array
blob, Int
next, Int
len, Int
next Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len #)

{- | A URL prefix a render writes in place of a hole's URL, before the URL's file name: the bytes
aeson writes for its characters, quotes excluded.
-}
newtype UrlPrefix = UrlPrefix ByteArray
    deriving stock (UrlPrefix -> UrlPrefix -> Bool
(UrlPrefix -> UrlPrefix -> Bool)
-> (UrlPrefix -> UrlPrefix -> Bool) -> Eq UrlPrefix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UrlPrefix -> UrlPrefix -> Bool
== :: UrlPrefix -> UrlPrefix -> Bool
$c/= :: UrlPrefix -> UrlPrefix -> Bool
/= :: UrlPrefix -> UrlPrefix -> Bool
Eq, Int -> UrlPrefix -> ShowS
[UrlPrefix] -> ShowS
UrlPrefix -> String
(Int -> UrlPrefix -> ShowS)
-> (UrlPrefix -> String)
-> ([UrlPrefix] -> ShowS)
-> Show UrlPrefix
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UrlPrefix -> ShowS
showsPrec :: Int -> UrlPrefix -> ShowS
$cshow :: UrlPrefix -> String
show :: UrlPrefix -> String
$cshowList :: [UrlPrefix] -> ShowS
showList :: [UrlPrefix] -> ShowS
Show)

-- | Encode a prefix once for every hole a render rebases.
urlPrefix :: Text -> UrlPrefix
urlPrefix :: Text -> UrlPrefix
urlPrefix Text
text = Array -> UrlPrefix
UrlPrefix (ShortByteString -> Array
SBS.unShortByteString (ByteString -> ShortByteString
SBS.toShort (Int -> ByteString -> ByteString
BS.take (ByteString -> Int
BS.length ByteString
encoded Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) (Int -> ByteString -> ByteString
BS.drop Int
1 ByteString
encoded))))
  where
    encoded :: ByteString
encoded = Text -> ByteString
encodeString Text
text

{- Where the file name lies in an encoded URL: after the last slash before any query or fragment. No
escape writes a slash, a question mark or a hash, so the span is the file name's own encoding. -}
fileSpan :: ByteArray -> Int -> Int -> (# Int, Int #)
fileSpan :: Array -> Int -> Int -> (# Int, Int #)
fileSpan Array
array Int
start Int
len
    | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = (# Int
start, Int
0 #)
    | Bool
otherwise = (# Int
fileStart, Int
pathEnd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
fileStart #)
  where
    end :: Int
end = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    pathEnd :: Int
pathEnd = Int -> Int
scanPath (Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    scanPath :: Int -> Int
scanPath !Int
at
        | Int
at Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end = Int
end
        | Bool
otherwise = case Array -> Int -> Word8
forall a. Prim a => Array -> Int -> a
indexByteArray Array
array Int
at :: Word8 of
            Word8
0x3f -> Int
at
            Word8
0x23 -> Int
at
            Word8
_ -> Int -> Int
scanPath (Int
at Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    fileStart :: Int
fileStart = Int -> Int
scanSlash Int
pathEnd
    scanSlash :: Int -> Int
scanSlash !Int
at
        | Int
at Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        | (Array -> Int -> Word8
forall a. Prim a => Array -> Int -> a
indexByteArray Array
array (Int
at Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) :: Word8) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x2f = Int
at
        | Bool
otherwise = Int -> Int
scanSlash (Int
at Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

-- The length of a value's encoding, with its hole rebased onto the prefix when one is given, or -1
-- when it names a string the table lacks.
renderedLength :: DocTable -> Maybe UrlPrefix -> Packed -> Int
renderedLength :: DocTable -> Maybe UrlPrefix -> Packed -> Int
renderedLength DocTable
table Maybe UrlPrefix
prefix (Packed Array
blob Int
hole) = case DocTable -> Array -> Int -> (# Int, Int #)
encodedAt DocTable
table Array
blob Int
0 of
    (# Int
len, Int
_ #)
        | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> -Int
1
        | Bool
otherwise -> case Maybe UrlPrefix
prefix of
            Just (UrlPrefix Array
bytes) | Int
hole Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 -> case DocTable -> Array -> Int -> (# Array, Int, Int, Int #)
scalarSource DocTable
table Array
blob Int
hole of
                (# Array
array, Int
start, Int
old, Int
_ #) -> case Array -> Int -> Int -> (# Int, Int #)
fileSpan Array
array Int
start Int
old of
                    (# Int
_, Int
file #) -> Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
old Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Array -> Int
sizeofByteArray Array
bytes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
file
            Maybe UrlPrefix
_ -> Int
len

{- Write the value's encoding at an offset, before the limit, and return the offset after it. A write
that would pass the limit, or a string the table lacks, returns an offset past the limit instead. -}
pokePacked :: Ptr Word8 -> Int -> Int -> DocTable -> Maybe UrlPrefix -> Packed -> IO Int
pokePacked :: Ptr Word8
-> Int -> Int -> DocTable -> Maybe UrlPrefix -> Packed -> IO Int
pokePacked Ptr Word8
target Int
limit Int
start DocTable
table Maybe UrlPrefix
prefix (Packed Array
blob Int
hole) = do
    at <- Int -> IO (PrimVar (PrimState IO) Int)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
a -> m (PrimVar (PrimState m) a)
newPrimVar Int
0
    out <- newPrimVar start
    let bounded Int
len Int -> m a
write = do
            o <- PrimVar (PrimState m) Int -> m Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> m a
readPrimVar PrimVar RealWorld Int
PrimVar (PrimState m) Int
out
            if len >= 0 && o + len <= limit then write o >> writePrimVar out (o + len) else writePrimVar out (limit + 1)
        byte Word8
w = Int -> (Int -> IO ()) -> IO ()
forall {m :: * -> *} {a}.
(PrimState m ~ RealWorld, PrimMonad m) =>
Int -> (Int -> m a) -> m ()
bounded Int
1 (\Int
o -> Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
target Int
o (Word8
w :: Word8))
        copyFrom Array
array Int
from Int
len = Int -> (Int -> m ()) -> m ()
forall {m :: * -> *} {a}.
(PrimState m ~ RealWorld, PrimMonad m) =>
Int -> (Int -> m a) -> m ()
bounded Int
len (\Int
o -> Ptr Word8 -> Array -> Int -> Int -> m ()
forall (m :: * -> *).
PrimMonad m =>
Ptr Word8 -> Array -> Int -> Int -> m ()
copyByteArrayToAddr (Ptr Word8
target Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
o) Array
array Int
from Int
len)
        literal ByteString
bytes = Int -> (Int -> IO ()) -> IO ()
forall {m :: * -> *} {a}.
(PrimState m ~ RealWorld, PrimMonad m) =>
Int -> (Int -> m a) -> m ()
bounded (ByteString -> Int
BS.length ByteString
bytes) (\Int
o -> ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BSU.unsafeUseAsCStringLen ByteString
bytes (\(Ptr CChar
source, Int
len) -> Ptr (ZonkAny 0) -> Ptr (ZonkAny 0) -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes (Ptr Word8
target Ptr Word8 -> Int -> Ptr (ZonkAny 0)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
o) (Ptr CChar -> Ptr (ZonkAny 0)
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
source) Int
len))
        value = do
            position <- PrimVar (PrimState IO) Int -> IO Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> m a
readPrimVar PrimVar RealWorld Int
PrimVar (PrimState IO) Int
at
            case prefix of
                Just (UrlPrefix Array
bytes) | Int
position Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
hole -> case DocTable -> Array -> Int -> (# Array, Int, Int, Int #)
scalarSource DocTable
table Array
blob Int
position of
                    (# Array
array, Int
from, Int
len, Int
next #) -> case Array -> Int -> Int -> (# Int, Int #)
fileSpan Array
array Int
from Int
len of
                        (# Int
file, Int
fileLen #) -> do
                            PrimVar (PrimState IO) Int -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> a -> m ()
writePrimVar PrimVar RealWorld Int
PrimVar (PrimState IO) Int
at Int
next
                            Word8 -> IO ()
byte Word8
quote IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Array -> Int -> Int -> IO ()
forall {m :: * -> *}.
(PrimState m ~ RealWorld, PrimMonad m) =>
Array -> Int -> Int -> m ()
copyFrom Array
bytes Int
0 (Array -> Int
sizeofByteArray Array
bytes) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Array -> Int -> Int -> IO ()
forall {m :: * -> *}.
(PrimState m ~ RealWorld, PrimMonad m) =>
Array -> Int -> Int -> m ()
copyFrom Array
array Int
file Int
fileLen IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> IO ()
byte Word8
quote
                Maybe UrlPrefix
_ -> Int -> IO ()
stored Int
position
        stored Int
position = case Array -> Int -> Word8
forall a. Prim a => Array -> Int -> a
indexByteArray Array
blob Int
position :: Word8 of
            Word8
code
                | Word8
code Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
opNull -> PrimVar (PrimState IO) Int -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> a -> m ()
writePrimVar PrimVar RealWorld Int
PrimVar (PrimState IO) Int
at (Int
position Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> IO ()
literal ByteString
"null"
                | Word8
code Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
opFalse -> PrimVar (PrimState IO) Int -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> a -> m ()
writePrimVar PrimVar RealWorld Int
PrimVar (PrimState IO) Int
at (Int
position Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> IO ()
literal ByteString
"false"
                | Word8
code Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
opTrue -> PrimVar (PrimState IO) Int -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> a -> m ()
writePrimVar PrimVar RealWorld Int
PrimVar (PrimState IO) Int
at (Int
position Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> IO ()
literal ByteString
"true"
                | Word8
code Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
opShared -> case Array -> Int -> (# Int, Int #)
readVarint Array
blob (Int
position Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) of
                    (# Int
index, Int
next #) -> PrimVar (PrimState IO) Int -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> a -> m ()
writePrimVar PrimVar RealWorld Int
PrimVar (PrimState IO) Int
at Int
next IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO ()
forall {m :: * -> *}.
(PrimState m ~ RealWorld, PrimMonad m) =>
Int -> m ()
sharedString Int
index
                | Word8
code Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
opObject -> case Array -> Int -> (# Int, Int #)
readVarint Array
blob (Int
position Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) of
                    (# Int
count, Int
next #) -> PrimVar (PrimState IO) Int -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> a -> m ()
writePrimVar PrimVar RealWorld Int
PrimVar (PrimState IO) Int
at Int
next IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> IO ()
byte Word8
0x7b IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Bool -> IO ()
members Int
count Bool
True IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> IO ()
byte Word8
0x7d
                | Word8
code Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
opArray -> case Array -> Int -> (# Int, Int #)
readVarint Array
blob (Int
position Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) of
                    (# Int
count, Int
next #) -> PrimVar (PrimState IO) Int -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> a -> m ()
writePrimVar PrimVar RealWorld Int
PrimVar (PrimState IO) Int
at Int
next IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> IO ()
byte Word8
0x5b IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Bool -> IO ()
items Int
count Bool
True IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> IO ()
byte Word8
0x5d
                | Bool
otherwise -> case Array -> Int -> (# Int, Int #)
readVarint Array
blob (Int
position Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) of
                    (# Int
len, Int
next #) -> PrimVar (PrimState IO) Int -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> a -> m ()
writePrimVar PrimVar RealWorld Int
PrimVar (PrimState IO) Int
at (Int
next Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Array -> Int -> Int -> IO ()
forall {m :: * -> *}.
(PrimState m ~ RealWorld, PrimMonad m) =>
Array -> Int -> Int -> m ()
copyFrom Array
blob Int
next Int
len
        sharedString Int
index = case DocTable -> Int -> (# Int, Int #)
tableEntry DocTable
table Int
index of (# Int
from, Int
len #) -> Array -> Int -> Int -> m ()
forall {m :: * -> *}.
(PrimState m ~ RealWorld, PrimMonad m) =>
Array -> Int -> Int -> m ()
copyFrom (DocTable -> Array
tableArena DocTable
table) Int
from Int
len
        members !Int
count Bool
leading = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
leading (Word8 -> IO ()
byte Word8
0x2c)
            position <- PrimVar (PrimState IO) Int -> IO Int
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> m a
readPrimVar PrimVar RealWorld Int
PrimVar (PrimState IO) Int
at
            case readVarint blob position of
                (# Int
tagged, Int
next #)
                    | Int -> Bool
forall a. Integral a => a -> Bool
even Int
tagged -> PrimVar (PrimState IO) Int -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> a -> m ()
writePrimVar PrimVar RealWorld Int
PrimVar (PrimState IO) Int
at Int
next IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> IO ()
forall {m :: * -> *}.
(PrimState m ~ RealWorld, PrimMonad m) =>
Int -> m ()
sharedString (Int
tagged Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
                    | Bool
otherwise -> PrimVar (PrimState IO) Int -> Int -> IO ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
PrimVar (PrimState m) a -> a -> m ()
writePrimVar PrimVar RealWorld Int
PrimVar (PrimState IO) Int
at (Int
next 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) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Array -> Int -> Int -> IO ()
forall {m :: * -> *}.
(PrimState m ~ RealWorld, PrimMonad m) =>
Array -> Int -> Int -> m ()
copyFrom Array
blob Int
next (Int
tagged Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
            byte 0x3a
            value
            members (count - 1) False
        items !Int
count Bool
leading = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
leading (Word8 -> IO ()
byte Word8
0x2c)
            IO ()
value
            Int -> Bool -> IO ()
items (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Bool
False
    value
    readPrimVar out

{- | A string or number as aeson reads the bytes aeson wrote for it. A number written in exponent or
fraction form reads back with an exponent aeson writes in that form again.
-}
decodeScalar :: ByteArray -> Int -> Int -> Value
decodeScalar :: Array -> Int -> Int -> Value
decodeScalar Array
array Int
start Int
len
    | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 Bool -> Bool -> Bool
&& Word8
opening Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
quote = if Int -> Bool
noEscape (Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) then Text -> Value
String (Int -> Int -> Text
copyText (Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)) else Value
escaped
    | Bool
otherwise = Value -> (Scientific -> Value) -> Maybe Scientific -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
Null Scientific -> Value
Number (Array -> Int -> Int -> Maybe Scientific
decodeNumber Array
array Int
start Int
len)
  where
    opening :: Word8
opening = Array -> Int -> Word8
forall a. Prim a => Array -> Int -> a
indexByteArray Array
array Int
start :: Word8
    end :: Int
end = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    noEscape :: Int -> Bool
noEscape !Int
at = Int
at Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end Bool -> Bool -> Bool
|| ((Array -> Int -> Word8
forall a. Prim a => Array -> Int -> a
indexByteArray Array
array Int
at :: Word8) Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0x5c Bool -> Bool -> Bool
&& Int -> Bool
noEscape (Int
at Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
    copyText :: Int -> Int -> Text
copyText Int
from Int
count = Array -> Int -> Int -> Text
TI.text ((forall s. ST s (MArray s)) -> Array
TA.run (Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
TA.new Int
count ST s (MArray s) -> (MArray s -> ST s (MArray s)) -> ST s (MArray s)
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MArray s
target -> Int -> MArray s -> Int -> Array -> Int -> ST s ()
forall s. Int -> MArray s -> Int -> Array -> Int -> ST s ()
TA.copyI Int
count MArray s
target Int
0 Array
array Int
from ST s () -> ST s (MArray s) -> ST s (MArray s)
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MArray s -> ST s (MArray s)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MArray s
target)) Int
0 Int
count
    escaped :: Value
escaped = Value -> Either String Value -> Value
forall b a. b -> Either a b -> b
fromRight Value
Null (ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict (Int -> (Ptr Word8 -> IO ()) -> ByteString
BSI.unsafeCreate Int
len (\Ptr Word8
target -> Ptr Word8 -> Array -> Int -> Int -> IO ()
forall (m :: * -> *).
PrimMonad m =>
Ptr Word8 -> Array -> Int -> Int -> m ()
copyByteArrayToAddr Ptr Word8
target Array
array Int
start Int
len)))

-- A number in aeson's encoding: an integer, or a fraction or exponent form for an exponent below zero
-- or above 1024.
decodeNumber :: ByteArray -> Int -> Int -> Maybe Scientific
decodeNumber :: Array -> Int -> Int -> Maybe Scientific
decodeNumber Array
array Int
start Int
len
    | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
18 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
signWidth, Int -> Bool
digitsOnly Int
afterSign = Scientific -> Maybe Scientific
forall a. a -> Maybe a
Just (Int -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int -> Int
smallInteger Int
afterSign Int
0))
    | Bool
otherwise = do
        let (Integer
whole, Int
afterWhole) = Int -> Integer -> (Integer, Int)
digitsFrom Int
afterSign Integer
0
            (Integer
fraction, Int
fractionDigits, Int
afterFraction) =
                if Int
afterWhole Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
end Bool -> Bool -> Bool
&& Int -> Word8
byteAt Int
afterWhole Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x2e
                    then let (Integer
value, Int
next) = Int -> Integer -> (Integer, Int)
digitsFrom (Int
afterWhole Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Integer
whole in (Integer
value, Int
next Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
afterWhole Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int
next)
                    else (Integer
whole, Int
0, Int
afterWhole)
        exponent <-
            if Int
afterFraction Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
end Bool -> Bool -> Bool
&& (Int -> Word8
byteAt Int
afterFraction Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x65 Bool -> Bool -> Bool
|| Int -> Word8
byteAt Int
afterFraction Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x45)
                then Int -> Maybe Int
forall {a}. Num a => Int -> Maybe a
exponentFrom (Int
afterFraction Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                else if Int
afterFraction Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
end then Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0 else Maybe Int
forall a. Maybe a
Nothing
        let written = Integer -> Int -> Scientific
scientific (Integer -> Integer
forall {a}. Num a => a -> a
signed Integer
fraction) (Int
exponent Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
fractionDigits)
        pure $! if afterWhole == end then written else aesonForm written
  where
    end :: Int
end = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len
    byteAt :: Int -> Word8
byteAt Int
at = Array -> Int -> Word8
forall a. Prim a => Array -> Int -> a
indexByteArray Array
array Int
at :: Word8
    negative :: Bool
negative = Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int -> Word8
byteAt Int
start Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x2d
    signWidth :: Int
signWidth = if Bool
negative then Int
1 else Int
0
    afterSign :: Int
afterSign = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
signWidth
    isDigit :: a -> Bool
isDigit a
byte = a
byte a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0x30 Bool -> Bool -> Bool
&& a
byte a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0x39
    digitsOnly :: Int -> Bool
digitsOnly !Int
at = Int
at Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
end Bool -> Bool -> Bool
&& Int -> Bool
all' Int
at
    all' :: Int -> Bool
all' !Int
at = Int
at Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end Bool -> Bool -> Bool
|| (Word8 -> Bool
forall {a}. (Ord a, Num a) => a -> Bool
isDigit (Int -> Word8
byteAt Int
at) Bool -> Bool -> Bool
&& Int -> Bool
all' (Int
at Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
    smallInteger :: Int -> Int -> Int
    smallInteger :: Int -> Int -> Int
smallInteger !Int
at !Int
acc
        | Int
at Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end = if Bool
negative then Int -> Int
forall {a}. Num a => a -> a
negate Int
acc else Int
acc
        | Bool
otherwise = Int -> Int -> Int
smallInteger (Int
at Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8
byteAt Int
at Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
0x30))
    signed :: a -> a
signed a
value = if Bool
negative then a -> a
forall {a}. Num a => a -> a
negate a
value else a
value
    digitsFrom :: Int -> Integer -> (Integer, Int)
    digitsFrom :: Int -> Integer -> (Integer, Int)
digitsFrom !Int
at !Integer
acc
        | Int
at Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
end, Word8 -> Bool
forall {a}. (Ord a, Num a) => a -> Bool
isDigit (Int -> Word8
byteAt Int
at) = Int -> Integer -> (Integer, Int)
digitsFrom (Int
at Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Integer
acc Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8
byteAt Int
at Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
0x30))
        | Bool
otherwise = (Integer
acc, Int
at)
    exponentFrom :: Int -> Maybe a
exponentFrom Int
at =
        let (Bool
minus, Int
digitsAt) = case Int -> Word8
byteAt Int
at of
                Word8
0x2d -> (Bool
True, Int
at Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                Word8
0x2b -> (Bool
False, Int
at Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                Word8
_ -> (Bool
False, Int
at)
            (Integer
value, Int
next) = Int -> Integer -> (Integer, Int)
digitsFrom Int
digitsAt Integer
0
         in if Int
next Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
end Bool -> Bool -> Bool
&& Int
next Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
digitsAt then a -> Maybe a
forall a. a -> Maybe a
Just (Integer -> a
forall a. Num a => Integer -> a
fromInteger (if Bool
minus then Integer -> Integer
forall {a}. Num a => a -> a
negate Integer
value else Integer
value)) else Maybe a
forall a. Maybe a
Nothing
    -- aeson writes a number whose exponent lies in [0, 1024] as an integer, so a fraction or exponent
    -- form came from an exponent outside that range, which a read keeps.
    aesonForm :: Scientific -> Scientific
aesonForm Scientific
written
        | Scientific -> Integer
Scientific.coefficient Scientific
written Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = Integer -> Int -> Scientific
scientific Integer
0 (-Int
1)
        | Bool
otherwise =
            let normal :: Scientific
normal = Scientific -> Scientific
normalize Scientific
written
                e :: Int
e = Scientific -> Int
Scientific.base10Exponent Scientific
normal
             in if Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1024 then Scientific
normal else Integer -> Int -> Scientific
scientific (Scientific -> Integer
Scientific.coefficient Scientific
normal Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) (-Int
1)

-- | Where a decode finds the string and the key a table index names.
class TableStrings t where
    tableValue :: t st -> Int -> ST st Value
    tableKey :: t st -> Int -> ST st Key.Key

-- A document table as a decode reads it, and a flag an index past the table sets.
data OfTable st = OfTable !DocTable !(PrimVar st Int)

instance TableStrings OfTable where
    tableValue :: forall st. OfTable st -> Int -> ST st Value
tableValue (OfTable DocTable
table PrimVar st Int
missing) Int
index = case DocTable -> Int -> (# Int, Int #)
tableEntry DocTable
table Int
index of
        (# Int
start, Int
len #)
            | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> 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
missing Int
1 ST st () -> Value -> ST st Value
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Value
Null
            | Bool
otherwise -> Value -> ST st Value
forall a. a -> ST st a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> ST st Value) -> Value -> ST st Value
forall a b. (a -> b) -> a -> b
$! Array -> Int -> Int -> Value
decodeScalar (DocTable -> Array
tableArena DocTable
table) Int
start Int
len
    tableKey :: forall st. OfTable st -> Int -> ST st Key
tableKey OfTable st
strings Int
index =
        OfTable st -> Int -> ST st Value
forall st. OfTable st -> Int -> ST st Value
forall (t :: * -> *) st.
TableStrings t =>
t st -> Int -> ST st Value
tableValue OfTable st
strings Int
index ST st Value -> (Value -> Key) -> ST st Key
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
            String Text
text -> Text -> Key
Key.fromText Text
text
            Value
_ -> Key
""

{- | Read the value at the position the variable holds back as aeson's tree, and move the variable
past it. The strings resolve a table index to its string and to its key.
-}
decodeWith :: (TableStrings t) => t st -> ByteArray -> PrimVar st Int -> ST st Value
decodeWith :: forall (t :: * -> *) st.
TableStrings t =>
t st -> Array -> PrimVar st Int -> ST st Value
decodeWith t st
strings Array
blob PrimVar st Int
at = 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
    case indexByteArray blob position :: Word8 of
        Word8
byte
            | Word8
byte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
opNull -> 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
position Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ST st () -> ST st Value -> ST st Value
forall a b. ST st a -> ST st b -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Value -> ST st Value
forall a. a -> ST st a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
Null
            | Word8
byte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
opFalse -> 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
position Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ST st () -> ST st Value -> ST st Value
forall a b. ST st a -> ST st b -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Value -> ST st Value
forall a. a -> ST st a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Value
Bool Bool
False)
            | Word8
byte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
opTrue -> 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
position Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ST st () -> ST st Value -> ST st Value
forall a b. ST st a -> ST st b -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Value -> ST st Value
forall a. a -> ST st a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Value
Bool Bool
True)
            | Word8
byte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
opShared -> case Array -> Int -> (# Int, Int #)
readVarint Array
blob (Int
position Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) of
                (# Int
index, Int
next #) -> 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
next ST st () -> ST st Value -> ST st Value
forall a b. ST st a -> ST st b -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> t st -> Int -> ST st Value
forall st. t st -> Int -> ST st Value
forall (t :: * -> *) st.
TableStrings t =>
t st -> Int -> ST st Value
tableValue t st
strings Int
index
            | Word8
byte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
opObject -> case Array -> Int -> (# Int, Int #)
readVarint Array
blob (Int
position Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) of
                (# Int
count, Int
next #) -> 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
next
                    members <- t st -> Array -> PrimVar st Int -> Int -> ST st (Map Key Value)
forall (t :: * -> *) st.
TableStrings t =>
t st -> Array -> PrimVar st Int -> Int -> ST st (Map Key Value)
decodeMapWith t st
strings Array
blob PrimVar st Int
at Int
count
                    pure $! Object (KeyMap.fromMap members)
            | Word8
byte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
opArray -> case Array -> Int -> (# Int, Int #)
readVarint Array
blob (Int
position Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) of
                (# Int
count, Int
next #) -> 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
next
                    list <- t st -> Array -> PrimVar st Int -> Int -> [Value] -> ST st [Value]
forall (t :: * -> *) st.
TableStrings t =>
t st -> Array -> PrimVar st Int -> Int -> [Value] -> ST st [Value]
decodeItemsWith t st
strings Array
blob PrimVar st Int
at Int
count []
                    pure $! Array (V.fromListN count (reverse list))
            | Bool
otherwise -> case Array -> Int -> (# Int, Int #)
readVarint Array
blob (Int
position Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) of
                (# Int
len, Int
next #) -> 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
next Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len)
                    Value -> ST st Value
forall a. a -> ST st a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> ST st Value) -> Value -> ST st Value
forall a b. (a -> b) -> a -> b
$! Array -> Int -> Int -> Value
decodeScalar Array
blob Int
next Int
len
{-# INLINEABLE decodeWith #-}

-- The next members of an object, the given number of them, as a balanced map built in key order.
decodeMapWith :: (TableStrings t) => t st -> ByteArray -> PrimVar st Int -> Int -> ST st (Map.Map Key.Key Value)
decodeMapWith :: forall (t :: * -> *) st.
TableStrings t =>
t st -> Array -> PrimVar st Int -> Int -> ST st (Map Key Value)
decodeMapWith t st
strings Array
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 <- t st -> Array -> PrimVar st Int -> Int -> ST st (Map Key Value)
forall (t :: * -> *) st.
TableStrings t =>
t st -> Array -> PrimVar st Int -> Int -> ST st (Map Key Value)
decodeMapWith t st
strings Array
blob PrimVar st Int
at Int
before
        name <- decodeKeyWith strings blob at
        member <- decodeWith strings blob at
        right <- decodeMapWith strings blob at (count - 1 - before)
        pure $! Bin count name member left right
{-# INLINEABLE decodeMapWith #-}

-- | The member key at the position the variable holds, moving the variable to its value.
decodeKeyWith :: (TableStrings t) => t st -> ByteArray -> PrimVar st Int -> ST st Key.Key
decodeKeyWith :: forall (t :: * -> *) st.
TableStrings t =>
t st -> Array -> PrimVar st Int -> ST st Key
decodeKeyWith t st
strings Array
blob PrimVar st Int
at = 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
    case readVarint blob position of
        (# Int
tagged, Int
next #)
            | Int -> Bool
forall a. Integral a => a -> Bool
even Int
tagged -> 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
next ST st () -> ST st Key -> ST st Key
forall a b. ST st a -> ST st b -> ST st b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> t st -> Int -> ST st Key
forall st. t st -> Int -> ST st Key
forall (t :: * -> *) st. TableStrings t => t st -> Int -> ST st Key
tableKey t st
strings (Int
tagged Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
            | Bool
otherwise -> 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
next 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)
                Key -> ST st Key
forall a. a -> ST st a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Key -> ST st Key) -> Key -> ST st Key
forall a b. (a -> b) -> a -> b
$! case Array -> Int -> Int -> Value
decodeScalar Array
blob Int
next (Int
tagged Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) of
                    String Text
text -> Text -> Key
Key.fromText Text
text
                    Value
_ -> Key
""
{-# INLINEABLE decodeKeyWith #-}

-- An array's items, last first.
decodeItemsWith :: (TableStrings t) => t st -> ByteArray -> PrimVar st Int -> Int -> [Value] -> ST st [Value]
decodeItemsWith :: forall (t :: * -> *) st.
TableStrings t =>
t st -> Array -> PrimVar st Int -> Int -> [Value] -> ST st [Value]
decodeItemsWith t st
strings Array
blob PrimVar st Int
at !Int
count [Value]
acc
    | Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = [Value] -> ST st [Value]
forall a. a -> ST st a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Value]
acc
    | Bool
otherwise = t st -> Array -> PrimVar st Int -> ST st Value
forall (t :: * -> *) st.
TableStrings t =>
t st -> Array -> PrimVar st Int -> ST st Value
decodeWith t st
strings Array
blob PrimVar st Int
at ST st Value -> (Value -> 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
>>= \Value
item -> t st -> Array -> PrimVar st Int -> Int -> [Value] -> ST st [Value]
forall (t :: * -> *) st.
TableStrings t =>
t st -> Array -> PrimVar st Int -> Int -> [Value] -> ST st [Value]
decodeItemsWith t st
strings Array
blob PrimVar st Int
at (Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Value
item Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: [Value]
acc)
{-# INLINEABLE decodeItemsWith #-}

-- | The value back as aeson's tree, or nothing when it names a string its table lacks.
packedValue :: DocTable -> Packed -> Maybe Value
packedValue :: DocTable -> Packed -> Maybe Value
packedValue DocTable
table (Packed Array
blob Int
_) = (forall s. ST s (Maybe Value)) -> Maybe Value
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Maybe Value)) -> Maybe Value)
-> (forall s. ST s (Maybe Value)) -> Maybe Value
forall a b. (a -> b) -> a -> b
$ do
    missing <- Int -> ST s (PrimVar (PrimState (ST s)) Int)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
a -> m (PrimVar (PrimState m) a)
newPrimVar Int
0
    value <- newPrimVar 0 >>= decodeWith (OfTable table missing) blob
    readPrimVar missing <&> \Int
flag -> Value
value Value -> Maybe () -> Maybe Value
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
flag Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)

-- The value as aeson's tree, with its hole's URL rebased onto the prefix as a render writes it, or
-- nothing when it names a string its table lacks.
rebasedValue :: DocTable -> Maybe UrlPrefix -> Packed -> Maybe Value
rebasedValue :: DocTable -> Maybe UrlPrefix -> Packed -> Maybe Value
rebasedValue DocTable
table Maybe UrlPrefix
prefix value :: Packed
value@(Packed Array
blob Int
hole) = case Maybe UrlPrefix
prefix of
    Just (UrlPrefix Array
bytes) | Int
hole Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 -> case DocTable -> Array -> Int -> (# Array, Int, Int, Int #)
scalarSource DocTable
table Array
blob Int
hole of
        (# Array
_, Int
_, Int
len, Int
_ #) | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> Maybe Value
forall a. Maybe a
Nothing
        (# Array
array, Int
from, Int
len, Int
next #) -> case Array -> Int -> Int -> (# Int, Int #)
fileSpan Array
array Int
from Int
len of
            (# Int
file, Int
fileLen #) ->
                let size :: Int
size = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Array -> Int
sizeofByteArray Array
bytes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fileLen
                    rest :: Int
rest = Array -> Int
sizeofByteArray Array
blob Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
next
                    rebased :: Array
rebased = Int -> (forall s. MutableByteArray s -> ST s ()) -> Array
createByteArray (Int
hole Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
varintSize Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rest) ((forall s. MutableByteArray s -> ST s ()) -> Array)
-> (forall s. MutableByteArray s -> ST s ()) -> Array
forall a b. (a -> b) -> a -> b
$ \MutableByteArray s
target -> do
                        MutableByteArray (PrimState (ST s))
-> Int -> Array -> Int -> Int -> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> Array -> Int -> Int -> m ()
copyByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
target Int
0 Array
blob Int
0 Int
hole
                        MutableByteArray (PrimState (ST s)) -> Int -> Word8 -> ST s ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
target Int
hole Word8
opInline
                        at <- Int -> MutableByteArray s -> Int -> ST s Int
forall st. Int -> MutableByteArray st -> Int -> ST st Int
writeVarint Int
size MutableByteArray s
target (Int
hole Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                        writeByteArray target at quote
                        copyByteArray target (at + 1) bytes 0 (sizeofByteArray bytes)
                        copyByteArray target (at + 1 + sizeofByteArray bytes) array file fileLen
                        writeByteArray target (at + size - 1) quote
                        copyByteArray target (at + size) blob next rest
                 in DocTable -> Packed -> Maybe Value
packedValue DocTable
table (Array -> Int -> Packed
Packed Array
rebased (-Int
1))
    Maybe UrlPrefix
_ -> DocTable -> Packed -> Maybe Value
packedValue DocTable
table Packed
value

-- | One packed value in a render, and the index of the plan's table its own document's read sealed.
data Piece = Piece !Int !Packed
    deriving stock (Piece -> Piece -> Bool
(Piece -> Piece -> Bool) -> (Piece -> Piece -> Bool) -> Eq Piece
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Piece -> Piece -> Bool
== :: Piece -> Piece -> Bool
$c/= :: Piece -> Piece -> Bool
/= :: Piece -> Piece -> Bool
Eq, Int -> Piece -> ShowS
[Piece] -> ShowS
Piece -> String
(Int -> Piece -> ShowS)
-> (Piece -> String) -> ([Piece] -> ShowS) -> Show Piece
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Piece -> ShowS
showsPrec :: Int -> Piece -> ShowS
$cshow :: Piece -> String
show :: Piece -> String
$cshowList :: [Piece] -> ShowS
showList :: [Piece] -> ShowS
Show)

{- | The packed member of a rendered document: an object's members, sorted by key with no key twice,
or an array's items. A render writes them in list order.
-}
data Pieces = ObjectPieces ![(Text, Piece)] | ArrayPieces ![Piece]
    deriving stock (Pieces -> Pieces -> Bool
(Pieces -> Pieces -> Bool)
-> (Pieces -> Pieces -> Bool) -> Eq Pieces
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Pieces -> Pieces -> Bool
== :: Pieces -> Pieces -> Bool
$c/= :: Pieces -> Pieces -> Bool
/= :: Pieces -> Pieces -> Bool
Eq, Int -> Pieces -> ShowS
[Pieces] -> ShowS
Pieces -> String
(Int -> Pieces -> ShowS)
-> (Pieces -> String) -> ([Pieces] -> ShowS) -> Show Pieces
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Pieces -> ShowS
showsPrec :: Int -> Pieces -> ShowS
$cshow :: Pieces -> String
show :: Pieces -> String
$cshowList :: [Pieces] -> ShowS
showList :: [Pieces] -> ShowS
Show)

{- | An assembled document: small members aeson encodes, and one member that renders from pieces over
its sources' tables, each hole rebased onto the prefix when the document rebases.
-}
data RenderPlan = RenderPlan
    { RenderPlan -> Object
planMembers :: !(KeyMap.KeyMap Value)
    , RenderPlan -> Key
planSlot :: !Key.Key
    , RenderPlan -> SmallArray DocTable
planTables :: !(SmallArray DocTable)
    , RenderPlan -> Pieces
planPieces :: !Pieces
    , RenderPlan -> Maybe UrlPrefix
planPrefix :: !(Maybe UrlPrefix)
    }
    deriving stock (RenderPlan -> RenderPlan -> Bool
(RenderPlan -> RenderPlan -> Bool)
-> (RenderPlan -> RenderPlan -> Bool) -> Eq RenderPlan
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RenderPlan -> RenderPlan -> Bool
== :: RenderPlan -> RenderPlan -> Bool
$c/= :: RenderPlan -> RenderPlan -> Bool
/= :: RenderPlan -> RenderPlan -> Bool
Eq, Int -> RenderPlan -> ShowS
[RenderPlan] -> ShowS
RenderPlan -> String
(Int -> RenderPlan -> ShowS)
-> (RenderPlan -> String)
-> ([RenderPlan] -> ShowS)
-> Show RenderPlan
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RenderPlan -> ShowS
showsPrec :: Int -> RenderPlan -> ShowS
$cshow :: RenderPlan -> String
show :: RenderPlan -> String
$cshowList :: [RenderPlan] -> ShowS
showList :: [RenderPlan] -> ShowS
Show)

-- The plan's table at an index, or nothing past the plan.
tableAt :: SmallArray DocTable -> Int -> Maybe DocTable
tableAt :: SmallArray DocTable -> Int -> Maybe DocTable
tableAt SmallArray DocTable
tables Int
index
    | Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< SmallArray DocTable -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray DocTable
tables = DocTable -> Maybe DocTable
forall a. a -> Maybe a
Just (SmallArray DocTable -> Int -> DocTable
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray DocTable
tables Int
index)
    | Bool
otherwise = Maybe DocTable
forall a. Maybe a
Nothing

data Part = Encoded !ByteString | Packs

-- The document's members in key order, each key's encoding with its value encoded or packed.
planParts :: RenderPlan -> [(ByteString, Part)]
planParts :: RenderPlan -> [(ByteString, Part)]
planParts RenderPlan
plan =
    [ (Text -> ByteString
encodeString (Key -> Text
Key.toText Key
key), Part -> (Value -> Part) -> Maybe Value -> Part
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Part
Packs (ByteString -> Part
Encoded (ByteString -> Part) -> (Value -> ByteString) -> Value -> Part
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall l s. LazyStrict l s => l -> s
toStrict (ByteString -> ByteString)
-> (Value -> ByteString) -> Value -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Encoding' Value -> ByteString
forall a. Encoding' a -> ByteString
encodingToLazyByteString (Encoding' Value -> ByteString)
-> (Value -> Encoding' Value) -> Value -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Encoding' Value
Encoding.value) Maybe Value
part)
    | (Key
key, Maybe Value
part) <- KeyMap (Maybe Value) -> [(Key, Maybe Value)]
forall v. KeyMap v -> [(Key, v)]
KeyMap.toAscList (Key -> Maybe Value -> KeyMap (Maybe Value) -> KeyMap (Maybe Value)
forall v. Key -> v -> KeyMap v -> KeyMap v
KeyMap.insert (RenderPlan -> Key
planSlot RenderPlan
plan) Maybe Value
forall a. Maybe a
Nothing (Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Object -> KeyMap (Maybe Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RenderPlan -> Object
planMembers RenderPlan
plan))
    ]

-- The render's length, or nothing when a piece names a table or string the plan lacks.
partsLength :: RenderPlan -> [(ByteString, Part)] -> Maybe Int
partsLength :: RenderPlan -> [(ByteString, Part)] -> Maybe Int
partsLength RenderPlan
plan [(ByteString, Part)]
parts = (Int -> Int
separators ([(ByteString, Part)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(ByteString, Part)]
parts) Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> ([Int] -> Int) -> [Int] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
forall a (f :: * -> *). (Foldable f, Num a) => f a -> a
sum ([Int] -> Int) -> Maybe [Int] -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ByteString, Part) -> Maybe Int)
-> [(ByteString, Part)] -> Maybe [Int]
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) -> [a] -> f [b]
traverse (ByteString, Part) -> Maybe Int
partLength [(ByteString, Part)]
parts
  where
    partLength :: (ByteString, Part) -> Maybe Int
partLength (ByteString
key, Part
part) =
        (ByteString -> Int
BS.length ByteString
key Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Part
part of
            Encoded ByteString
bytes -> Int -> Maybe Int
forall a. a -> Maybe a
Just (ByteString -> Int
BS.length ByteString
bytes)
            Part
Packs -> case RenderPlan -> Pieces
planPieces RenderPlan
plan of
                ObjectPieces [(Text, Piece)]
members -> (Int -> Int
separators ([(Text, Piece)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Piece)]
members) Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> ([Int] -> Int) -> [Int] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
forall a (f :: * -> *). (Foldable f, Num a) => f a -> a
sum ([Int] -> Int) -> Maybe [Int] -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text, Piece) -> Maybe Int) -> [(Text, Piece)] -> Maybe [Int]
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) -> [a] -> f [b]
traverse (\(Text
version, Piece
piece) -> (Text -> Int
encodedLength Text
version Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Piece -> Maybe Int
pieceLength Piece
piece) [(Text, Piece)]
members
                ArrayPieces [Piece]
items -> (Int -> Int
separators ([Piece] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Piece]
items) Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> ([Int] -> Int) -> [Int] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
forall a (f :: * -> *). (Foldable f, Num a) => f a -> a
sum ([Int] -> Int) -> Maybe [Int] -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Piece -> Maybe Int) -> [Piece] -> Maybe [Int]
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) -> [a] -> f [b]
traverse Piece -> Maybe Int
pieceLength [Piece]
items
    pieceLength :: Piece -> Maybe Int
pieceLength (Piece Int
index Packed
value) = do
        table <- SmallArray DocTable -> Int -> Maybe DocTable
tableAt (RenderPlan -> SmallArray DocTable
planTables RenderPlan
plan) Int
index
        let len = DocTable -> Maybe UrlPrefix -> Packed -> Int
renderedLength DocTable
table (RenderPlan -> Maybe UrlPrefix
planPrefix RenderPlan
plan) Packed
value
        guard (len >= 0)
        pure len

{- | Render an assembled document into one buffer of its exact length, or nothing when a piece names a
table or string the plan lacks, or the render does not fill the buffer exactly.
-}
renderPlan :: RenderPlan -> Maybe ByteString
renderPlan :: RenderPlan -> Maybe ByteString
renderPlan RenderPlan
plan = do
    size <- RenderPlan -> [(ByteString, Part)] -> Maybe Int
partsLength RenderPlan
plan [(ByteString, Part)]
parts
    let rendered = Int -> (Ptr Word8 -> IO Int) -> ByteString
BSI.unsafeCreateUptoN Int
size ((Ptr Word8 -> IO Int) -> ByteString)
-> (Ptr Word8 -> IO Int) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
target -> do
            let within :: Int -> Int -> m a -> m Int
within Int
offset Int
len m a
write
                    | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
size = m a
write m a -> m Int -> m Int
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> m Int
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len)
                    | Bool
otherwise = Int -> m Int
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                byte :: Int -> Word8 -> IO Int
byte Int
offset Word8
w = Int -> Int -> IO () -> IO Int
forall {m :: * -> *} {a}. Monad m => Int -> Int -> m a -> m Int
within Int
offset Int
1 (Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
target Int
offset (Word8
w :: Word8))
                bytes :: Int -> ByteString -> IO Int
bytes Int
offset ByteString
b = Int -> Int -> IO () -> IO Int
forall {m :: * -> *} {a}. Monad m => Int -> Int -> m a -> m Int
within Int
offset (ByteString -> Int
BS.length ByteString
b) (ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BSU.unsafeUseAsCStringLen ByteString
b (\(Ptr CChar
source, Int
len) -> Ptr (ZonkAny 1) -> Ptr (ZonkAny 1) -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes (Ptr Word8
target Ptr Word8 -> Int -> Ptr (ZonkAny 1)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
offset) (Ptr CChar -> Ptr (ZonkAny 1)
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
source) Int
len))
                separated :: Int -> [t] -> (Int -> t -> IO Int) -> IO Int
separated Int
offset [t]
list Int -> t -> IO Int
write = (Int -> (Int, t) -> IO Int) -> Int -> [(Int, t)] -> IO Int
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM (\Int
o (Int
index, t
item) -> (if Int
index Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> (Int
0 :: Int) then Int -> Word8 -> IO Int
byte Int
o Word8
0x2c else Int -> IO Int
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
o) IO Int -> (Int -> IO Int) -> IO Int
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
afterComma -> Int -> t -> IO Int
write Int
afterComma t
item) Int
offset ([Int] -> [t] -> [(Int, t)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [t]
list)
                member :: Int -> ByteString -> (Int -> IO b) -> IO b
member Int
offset ByteString
key Int -> IO b
write = Int -> ByteString -> IO Int
bytes Int
offset ByteString
key IO Int -> (Int -> IO b) -> IO b
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
afterKey -> Int -> Word8 -> IO Int
byte Int
afterKey Word8
0x3a IO Int -> (Int -> IO b) -> IO b
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> IO b
write
                piece :: Int -> Piece -> IO Int
piece Int
offset (Piece Int
index Packed
value) = case SmallArray DocTable -> Int -> Maybe DocTable
tableAt (RenderPlan -> SmallArray DocTable
planTables RenderPlan
plan) Int
index of
                    Just DocTable
table | Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
size -> Ptr Word8
-> Int -> Int -> DocTable -> Maybe UrlPrefix -> Packed -> IO Int
pokePacked Ptr Word8
target Int
size Int
offset DocTable
table (RenderPlan -> Maybe UrlPrefix
planPrefix RenderPlan
plan) Packed
value
                    Maybe DocTable
_ -> Int -> IO Int
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                part :: Int -> Part -> IO Int
part Int
offset = \case
                    Encoded ByteString
b -> Int -> ByteString -> IO Int
bytes Int
offset ByteString
b
                    Part
Packs -> case RenderPlan -> Pieces
planPieces RenderPlan
plan of
                        ObjectPieces [(Text, Piece)]
members -> do
                            open <- Int -> Word8 -> IO Int
byte Int
offset Word8
0x7b
                            end <- separated open members $ \Int
at (Text
version, Piece
item) -> Int -> ByteString -> (Int -> IO Int) -> IO Int
forall {b}. Int -> ByteString -> (Int -> IO b) -> IO b
member Int
at (Text -> ByteString
encodeString Text
version) (Int -> Piece -> IO Int
`piece` Piece
item)
                            byte end 0x7d
                        ArrayPieces [Piece]
items -> do
                            open <- Int -> Word8 -> IO Int
byte Int
offset Word8
0x5b
                            end <- separated open items piece
                            byte end 0x5d
            open <- Int -> Word8 -> IO Int
byte Int
0 Word8
0x7b
            end <- separated open parts $ \Int
at (ByteString
key, Part
p) -> Int -> ByteString -> (Int -> IO Int) -> IO Int
forall {b}. Int -> ByteString -> (Int -> IO b) -> IO b
member Int
at ByteString
key (Int -> Part -> IO Int
`part` Part
p)
            final <- byte end 0x7d
            pure (if final == size then size else 0)
    guard (BS.length rendered == size)
    pure rendered
  where
    parts :: [(ByteString, Part)]
parts = RenderPlan -> [(ByteString, Part)]
planParts RenderPlan
plan

{- | The assembled document as aeson's tree, as its render writes it, or nothing when a piece names a
table or string the plan lacks.
-}
planValue :: RenderPlan -> Maybe Value
planValue :: RenderPlan -> Maybe Value
planValue RenderPlan
plan = (\Value
slotValue -> Object -> Value
Object (Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
KeyMap.insert (RenderPlan -> Key
planSlot RenderPlan
plan) Value
slotValue (RenderPlan -> Object
planMembers RenderPlan
plan))) (Value -> Value) -> Maybe Value -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Value
slot
  where
    slot :: Maybe Value
slot = case RenderPlan -> Pieces
planPieces RenderPlan
plan of
        ObjectPieces [(Text, Piece)]
list -> Object -> Value
Object (Object -> Value)
-> ([(Key, Value)] -> Object) -> [(Key, Value)] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KeyMap.fromList ([(Key, Value)] -> Value) -> Maybe [(Key, Value)] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text, Piece) -> Maybe (Key, Value))
-> [(Text, Piece)] -> Maybe [(Key, 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) -> [a] -> f [b]
traverse (\(Text
version, Piece
item) -> (Text -> Key
Key.fromText Text
version,) (Value -> (Key, Value)) -> Maybe Value -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Piece -> Maybe Value
pieceValue Piece
item) [(Text, Piece)]
list
        ArrayPieces [Piece]
list -> Array -> Value
Array (Array -> Value) -> ([Value] -> Array) -> [Value] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Array
forall a. [a] -> Vector a
V.fromList ([Value] -> Value) -> Maybe [Value] -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Piece -> Maybe Value) -> [Piece] -> 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) -> [a] -> f [b]
traverse Piece -> Maybe Value
pieceValue [Piece]
list
    pieceValue :: Piece -> Maybe Value
pieceValue (Piece Int
index Packed
value) = SmallArray DocTable -> Int -> Maybe DocTable
tableAt (RenderPlan -> SmallArray DocTable
planTables RenderPlan
plan) Int
index Maybe DocTable -> (DocTable -> Maybe Value) -> Maybe Value
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \DocTable
table -> DocTable -> Maybe UrlPrefix -> Packed -> Maybe Value
rebasedValue DocTable
table (RenderPlan -> Maybe UrlPrefix
planPrefix RenderPlan
plan) Packed
value

-- | The heap bytes the plan's tables and pieces hold, each piece with its list cell, record and key.
planResident :: RenderPlan -> Int
planResident :: RenderPlan -> Int
planResident RenderPlan
plan =
    [Int] -> Int
forall a (f :: * -> *). (Foldable f, Num a) => f a -> a
sum ((DocTable -> Int) -> [DocTable] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map DocTable -> Int
tableResident (SmallArray DocTable -> [DocTable]
forall a. SmallArray a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (RenderPlan -> SmallArray DocTable
planTables RenderPlan
plan))) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ case RenderPlan -> Pieces
planPieces RenderPlan
plan of
        ObjectPieces [(Text, Piece)]
list -> [Int] -> Int
forall a (f :: * -> *). (Foldable f, Num a) => f a -> a
sum [Int
72 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
textStorageBytes Text
version Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Piece -> Int
pieceResident Piece
item | (Text
version, Piece
item) <- [(Text, Piece)]
list]
        ArrayPieces [Piece]
list -> [Int] -> Int
forall a (f :: * -> *). (Foldable f, Num a) => f a -> a
sum [Int
48 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Piece -> Int
pieceResident Piece
item | Piece
item <- [Piece]
list]
  where
    pieceResident :: Piece -> Int
pieceResident (Piece Int
_ Packed
value) = Packed -> Int
packedResident Packed
value