{-# language DataKinds #-}
{-# language DeriveFunctor #-}
{-# language DuplicateRecordFields #-}
{-# language NamedFieldPuns #-}
{-# language MultiWayIf #-}

module Flatbuffers.Parser
  ( Parser
  , TableParser
  , UnionParser
  , Error(..)
  , run
  , tableParserThrow
    -- * Table Fields
  , boolean
  , int8
  , int16
  , word8Eq
  , word16
  , word16Eq
  , int32
  , int64
  , ignore
  , string
  , union
  , table
  , optTable
  , array
  , structs
    -- * Unions
  , constructUnion2
  , constructUnion3
  , constructUnionFromList
  ) where

import Prelude hiding (length)

import Control.Monad (when)
import Control.Monad.ST (runST)
import Data.Bytes.Types (Bytes(Bytes))
import Data.Word (Word16, Word32)
import Data.Text (Text)
import Data.Int (Int8,Int16,Int32,Int64)
import Data.Word (Word8)
import Data.Kind (Type)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except (runExceptT, except)

import Data.Primitive (Prim, sizeOfType, alignmentOfType)
import Data.Primitive (sizeofByteArray,indexSmallArray,sizeofSmallArray)
import Data.Primitive (newByteArray,unsafeFreezeByteArray)
import Data.Primitive (unsafeFreezeSmallArray,newSmallArray)
import Data.Primitive (PrimArray(PrimArray),ByteArray(ByteArray),SmallArray)
import Data.Primitive.Contiguous (Slice,Sliced,slice)
import System.ByteOrder (ByteOrder(LittleEndian), Fixed(Fixed))

import qualified Data.Primitive as PM
import qualified Data.Primitive.Contiguous as Contiguous
import qualified Data.Bytes.Types
import qualified Data.Bytes.Text.Utf8 as Utf8
import qualified Data.Primitive.ByteArray.LittleEndian as LE
import qualified GHC.Exts as Exts

-- We do not include the vtable length in the slice since that number
-- is already captured by the Sliced data constructor itself. We begin
-- with the table length at index 0. The table length has to be included
-- in the vtable because we need to validate that it does not imply OOB
-- outside of the vtable decoding function.
--
-- Invariant: Length of slice >= 1 (because element 0 is table length)
-- Invariant: Table length >= 4 (table must include VTable offset)
-- Invariant: All offsets are < table length (this simplifies bounds
--   checking later).
newtype VTable = VTable (Sliced PrimArray (Fixed 'LittleEndian Word16))

data Error
  = VTableAlignmentError
  | VTableLengthError
  | UnionTagOutOfBounds
  | TableOffsetAlignmentError
  | StringOffsetAlignmentError
  | FieldStringAlignmentError
  | VTableLengthOutOfBoundsError
  | VTableLengthAlignmentError
  | VTableIndexOutOfBoundsError !Int !Int
  | NegativeVTableIndexError !Int
  | TableVTableEndOfInputError
  | TableAlignmentError
  | StringNotUtf8
  | StringOffsetOutOfBounds
  | TagImpliesUnionNone
  | VTableImpliesOutOfBoundsField
  | VTableLengthLessThanFour
      !Int -- offset of the vtable (where it starts)
      !Int
  | FieldBooleanNotInRange
  | FieldInt16AlignmentError
  | FieldInt32AlignmentError
  | FieldInt64AlignmentError
  | DefaultingStringNotSupportedYet
  | DefaultingTableNotSupported
  | VTableSizeImpliesTableOutOfBounds
  | TooSmallForRootTableOffset
  | RootTableOffsetOutOfBounds
  | RootTableOffsetLessThanFourError
  | ArrayOffsetOutOfBounds
  | ArrayOfStructOffsetOutOfBounds
  | ArrayOfStructPayloadOutOfBounds !Int !Int !Int
  | ArrayOffsetAlignmentError
  | ArrayOfStructOffsetAlignmentError
  | FieldArrayAlignmentError
  | ExpectedWord8EqButGot !Word8 !Word8
  | ExpectedWord16EqButGot !Word16 !Word16
  | MissingFieldWithIndex !Int
  | UnsupportedUnionTag !Word8
  deriving (Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Error -> ShowS
showsPrec :: Int -> Error -> ShowS
$cshow :: Error -> String
show :: Error -> String
$cshowList :: [Error] -> ShowS
showList :: [Error] -> ShowS
Show)

type Parser :: Type -> Type
newtype Parser a = Parser
  (    ByteArray  -- The entire encoded document
    -> Int -- position
    -> Int -- end position (the length of the bytearray, a constant)
    -> Either Error a
  )

deriving instance Functor Parser

type TableParser :: Type -> Type
newtype TableParser a = TableParser
  (    ByteArray  -- The entire encoded document
    -> Int -- offset to the beginning of the table (a constant)
    -> Int -- end position (the length of the bytearray, a constant)
    -> VTable -- VTable for the table currently being decoded
    -> Int    -- current field position
    -> Either Error (R a)
  )

deriving instance Functor TableParser
instance Applicative TableParser where
  pure :: forall a. a -> TableParser a
pure a
x = (ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R a))
-> TableParser a
forall a.
(ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R a))
-> TableParser a
TableParser
    (\ByteArray
_ Int
_ Int
_ VTable
_ Int
field -> R a -> Either Error (R a)
forall a b. b -> Either a b
Right (Int -> a -> R a
forall a. Int -> a -> R a
R Int
field a
x))
  TableParser ByteArray
-> Int -> Int -> VTable -> Int -> Either Error (R (a -> b))
f <*> :: forall a b. TableParser (a -> b) -> TableParser a -> TableParser b
<*> TableParser ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R a)
g = (ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R b))
-> TableParser b
forall a.
(ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R a))
-> TableParser a
TableParser ((ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R b))
 -> TableParser b)
-> (ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R b))
-> TableParser b
forall a b. (a -> b) -> a -> b
$
    \ByteArray
doc Int
off Int
end VTable
vt Int
field -> case ByteArray
-> Int -> Int -> VTable -> Int -> Either Error (R (a -> b))
f ByteArray
doc Int
off Int
end VTable
vt Int
field of
      Left Error
e -> Error -> Either Error (R b)
forall a b. a -> Either a b
Left Error
e
      Right (R Int
field' a -> b
h) -> case ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R a)
g ByteArray
doc Int
off Int
end VTable
vt Int
field' of
        Left Error
e -> Error -> Either Error (R b)
forall a b. a -> Either a b
Left Error
e
        Right (R Int
field'' a
a) -> R b -> Either Error (R b)
forall a b. b -> Either a b
Right (Int -> b -> R b
forall a. Int -> a -> R a
R Int
field'' (a -> b
h a
a))
instance Monad TableParser where
  TableParser ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R a)
f >>= :: forall a b. TableParser a -> (a -> TableParser b) -> TableParser b
>>= a -> TableParser b
g = (ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R b))
-> TableParser b
forall a.
(ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R a))
-> TableParser a
TableParser ((ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R b))
 -> TableParser b)
-> (ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R b))
-> TableParser b
forall a b. (a -> b) -> a -> b
$
    \ByteArray
doc Int
off Int
end VTable
vt Int
field -> case ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R a)
f ByteArray
doc Int
off Int
end VTable
vt Int
field of
      Left Error
e -> Error -> Either Error (R b)
forall a b. a -> Either a b
Left Error
e
      Right (R Int
field' a
a) -> case a -> TableParser b
g a
a of
        TableParser ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R b)
h -> ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R b)
h ByteArray
doc Int
off Int
end VTable
vt Int
field'

data R a = R !Int !a

deriving instance Functor R

-- | Unions can only be unions of tables. In 2017, flatbuffers changed
-- this to support more types, but this library sticks with the original
-- restriction to make things more simple.
newtype UnionParser a = UnionParser (SmallArray (TableParser a))

tableParserThrow :: Error -> TableParser a
tableParserThrow :: forall a. Error -> TableParser a
tableParserThrow Error
e = (ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R a))
-> TableParser a
forall a.
(ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R a))
-> TableParser a
TableParser (\ByteArray
_ Int
_ Int
_ VTable
_ Int
_ -> Error -> Either Error (R a)
forall a b. a -> Either a b
Left Error
e)

constructUnion2 :: TableParser a -> TableParser a -> UnionParser a
constructUnion2 :: forall a. TableParser a -> TableParser a -> UnionParser a
constructUnion2 TableParser a
a TableParser a
b = SmallArray (TableParser a) -> UnionParser a
forall a. SmallArray (TableParser a) -> UnionParser a
UnionParser (TableParser a -> TableParser a -> SmallArray (TableParser a)
forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
a -> a -> arr a
Contiguous.construct2 TableParser a
a TableParser a
b)

constructUnion3 :: TableParser a -> TableParser a -> TableParser a -> UnionParser a
constructUnion3 :: forall a.
TableParser a -> TableParser a -> TableParser a -> UnionParser a
constructUnion3 TableParser a
a TableParser a
b TableParser a
c = SmallArray (TableParser a) -> UnionParser a
forall a. SmallArray (TableParser a) -> UnionParser a
UnionParser (TableParser a
-> TableParser a -> TableParser a -> SmallArray (TableParser a)
forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
a -> a -> a -> arr a
Contiguous.construct3 TableParser a
a TableParser a
b TableParser a
c)

constructUnionFromList :: [TableParser a] -> UnionParser a
constructUnionFromList :: forall a. [TableParser a] -> UnionParser a
constructUnionFromList [TableParser a]
xs = SmallArray (TableParser a) -> UnionParser a
forall a. SmallArray (TableParser a) -> UnionParser a
UnionParser ([Item (SmallArray (TableParser a))] -> SmallArray (TableParser a)
forall l. IsList l => [Item l] -> l
Exts.fromList [Item (SmallArray (TableParser a))]
[TableParser a]
xs)

-- | Reads the first four bytes to determine the root table.
run :: TableParser a -> ByteArray -> Either Error a
run :: forall a. TableParser a -> ByteArray -> Either Error a
run TableParser a
p ByteArray
x = do
  Bool -> Either Error () -> Either Error ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteArray -> Int
sizeofByteArray ByteArray
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4) (Error -> Either Error ()
forall a b. a -> Either a b
Left Error
TooSmallForRootTableOffset)
  let !(Word32
rootTableOffset :: Word32) = ByteArray -> Int -> Word32
forall a. (Prim a, Bytes a) => ByteArray -> Int -> a
LE.indexByteArray ByteArray
x Int
0
  let !rootTableOffsetI :: Int
rootTableOffsetI = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word32 @Int Word32
rootTableOffset
  -- These two checks are probably redundant, but they will result
  -- in a better error message if a user tries to decode a malformed
  -- document.
  Bool -> Either Error () -> Either Error ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
rootTableOffsetI Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4) (Error -> Either Error ()
forall a b. a -> Either a b
Left Error
RootTableOffsetLessThanFourError)
  Bool -> Either Error () -> Either Error ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
rootTableOffsetI Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> ByteArray -> Int
sizeofByteArray ByteArray
x) (Error -> Either Error ()
forall a b. a -> Either a b
Left Error
RootTableOffsetOutOfBounds)
  case TableParser a -> Parser a
forall a. TableParser a -> Parser a
lowerTableParser TableParser a
p of
    Parser ByteArray -> Int -> Int -> Either Error a
f -> ByteArray -> Int -> Int -> Either Error a
f ByteArray
x Int
rootTableOffsetI (ByteArray -> Int
sizeofByteArray ByteArray
x)

lowerTableParser :: TableParser a -> Parser a
lowerTableParser :: forall a. TableParser a -> Parser a
lowerTableParser (TableParser ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R a)
f) = (ByteArray -> Int -> Int -> Either Error a) -> Parser a
forall a. (ByteArray -> Int -> Int -> Either Error a) -> Parser a
Parser ((ByteArray -> Int -> Int -> Either Error a) -> Parser a)
-> (ByteArray -> Int -> Int -> Either Error a) -> Parser a
forall a b. (a -> b) -> a -> b
$ \ByteArray
theArray Int
offset Int
end ->
  if | Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 -> Error -> Either Error a
forall a b. a -> Either a b
Left Error
TableVTableEndOfInputError
     | Int -> Int -> Int
forall a. Integral a => a -> a -> a
rem Int
offset Int
4 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 -> Error -> Either Error a
forall a b. a -> Either a b
Left Error
TableAlignmentError
     | (Int32
vtableInvertedRelOffsetI32 :: Int32) <- ByteArray -> Int -> Int32
forall a. (Prim a, Bytes a) => ByteArray -> Int -> a
LE.indexByteArray ByteArray
theArray (Int -> Int -> Int
forall a. Integral a => a -> a -> a
quot Int
offset Int
4)
     , Int
vtableInvertedRelOffset <- forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int32 @Int Int32
vtableInvertedRelOffsetI32
     , Int
vtableIndex <- Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
vtableInvertedRelOffset ->
       if | Int
vtableIndex Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> Error -> Either Error a
forall a b. a -> Either a b
Left (Int -> Error
NegativeVTableIndexError Int
vtableIndex)
          | Int
vtableIndex Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end -> Error -> Either Error a
forall a b. a -> Either a b
Left (Int -> Int -> Error
VTableIndexOutOfBoundsError Int
vtableIndex Int
end)
          | Bool
otherwise -> do
              VTable
vtable <- ByteArray -> Int -> Int -> Either Error VTable
bytesToVTable ByteArray
theArray Int
vtableIndex Int
end
              Bool -> Either Error () -> Either Error ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ VTable -> Int
tableSizeFromVTable VTable
vtable Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
end) (Error -> Either Error ()
forall a b. a -> Either a b
Left Error
VTableSizeImpliesTableOutOfBounds)
              R Int
_ a
a <- ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R a)
f ByteArray
theArray Int
offset Int
end VTable
vtable Int
0
              a -> Either Error a
forall a b. b -> Either a b
Right a
a

boolean :: TableParser Bool
boolean :: TableParser Bool
boolean = (ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R Bool))
-> TableParser Bool
forall a.
(ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R a))
-> TableParser a
TableParser ((ByteArray
  -> Int -> Int -> VTable -> Int -> Either Error (R Bool))
 -> TableParser Bool)
-> (ByteArray
    -> Int -> Int -> VTable -> Int -> Either Error (R Bool))
-> TableParser Bool
forall a b. (a -> b) -> a -> b
$ \ByteArray
content Int
tableOffset Int
_ VTable
vtable Int
fieldIx -> do
  !Word16
fieldOffset <- VTable -> Int -> Either Error Word16
indexVTableField VTable
vtable Int
fieldIx
  case Word16
fieldOffset of
    Word16
0 -> do
      let !fieldIx' :: Int
fieldIx' = Int
fieldIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      R Bool -> Either Error (R Bool)
forall a b. b -> Either a b
Right (Int -> Bool -> R Bool
forall a. Int -> a -> R a
R Int
fieldIx' Bool
False)
    Word16
_ -> do
      let !effectiveOffset :: Int
effectiveOffset = (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Int Word16
fieldOffset) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tableOffset
      let !v :: Word8
v = ByteArray -> Int -> Word8
forall a. (Prim a, Bytes a) => ByteArray -> Int -> a
LE.indexByteArray ByteArray
content Int
effectiveOffset :: Word8
      let !fieldIx' :: Int
fieldIx' = Int
fieldIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      case Word8
v of
        Word8
0 -> R Bool -> Either Error (R Bool)
forall a b. b -> Either a b
Right (Int -> Bool -> R Bool
forall a. Int -> a -> R a
R Int
fieldIx' Bool
False)
        Word8
1 -> R Bool -> Either Error (R Bool)
forall a b. b -> Either a b
Right (Int -> Bool -> R Bool
forall a. Int -> a -> R a
R Int
fieldIx' Bool
True)
        Word8
_ -> Error -> Either Error (R Bool)
forall a b. a -> Either a b
Left Error
FieldBooleanNotInRange

word8Eq :: Word8 -> TableParser ()
word8Eq :: Word8 -> TableParser ()
word8Eq !Word8
expecting = (ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R ()))
-> TableParser ()
forall a.
(ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R a))
-> TableParser a
TableParser ((ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R ()))
 -> TableParser ())
-> (ByteArray
    -> Int -> Int -> VTable -> Int -> Either Error (R ()))
-> TableParser ()
forall a b. (a -> b) -> a -> b
$ \ByteArray
content Int
tableOffset Int
_ VTable
vtable Int
fieldIx -> do
  !Word16
fieldOffset <- VTable -> Int -> Either Error Word16
indexVTableField VTable
vtable Int
fieldIx
  case Word16
fieldOffset of
    Word16
0 -> do
      let !fieldIx' :: Int
fieldIx' = Int
fieldIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      if Word8
expecting Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0
        then R () -> Either Error (R ())
forall a b. b -> Either a b
Right (Int -> () -> R ()
forall a. Int -> a -> R a
R Int
fieldIx' ())
        else Error -> Either Error (R ())
forall a b. a -> Either a b
Left (Word8 -> Word8 -> Error
ExpectedWord8EqButGot Word8
expecting Word8
0)
    Word16
_ -> do
      let !effectiveOffset :: Int
effectiveOffset = (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Int Word16
fieldOffset) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tableOffset
      let !v :: Word8
v = ByteArray -> Int -> Word8
forall a. (Prim a, Bytes a) => ByteArray -> Int -> a
LE.indexByteArray ByteArray
content Int
effectiveOffset
      let !fieldIx' :: Int
fieldIx' = Int
fieldIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      if Word8
expecting Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
v
        then R () -> Either Error (R ())
forall a b. b -> Either a b
Right (Int -> () -> R ()
forall a. Int -> a -> R a
R Int
fieldIx' ())
        else Error -> Either Error (R ())
forall a b. a -> Either a b
Left (Word8 -> Word8 -> Error
ExpectedWord8EqButGot Word8
expecting Word8
v)

word8 :: TableParser Word8
word8 :: TableParser Word8
word8 = (ByteArray
 -> Int -> Int -> VTable -> Int -> Either Error (R Word8))
-> TableParser Word8
forall a.
(ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R a))
-> TableParser a
TableParser ((ByteArray
  -> Int -> Int -> VTable -> Int -> Either Error (R Word8))
 -> TableParser Word8)
-> (ByteArray
    -> Int -> Int -> VTable -> Int -> Either Error (R Word8))
-> TableParser Word8
forall a b. (a -> b) -> a -> b
$ \ByteArray
content Int
tableOffset Int
_ VTable
vtable Int
fieldIx -> do
  !Word16
fieldOffset <- VTable -> Int -> Either Error Word16
indexVTableField VTable
vtable Int
fieldIx
  case Word16
fieldOffset of
    Word16
0 -> do
      let !fieldIx' :: Int
fieldIx' = Int
fieldIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      R Word8 -> Either Error (R Word8)
forall a b. b -> Either a b
Right (Int -> Word8 -> R Word8
forall a. Int -> a -> R a
R Int
fieldIx' Word8
0)
    Word16
_ -> do
      let !effectiveOffset :: Int
effectiveOffset = (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Int Word16
fieldOffset) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tableOffset
      let !v :: Word8
v = ByteArray -> Int -> Word8
forall a. (Prim a, Bytes a) => ByteArray -> Int -> a
LE.indexByteArray ByteArray
content Int
effectiveOffset
      let !fieldIx' :: Int
fieldIx' = Int
fieldIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      R Word8 -> Either Error (R Word8)
forall a b. b -> Either a b
Right (Int -> Word8 -> R Word8
forall a. Int -> a -> R a
R Int
fieldIx' Word8
v)

int8 :: TableParser Int8
int8 :: TableParser Int8
int8 = (ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R Int8))
-> TableParser Int8
forall a.
(ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R a))
-> TableParser a
TableParser ((ByteArray
  -> Int -> Int -> VTable -> Int -> Either Error (R Int8))
 -> TableParser Int8)
-> (ByteArray
    -> Int -> Int -> VTable -> Int -> Either Error (R Int8))
-> TableParser Int8
forall a b. (a -> b) -> a -> b
$ \ByteArray
content Int
tableOffset Int
_ VTable
vtable Int
fieldIx -> do
  !Word16
fieldOffset <- VTable -> Int -> Either Error Word16
indexVTableField VTable
vtable Int
fieldIx
  case Word16
fieldOffset of
    Word16
0 -> do
      let !fieldIx' :: Int
fieldIx' = Int
fieldIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      R Int8 -> Either Error (R Int8)
forall a b. b -> Either a b
Right (Int -> Int8 -> R Int8
forall a. Int -> a -> R a
R Int
fieldIx' Int8
0)
    Word16
_ -> do
      let !effectiveOffset :: Int
effectiveOffset = (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Int Word16
fieldOffset) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tableOffset
      let !v :: Int8
v = ByteArray -> Int -> Int8
forall a. (Prim a, Bytes a) => ByteArray -> Int -> a
LE.indexByteArray ByteArray
content Int
effectiveOffset
      let !fieldIx' :: Int
fieldIx' = Int
fieldIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      R Int8 -> Either Error (R Int8)
forall a b. b -> Either a b
Right (Int -> Int8 -> R Int8
forall a. Int -> a -> R a
R Int
fieldIx' Int8
v)

int16 :: TableParser Int16
int16 :: TableParser Int16
int16 = (ByteArray
 -> Int -> Int -> VTable -> Int -> Either Error (R Int16))
-> TableParser Int16
forall a.
(ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R a))
-> TableParser a
TableParser ((ByteArray
  -> Int -> Int -> VTable -> Int -> Either Error (R Int16))
 -> TableParser Int16)
-> (ByteArray
    -> Int -> Int -> VTable -> Int -> Either Error (R Int16))
-> TableParser Int16
forall a b. (a -> b) -> a -> b
$ \ByteArray
content Int
tableOffset Int
_ VTable
vtable Int
fieldIx -> do
  !Word16
fieldOffset <- VTable -> Int -> Either Error Word16
indexVTableField VTable
vtable Int
fieldIx
  case Word16
fieldOffset of
    Word16
0 -> do
      let !fieldIx' :: Int
fieldIx' = Int
fieldIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      R Int16 -> Either Error (R Int16)
forall a b. b -> Either a b
Right (Int -> Int16 -> R Int16
forall a. Int -> a -> R a
R Int
fieldIx' Int16
0)
    Word16
_ -> do
      let !effectiveOffset :: Int
effectiveOffset = (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Int Word16
fieldOffset) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tableOffset
      Bool -> Either Error () -> Either Error ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Int -> Int
forall a. Integral a => a -> a -> a
rem Int
effectiveOffset Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (Error -> Either Error ()
forall a b. a -> Either a b
Left Error
FieldInt16AlignmentError)
      let !v :: Int16
v = ByteArray -> Int -> Int16
forall a. (Prim a, Bytes a) => ByteArray -> Int -> a
LE.indexByteArray ByteArray
content (Int -> Int -> Int
forall a. Integral a => a -> a -> a
quot Int
effectiveOffset Int
2)
      let !fieldIx' :: Int
fieldIx' = Int
fieldIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      R Int16 -> Either Error (R Int16)
forall a b. b -> Either a b
Right (Int -> Int16 -> R Int16
forall a. Int -> a -> R a
R Int
fieldIx' Int16
v)

word16 :: TableParser Word16
word16 :: TableParser Word16
word16 = (ByteArray
 -> Int -> Int -> VTable -> Int -> Either Error (R Word16))
-> TableParser Word16
forall a.
(ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R a))
-> TableParser a
TableParser ((ByteArray
  -> Int -> Int -> VTable -> Int -> Either Error (R Word16))
 -> TableParser Word16)
-> (ByteArray
    -> Int -> Int -> VTable -> Int -> Either Error (R Word16))
-> TableParser Word16
forall a b. (a -> b) -> a -> b
$ \ByteArray
content Int
tableOffset Int
_ VTable
vtable Int
fieldIx -> do
  !Word16
fieldOffset <- VTable -> Int -> Either Error Word16
indexVTableField VTable
vtable Int
fieldIx
  case Word16
fieldOffset of
    Word16
0 -> do
      let !fieldIx' :: Int
fieldIx' = Int
fieldIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      R Word16 -> Either Error (R Word16)
forall a b. b -> Either a b
Right (Int -> Word16 -> R Word16
forall a. Int -> a -> R a
R Int
fieldIx' Word16
0)
    Word16
_ -> do
      let !effectiveOffset :: Int
effectiveOffset = (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Int Word16
fieldOffset) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tableOffset
      Bool -> Either Error () -> Either Error ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Int -> Int
forall a. Integral a => a -> a -> a
rem Int
effectiveOffset Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (Error -> Either Error ()
forall a b. a -> Either a b
Left Error
FieldInt16AlignmentError)
      let !v :: Word16
v = ByteArray -> Int -> Word16
forall a. (Prim a, Bytes a) => ByteArray -> Int -> a
LE.indexByteArray ByteArray
content (Int -> Int -> Int
forall a. Integral a => a -> a -> a
quot Int
effectiveOffset Int
2)
      let !fieldIx' :: Int
fieldIx' = Int
fieldIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      R Word16 -> Either Error (R Word16)
forall a b. b -> Either a b
Right (Int -> Word16 -> R Word16
forall a. Int -> a -> R a
R Int
fieldIx' Word16
v)

word16Eq :: Word16 -> TableParser ()
word16Eq :: Word16 -> TableParser ()
word16Eq !Word16
expecting = (ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R ()))
-> TableParser ()
forall a.
(ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R a))
-> TableParser a
TableParser ((ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R ()))
 -> TableParser ())
-> (ByteArray
    -> Int -> Int -> VTable -> Int -> Either Error (R ()))
-> TableParser ()
forall a b. (a -> b) -> a -> b
$ \ByteArray
content Int
tableOffset Int
_ VTable
vtable Int
fieldIx -> do
  !Word16
fieldOffset <- VTable -> Int -> Either Error Word16
indexVTableField VTable
vtable Int
fieldIx
  case Word16
fieldOffset of
    Word16
0 -> do
      let !fieldIx' :: Int
fieldIx' = Int
fieldIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      if Word16
expecting Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
0
        then R () -> Either Error (R ())
forall a b. b -> Either a b
Right (Int -> () -> R ()
forall a. Int -> a -> R a
R Int
fieldIx' ())
        else Error -> Either Error (R ())
forall a b. a -> Either a b
Left (Word16 -> Word16 -> Error
ExpectedWord16EqButGot Word16
expecting Word16
0)
    Word16
_ -> do
      let !effectiveOffset :: Int
effectiveOffset = (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Int Word16
fieldOffset) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tableOffset
      Bool -> Either Error () -> Either Error ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Int -> Int
forall a. Integral a => a -> a -> a
rem Int
effectiveOffset Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (Error -> Either Error ()
forall a b. a -> Either a b
Left Error
FieldInt16AlignmentError)
      let !v :: Word16
v = ByteArray -> Int -> Word16
forall a. (Prim a, Bytes a) => ByteArray -> Int -> a
LE.indexByteArray ByteArray
content (Int -> Int -> Int
forall a. Integral a => a -> a -> a
quot Int
effectiveOffset Int
2)
      let !fieldIx' :: Int
fieldIx' = Int
fieldIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      if Word16
expecting Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
v
        then R () -> Either Error (R ())
forall a b. b -> Either a b
Right (Int -> () -> R ()
forall a. Int -> a -> R a
R Int
fieldIx' ())
        else Error -> Either Error (R ())
forall a b. a -> Either a b
Left (Word16 -> Word16 -> Error
ExpectedWord16EqButGot Word16
expecting Word16
v)

int32 :: TableParser Int32
int32 :: TableParser Int32
int32 = (ByteArray
 -> Int -> Int -> VTable -> Int -> Either Error (R Int32))
-> TableParser Int32
forall a.
(ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R a))
-> TableParser a
TableParser ((ByteArray
  -> Int -> Int -> VTable -> Int -> Either Error (R Int32))
 -> TableParser Int32)
-> (ByteArray
    -> Int -> Int -> VTable -> Int -> Either Error (R Int32))
-> TableParser Int32
forall a b. (a -> b) -> a -> b
$ \ByteArray
content Int
tableOffset Int
_ VTable
vtable Int
fieldIx -> do
  !Word16
fieldOffset <- VTable -> Int -> Either Error Word16
indexVTableField VTable
vtable Int
fieldIx
  case Word16
fieldOffset of
    Word16
0 -> do
      let !fieldIx' :: Int
fieldIx' = Int
fieldIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      R Int32 -> Either Error (R Int32)
forall a b. b -> Either a b
Right (Int -> Int32 -> R Int32
forall a. Int -> a -> R a
R Int
fieldIx' Int32
0)
    Word16
_ -> do
      let !effectiveOffset :: Int
effectiveOffset = (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Int Word16
fieldOffset) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tableOffset
      Bool -> Either Error () -> Either Error ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Int -> Int
forall a. Integral a => a -> a -> a
rem Int
effectiveOffset Int
4 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (Error -> Either Error ()
forall a b. a -> Either a b
Left Error
FieldInt32AlignmentError)
      let !v :: Int32
v = ByteArray -> Int -> Int32
forall a. (Prim a, Bytes a) => ByteArray -> Int -> a
LE.indexByteArray ByteArray
content (Int -> Int -> Int
forall a. Integral a => a -> a -> a
quot Int
effectiveOffset Int
4)
      let !fieldIx' :: Int
fieldIx' = Int
fieldIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      R Int32 -> Either Error (R Int32)
forall a b. b -> Either a b
Right (Int -> Int32 -> R Int32
forall a. Int -> a -> R a
R Int
fieldIx' Int32
v)

optTable :: TableParser a -> TableParser (Maybe a)
optTable :: forall a. TableParser a -> TableParser (Maybe a)
optTable TableParser a
arg = (ByteArray
 -> Int -> Int -> VTable -> Int -> Either Error (R (Maybe a)))
-> TableParser (Maybe a)
forall a.
(ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R a))
-> TableParser a
TableParser ((ByteArray
  -> Int -> Int -> VTable -> Int -> Either Error (R (Maybe a)))
 -> TableParser (Maybe a))
-> (ByteArray
    -> Int -> Int -> VTable -> Int -> Either Error (R (Maybe a)))
-> TableParser (Maybe a)
forall a b. (a -> b) -> a -> b
$ \ByteArray
content Int
tableOffset Int
end VTable
vtable Int
fieldIx -> do
  !Word16
fieldOffset <- VTable -> Int -> Either Error Word16
indexVTableField VTable
vtable Int
fieldIx
  case Word16
fieldOffset of
    Word16
0 -> do
      let !fieldIx' :: Int
fieldIx' = Int
fieldIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      R (Maybe a) -> Either Error (R (Maybe a))
forall a b. b -> Either a b
Right (Int -> Maybe a -> R (Maybe a)
forall a. Int -> a -> R a
R Int
fieldIx' Maybe a
forall a. Maybe a
Nothing)
    Word16
_ -> do
      let !effectiveOffset :: Int
effectiveOffset = (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Int Word16
fieldOffset) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tableOffset
      Bool -> Either Error () -> Either Error ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Int -> Int
forall a. Integral a => a -> a -> a
rem Int
effectiveOffset Int
4 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (Error -> Either Error ()
forall a b. a -> Either a b
Left Error
FieldStringAlignmentError)
      let !(Word32
tableFieldOffset :: Word32) = ByteArray -> Int -> Word32
forall a. (Prim a, Bytes a) => ByteArray -> Int -> a
LE.indexByteArray ByteArray
content (Int -> Int -> Int
forall a. Integral a => a -> a -> a
quot Int
effectiveOffset Int
4)
      let !effectiveTableOffset :: Int
effectiveTableOffset = (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word32 @Int Word32
tableFieldOffset) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
effectiveOffset
      Bool -> Either Error () -> Either Error ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Int -> Int
forall a. Integral a => a -> a -> a
rem Int
effectiveTableOffset Int
4 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (Error -> Either Error ()
forall a b. a -> Either a b
Left Error
TableOffsetAlignmentError)
      case TableParser a -> Parser a
forall a. TableParser a -> Parser a
lowerTableParser TableParser a
arg of
        Parser ByteArray -> Int -> Int -> Either Error a
f -> do
          a
result <- ByteArray -> Int -> Int -> Either Error a
f ByteArray
content Int
effectiveTableOffset Int
end
          let !fieldIx' :: Int
fieldIx' = Int
fieldIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
          R (Maybe a) -> Either Error (R (Maybe a))
forall a. a -> Either Error a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Maybe a -> R (Maybe a)
forall a. Int -> a -> R a
R Int
fieldIx' (a -> Maybe a
forall a. a -> Maybe a
Just a
result))

-- | Use a table as a field in another table.
table :: TableParser a -> TableParser a
table :: forall a. TableParser a -> TableParser a
table TableParser a
arg = (ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R a))
-> TableParser a
forall a.
(ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R a))
-> TableParser a
TableParser ((ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R a))
 -> TableParser a)
-> (ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R a))
-> TableParser a
forall a b. (a -> b) -> a -> b
$ \ByteArray
content Int
tableOffset Int
end VTable
vtable Int
fieldIx -> do
  !Word16
fieldOffset <- VTable -> Int -> Either Error Word16
indexVTableField VTable
vtable Int
fieldIx
  case Word16
fieldOffset of
    Word16
0 -> Error -> Either Error ()
forall a b. a -> Either a b
Left Error
DefaultingTableNotSupported
    Word16
_ -> () -> Either Error ()
forall a. a -> Either Error a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  let !effectiveOffset :: Int
effectiveOffset = (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Int Word16
fieldOffset) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tableOffset
  Bool -> Either Error () -> Either Error ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Int -> Int
forall a. Integral a => a -> a -> a
rem Int
effectiveOffset Int
4 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (Error -> Either Error ()
forall a b. a -> Either a b
Left Error
FieldStringAlignmentError)
  let !(Word32
tableFieldOffset :: Word32) = ByteArray -> Int -> Word32
forall a. (Prim a, Bytes a) => ByteArray -> Int -> a
LE.indexByteArray ByteArray
content (Int -> Int -> Int
forall a. Integral a => a -> a -> a
quot Int
effectiveOffset Int
4)
  let !effectiveTableOffset :: Int
effectiveTableOffset = (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word32 @Int Word32
tableFieldOffset) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
effectiveOffset
  Bool -> Either Error () -> Either Error ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Int -> Int
forall a. Integral a => a -> a -> a
rem Int
effectiveTableOffset Int
4 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (Error -> Either Error ()
forall a b. a -> Either a b
Left Error
TableOffsetAlignmentError)
  case TableParser a -> Parser a
forall a. TableParser a -> Parser a
lowerTableParser TableParser a
arg of
    Parser ByteArray -> Int -> Int -> Either Error a
f -> do
      a
result <- ByteArray -> Int -> Int -> Either Error a
f ByteArray
content Int
effectiveTableOffset Int
end
      let !fieldIx' :: Int
fieldIx' = Int
fieldIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      R a -> Either Error (R a)
forall a. a -> Either Error a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> a -> R a
forall a. Int -> a -> R a
R Int
fieldIx' a
result)

-- | Use a string as a field in a table.
string :: TableParser Text
string :: TableParser Text
string = (ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R Text))
-> TableParser Text
forall a.
(ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R a))
-> TableParser a
TableParser ((ByteArray
  -> Int -> Int -> VTable -> Int -> Either Error (R Text))
 -> TableParser Text)
-> (ByteArray
    -> Int -> Int -> VTable -> Int -> Either Error (R Text))
-> TableParser Text
forall a b. (a -> b) -> a -> b
$ \ByteArray
content Int
tableOffset Int
end VTable
vtable Int
fieldIx -> do
  !Word16
fieldOffset <- VTable -> Int -> Either Error Word16
indexVTableField VTable
vtable Int
fieldIx
  case Word16
fieldOffset of
    Word16
0 -> Error -> Either Error ()
forall a b. a -> Either a b
Left Error
DefaultingStringNotSupportedYet
    Word16
_ -> () -> Either Error ()
forall a. a -> Either Error a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  let !effectiveOffset :: Int
effectiveOffset = (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Int Word16
fieldOffset) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tableOffset
  Bool -> Either Error () -> Either Error ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Int -> Int
forall a. Integral a => a -> a -> a
rem Int
effectiveOffset Int
4 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (Error -> Either Error ()
forall a b. a -> Either a b
Left Error
FieldStringAlignmentError)
  let !(Word32
stringOffset :: Word32) = ByteArray -> Int -> Word32
forall a. (Prim a, Bytes a) => ByteArray -> Int -> a
LE.indexByteArray ByteArray
content (Int -> Int -> Int
forall a. Integral a => a -> a -> a
quot Int
effectiveOffset Int
4)
  let !effectiveStringOffset :: Int
effectiveStringOffset = (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word32 @Int Word32
stringOffset) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
effectiveOffset
  Bool -> Either Error () -> Either Error ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Int -> Int
forall a. Integral a => a -> a -> a
rem Int
effectiveStringOffset Int
4 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (Error -> Either Error ()
forall a b. a -> Either a b
Left Error
StringOffsetAlignmentError)
  Bool -> Either Error () -> Either Error ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
effectiveStringOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
end) (Error -> Either Error ()
forall a b. a -> Either a b
Left Error
StringOffsetOutOfBounds)
  let !(Word32
stringLength :: Word32) = ByteArray -> Int -> Word32
forall a. (Prim a, Bytes a) => ByteArray -> Int -> a
LE.indexByteArray ByteArray
content (Int -> Int -> Int
forall a. Integral a => a -> a -> a
quot Int
effectiveStringOffset Int
4)
  let stringLengthI :: Int
stringLengthI = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word32 @Int Word32
stringLength
  Bool -> Either Error () -> Either Error ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
effectiveStringOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
stringLengthI Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
end) (Error -> Either Error ()
forall a b. a -> Either a b
Left Error
StringOffsetOutOfBounds)
  let !payload :: Bytes
payload = ByteArray -> Int -> Int -> Bytes
Bytes ByteArray
content (Int
effectiveStringOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) Int
stringLengthI
  !Text
t <- case Bytes -> Maybe Text
Utf8.toText Bytes
payload of
    Maybe Text
Nothing -> Error -> Either Error Text
forall a b. a -> Either a b
Left Error
StringNotUtf8
    Just Text
t -> Text -> Either Error Text
forall a b. b -> Either a b
Right Text
t
  let !fieldIx' :: Int
fieldIx' = Int
fieldIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
  R Text -> Either Error (R Text)
forall a b. b -> Either a b
Right (Int -> Text -> R Text
forall a. Int -> a -> R a
R Int
fieldIx' Text
t)

structs :: forall a. Prim a => TableParser (PrimArray a)
structs :: forall a. Prim a => TableParser (PrimArray a)
structs = Int -> Int -> TableParser (PrimArray a)
forall a. Int -> Int -> TableParser (PrimArray a)
structsInternal (forall a. Prim a => Int
alignmentOfType @a) (forall a. Prim a => Int
sizeOfType @a)

structsInternal :: Int -> Int -> TableParser (PrimArray a)
structsInternal :: forall a. Int -> Int -> TableParser (PrimArray a)
structsInternal !Int
alignment !Int
sz = (ByteArray
 -> Int -> Int -> VTable -> Int -> Either Error (R (PrimArray a)))
-> TableParser (PrimArray a)
forall a.
(ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R a))
-> TableParser a
TableParser ((ByteArray
  -> Int -> Int -> VTable -> Int -> Either Error (R (PrimArray a)))
 -> TableParser (PrimArray a))
-> (ByteArray
    -> Int -> Int -> VTable -> Int -> Either Error (R (PrimArray a)))
-> TableParser (PrimArray a)
forall a b. (a -> b) -> a -> b
$ \ByteArray
content Int
tableOffset Int
end VTable
vtable Int
fieldIx -> do
  !Word16
fieldOffset <- VTable -> Int -> Either Error Word16
indexVTableField VTable
vtable Int
fieldIx
  case Word16
fieldOffset of
    Word16
0 -> Error -> Either Error ()
forall a b. a -> Either a b
Left Error
DefaultingStringNotSupportedYet
    Word16
_ -> () -> Either Error ()
forall a. a -> Either Error a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  let !effectiveOffset :: Int
effectiveOffset = (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Int Word16
fieldOffset) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tableOffset
  Bool -> Either Error () -> Either Error ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Int -> Int
forall a. Integral a => a -> a -> a
rem Int
effectiveOffset Int
4 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (Error -> Either Error ()
forall a b. a -> Either a b
Left Error
FieldArrayAlignmentError)
  let !(Word32
arrayOffset :: Word32) = ByteArray -> Int -> Word32
forall a. (Prim a, Bytes a) => ByteArray -> Int -> a
LE.indexByteArray ByteArray
content (Int -> Int -> Int
forall a. Integral a => a -> a -> a
quot Int
effectiveOffset Int
4)
  let !effectiveArrayOffset :: Int
effectiveArrayOffset = (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word32 @Int Word32
arrayOffset) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
effectiveOffset
  Bool -> Either Error () -> Either Error ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Int -> Int
forall a. Integral a => a -> a -> a
rem Int
effectiveArrayOffset Int
4 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (Error -> Either Error ()
forall a b. a -> Either a b
Left Error
ArrayOfStructOffsetAlignmentError)
  Bool -> Either Error () -> Either Error ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
effectiveArrayOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
end) (Error -> Either Error ()
forall a b. a -> Either a b
Left Error
ArrayOfStructOffsetOutOfBounds)
  let !(Word32
arrayLength :: Word32) = ByteArray -> Int -> Word32
forall a. (Prim a, Bytes a) => ByteArray -> Int -> a
LE.indexByteArray ByteArray
content (Int -> Int -> Int
forall a. Integral a => a -> a -> a
quot Int
effectiveArrayOffset Int
4)
  let arrayLengthI :: Int
arrayLengthI = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word32 @Int Word32
arrayLength
  -- We do not check the alignment of the start element when the length
  -- is zero because there is no start element.
  Bool -> Either Error () -> Either Error ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
arrayLengthI Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Either Error () -> Either Error ())
-> Either Error () -> Either Error ()
forall a b. (a -> b) -> a -> b
$ do
    Bool -> Either Error () -> Either Error ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Int -> Int
forall a. Integral a => a -> a -> a
rem (Int
effectiveArrayOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) Int
alignment Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (Error -> Either Error ()
forall a b. a -> Either a b
Left Error
ArrayOfStructOffsetAlignmentError)
  let !payloadSz :: Int
payloadSz = Int
arrayLengthI Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
sz
  Bool -> Either Error () -> Either Error ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
effectiveArrayOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
payloadSz Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
end) (Error -> Either Error ()
forall a b. a -> Either a b
Left (Int -> Int -> Int -> Error
ArrayOfStructPayloadOutOfBounds Int
effectiveArrayOffset Int
payloadSz Int
end))
  let !(ByteArray ByteArray#
arr) = (forall s. ST s ByteArray) -> ByteArray
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s ByteArray) -> ByteArray)
-> (forall s. ST s ByteArray) -> ByteArray
forall a b. (a -> b) -> a -> b
$ do
        MutableByteArray s
dst <- Int -> ST s (MutableByteArray (PrimState (ST s)))
forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newByteArray (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
arrayLengthI)
        MutableByteArray (PrimState (ST s))
-> Int -> ByteArray -> Int -> Int -> ST s ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
PM.copyByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
dst Int
0 ByteArray
content (Int
effectiveArrayOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) (Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
arrayLengthI)
        MutableByteArray (PrimState (ST s)) -> ST s ByteArray
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> m ByteArray
unsafeFreezeByteArray MutableByteArray s
MutableByteArray (PrimState (ST s))
dst
  let !fieldIx' :: Int
fieldIx' = Int
fieldIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
  R (PrimArray a) -> Either Error (R (PrimArray a))
forall a b. b -> Either a b
Right (Int -> PrimArray a -> R (PrimArray a)
forall a. Int -> a -> R a
R Int
fieldIx' (ByteArray# -> PrimArray a
forall a. ByteArray# -> PrimArray a
PrimArray ByteArray#
arr))

-- | Use an array of tables as a field in a table.
array :: TableParser a -> TableParser (SmallArray a)
array :: forall a. TableParser a -> TableParser (SmallArray a)
array TableParser a
tp = (ByteArray
 -> Int -> Int -> VTable -> Int -> Either Error (R (SmallArray a)))
-> TableParser (SmallArray a)
forall a.
(ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R a))
-> TableParser a
TableParser ((ByteArray
  -> Int -> Int -> VTable -> Int -> Either Error (R (SmallArray a)))
 -> TableParser (SmallArray a))
-> (ByteArray
    -> Int -> Int -> VTable -> Int -> Either Error (R (SmallArray a)))
-> TableParser (SmallArray a)
forall a b. (a -> b) -> a -> b
$ \ByteArray
content Int
tableOffset Int
end VTable
vtable Int
fieldIx -> do
  !Word16
fieldOffset <- VTable -> Int -> Either Error Word16
indexVTableField VTable
vtable Int
fieldIx
  case Word16
fieldOffset of
    Word16
0 -> Error -> Either Error ()
forall a b. a -> Either a b
Left Error
DefaultingStringNotSupportedYet
    Word16
_ -> () -> Either Error ()
forall a. a -> Either Error a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  let !effectiveOffset :: Int
effectiveOffset = (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Int Word16
fieldOffset) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tableOffset
  Bool -> Either Error () -> Either Error ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Int -> Int
forall a. Integral a => a -> a -> a
rem Int
effectiveOffset Int
4 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (Error -> Either Error ()
forall a b. a -> Either a b
Left Error
FieldArrayAlignmentError)
  let !(Word32
arrayOffset :: Word32) = ByteArray -> Int -> Word32
forall a. (Prim a, Bytes a) => ByteArray -> Int -> a
LE.indexByteArray ByteArray
content (Int -> Int -> Int
forall a. Integral a => a -> a -> a
quot Int
effectiveOffset Int
4)
  let !effectiveArrayOffset :: Int
effectiveArrayOffset = (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word32 @Int Word32
arrayOffset) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
effectiveOffset
  Bool -> Either Error () -> Either Error ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Int -> Int
forall a. Integral a => a -> a -> a
rem Int
effectiveArrayOffset Int
4 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (Error -> Either Error ()
forall a b. a -> Either a b
Left Error
ArrayOffsetAlignmentError)
  Bool -> Either Error () -> Either Error ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
effectiveArrayOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
end) (Error -> Either Error ()
forall a b. a -> Either a b
Left Error
ArrayOffsetOutOfBounds)
  let !(Word32
arrayLength :: Word32) = ByteArray -> Int -> Word32
forall a. (Prim a, Bytes a) => ByteArray -> Int -> a
LE.indexByteArray ByteArray
content (Int -> Int -> Int
forall a. Integral a => a -> a -> a
quot Int
effectiveArrayOffset Int
4)
  let arrayLengthI :: Int
arrayLengthI = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word32 @Int Word32
arrayLength
  Bool -> Either Error () -> Either Error ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
effectiveArrayOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
arrayLengthI Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
end) (Error -> Either Error ()
forall a b. a -> Either a b
Left Error
ArrayOffsetOutOfBounds)
  let !offsetsArray :: Sliced PrimArray (Fixed 'LittleEndian Word32)
offsetsArray = PrimArray (Fixed 'LittleEndian Word32)
-> Int -> Int -> Sliced PrimArray (Fixed 'LittleEndian Word32)
forall a.
Element PrimArray a =>
PrimArray a -> Int -> Int -> Sliced PrimArray a
forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
arr a -> Int -> Int -> Sliced arr a
slice (ByteArray -> PrimArray (Fixed 'LittleEndian Word32)
reinterpret32 ByteArray
content) (Int -> Int -> Int
forall a. Integral a => a -> a -> a
quot (Int
effectiveArrayOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) Int
4) Int
arrayLengthI
  SmallArray a
arr <- (forall s. ST s (Either Error (SmallArray a)))
-> Either Error (SmallArray a)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Either Error (SmallArray a)))
 -> Either Error (SmallArray a))
-> (forall s. ST s (Either Error (SmallArray a)))
-> Either Error (SmallArray a)
forall a b. (a -> b) -> a -> b
$ ExceptT Error (ST s) (SmallArray a)
-> ST s (Either Error (SmallArray a))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Error (ST s) (SmallArray a)
 -> ST s (Either Error (SmallArray a)))
-> ExceptT Error (ST s) (SmallArray a)
-> ST s (Either Error (SmallArray a))
forall a b. (a -> b) -> a -> b
$ do
    SmallMutableArray s a
dst <- ST s (SmallMutableArray s a)
-> ExceptT Error (ST s) (SmallMutableArray s a)
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Int -> a -> ST s (SmallMutableArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (SmallMutableArray (PrimState m) a)
newSmallArray Int
arrayLengthI a
forall a. HasCallStack => a
undefined)
    (Int -> Fixed 'LittleEndian Word32 -> ExceptT Error (ST s) ())
-> Slice PrimArray (Fixed 'LittleEndian Word32)
-> ExceptT Error (ST s) ()
forall (arr :: * -> *) a (f :: * -> *) b.
(Contiguous arr, Element arr a, Applicative f) =>
(Int -> a -> f b) -> arr a -> f ()
Contiguous.itraverse_
      ( \Int
ix (Fixed Word32
off) -> do
        let offI :: Int
offI = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
off :: Int
        a
x <- Either Error a -> ExceptT Error (ST s) a
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either Error a -> ExceptT Error (ST s) a)
-> Either Error a -> ExceptT Error (ST s) a
forall a b. (a -> b) -> a -> b
$ case TableParser a -> Parser a
forall a. TableParser a -> Parser a
lowerTableParser TableParser a
tp of
          Parser ByteArray -> Int -> Int -> Either Error a
f -> ByteArray -> Int -> Int -> Either Error a
f ByteArray
content (Int
effectiveArrayOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offI) Int
end
        ST s () -> ExceptT Error (ST s) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT Error m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SmallMutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
PM.writeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ST s)) a
dst Int
ix a
x)
      ) Slice PrimArray (Fixed 'LittleEndian Word32)
offsetsArray
    SmallMutableArray (PrimState (ExceptT Error (ST s))) a
-> ExceptT Error (ST s) (SmallArray a)
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> m (SmallArray a)
unsafeFreezeSmallArray SmallMutableArray s a
SmallMutableArray (PrimState (ExceptT Error (ST s))) a
dst
  let !fieldIx' :: Int
fieldIx' = Int
fieldIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
  R (SmallArray a) -> Either Error (R (SmallArray a))
forall a b. b -> Either a b
Right (Int -> SmallArray a -> R (SmallArray a)
forall a. Int -> a -> R a
R Int
fieldIx' SmallArray a
arr)

-- | If the tag is set to zero for the None option, this fails. 
union :: UnionParser a -> TableParser a
union :: forall a. UnionParser a -> TableParser a
union (UnionParser SmallArray (TableParser a)
options) = do
  !Word8
tagW <- TableParser Word8
word8
  Bool -> TableParser () -> TableParser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
tagW Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) (Error -> TableParser ()
forall a. Error -> TableParser a
tableParserThrow Error
TagImpliesUnionNone)
  let !tag :: Int
tag = (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
tagW :: Int) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
  Bool -> TableParser () -> TableParser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
tag Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= SmallArray (TableParser a) -> Int
forall a. SmallArray a -> Int
sizeofSmallArray SmallArray (TableParser a)
options) (Error -> TableParser ()
forall a. Error -> TableParser a
tableParserThrow Error
UnionTagOutOfBounds)
  let !tp :: TableParser a
tp = SmallArray (TableParser a) -> Int -> TableParser a
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray (TableParser a)
options Int
tag
  TableParser a -> TableParser a
forall a. TableParser a -> TableParser a
table TableParser a
tp

ignore :: TableParser ()
ignore :: TableParser ()
ignore = (ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R ()))
-> TableParser ()
forall a.
(ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R a))
-> TableParser a
TableParser ((ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R ()))
 -> TableParser ())
-> (ByteArray
    -> Int -> Int -> VTable -> Int -> Either Error (R ()))
-> TableParser ()
forall a b. (a -> b) -> a -> b
$ \ByteArray
_ Int
_ Int
_ VTable
vtable Int
fieldIx -> do
  !Word16
_ <- VTable -> Int -> Either Error Word16
indexVTableField VTable
vtable Int
fieldIx
  let !fieldIx' :: Int
fieldIx' = Int
fieldIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
  R () -> Either Error (R ())
forall a b. b -> Either a b
Right (Int -> () -> R ()
forall a. Int -> a -> R a
R Int
fieldIx' ())

int64 :: TableParser Int64
int64 :: TableParser Int64
int64 = (ByteArray
 -> Int -> Int -> VTable -> Int -> Either Error (R Int64))
-> TableParser Int64
forall a.
(ByteArray -> Int -> Int -> VTable -> Int -> Either Error (R a))
-> TableParser a
TableParser ((ByteArray
  -> Int -> Int -> VTable -> Int -> Either Error (R Int64))
 -> TableParser Int64)
-> (ByteArray
    -> Int -> Int -> VTable -> Int -> Either Error (R Int64))
-> TableParser Int64
forall a b. (a -> b) -> a -> b
$ \ByteArray
content Int
tableOffset Int
_ VTable
vtable Int
fieldIx -> do
  !Word16
fieldOffset <- VTable -> Int -> Either Error Word16
indexVTableField VTable
vtable Int
fieldIx
  case Word16
fieldOffset of
    Word16
0 -> do
      let !fieldIx' :: Int
fieldIx' = Int
fieldIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      R Int64 -> Either Error (R Int64)
forall a b. b -> Either a b
Right (Int -> Int64 -> R Int64
forall a. Int -> a -> R a
R Int
fieldIx' Int64
0)
    Word16
_ -> do
      let !effectiveOffset :: Int
effectiveOffset = (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Int Word16
fieldOffset) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tableOffset
      Bool -> Either Error () -> Either Error ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Int -> Int
forall a. Integral a => a -> a -> a
rem Int
effectiveOffset Int
8 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (Error -> Either Error ()
forall a b. a -> Either a b
Left Error
FieldInt64AlignmentError)
      let !v :: Int64
v = ByteArray -> Int -> Int64
forall a. (Prim a, Bytes a) => ByteArray -> Int -> a
LE.indexByteArray ByteArray
content (Int -> Int -> Int
forall a. Integral a => a -> a -> a
quot Int
effectiveOffset Int
8)
      let !fieldIx' :: Int
fieldIx' = Int
fieldIx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      R Int64 -> Either Error (R Int64)
forall a b. b -> Either a b
Right (Int -> Int64 -> R Int64
forall a. Int -> a -> R a
R Int
fieldIx' Int64
v)

-- string :: TableParser Text
-- string = _

bytesToVTable :: ByteArray -> Int -> Int -> Either Error VTable
bytesToVTable :: ByteArray -> Int -> Int -> Either Error VTable
bytesToVTable !ByteArray
theArray !Int
offset !Int
end
  | Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 = Error -> Either Error VTable
forall a b. a -> Either a b
Left Error
VTableLengthError
  | Int -> Int -> Int
forall a. Integral a => a -> a -> a
rem Int
offset Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 = Error -> Either Error VTable
forall a b. a -> Either a b
Left Error
VTableAlignmentError
  | !(Int
offsetW16 :: Int) <- Int -> Int -> Int
forall a. Integral a => a -> a -> a
quot Int
offset Int
2
  , !(Word16
vtableLen :: Word16) <- ByteArray -> Int -> Word16
forall a. (Prim a, Bytes a) => ByteArray -> Int -> a
LE.indexByteArray ByteArray
theArray Int
offsetW16
  , !(Int
vtableLenI :: Int) <- forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Int Word16
vtableLen =
    if | Int
vtableLenI Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
end -> Error -> Either Error VTable
forall a b. a -> Either a b
Left Error
VTableLengthOutOfBoundsError
       | Int -> Int -> Int
forall a. Integral a => a -> a -> a
rem Int
vtableLenI Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 -> Error -> Either Error VTable
forall a b. a -> Either a b
Left Error
VTableLengthAlignmentError
       | Int
vtableLenI Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 -> Error -> Either Error VTable
forall a b. a -> Either a b
Left (Int -> Int -> Error
VTableLengthLessThanFour Int
offset Int
vtableLenI)
       | !Int
sliceLen <- Int -> Int -> Int
forall a. Integral a => a -> a -> a
quot Int
vtableLenI Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
       , !PrimArray (Fixed 'LittleEndian Word16)
arrW16 <- ByteArray -> PrimArray (Fixed 'LittleEndian Word16)
reinterpret16 ByteArray
theArray
       , !Sliced PrimArray (Fixed 'LittleEndian Word16)
theSlice <- PrimArray (Fixed 'LittleEndian Word16)
-> Int -> Int -> Sliced PrimArray (Fixed 'LittleEndian Word16)
forall a.
Element PrimArray a =>
PrimArray a -> Int -> Int -> Sliced PrimArray a
forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
arr a -> Int -> Int -> Sliced arr a
slice PrimArray (Fixed 'LittleEndian Word16)
arrW16 (Int
offsetW16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
sliceLen
       , !Sliced PrimArray (Fixed 'LittleEndian Word16)
theSliceWithoutTableLen <- PrimArray (Fixed 'LittleEndian Word16)
-> Int -> Int -> Sliced PrimArray (Fixed 'LittleEndian Word16)
forall a.
Element PrimArray a =>
PrimArray a -> Int -> Int -> Sliced PrimArray a
forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
arr a -> Int -> Int -> Sliced arr a
slice PrimArray (Fixed 'LittleEndian Word16)
arrW16 (Int
offsetW16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Int
sliceLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
       , !(Fixed Word16
tableSize) <- Slice PrimArray (Fixed 'LittleEndian Word16)
-> Int -> Fixed 'LittleEndian Word16
forall b.
Element (Slice PrimArray) b =>
Slice PrimArray b -> Int -> b
forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
Contiguous.index Sliced PrimArray (Fixed 'LittleEndian Word16)
Slice PrimArray (Fixed 'LittleEndian Word16)
theSlice Int
0 ->
         if | Bool -> Bool
not ((Fixed 'LittleEndian Word16 -> Bool)
-> Slice PrimArray (Fixed 'LittleEndian Word16) -> Bool
forall (arr :: * -> *) a.
(Contiguous arr, Element arr a) =>
(a -> Bool) -> arr a -> Bool
Contiguous.all (\(Fixed Word16
x) -> Word16
x Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
< Word16
tableSize) Sliced PrimArray (Fixed 'LittleEndian Word16)
Slice PrimArray (Fixed 'LittleEndian Word16)
theSliceWithoutTableLen) -> Error -> Either Error VTable
forall a b. a -> Either a b
Left Error
VTableImpliesOutOfBoundsField
            | Bool
otherwise -> VTable -> Either Error VTable
forall a b. b -> Either a b
Right (VTable -> Either Error VTable) -> VTable -> Either Error VTable
forall a b. (a -> b) -> a -> b
$! Sliced PrimArray (Fixed 'LittleEndian Word16) -> VTable
VTable Sliced PrimArray (Fixed 'LittleEndian Word16)
theSlice

reinterpret16 :: ByteArray -> PrimArray (Fixed 'LittleEndian Word16)
{-# inline reinterpret16 #-}
reinterpret16 :: ByteArray -> PrimArray (Fixed 'LittleEndian Word16)
reinterpret16 (ByteArray ByteArray#
x) = ByteArray# -> PrimArray (Fixed 'LittleEndian Word16)
forall a. ByteArray# -> PrimArray a
PrimArray ByteArray#
x

reinterpret32 :: ByteArray -> PrimArray (Fixed 'LittleEndian Word32)
{-# inline reinterpret32 #-}
reinterpret32 :: ByteArray -> PrimArray (Fixed 'LittleEndian Word32)
reinterpret32 (ByteArray ByteArray#
x) = ByteArray# -> PrimArray (Fixed 'LittleEndian Word32)
forall a. ByteArray# -> PrimArray a
PrimArray ByteArray#
x

indexVTableField :: VTable -> Int -> Either Error Word16
indexVTableField :: VTable -> Int -> Either Error Word16
indexVTableField (VTable Sliced PrimArray (Fixed 'LittleEndian Word16)
xs) !Int
ix
    -- everything missing from the end is treated like Absent
  | Int
effectiveIx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Slice PrimArray (Fixed 'LittleEndian Word16) -> Int
forall b. Element (Slice PrimArray) b => Slice PrimArray b -> Int
forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int
Contiguous.size Sliced PrimArray (Fixed 'LittleEndian Word16)
Slice PrimArray (Fixed 'LittleEndian Word16)
xs = Word16 -> Either Error Word16
forall a b. b -> Either a b
Right Word16
0
  | Bool
otherwise = let Fixed Word16
w = Slice PrimArray (Fixed 'LittleEndian Word16)
-> Int -> Fixed 'LittleEndian Word16
forall b.
Element (Slice PrimArray) b =>
Slice PrimArray b -> Int -> b
forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
Contiguous.index Sliced PrimArray (Fixed 'LittleEndian Word16)
Slice PrimArray (Fixed 'LittleEndian Word16)
xs Int
effectiveIx in Word16 -> Either Error Word16
forall a b. b -> Either a b
Right Word16
w
  where
  !effectiveIx :: Int
effectiveIx = Int
ix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

tableSizeFromVTable :: VTable -> Int
tableSizeFromVTable :: VTable -> Int
tableSizeFromVTable (VTable Sliced PrimArray (Fixed 'LittleEndian Word16)
xs) =
  let Fixed Word16
w = Slice PrimArray (Fixed 'LittleEndian Word16)
-> Int -> Fixed 'LittleEndian Word16
forall b.
Element (Slice PrimArray) b =>
Slice PrimArray b -> Int -> b
forall (arr :: * -> *) b.
(Contiguous arr, Element arr b) =>
arr b -> Int -> b
Contiguous.index Sliced PrimArray (Fixed 'LittleEndian Word16)
Slice PrimArray (Fixed 'LittleEndian Word16)
xs Int
0 in Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
w