{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE InstanceSigs #-}
{-# OPTIONS_HADDOCK not-home #-}
module FlatBuffers.Internal.Read where
import Control.Monad ( (>=>), join )
import Data.Binary.Get ( Get )
import qualified Data.Binary.Get as G
import qualified Data.ByteString as BS
import Data.ByteString.Lazy ( ByteString )
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Lazy.Internal as BSL
import qualified Data.ByteString.Unsafe as BSU
import Data.Coerce ( coerce )
import Data.Functor ( (<&>) )
import Data.Int
import qualified Data.List as L
import Data.Text ( Text )
import qualified Data.Text.Encoding as T
import qualified Data.Text.Encoding.Error as T
import Data.Word
import FlatBuffers.Internal.Constants
import FlatBuffers.Internal.FileIdentifier ( FileIdentifier(..), HasFileIdentifier(..) )
import FlatBuffers.Internal.Types
import Prelude hiding ( drop, length, take )
type ReadError = String
newtype TableIndex = TableIndex { TableIndex -> Word16
unTableIndex :: Word16 }
deriving newtype (Int -> TableIndex -> ShowS
[TableIndex] -> ShowS
TableIndex -> String
(Int -> TableIndex -> ShowS)
-> (TableIndex -> String)
-> ([TableIndex] -> ShowS)
-> Show TableIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TableIndex] -> ShowS
$cshowList :: [TableIndex] -> ShowS
show :: TableIndex -> String
$cshow :: TableIndex -> String
showsPrec :: Int -> TableIndex -> ShowS
$cshowsPrec :: Int -> TableIndex -> ShowS
Show, Integer -> TableIndex
TableIndex -> TableIndex
TableIndex -> TableIndex -> TableIndex
(TableIndex -> TableIndex -> TableIndex)
-> (TableIndex -> TableIndex -> TableIndex)
-> (TableIndex -> TableIndex -> TableIndex)
-> (TableIndex -> TableIndex)
-> (TableIndex -> TableIndex)
-> (TableIndex -> TableIndex)
-> (Integer -> TableIndex)
-> Num TableIndex
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> TableIndex
$cfromInteger :: Integer -> TableIndex
signum :: TableIndex -> TableIndex
$csignum :: TableIndex -> TableIndex
abs :: TableIndex -> TableIndex
$cabs :: TableIndex -> TableIndex
negate :: TableIndex -> TableIndex
$cnegate :: TableIndex -> TableIndex
* :: TableIndex -> TableIndex -> TableIndex
$c* :: TableIndex -> TableIndex -> TableIndex
- :: TableIndex -> TableIndex -> TableIndex
$c- :: TableIndex -> TableIndex -> TableIndex
+ :: TableIndex -> TableIndex -> TableIndex
$c+ :: TableIndex -> TableIndex -> TableIndex
Num)
newtype VOffset = VOffset { VOffset -> Word16
unVOffset :: Word16 }
deriving newtype (Int -> VOffset -> ShowS
[VOffset] -> ShowS
VOffset -> String
(Int -> VOffset -> ShowS)
-> (VOffset -> String) -> ([VOffset] -> ShowS) -> Show VOffset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VOffset] -> ShowS
$cshowList :: [VOffset] -> ShowS
show :: VOffset -> String
$cshow :: VOffset -> String
showsPrec :: Int -> VOffset -> ShowS
$cshowsPrec :: Int -> VOffset -> ShowS
Show, Integer -> VOffset
VOffset -> VOffset
VOffset -> VOffset -> VOffset
(VOffset -> VOffset -> VOffset)
-> (VOffset -> VOffset -> VOffset)
-> (VOffset -> VOffset -> VOffset)
-> (VOffset -> VOffset)
-> (VOffset -> VOffset)
-> (VOffset -> VOffset)
-> (Integer -> VOffset)
-> Num VOffset
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> VOffset
$cfromInteger :: Integer -> VOffset
signum :: VOffset -> VOffset
$csignum :: VOffset -> VOffset
abs :: VOffset -> VOffset
$cabs :: VOffset -> VOffset
negate :: VOffset -> VOffset
$cnegate :: VOffset -> VOffset
* :: VOffset -> VOffset -> VOffset
$c* :: VOffset -> VOffset -> VOffset
- :: VOffset -> VOffset -> VOffset
$c- :: VOffset -> VOffset -> VOffset
+ :: VOffset -> VOffset -> VOffset
$c+ :: VOffset -> VOffset -> VOffset
Num, Num VOffset
Ord VOffset
Num VOffset -> Ord VOffset -> (VOffset -> Rational) -> Real VOffset
VOffset -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: VOffset -> Rational
$ctoRational :: VOffset -> Rational
$cp2Real :: Ord VOffset
$cp1Real :: Num VOffset
Real, Eq VOffset
Eq VOffset
-> (VOffset -> VOffset -> Ordering)
-> (VOffset -> VOffset -> Bool)
-> (VOffset -> VOffset -> Bool)
-> (VOffset -> VOffset -> Bool)
-> (VOffset -> VOffset -> Bool)
-> (VOffset -> VOffset -> VOffset)
-> (VOffset -> VOffset -> VOffset)
-> Ord VOffset
VOffset -> VOffset -> Bool
VOffset -> VOffset -> Ordering
VOffset -> VOffset -> VOffset
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VOffset -> VOffset -> VOffset
$cmin :: VOffset -> VOffset -> VOffset
max :: VOffset -> VOffset -> VOffset
$cmax :: VOffset -> VOffset -> VOffset
>= :: VOffset -> VOffset -> Bool
$c>= :: VOffset -> VOffset -> Bool
> :: VOffset -> VOffset -> Bool
$c> :: VOffset -> VOffset -> Bool
<= :: VOffset -> VOffset -> Bool
$c<= :: VOffset -> VOffset -> Bool
< :: VOffset -> VOffset -> Bool
$c< :: VOffset -> VOffset -> Bool
compare :: VOffset -> VOffset -> Ordering
$ccompare :: VOffset -> VOffset -> Ordering
$cp1Ord :: Eq VOffset
Ord, Int -> VOffset
VOffset -> Int
VOffset -> [VOffset]
VOffset -> VOffset
VOffset -> VOffset -> [VOffset]
VOffset -> VOffset -> VOffset -> [VOffset]
(VOffset -> VOffset)
-> (VOffset -> VOffset)
-> (Int -> VOffset)
-> (VOffset -> Int)
-> (VOffset -> [VOffset])
-> (VOffset -> VOffset -> [VOffset])
-> (VOffset -> VOffset -> [VOffset])
-> (VOffset -> VOffset -> VOffset -> [VOffset])
-> Enum VOffset
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: VOffset -> VOffset -> VOffset -> [VOffset]
$cenumFromThenTo :: VOffset -> VOffset -> VOffset -> [VOffset]
enumFromTo :: VOffset -> VOffset -> [VOffset]
$cenumFromTo :: VOffset -> VOffset -> [VOffset]
enumFromThen :: VOffset -> VOffset -> [VOffset]
$cenumFromThen :: VOffset -> VOffset -> [VOffset]
enumFrom :: VOffset -> [VOffset]
$cenumFrom :: VOffset -> [VOffset]
fromEnum :: VOffset -> Int
$cfromEnum :: VOffset -> Int
toEnum :: Int -> VOffset
$ctoEnum :: Int -> VOffset
pred :: VOffset -> VOffset
$cpred :: VOffset -> VOffset
succ :: VOffset -> VOffset
$csucc :: VOffset -> VOffset
Enum, Enum VOffset
Real VOffset
Real VOffset
-> Enum VOffset
-> (VOffset -> VOffset -> VOffset)
-> (VOffset -> VOffset -> VOffset)
-> (VOffset -> VOffset -> VOffset)
-> (VOffset -> VOffset -> VOffset)
-> (VOffset -> VOffset -> (VOffset, VOffset))
-> (VOffset -> VOffset -> (VOffset, VOffset))
-> (VOffset -> Integer)
-> Integral VOffset
VOffset -> Integer
VOffset -> VOffset -> (VOffset, VOffset)
VOffset -> VOffset -> VOffset
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: VOffset -> Integer
$ctoInteger :: VOffset -> Integer
divMod :: VOffset -> VOffset -> (VOffset, VOffset)
$cdivMod :: VOffset -> VOffset -> (VOffset, VOffset)
quotRem :: VOffset -> VOffset -> (VOffset, VOffset)
$cquotRem :: VOffset -> VOffset -> (VOffset, VOffset)
mod :: VOffset -> VOffset -> VOffset
$cmod :: VOffset -> VOffset -> VOffset
div :: VOffset -> VOffset -> VOffset
$cdiv :: VOffset -> VOffset -> VOffset
rem :: VOffset -> VOffset -> VOffset
$crem :: VOffset -> VOffset -> VOffset
quot :: VOffset -> VOffset -> VOffset
$cquot :: VOffset -> VOffset -> VOffset
$cp2Integral :: Enum VOffset
$cp1Integral :: Real VOffset
Integral, VOffset -> VOffset -> Bool
(VOffset -> VOffset -> Bool)
-> (VOffset -> VOffset -> Bool) -> Eq VOffset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VOffset -> VOffset -> Bool
$c/= :: VOffset -> VOffset -> Bool
== :: VOffset -> VOffset -> Bool
$c== :: VOffset -> VOffset -> Bool
Eq)
newtype OffsetFromRoot = OffsetFromRoot Int32
deriving newtype (Int -> OffsetFromRoot -> ShowS
[OffsetFromRoot] -> ShowS
OffsetFromRoot -> String
(Int -> OffsetFromRoot -> ShowS)
-> (OffsetFromRoot -> String)
-> ([OffsetFromRoot] -> ShowS)
-> Show OffsetFromRoot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OffsetFromRoot] -> ShowS
$cshowList :: [OffsetFromRoot] -> ShowS
show :: OffsetFromRoot -> String
$cshow :: OffsetFromRoot -> String
showsPrec :: Int -> OffsetFromRoot -> ShowS
$cshowsPrec :: Int -> OffsetFromRoot -> ShowS
Show, Integer -> OffsetFromRoot
OffsetFromRoot -> OffsetFromRoot
OffsetFromRoot -> OffsetFromRoot -> OffsetFromRoot
(OffsetFromRoot -> OffsetFromRoot -> OffsetFromRoot)
-> (OffsetFromRoot -> OffsetFromRoot -> OffsetFromRoot)
-> (OffsetFromRoot -> OffsetFromRoot -> OffsetFromRoot)
-> (OffsetFromRoot -> OffsetFromRoot)
-> (OffsetFromRoot -> OffsetFromRoot)
-> (OffsetFromRoot -> OffsetFromRoot)
-> (Integer -> OffsetFromRoot)
-> Num OffsetFromRoot
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> OffsetFromRoot
$cfromInteger :: Integer -> OffsetFromRoot
signum :: OffsetFromRoot -> OffsetFromRoot
$csignum :: OffsetFromRoot -> OffsetFromRoot
abs :: OffsetFromRoot -> OffsetFromRoot
$cabs :: OffsetFromRoot -> OffsetFromRoot
negate :: OffsetFromRoot -> OffsetFromRoot
$cnegate :: OffsetFromRoot -> OffsetFromRoot
* :: OffsetFromRoot -> OffsetFromRoot -> OffsetFromRoot
$c* :: OffsetFromRoot -> OffsetFromRoot -> OffsetFromRoot
- :: OffsetFromRoot -> OffsetFromRoot -> OffsetFromRoot
$c- :: OffsetFromRoot -> OffsetFromRoot -> OffsetFromRoot
+ :: OffsetFromRoot -> OffsetFromRoot -> OffsetFromRoot
$c+ :: OffsetFromRoot -> OffsetFromRoot -> OffsetFromRoot
Num, Num OffsetFromRoot
Ord OffsetFromRoot
Num OffsetFromRoot
-> Ord OffsetFromRoot
-> (OffsetFromRoot -> Rational)
-> Real OffsetFromRoot
OffsetFromRoot -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: OffsetFromRoot -> Rational
$ctoRational :: OffsetFromRoot -> Rational
$cp2Real :: Ord OffsetFromRoot
$cp1Real :: Num OffsetFromRoot
Real, Eq OffsetFromRoot
Eq OffsetFromRoot
-> (OffsetFromRoot -> OffsetFromRoot -> Ordering)
-> (OffsetFromRoot -> OffsetFromRoot -> Bool)
-> (OffsetFromRoot -> OffsetFromRoot -> Bool)
-> (OffsetFromRoot -> OffsetFromRoot -> Bool)
-> (OffsetFromRoot -> OffsetFromRoot -> Bool)
-> (OffsetFromRoot -> OffsetFromRoot -> OffsetFromRoot)
-> (OffsetFromRoot -> OffsetFromRoot -> OffsetFromRoot)
-> Ord OffsetFromRoot
OffsetFromRoot -> OffsetFromRoot -> Bool
OffsetFromRoot -> OffsetFromRoot -> Ordering
OffsetFromRoot -> OffsetFromRoot -> OffsetFromRoot
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OffsetFromRoot -> OffsetFromRoot -> OffsetFromRoot
$cmin :: OffsetFromRoot -> OffsetFromRoot -> OffsetFromRoot
max :: OffsetFromRoot -> OffsetFromRoot -> OffsetFromRoot
$cmax :: OffsetFromRoot -> OffsetFromRoot -> OffsetFromRoot
>= :: OffsetFromRoot -> OffsetFromRoot -> Bool
$c>= :: OffsetFromRoot -> OffsetFromRoot -> Bool
> :: OffsetFromRoot -> OffsetFromRoot -> Bool
$c> :: OffsetFromRoot -> OffsetFromRoot -> Bool
<= :: OffsetFromRoot -> OffsetFromRoot -> Bool
$c<= :: OffsetFromRoot -> OffsetFromRoot -> Bool
< :: OffsetFromRoot -> OffsetFromRoot -> Bool
$c< :: OffsetFromRoot -> OffsetFromRoot -> Bool
compare :: OffsetFromRoot -> OffsetFromRoot -> Ordering
$ccompare :: OffsetFromRoot -> OffsetFromRoot -> Ordering
$cp1Ord :: Eq OffsetFromRoot
Ord, Int -> OffsetFromRoot
OffsetFromRoot -> Int
OffsetFromRoot -> [OffsetFromRoot]
OffsetFromRoot -> OffsetFromRoot
OffsetFromRoot -> OffsetFromRoot -> [OffsetFromRoot]
OffsetFromRoot
-> OffsetFromRoot -> OffsetFromRoot -> [OffsetFromRoot]
(OffsetFromRoot -> OffsetFromRoot)
-> (OffsetFromRoot -> OffsetFromRoot)
-> (Int -> OffsetFromRoot)
-> (OffsetFromRoot -> Int)
-> (OffsetFromRoot -> [OffsetFromRoot])
-> (OffsetFromRoot -> OffsetFromRoot -> [OffsetFromRoot])
-> (OffsetFromRoot -> OffsetFromRoot -> [OffsetFromRoot])
-> (OffsetFromRoot
-> OffsetFromRoot -> OffsetFromRoot -> [OffsetFromRoot])
-> Enum OffsetFromRoot
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: OffsetFromRoot
-> OffsetFromRoot -> OffsetFromRoot -> [OffsetFromRoot]
$cenumFromThenTo :: OffsetFromRoot
-> OffsetFromRoot -> OffsetFromRoot -> [OffsetFromRoot]
enumFromTo :: OffsetFromRoot -> OffsetFromRoot -> [OffsetFromRoot]
$cenumFromTo :: OffsetFromRoot -> OffsetFromRoot -> [OffsetFromRoot]
enumFromThen :: OffsetFromRoot -> OffsetFromRoot -> [OffsetFromRoot]
$cenumFromThen :: OffsetFromRoot -> OffsetFromRoot -> [OffsetFromRoot]
enumFrom :: OffsetFromRoot -> [OffsetFromRoot]
$cenumFrom :: OffsetFromRoot -> [OffsetFromRoot]
fromEnum :: OffsetFromRoot -> Int
$cfromEnum :: OffsetFromRoot -> Int
toEnum :: Int -> OffsetFromRoot
$ctoEnum :: Int -> OffsetFromRoot
pred :: OffsetFromRoot -> OffsetFromRoot
$cpred :: OffsetFromRoot -> OffsetFromRoot
succ :: OffsetFromRoot -> OffsetFromRoot
$csucc :: OffsetFromRoot -> OffsetFromRoot
Enum, Enum OffsetFromRoot
Real OffsetFromRoot
Real OffsetFromRoot
-> Enum OffsetFromRoot
-> (OffsetFromRoot -> OffsetFromRoot -> OffsetFromRoot)
-> (OffsetFromRoot -> OffsetFromRoot -> OffsetFromRoot)
-> (OffsetFromRoot -> OffsetFromRoot -> OffsetFromRoot)
-> (OffsetFromRoot -> OffsetFromRoot -> OffsetFromRoot)
-> (OffsetFromRoot
-> OffsetFromRoot -> (OffsetFromRoot, OffsetFromRoot))
-> (OffsetFromRoot
-> OffsetFromRoot -> (OffsetFromRoot, OffsetFromRoot))
-> (OffsetFromRoot -> Integer)
-> Integral OffsetFromRoot
OffsetFromRoot -> Integer
OffsetFromRoot
-> OffsetFromRoot -> (OffsetFromRoot, OffsetFromRoot)
OffsetFromRoot -> OffsetFromRoot -> OffsetFromRoot
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: OffsetFromRoot -> Integer
$ctoInteger :: OffsetFromRoot -> Integer
divMod :: OffsetFromRoot
-> OffsetFromRoot -> (OffsetFromRoot, OffsetFromRoot)
$cdivMod :: OffsetFromRoot
-> OffsetFromRoot -> (OffsetFromRoot, OffsetFromRoot)
quotRem :: OffsetFromRoot
-> OffsetFromRoot -> (OffsetFromRoot, OffsetFromRoot)
$cquotRem :: OffsetFromRoot
-> OffsetFromRoot -> (OffsetFromRoot, OffsetFromRoot)
mod :: OffsetFromRoot -> OffsetFromRoot -> OffsetFromRoot
$cmod :: OffsetFromRoot -> OffsetFromRoot -> OffsetFromRoot
div :: OffsetFromRoot -> OffsetFromRoot -> OffsetFromRoot
$cdiv :: OffsetFromRoot -> OffsetFromRoot -> OffsetFromRoot
rem :: OffsetFromRoot -> OffsetFromRoot -> OffsetFromRoot
$crem :: OffsetFromRoot -> OffsetFromRoot -> OffsetFromRoot
quot :: OffsetFromRoot -> OffsetFromRoot -> OffsetFromRoot
$cquot :: OffsetFromRoot -> OffsetFromRoot -> OffsetFromRoot
$cp2Integral :: Enum OffsetFromRoot
$cp1Integral :: Real OffsetFromRoot
Integral, OffsetFromRoot -> OffsetFromRoot -> Bool
(OffsetFromRoot -> OffsetFromRoot -> Bool)
-> (OffsetFromRoot -> OffsetFromRoot -> Bool) -> Eq OffsetFromRoot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OffsetFromRoot -> OffsetFromRoot -> Bool
$c/= :: OffsetFromRoot -> OffsetFromRoot -> Bool
== :: OffsetFromRoot -> OffsetFromRoot -> Bool
$c== :: OffsetFromRoot -> OffsetFromRoot -> Bool
Eq)
data Table a = Table
{ Table a -> Position
vtable :: !Position
, Table a -> PositionInfo
tablePos :: !PositionInfo
}
newtype Struct a = Struct
{ Struct a -> Position
structPos :: Position
}
data Union a
= Union !a
| UnionNone
| UnionUnknown !Word8
type Position = ByteString
data PositionInfo = PositionInfo
{ PositionInfo -> Position
posRoot :: !Position
, PositionInfo -> Position
posCurrent :: !Position
, PositionInfo -> OffsetFromRoot
posOffsetFromRoot :: !OffsetFromRoot
}
class HasPosition a where
getPosition :: a -> Position
move :: Integral i => a -> i -> a
instance HasPosition ByteString where
getPosition :: Position -> Position
getPosition = Position -> Position
forall a. a -> a
id
move :: Position -> i -> Position
move Position
bs i
offset = Int64 -> Position -> Position
BSL.drop (i -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral @_ @Int64 i
offset) Position
bs
instance HasPosition PositionInfo where
getPosition :: PositionInfo -> Position
getPosition = PositionInfo -> Position
posCurrent
move :: PositionInfo -> i -> PositionInfo
move PositionInfo{Position
OffsetFromRoot
posOffsetFromRoot :: OffsetFromRoot
posCurrent :: Position
posRoot :: Position
posOffsetFromRoot :: PositionInfo -> OffsetFromRoot
posCurrent :: PositionInfo -> Position
posRoot :: PositionInfo -> Position
..} i
offset =
PositionInfo :: Position -> Position -> OffsetFromRoot -> PositionInfo
PositionInfo
{ posRoot :: Position
posRoot = Position
posRoot
, posCurrent :: Position
posCurrent = Position -> i -> Position
forall a i. (HasPosition a, Integral i) => a -> i -> a
move Position
posCurrent i
offset
, posOffsetFromRoot :: OffsetFromRoot
posOffsetFromRoot = OffsetFromRoot
posOffsetFromRoot OffsetFromRoot -> OffsetFromRoot -> OffsetFromRoot
forall a. Num a => a -> a -> a
+ Int32 -> OffsetFromRoot
OffsetFromRoot (i -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral @_ @Int32 i
offset)
}
decode :: ByteString -> Either ReadError (Table a)
decode :: Position -> Either String (Table a)
decode Position
root = PositionInfo -> Either String (Table a)
forall t. PositionInfo -> Either String (Table t)
readTable PositionInfo
initialPos
where
initialPos :: PositionInfo
initialPos = Position -> Position -> OffsetFromRoot -> PositionInfo
PositionInfo Position
root Position
root OffsetFromRoot
0
checkFileIdentifier :: forall a. HasFileIdentifier a => ByteString -> Bool
checkFileIdentifier :: Position -> Bool
checkFileIdentifier = FileIdentifier -> Position -> Bool
checkFileIdentifier' (HasFileIdentifier a => FileIdentifier
forall a. HasFileIdentifier a => FileIdentifier
getFileIdentifier @a)
checkFileIdentifier' :: FileIdentifier -> ByteString -> Bool
checkFileIdentifier' :: FileIdentifier -> Position -> Bool
checkFileIdentifier' (FileIdentifier -> ByteString
unFileIdentifier -> ByteString
fileIdent) Position
bs =
Position
actualFileIdent Position -> Position -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Position
BSL.fromStrict ByteString
fileIdent
where
actualFileIdent :: Position
actualFileIdent =
Int64 -> Position -> Position
BSL.take Int64
forall a. Num a => a
fileIdentifierSize (Position -> Position)
-> (Position -> Position) -> Position -> Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int64 -> Position -> Position
BSL.drop Int64
forall a. Num a => a
uoffsetSize (Position -> Position) -> Position -> Position
forall a b. (a -> b) -> a -> b
$
Position
bs
newtype Positive a = Positive { Positive a -> a
getPositive :: a }
deriving newtype (Positive a -> Positive a -> Bool
(Positive a -> Positive a -> Bool)
-> (Positive a -> Positive a -> Bool) -> Eq (Positive a)
forall a. Eq a => Positive a -> Positive a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Positive a -> Positive a -> Bool
$c/= :: forall a. Eq a => Positive a -> Positive a -> Bool
== :: Positive a -> Positive a -> Bool
$c== :: forall a. Eq a => Positive a -> Positive a -> Bool
Eq, Int -> Positive a -> ShowS
[Positive a] -> ShowS
Positive a -> String
(Int -> Positive a -> ShowS)
-> (Positive a -> String)
-> ([Positive a] -> ShowS)
-> Show (Positive a)
forall a. Show a => Int -> Positive a -> ShowS
forall a. Show a => [Positive a] -> ShowS
forall a. Show a => Positive a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Positive a] -> ShowS
$cshowList :: forall a. Show a => [Positive a] -> ShowS
show :: Positive a -> String
$cshow :: forall a. Show a => Positive a -> String
showsPrec :: Int -> Positive a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Positive a -> ShowS
Show)
{-# INLINE positive #-}
positive :: (Num a, Ord a) => a -> Maybe (Positive a)
positive :: a -> Maybe (Positive a)
positive a
n = if a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0 then Positive a -> Maybe (Positive a)
forall a. a -> Maybe a
Just (a -> Positive a
forall a. a -> Positive a
Positive a
n) else Maybe (Positive a)
forall a. Maybe a
Nothing
{-# INLINE moveToElem #-}
moveToElem :: HasPosition pos => pos -> Int32 -> Int32 -> pos
moveToElem :: pos -> Int32 -> Int32 -> pos
moveToElem pos
pos Int32
elemSize Int32
ix =
pos -> Int32 -> pos
forall a i. (HasPosition a, Integral i) => a -> i -> a
move pos
pos (Int32
ix Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
elemSize)
{-# INLINE checkIndexBounds #-}
checkIndexBounds :: Int32 -> Int32 -> Int32
checkIndexBounds :: Int32 -> Int32 -> Int32
checkIndexBounds Int32
ix Int32
length
| Int32
ix Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
< Int32
0 = String -> Int32
forall a. HasCallStack => String -> a
error (String
"FlatBuffers.Internal.Read.index: negative index: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int32 -> String
forall a. Show a => a -> String
show Int32
ix)
| Int32
ix Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int32
length = String -> Int32
forall a. HasCallStack => String -> a
error (String
"FlatBuffers.Internal.Read.index: index too large: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int32 -> String
forall a. Show a => a -> String
show Int32
ix)
| Bool
otherwise = Int32
ix
{-# INLINE inlineVectorToList #-}
inlineVectorToList :: Get a -> Int32 -> Position -> Either ReadError [a]
inlineVectorToList :: Get a -> Int32 -> Position -> Either String [a]
inlineVectorToList Get a
get Int32
len Position
pos =
Position -> Get [a] -> Either String [a]
forall a. Position -> Get a -> Either String a
runGet Position
pos (Get [a] -> Either String [a]) -> Get [a] -> Either String [a]
forall a b. (a -> b) -> a -> b
$
[Get a] -> Get [a]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Get a] -> Get [a]) -> [Get a] -> Get [a]
forall a b. (a -> b) -> a -> b
$ Int -> Get a -> [Get a]
forall a. Int -> a -> [a]
L.replicate (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int32 @Int Int32
len) Get a
get
clamp :: Int32 -> Int32 -> Int32
clamp :: Int32 -> Int32 -> Int32
clamp Int32
n Int32
upperBound = Int32
n Int32 -> Int32 -> Int32
forall a. Ord a => a -> a -> a
`min` Int32
upperBound Int32 -> Int32 -> Int32
forall a. Ord a => a -> a -> a
`max` Int32
0
class VectorElement a where
data Vector a
length :: Vector a -> Int32
unsafeIndex :: Vector a -> Int32 -> Either ReadError a
toList :: Vector a -> Either ReadError [a]
take :: Int32 -> Vector a -> Vector a
drop :: Int32 -> Vector a -> Vector a
index :: VectorElement a => Vector a -> Int32 -> Either ReadError a
index :: Vector a -> Int32 -> Either String a
index Vector a
vec Int32
ix = Vector a -> Int32 -> Either String a
forall a. VectorElement a => Vector a -> Int32 -> Either String a
unsafeIndex Vector a
vec (Int32 -> Either String a)
-> (Int32 -> Int32) -> Int32 -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int32 -> Int32
checkIndexBounds Int32
ix (Int32 -> Either String a) -> Int32 -> Either String a
forall a b. (a -> b) -> a -> b
$ Vector a -> Int32
forall a. VectorElement a => Vector a -> Int32
length Vector a
vec
toLazyByteString :: Vector Word8 -> ByteString
toLazyByteString :: Vector Word8 -> Position
toLazyByteString (VectorWord8 len pos) =
Int64 -> Position -> Position
BSL.take (Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int32 @Int64 Int32
len) Position
pos
instance VectorElement Word8 where
data Vector Word8 = VectorWord8 !Int32 !Position
length :: Vector Word8 -> Int32
length (VectorWord8 len _) = Int32
len
unsafeIndex :: Vector Word8 -> Int32 -> Either String Word8
unsafeIndex (VectorWord8 _ pos) = Position -> Int32 -> Either String Word8
byteStringSafeIndex Position
pos
take :: Int32 -> Vector Word8 -> Vector Word8
take Int32
n (VectorWord8 len pos) = Int32 -> Position -> Vector Word8
VectorWord8 (Int32 -> Int32 -> Int32
clamp Int32
n Int32
len) Position
pos
drop :: Int32 -> Vector Word8 -> Vector Word8
drop Int32
n (VectorWord8 len pos) = Int32 -> Position -> Vector Word8
VectorWord8 (Int32 -> Int32 -> Int32
clamp (Int32
len Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
n) Int32
len) (Int64 -> Position -> Position
BSL.drop (Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int32 @Int64 Int32
n) Position
pos)
toList :: Vector Word8 -> Either String [Word8]
toList = [Word8] -> Either String [Word8]
forall a b. b -> Either a b
Right ([Word8] -> Either String [Word8])
-> (Vector Word8 -> [Word8])
-> Vector Word8
-> Either String [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> [Word8]
BSL.unpack (Position -> [Word8])
-> (Vector Word8 -> Position) -> Vector Word8 -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Word8 -> Position
toLazyByteString
instance VectorElement Word16 where
data Vector Word16 = VectorWord16 !Int32 !Position
length :: Vector Word16 -> Int32
length (VectorWord16 len _) = Int32
len
unsafeIndex :: Vector Word16 -> Int32 -> Either String Word16
unsafeIndex (VectorWord16 _ pos) = Position -> Either String Word16
forall a. HasPosition a => a -> Either String Word16
readWord16 (Position -> Either String Word16)
-> (Int32 -> Position) -> Int32 -> Either String Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> Int32 -> Int32 -> Position
forall pos. HasPosition pos => pos -> Int32 -> Int32 -> pos
moveToElem Position
pos Int32
forall a. Num a => a
word16Size
take :: Int32 -> Vector Word16 -> Vector Word16
take Int32
n (VectorWord16 len pos) = Int32 -> Position -> Vector Word16
VectorWord16 (Int32 -> Int32 -> Int32
clamp Int32
n Int32
len) Position
pos
drop :: Int32 -> Vector Word16 -> Vector Word16
drop Int32
n (VectorWord16 len pos) = Int32 -> Position -> Vector Word16
VectorWord16 (Int32
len Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
n') (Position -> Int32 -> Int32 -> Position
forall pos. HasPosition pos => pos -> Int32 -> Int32 -> pos
moveToElem Position
pos Int32
forall a. Num a => a
word16Size Int32
n')
where n' :: Int32
n' = Int32 -> Int32 -> Int32
clamp Int32
n Int32
len
toList :: Vector Word16 -> Either String [Word16]
toList (VectorWord16 len pos) = Get Word16 -> Int32 -> Position -> Either String [Word16]
forall a. Get a -> Int32 -> Position -> Either String [a]
inlineVectorToList Get Word16
G.getWord16le Int32
len Position
pos
instance VectorElement Word32 where
data Vector Word32 = VectorWord32 !Int32 !Position
length :: Vector Word32 -> Int32
length (VectorWord32 len _) = Int32
len
unsafeIndex :: Vector Word32 -> Int32 -> Either String Word32
unsafeIndex (VectorWord32 _ pos) = Position -> Either String Word32
forall a. HasPosition a => a -> Either String Word32
readWord32 (Position -> Either String Word32)
-> (Int32 -> Position) -> Int32 -> Either String Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> Int32 -> Int32 -> Position
forall pos. HasPosition pos => pos -> Int32 -> Int32 -> pos
moveToElem Position
pos Int32
forall a. Num a => a
word32Size
take :: Int32 -> Vector Word32 -> Vector Word32
take Int32
n (VectorWord32 len pos) = Int32 -> Position -> Vector Word32
VectorWord32 (Int32 -> Int32 -> Int32
clamp Int32
n Int32
len) Position
pos
drop :: Int32 -> Vector Word32 -> Vector Word32
drop Int32
n (VectorWord32 len pos) = Int32 -> Position -> Vector Word32
VectorWord32 (Int32
len Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
n') (Position -> Int32 -> Int32 -> Position
forall pos. HasPosition pos => pos -> Int32 -> Int32 -> pos
moveToElem Position
pos Int32
forall a. Num a => a
word32Size Int32
n')
where n' :: Int32
n' = Int32 -> Int32 -> Int32
clamp Int32
n Int32
len
toList :: Vector Word32 -> Either String [Word32]
toList (VectorWord32 len pos) = Get Word32 -> Int32 -> Position -> Either String [Word32]
forall a. Get a -> Int32 -> Position -> Either String [a]
inlineVectorToList Get Word32
G.getWord32le Int32
len Position
pos
instance VectorElement Word64 where
data Vector Word64 = VectorWord64 !Int32 !Position
length :: Vector Word64 -> Int32
length (VectorWord64 len _) = Int32
len
unsafeIndex :: Vector Word64 -> Int32 -> Either String Word64
unsafeIndex (VectorWord64 _ pos) = Position -> Either String Word64
forall a. HasPosition a => a -> Either String Word64
readWord64 (Position -> Either String Word64)
-> (Int32 -> Position) -> Int32 -> Either String Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> Int32 -> Int32 -> Position
forall pos. HasPosition pos => pos -> Int32 -> Int32 -> pos
moveToElem Position
pos Int32
forall a. Num a => a
word64Size
take :: Int32 -> Vector Word64 -> Vector Word64
take Int32
n (VectorWord64 len pos) = Int32 -> Position -> Vector Word64
VectorWord64 (Int32 -> Int32 -> Int32
clamp Int32
n Int32
len) Position
pos
drop :: Int32 -> Vector Word64 -> Vector Word64
drop Int32
n (VectorWord64 len pos) = Int32 -> Position -> Vector Word64
VectorWord64 (Int32
len Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
n') (Position -> Int32 -> Int32 -> Position
forall pos. HasPosition pos => pos -> Int32 -> Int32 -> pos
moveToElem Position
pos Int32
forall a. Num a => a
word64Size Int32
n')
where n' :: Int32
n' = Int32 -> Int32 -> Int32
clamp Int32
n Int32
len
toList :: Vector Word64 -> Either String [Word64]
toList (VectorWord64 len pos) = Get Word64 -> Int32 -> Position -> Either String [Word64]
forall a. Get a -> Int32 -> Position -> Either String [a]
inlineVectorToList Get Word64
G.getWord64le Int32
len Position
pos
instance VectorElement Int8 where
data Vector Int8 = VectorInt8 !Int32 !Position
length :: Vector Int8 -> Int32
length (VectorInt8 len _) = Int32
len
unsafeIndex :: Vector Int8 -> Int32 -> Either String Int8
unsafeIndex (VectorInt8 _ pos) = Position -> Either String Int8
forall a. HasPosition a => a -> Either String Int8
readInt8 (Position -> Either String Int8)
-> (Int32 -> Position) -> Int32 -> Either String Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> Int32 -> Int32 -> Position
forall pos. HasPosition pos => pos -> Int32 -> Int32 -> pos
moveToElem Position
pos Int32
forall a. Num a => a
int8Size
take :: Int32 -> Vector Int8 -> Vector Int8
take Int32
n (VectorInt8 len pos) = Int32 -> Position -> Vector Int8
VectorInt8 (Int32 -> Int32 -> Int32
clamp Int32
n Int32
len) Position
pos
drop :: Int32 -> Vector Int8 -> Vector Int8
drop Int32
n (VectorInt8 len pos) = Int32 -> Position -> Vector Int8
VectorInt8 (Int32
len Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
n') (Position -> Int32 -> Int32 -> Position
forall pos. HasPosition pos => pos -> Int32 -> Int32 -> pos
moveToElem Position
pos Int32
forall a. Num a => a
int8Size Int32
n')
where n' :: Int32
n' = Int32 -> Int32 -> Int32
clamp Int32
n Int32
len
toList :: Vector Int8 -> Either String [Int8]
toList (VectorInt8 len pos) = Get Int8 -> Int32 -> Position -> Either String [Int8]
forall a. Get a -> Int32 -> Position -> Either String [a]
inlineVectorToList Get Int8
G.getInt8 Int32
len Position
pos
instance VectorElement Int16 where
data Vector Int16 = VectorInt16 !Int32 !Position
length :: Vector Int16 -> Int32
length (VectorInt16 len _) = Int32
len
unsafeIndex :: Vector Int16 -> Int32 -> Either String Int16
unsafeIndex (VectorInt16 _ pos) = Position -> Either String Int16
forall a. HasPosition a => a -> Either String Int16
readInt16 (Position -> Either String Int16)
-> (Int32 -> Position) -> Int32 -> Either String Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> Int32 -> Int32 -> Position
forall pos. HasPosition pos => pos -> Int32 -> Int32 -> pos
moveToElem Position
pos Int32
forall a. Num a => a
int16Size
take :: Int32 -> Vector Int16 -> Vector Int16
take Int32
n (VectorInt16 len pos) = Int32 -> Position -> Vector Int16
VectorInt16 (Int32 -> Int32 -> Int32
clamp Int32
n Int32
len) Position
pos
drop :: Int32 -> Vector Int16 -> Vector Int16
drop Int32
n (VectorInt16 len pos) = Int32 -> Position -> Vector Int16
VectorInt16 (Int32
len Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
n') (Position -> Int32 -> Int32 -> Position
forall pos. HasPosition pos => pos -> Int32 -> Int32 -> pos
moveToElem Position
pos Int32
forall a. Num a => a
int16Size Int32
n')
where n' :: Int32
n' = Int32 -> Int32 -> Int32
clamp Int32
n Int32
len
toList :: Vector Int16 -> Either String [Int16]
toList (VectorInt16 len pos) = Get Int16 -> Int32 -> Position -> Either String [Int16]
forall a. Get a -> Int32 -> Position -> Either String [a]
inlineVectorToList Get Int16
G.getInt16le Int32
len Position
pos
instance VectorElement Int32 where
data Vector Int32 = VectorInt32 !Int32 !Position
length :: Vector Int32 -> Int32
length (VectorInt32 len _) = Int32
len
unsafeIndex :: Vector Int32 -> Int32 -> Either String Int32
unsafeIndex (VectorInt32 _ pos) = Position -> Either String Int32
forall a. HasPosition a => a -> Either String Int32
readInt32 (Position -> Either String Int32)
-> (Int32 -> Position) -> Int32 -> Either String Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> Int32 -> Int32 -> Position
forall pos. HasPosition pos => pos -> Int32 -> Int32 -> pos
moveToElem Position
pos Int32
forall a. Num a => a
int32Size
take :: Int32 -> Vector Int32 -> Vector Int32
take Int32
n (VectorInt32 len pos) = Int32 -> Position -> Vector Int32
VectorInt32 (Int32 -> Int32 -> Int32
clamp Int32
n Int32
len) Position
pos
drop :: Int32 -> Vector Int32 -> Vector Int32
drop Int32
n (VectorInt32 len pos) = Int32 -> Position -> Vector Int32
VectorInt32 (Int32
len Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
n') (Position -> Int32 -> Int32 -> Position
forall pos. HasPosition pos => pos -> Int32 -> Int32 -> pos
moveToElem Position
pos Int32
forall a. Num a => a
int32Size Int32
n')
where n' :: Int32
n' = Int32 -> Int32 -> Int32
clamp Int32
n Int32
len
toList :: Vector Int32 -> Either String [Int32]
toList (VectorInt32 len pos) = Get Int32 -> Int32 -> Position -> Either String [Int32]
forall a. Get a -> Int32 -> Position -> Either String [a]
inlineVectorToList Get Int32
G.getInt32le Int32
len Position
pos
instance VectorElement Int64 where
data Vector Int64 = VectorInt64 !Int32 !Position
length :: Vector Int64 -> Int32
length (VectorInt64 len _) = Int32
len
unsafeIndex :: Vector Int64 -> Int32 -> Either String Int64
unsafeIndex (VectorInt64 _ pos) = Position -> Either String Int64
forall a. HasPosition a => a -> Either String Int64
readInt64 (Position -> Either String Int64)
-> (Int32 -> Position) -> Int32 -> Either String Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> Int32 -> Int32 -> Position
forall pos. HasPosition pos => pos -> Int32 -> Int32 -> pos
moveToElem Position
pos Int32
forall a. Num a => a
int64Size
take :: Int32 -> Vector Int64 -> Vector Int64
take Int32
n (VectorInt64 len pos) = Int32 -> Position -> Vector Int64
VectorInt64 (Int32 -> Int32 -> Int32
clamp Int32
n Int32
len) Position
pos
drop :: Int32 -> Vector Int64 -> Vector Int64
drop Int32
n (VectorInt64 len pos) = Int32 -> Position -> Vector Int64
VectorInt64 (Int32
len Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
n') (Position -> Int32 -> Int32 -> Position
forall pos. HasPosition pos => pos -> Int32 -> Int32 -> pos
moveToElem Position
pos Int32
forall a. Num a => a
int64Size Int32
n')
where n' :: Int32
n' = Int32 -> Int32 -> Int32
clamp Int32
n Int32
len
toList :: Vector Int64 -> Either String [Int64]
toList (VectorInt64 len pos) = Get Int64 -> Int32 -> Position -> Either String [Int64]
forall a. Get a -> Int32 -> Position -> Either String [a]
inlineVectorToList Get Int64
G.getInt64le Int32
len Position
pos
instance VectorElement Float where
data Vector Float = VectorFloat !Int32 !Position
length :: Vector Float -> Int32
length (VectorFloat len _) = Int32
len
unsafeIndex :: Vector Float -> Int32 -> Either String Float
unsafeIndex (VectorFloat _ pos) = Position -> Either String Float
forall a. HasPosition a => a -> Either String Float
readFloat (Position -> Either String Float)
-> (Int32 -> Position) -> Int32 -> Either String Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> Int32 -> Int32 -> Position
forall pos. HasPosition pos => pos -> Int32 -> Int32 -> pos
moveToElem Position
pos Int32
forall a. Num a => a
floatSize
take :: Int32 -> Vector Float -> Vector Float
take Int32
n (VectorFloat len pos) = Int32 -> Position -> Vector Float
VectorFloat (Int32 -> Int32 -> Int32
clamp Int32
n Int32
len) Position
pos
drop :: Int32 -> Vector Float -> Vector Float
drop Int32
n (VectorFloat len pos) = Int32 -> Position -> Vector Float
VectorFloat (Int32
len Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
n') (Position -> Int32 -> Int32 -> Position
forall pos. HasPosition pos => pos -> Int32 -> Int32 -> pos
moveToElem Position
pos Int32
forall a. Num a => a
floatSize Int32
n')
where n' :: Int32
n' = Int32 -> Int32 -> Int32
clamp Int32
n Int32
len
toList :: Vector Float -> Either String [Float]
toList (VectorFloat len pos) = Get Float -> Int32 -> Position -> Either String [Float]
forall a. Get a -> Int32 -> Position -> Either String [a]
inlineVectorToList Get Float
G.getFloatle Int32
len Position
pos
instance VectorElement Double where
data Vector Double = VectorDouble !Int32 !Position
length :: Vector Double -> Int32
length (VectorDouble len _) = Int32
len
unsafeIndex :: Vector Double -> Int32 -> Either String Double
unsafeIndex (VectorDouble _ pos) = Position -> Either String Double
forall a. HasPosition a => a -> Either String Double
readDouble (Position -> Either String Double)
-> (Int32 -> Position) -> Int32 -> Either String Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> Int32 -> Int32 -> Position
forall pos. HasPosition pos => pos -> Int32 -> Int32 -> pos
moveToElem Position
pos Int32
forall a. Num a => a
doubleSize
take :: Int32 -> Vector Double -> Vector Double
take Int32
n (VectorDouble len pos) = Int32 -> Position -> Vector Double
VectorDouble (Int32 -> Int32 -> Int32
clamp Int32
n Int32
len) Position
pos
drop :: Int32 -> Vector Double -> Vector Double
drop Int32
n (VectorDouble len pos) = Int32 -> Position -> Vector Double
VectorDouble (Int32
len Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
n') (Position -> Int32 -> Int32 -> Position
forall pos. HasPosition pos => pos -> Int32 -> Int32 -> pos
moveToElem Position
pos Int32
forall a. Num a => a
doubleSize Int32
n')
where n' :: Int32
n' = Int32 -> Int32 -> Int32
clamp Int32
n Int32
len
toList :: Vector Double -> Either String [Double]
toList (VectorDouble len pos) = Get Double -> Int32 -> Position -> Either String [Double]
forall a. Get a -> Int32 -> Position -> Either String [a]
inlineVectorToList Get Double
G.getDoublele Int32
len Position
pos
instance VectorElement Bool where
data Vector Bool = VectorBool !Int32 !Position
length :: Vector Bool -> Int32
length (VectorBool len _) = Int32
len
unsafeIndex :: Vector Bool -> Int32 -> Either String Bool
unsafeIndex (VectorBool _ pos) = Position -> Either String Bool
forall a. HasPosition a => a -> Either String Bool
readBool (Position -> Either String Bool)
-> (Int32 -> Position) -> Int32 -> Either String Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> Int32 -> Int32 -> Position
forall pos. HasPosition pos => pos -> Int32 -> Int32 -> pos
moveToElem Position
pos Int32
forall a. Num a => a
boolSize
take :: Int32 -> Vector Bool -> Vector Bool
take Int32
n (VectorBool len pos) = Int32 -> Position -> Vector Bool
VectorBool (Int32 -> Int32 -> Int32
clamp Int32
n Int32
len) Position
pos
drop :: Int32 -> Vector Bool -> Vector Bool
drop Int32
n (VectorBool len pos) = Int32 -> Position -> Vector Bool
VectorBool (Int32
len Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
n') (Position -> Int32 -> Int32 -> Position
forall pos. HasPosition pos => pos -> Int32 -> Int32 -> pos
moveToElem Position
pos Int32
forall a. Num a => a
boolSize Int32
n')
where n' :: Int32
n' = Int32 -> Int32 -> Int32
clamp Int32
n Int32
len
toList :: Vector Bool -> Either String [Bool]
toList (VectorBool len pos) = (Word8 -> Bool) -> [Word8] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Bool
word8ToBool ([Word8] -> [Bool])
-> Either String [Word8] -> Either String [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector Word8 -> Either String [Word8]
forall a. VectorElement a => Vector a -> Either String [a]
toList (Int32 -> Position -> Vector Word8
VectorWord8 Int32
len Position
pos)
instance VectorElement Text where
data Vector Text = VectorText !Int32 !Position
length :: Vector Text -> Int32
length (VectorText len _) = Int32
len
unsafeIndex :: Vector Text -> Int32 -> Either String Text
unsafeIndex (VectorText _ pos) = Position -> Either String Text
forall a. HasPosition a => a -> Either String Text
readText (Position -> Either String Text)
-> (Int32 -> Position) -> Int32 -> Either String Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> Int32 -> Int32 -> Position
forall pos. HasPosition pos => pos -> Int32 -> Int32 -> pos
moveToElem Position
pos Int32
forall a. Num a => a
textRefSize
take :: Int32 -> Vector Text -> Vector Text
take Int32
n (VectorText len pos) = Int32 -> Position -> Vector Text
VectorText (Int32 -> Int32 -> Int32
clamp Int32
n Int32
len) Position
pos
drop :: Int32 -> Vector Text -> Vector Text
drop Int32
n (VectorText len pos) = Int32 -> Position -> Vector Text
VectorText (Int32
len Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
n') (Position -> Int32 -> Int32 -> Position
forall pos. HasPosition pos => pos -> Int32 -> Int32 -> pos
moveToElem Position
pos Int32
forall a. Num a => a
textRefSize Int32
n')
where n' :: Int32
n' = Int32 -> Int32 -> Int32
clamp Int32
n Int32
len
toList :: Vector Text -> Either ReadError [Text]
toList :: Vector Text -> Either String [Text]
toList (VectorText len pos) = do
[Int32]
offsets <- Get Int32 -> Int32 -> Position -> Either String [Int32]
forall a. Get a -> Int32 -> Position -> Either String [a]
inlineVectorToList Get Int32
G.getInt32le Int32
len Position
pos
[Text] -> [Text]
forall a. [a] -> [a]
L.reverse ([Text] -> [Text]) -> Either String [Text] -> Either String [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int32] -> Int32 -> [Text] -> Either String [Text]
go [Int32]
offsets Int32
0 []
where
go :: [Int32] -> Int32 -> [Text] -> Either ReadError [Text]
go :: [Int32] -> Int32 -> [Text] -> Either String [Text]
go [] Int32
_ [Text]
acc = [Text] -> Either String [Text]
forall a b. b -> Either a b
Right [Text]
acc
go (Int32
offset : [Int32]
xs) Int32
ix [Text]
acc = do
let textPos :: Position
textPos = Position -> Int32 -> Position
forall a i. (HasPosition a, Integral i) => a -> i -> a
move Position
pos (Int32
offset Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ (Int32
ix Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
4))
Text
text <- Either String (Either String Text) -> Either String Text
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Either String (Either String Text) -> Either String Text)
-> Either String (Either String Text) -> Either String Text
forall a b. (a -> b) -> a -> b
$ Position
-> Get (Either String Text) -> Either String (Either String Text)
forall a. Position -> Get a -> Either String a
runGet Position
textPos Get (Either String Text)
readText'
[Int32] -> Int32 -> [Text] -> Either String [Text]
go [Int32]
xs (Int32
ix Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
1) (Text
text Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
acc)
instance IsStruct a => VectorElement (Struct a) where
data Vector (Struct a) = VectorStruct !Int32 !Position
length :: Vector (Struct a) -> Int32
length (VectorStruct len _) = Int32
len
unsafeIndex :: Vector (Struct a) -> Int32 -> Either String (Struct a)
unsafeIndex (VectorStruct _ pos) = Struct a -> Either String (Struct a)
forall a b. b -> Either a b
Right (Struct a -> Either String (Struct a))
-> (Int32 -> Struct a) -> Int32 -> Either String (Struct a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> Struct a
forall a s. HasPosition a => a -> Struct s
readStruct (Position -> Struct a) -> (Int32 -> Position) -> Int32 -> Struct a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> Int32 -> Int32 -> Position
forall pos. HasPosition pos => pos -> Int32 -> Int32 -> pos
moveToElem Position
pos (InlineSize -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IsStruct a => InlineSize
forall a. IsStruct a => InlineSize
structSizeOf @a))
take :: Int32 -> Vector (Struct a) -> Vector (Struct a)
take Int32
n (VectorStruct len pos) = Int32 -> Position -> Vector (Struct a)
forall a. Int32 -> Position -> Vector (Struct a)
VectorStruct (Int32 -> Int32 -> Int32
clamp Int32
n Int32
len) Position
pos
drop :: Int32 -> Vector (Struct a) -> Vector (Struct a)
drop Int32
n (VectorStruct len pos) = Int32 -> Position -> Vector (Struct a)
forall a. Int32 -> Position -> Vector (Struct a)
VectorStruct (Int32
len Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
n') (Position -> Int32 -> Int32 -> Position
forall pos. HasPosition pos => pos -> Int32 -> Int32 -> pos
moveToElem Position
pos (InlineSize -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IsStruct a => InlineSize
forall a. IsStruct a => InlineSize
structSizeOf @a)) Int32
n')
where n' :: Int32
n' = Int32 -> Int32 -> Int32
clamp Int32
n Int32
len
toList :: Vector (Struct a) -> Either String [Struct a]
toList (VectorStruct len pos) =
[Struct a] -> Either String [Struct a]
forall a b. b -> Either a b
Right (Int32 -> Position -> [Struct a]
go Int32
len Position
pos)
where
go :: Int32 -> Position -> [Struct a]
go :: Int32 -> Position -> [Struct a]
go Int32
0 Position
_ = []
go !Int32
len Position
pos =
let head :: Struct a
head = Position -> Struct a
forall a s. HasPosition a => a -> Struct s
readStruct Position
pos
tail :: [Struct a]
tail = Int32 -> Position -> [Struct a]
go (Int32
len Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
1) (Position -> InlineSize -> Position
forall a i. (HasPosition a, Integral i) => a -> i -> a
move Position
pos (IsStruct a => InlineSize
forall a. IsStruct a => InlineSize
structSizeOf @a))
in Struct a
head Struct a -> [Struct a] -> [Struct a]
forall a. a -> [a] -> [a]
: [Struct a]
tail
instance VectorElement (Table a) where
data Vector (Table a) = VectorTable !Int32 !PositionInfo
length :: Vector (Table a) -> Int32
length (VectorTable len _) = Int32
len
unsafeIndex :: Vector (Table a) -> Int32 -> Either String (Table a)
unsafeIndex (VectorTable _ pos) = PositionInfo -> Either String (Table a)
forall t. PositionInfo -> Either String (Table t)
readTable (PositionInfo -> Either String (Table a))
-> (Int32 -> PositionInfo) -> Int32 -> Either String (Table a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PositionInfo -> Int32 -> Int32 -> PositionInfo
forall pos. HasPosition pos => pos -> Int32 -> Int32 -> pos
moveToElem PositionInfo
pos Int32
forall a. Num a => a
tableRefSize
take :: Int32 -> Vector (Table a) -> Vector (Table a)
take Int32
n (VectorTable len pos) = Int32 -> PositionInfo -> Vector (Table a)
forall a. Int32 -> PositionInfo -> Vector (Table a)
VectorTable (Int32 -> Int32 -> Int32
clamp Int32
n Int32
len) PositionInfo
pos
drop :: Int32 -> Vector (Table a) -> Vector (Table a)
drop Int32
n (VectorTable len pos) = Int32 -> PositionInfo -> Vector (Table a)
forall a. Int32 -> PositionInfo -> Vector (Table a)
VectorTable (Int32
len Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
n') (PositionInfo -> Int32 -> Int32 -> PositionInfo
forall pos. HasPosition pos => pos -> Int32 -> Int32 -> pos
moveToElem PositionInfo
pos Int32
forall a. Num a => a
tableRefSize Int32
n')
where n' :: Int32
n' = Int32 -> Int32 -> Int32
clamp Int32
n Int32
len
toList :: Vector (Table a) -> Either String [Table a]
toList (VectorTable len vectorPos) = do
[Int32]
offsets <- Get Int32 -> Int32 -> Position -> Either String [Int32]
forall a. Get a -> Int32 -> Position -> Either String [a]
inlineVectorToList Get Int32
G.getInt32le Int32
len (PositionInfo -> Position
forall a. HasPosition a => a -> Position
getPosition PositionInfo
vectorPos)
[Int32] -> Int32 -> Either String [Table a]
go [Int32]
offsets Int32
0
where
go :: [Int32] -> Int32 -> Either ReadError [Table a]
go :: [Int32] -> Int32 -> Either String [Table a]
go [] Int32
_ = [Table a] -> Either String [Table a]
forall a b. b -> Either a b
Right []
go (Int32
offset : [Int32]
offsets) !Int32
ix = do
let tablePos :: PositionInfo
tablePos = PositionInfo -> Int32 -> PositionInfo
forall a i. (HasPosition a, Integral i) => a -> i -> a
move PositionInfo
vectorPos (Int32
offset Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ (Int32
ix Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
4))
Table a
table <- PositionInfo -> Either String (Table a)
forall t. PositionInfo -> Either String (Table t)
readTable' PositionInfo
tablePos
[Table a]
tables <- [Int32] -> Int32 -> Either String [Table a]
go [Int32]
offsets (Int32
ix Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
1)
[Table a] -> Either String [Table a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Table a
table Table a -> [Table a] -> [Table a]
forall a. a -> [a] -> [a]
: [Table a]
tables)
instance VectorElement (Union a) where
data Vector (Union a) = VectorUnion
{ Vector (Union a) -> Vector Word8
vectorUnionTypesPos :: !(Vector Word8)
, Vector (Union a) -> PositionInfo
vectorUnionValuesPos :: !PositionInfo
, Vector (Union a)
-> Positive Word8 -> PositionInfo -> Either String (Union a)
vectorUnionReadElem :: !(Positive Word8 -> PositionInfo -> Either ReadError (Union a))
}
length :: Vector (Union a) -> Int32
length = Vector Word8 -> Int32
forall a. VectorElement a => Vector a -> Int32
length (Vector Word8 -> Int32)
-> (Vector (Union a) -> Vector Word8) -> Vector (Union a) -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Union a) -> Vector Word8
forall a. Vector (Union a) -> Vector Word8
vectorUnionTypesPos
unsafeIndex :: Vector (Union a) -> Int32 -> Either String (Union a)
unsafeIndex (VectorUnion typesPos valuesPos readElem) Int32
ix = do
Word8
unionType <- Vector Word8 -> Int32 -> Either String Word8
forall a. VectorElement a => Vector a -> Int32 -> Either String a
unsafeIndex Vector Word8
typesPos Int32
ix
case Word8 -> Maybe (Positive Word8)
forall a. (Num a, Ord a) => a -> Maybe (Positive a)
positive Word8
unionType of
Maybe (Positive Word8)
Nothing -> Union a -> Either String (Union a)
forall a b. b -> Either a b
Right Union a
forall a. Union a
UnionNone
Just Positive Word8
unionType' -> do
PositionInfo
tablePos <- PositionInfo -> Either String PositionInfo
forall pos. HasPosition pos => pos -> Either String pos
readUOffsetAndSkip (PositionInfo -> Either String PositionInfo)
-> PositionInfo -> Either String PositionInfo
forall a b. (a -> b) -> a -> b
$ PositionInfo -> Int32 -> Int32 -> PositionInfo
forall pos. HasPosition pos => pos -> Int32 -> Int32 -> pos
moveToElem PositionInfo
valuesPos Int32
forall a. Num a => a
tableRefSize Int32
ix
Positive Word8 -> PositionInfo -> Either String (Union a)
readElem Positive Word8
unionType' PositionInfo
tablePos
take :: Int32 -> Vector (Union a) -> Vector (Union a)
take Int32
n (VectorUnion typesPos valuesPos readElem) = Vector Word8
-> PositionInfo
-> (Positive Word8 -> PositionInfo -> Either String (Union a))
-> Vector (Union a)
forall a.
Vector Word8
-> PositionInfo
-> (Positive Word8 -> PositionInfo -> Either String (Union a))
-> Vector (Union a)
VectorUnion (Int32 -> Vector Word8 -> Vector Word8
forall a. VectorElement a => Int32 -> Vector a -> Vector a
take Int32
n Vector Word8
typesPos) PositionInfo
valuesPos Positive Word8 -> PositionInfo -> Either String (Union a)
readElem
drop :: Int32 -> Vector (Union a) -> Vector (Union a)
drop Int32
n vec :: Vector (Union a)
vec@(VectorUnion typesPos valuesPos readElem) = Vector Word8
-> PositionInfo
-> (Positive Word8 -> PositionInfo -> Either String (Union a))
-> Vector (Union a)
forall a.
Vector Word8
-> PositionInfo
-> (Positive Word8 -> PositionInfo -> Either String (Union a))
-> Vector (Union a)
VectorUnion (Int32 -> Vector Word8 -> Vector Word8
forall a. VectorElement a => Int32 -> Vector a -> Vector a
drop Int32
n Vector Word8
typesPos) (PositionInfo -> Int32 -> Int32 -> PositionInfo
forall pos. HasPosition pos => pos -> Int32 -> Int32 -> pos
moveToElem PositionInfo
valuesPos Int32
forall a. Num a => a
tableRefSize Int32
n') Positive Word8 -> PositionInfo -> Either String (Union a)
readElem
where n' :: Int32
n' = Int32 -> Int32 -> Int32
clamp Int32
n (Vector (Union a) -> Int32
forall a. VectorElement a => Vector a -> Int32
length Vector (Union a)
vec)
toList :: Vector (Union a) -> Either String [Union a]
toList vec :: Vector (Union a)
vec@(VectorUnion typesPos valuesPos readElem) = do
[Word8]
unionTypes <- Vector Word8 -> Either String [Word8]
forall a. VectorElement a => Vector a -> Either String [a]
toList Vector Word8
typesPos
[Int32]
offsets <- Get Int32 -> Int32 -> Position -> Either String [Int32]
forall a. Get a -> Int32 -> Position -> Either String [a]
inlineVectorToList Get Int32
G.getInt32le (Vector (Union a) -> Int32
forall a. VectorElement a => Vector a -> Int32
length Vector (Union a)
vec) (PositionInfo -> Position
forall a. HasPosition a => a -> Position
getPosition PositionInfo
valuesPos)
[Word8] -> [Int32] -> Int32 -> Either String [Union a]
go [Word8]
unionTypes [Int32]
offsets Int32
0
where
go :: [Word8] -> [Int32] -> Int32 -> Either ReadError [Union a]
go :: [Word8] -> [Int32] -> Int32 -> Either String [Union a]
go [] [] Int32
_ = [Union a] -> Either String [Union a]
forall a b. b -> Either a b
Right []
go (Word8
unionType : [Word8]
unionTypes) (Int32
offset : [Int32]
offsets) !Int32
ix = do
Union a
union <-
case Word8 -> Maybe (Positive Word8)
forall a. (Num a, Ord a) => a -> Maybe (Positive a)
positive Word8
unionType of
Maybe (Positive Word8)
Nothing -> Union a -> Either String (Union a)
forall a b. b -> Either a b
Right Union a
forall a. Union a
UnionNone
Just Positive Word8
unionType' ->
let tablePos :: PositionInfo
tablePos = PositionInfo -> Int32 -> PositionInfo
forall a i. (HasPosition a, Integral i) => a -> i -> a
move PositionInfo
valuesPos (Int32
offset Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ (Int32
ix Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
4))
in Positive Word8 -> PositionInfo -> Either String (Union a)
readElem Positive Word8
unionType' PositionInfo
tablePos
[Union a]
unions <- [Word8] -> [Int32] -> Int32 -> Either String [Union a]
go [Word8]
unionTypes [Int32]
offsets (Int32
ix Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
1)
[Union a] -> Either String [Union a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Union a
union Union a -> [Union a] -> [Union a]
forall a. a -> [a] -> [a]
: [Union a]
unions)
go [Word8]
_ [Int32]
_ Int32
_ = String -> Either String [Union a]
forall a b. a -> Either a b
Left String
"Union vector: 'type vector' and 'value vector' do not have the same length."
{-# INLINE readStructField #-}
readStructField :: (Position -> a) -> VOffset -> Struct s -> a
readStructField :: (Position -> a) -> VOffset -> Struct s -> a
readStructField Position -> a
read VOffset
voffset (Struct Position
bs) =
Position -> a
read (Position -> VOffset -> Position
forall a i. (HasPosition a, Integral i) => a -> i -> a
move Position
bs VOffset
voffset)
{-# INLINE readTableFieldOpt #-}
readTableFieldOpt :: (PositionInfo -> Either ReadError a) -> TableIndex -> Table t -> Either ReadError (Maybe a)
readTableFieldOpt :: (PositionInfo -> Either String a)
-> TableIndex -> Table t -> Either String (Maybe a)
readTableFieldOpt PositionInfo -> Either String a
read TableIndex
ix Table t
t = do
Maybe VOffset
mbOffset <- Table t -> TableIndex -> Either String (Maybe VOffset)
forall t. Table t -> TableIndex -> Either String (Maybe VOffset)
tableIndexToVOffset Table t
t TableIndex
ix
(VOffset -> Either String a)
-> Maybe VOffset -> Either String (Maybe a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\VOffset
offset -> PositionInfo -> Either String a
read (PositionInfo -> VOffset -> PositionInfo
forall a i. (HasPosition a, Integral i) => a -> i -> a
move (Table t -> PositionInfo
forall a. Table a -> PositionInfo
tablePos Table t
t) VOffset
offset)) Maybe VOffset
mbOffset
{-# INLINE readTableFieldReq #-}
readTableFieldReq :: (PositionInfo -> Either ReadError a) -> TableIndex -> String -> Table t -> Either ReadError a
readTableFieldReq :: (PositionInfo -> Either String a)
-> TableIndex -> String -> Table t -> Either String a
readTableFieldReq PositionInfo -> Either String a
read TableIndex
ix String
name Table t
t = do
Maybe VOffset
mbOffset <- Table t -> TableIndex -> Either String (Maybe VOffset)
forall t. Table t -> TableIndex -> Either String (Maybe VOffset)
tableIndexToVOffset Table t
t TableIndex
ix
case Maybe VOffset
mbOffset of
Maybe VOffset
Nothing -> String -> Either String a
forall a. String -> Either String a
missingField String
name
Just VOffset
offset -> PositionInfo -> Either String a
read (PositionInfo -> VOffset -> PositionInfo
forall a i. (HasPosition a, Integral i) => a -> i -> a
move (Table t -> PositionInfo
forall a. Table a -> PositionInfo
tablePos Table t
t) VOffset
offset)
{-# INLINE readTableFieldWithDef #-}
readTableFieldWithDef :: (PositionInfo -> Either ReadError a) -> TableIndex -> a -> Table t -> Either ReadError a
readTableFieldWithDef :: (PositionInfo -> Either String a)
-> TableIndex -> a -> Table t -> Either String a
readTableFieldWithDef PositionInfo -> Either String a
read TableIndex
ix a
dflt Table t
t =
Table t -> TableIndex -> Either String (Maybe VOffset)
forall t. Table t -> TableIndex -> Either String (Maybe VOffset)
tableIndexToVOffset Table t
t TableIndex
ix Either String (Maybe VOffset)
-> (Maybe VOffset -> Either String a) -> Either String a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe VOffset
Nothing -> a -> Either String a
forall a b. b -> Either a b
Right a
dflt
Just VOffset
offset -> PositionInfo -> Either String a
read (PositionInfo -> VOffset -> PositionInfo
forall a i. (HasPosition a, Integral i) => a -> i -> a
move (Table t -> PositionInfo
forall a. Table a -> PositionInfo
tablePos Table t
t) VOffset
offset)
{-# INLINE readTableFieldUnion #-}
readTableFieldUnion :: (Positive Word8 -> PositionInfo -> Either ReadError (Union a)) -> TableIndex -> Table t -> Either ReadError (Union a)
readTableFieldUnion :: (Positive Word8 -> PositionInfo -> Either String (Union a))
-> TableIndex -> Table t -> Either String (Union a)
readTableFieldUnion Positive Word8 -> PositionInfo -> Either String (Union a)
read TableIndex
ix Table t
t =
(PositionInfo -> Either String Word8)
-> TableIndex -> Word8 -> Table t -> Either String Word8
forall a t.
(PositionInfo -> Either String a)
-> TableIndex -> a -> Table t -> Either String a
readTableFieldWithDef PositionInfo -> Either String Word8
forall a. HasPosition a => a -> Either String Word8
readWord8 (TableIndex
ix TableIndex -> TableIndex -> TableIndex
forall a. Num a => a -> a -> a
- TableIndex
1) Word8
0 Table t
t Either String Word8
-> (Word8 -> Either String (Union a)) -> Either String (Union a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word8
unionType ->
case Word8 -> Maybe (Positive Word8)
forall a. (Num a, Ord a) => a -> Maybe (Positive a)
positive Word8
unionType of
Maybe (Positive Word8)
Nothing -> Union a -> Either String (Union a)
forall a b. b -> Either a b
Right Union a
forall a. Union a
UnionNone
Just Positive Word8
unionType' ->
Table t -> TableIndex -> Either String (Maybe VOffset)
forall t. Table t -> TableIndex -> Either String (Maybe VOffset)
tableIndexToVOffset Table t
t TableIndex
ix Either String (Maybe VOffset)
-> (Maybe VOffset -> Either String (Union a))
-> Either String (Union a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe VOffset
Nothing -> String -> Either String (Union a)
forall a b. a -> Either a b
Left String
"Union: 'union type' found but 'union value' is missing."
Just VOffset
offset -> PositionInfo -> Either String PositionInfo
forall pos. HasPosition pos => pos -> Either String pos
readUOffsetAndSkip (PositionInfo -> VOffset -> PositionInfo
forall a i. (HasPosition a, Integral i) => a -> i -> a
move (Table t -> PositionInfo
forall a. Table a -> PositionInfo
tablePos Table t
t) VOffset
offset) Either String PositionInfo
-> (PositionInfo -> Either String (Union a))
-> Either String (Union a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Positive Word8 -> PositionInfo -> Either String (Union a)
read Positive Word8
unionType'
readTableFieldUnionVectorOpt ::
(Positive Word8 -> PositionInfo -> Either ReadError (Union a))
-> TableIndex
-> Table t
-> Either ReadError (Maybe (Vector (Union a)))
readTableFieldUnionVectorOpt :: (Positive Word8 -> PositionInfo -> Either String (Union a))
-> TableIndex
-> Table t
-> Either String (Maybe (Vector (Union a)))
readTableFieldUnionVectorOpt Positive Word8 -> PositionInfo -> Either String (Union a)
read TableIndex
ix Table t
t =
Table t -> TableIndex -> Either String (Maybe VOffset)
forall t. Table t -> TableIndex -> Either String (Maybe VOffset)
tableIndexToVOffset Table t
t (TableIndex
ix TableIndex -> TableIndex -> TableIndex
forall a. Num a => a -> a -> a
- TableIndex
1) Either String (Maybe VOffset)
-> (Maybe VOffset -> Either String (Maybe (Vector (Union a))))
-> Either String (Maybe (Vector (Union a)))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe VOffset
Nothing -> Maybe (Vector (Union a))
-> Either String (Maybe (Vector (Union a)))
forall a b. b -> Either a b
Right Maybe (Vector (Union a))
forall a. Maybe a
Nothing
Just VOffset
typesOffset ->
Table t -> TableIndex -> Either String (Maybe VOffset)
forall t. Table t -> TableIndex -> Either String (Maybe VOffset)
tableIndexToVOffset Table t
t TableIndex
ix Either String (Maybe VOffset)
-> (Maybe VOffset -> Either String (Maybe (Vector (Union a))))
-> Either String (Maybe (Vector (Union a)))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe VOffset
Nothing -> String -> Either String (Maybe (Vector (Union a)))
forall a b. a -> Either a b
Left String
"Union vector: 'type vector' found but 'value vector' is missing."
Just VOffset
valuesOffset ->
Vector (Union a) -> Maybe (Vector (Union a))
forall a. a -> Maybe a
Just (Vector (Union a) -> Maybe (Vector (Union a)))
-> Either String (Vector (Union a))
-> Either String (Maybe (Vector (Union a)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Positive Word8 -> PositionInfo -> Either String (Union a))
-> PositionInfo -> PositionInfo -> Either String (Vector (Union a))
forall a.
(Positive Word8 -> PositionInfo -> Either String (Union a))
-> PositionInfo -> PositionInfo -> Either String (Vector (Union a))
readUnionVector Positive Word8 -> PositionInfo -> Either String (Union a)
read (PositionInfo -> VOffset -> PositionInfo
forall a i. (HasPosition a, Integral i) => a -> i -> a
move (Table t -> PositionInfo
forall a. Table a -> PositionInfo
tablePos Table t
t) VOffset
typesOffset) (PositionInfo -> VOffset -> PositionInfo
forall a i. (HasPosition a, Integral i) => a -> i -> a
move (Table t -> PositionInfo
forall a. Table a -> PositionInfo
tablePos Table t
t) VOffset
valuesOffset)
readTableFieldUnionVectorReq ::
(Positive Word8 -> PositionInfo -> Either ReadError (Union a))
-> TableIndex
-> String
-> Table t
-> Either ReadError (Vector (Union a))
readTableFieldUnionVectorReq :: (Positive Word8 -> PositionInfo -> Either String (Union a))
-> TableIndex
-> String
-> Table t
-> Either String (Vector (Union a))
readTableFieldUnionVectorReq Positive Word8 -> PositionInfo -> Either String (Union a)
read TableIndex
ix String
name Table t
t =
Table t -> TableIndex -> Either String (Maybe VOffset)
forall t. Table t -> TableIndex -> Either String (Maybe VOffset)
tableIndexToVOffset Table t
t (TableIndex
ix TableIndex -> TableIndex -> TableIndex
forall a. Num a => a -> a -> a
- TableIndex
1) Either String (Maybe VOffset)
-> (Maybe VOffset -> Either String (Vector (Union a)))
-> Either String (Vector (Union a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe VOffset
Nothing -> String -> Either String (Vector (Union a))
forall a. String -> Either String a
missingField String
name
Just VOffset
typesOffset ->
Table t -> TableIndex -> Either String (Maybe VOffset)
forall t. Table t -> TableIndex -> Either String (Maybe VOffset)
tableIndexToVOffset Table t
t TableIndex
ix Either String (Maybe VOffset)
-> (Maybe VOffset -> Either String (Vector (Union a)))
-> Either String (Vector (Union a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe VOffset
Nothing -> String -> Either String (Vector (Union a))
forall a b. a -> Either a b
Left String
"Union vector: 'type vector' found but 'value vector' is missing."
Just VOffset
valuesOffset ->
(Positive Word8 -> PositionInfo -> Either String (Union a))
-> PositionInfo -> PositionInfo -> Either String (Vector (Union a))
forall a.
(Positive Word8 -> PositionInfo -> Either String (Union a))
-> PositionInfo -> PositionInfo -> Either String (Vector (Union a))
readUnionVector Positive Word8 -> PositionInfo -> Either String (Union a)
read (PositionInfo -> VOffset -> PositionInfo
forall a i. (HasPosition a, Integral i) => a -> i -> a
move (Table t -> PositionInfo
forall a. Table a -> PositionInfo
tablePos Table t
t) VOffset
typesOffset) (PositionInfo -> VOffset -> PositionInfo
forall a i. (HasPosition a, Integral i) => a -> i -> a
move (Table t -> PositionInfo
forall a. Table a -> PositionInfo
tablePos Table t
t) VOffset
valuesOffset)
{-# INLINE readInt8 #-}
readInt8 :: HasPosition a => a -> Either ReadError Int8
readInt8 :: a -> Either String Int8
readInt8 (a -> Position
forall a. HasPosition a => a -> Position
getPosition -> Position
pos) = Position -> Get Int8 -> Either String Int8
forall a. Position -> Get a -> Either String a
runGet Position
pos Get Int8
G.getInt8
{-# INLINE readInt16 #-}
readInt16 :: HasPosition a => a -> Either ReadError Int16
readInt16 :: a -> Either String Int16
readInt16 (a -> Position
forall a. HasPosition a => a -> Position
getPosition -> Position
pos) = Position -> Get Int16 -> Either String Int16
forall a. Position -> Get a -> Either String a
runGet Position
pos Get Int16
G.getInt16le
{-# INLINE readInt32 #-}
readInt32 :: HasPosition a => a -> Either ReadError Int32
readInt32 :: a -> Either String Int32
readInt32 (a -> Position
forall a. HasPosition a => a -> Position
getPosition -> Position
pos) = Position -> Get Int32 -> Either String Int32
forall a. Position -> Get a -> Either String a
runGet Position
pos Get Int32
G.getInt32le
{-# INLINE readInt64 #-}
readInt64 :: HasPosition a => a -> Either ReadError Int64
readInt64 :: a -> Either String Int64
readInt64 (a -> Position
forall a. HasPosition a => a -> Position
getPosition -> Position
pos) = Position -> Get Int64 -> Either String Int64
forall a. Position -> Get a -> Either String a
runGet Position
pos Get Int64
G.getInt64le
{-# INLINE readWord8 #-}
readWord8 :: HasPosition a => a -> Either ReadError Word8
readWord8 :: a -> Either String Word8
readWord8 (a -> Position
forall a. HasPosition a => a -> Position
getPosition -> Position
pos) = Position -> Get Word8 -> Either String Word8
forall a. Position -> Get a -> Either String a
runGet Position
pos Get Word8
G.getWord8
{-# INLINE readWord16 #-}
readWord16 :: HasPosition a => a -> Either ReadError Word16
readWord16 :: a -> Either String Word16
readWord16 (a -> Position
forall a. HasPosition a => a -> Position
getPosition -> Position
pos) = Position -> Get Word16 -> Either String Word16
forall a. Position -> Get a -> Either String a
runGet Position
pos Get Word16
G.getWord16le
{-# INLINE readWord32 #-}
readWord32 :: HasPosition a => a -> Either ReadError Word32
readWord32 :: a -> Either String Word32
readWord32 (a -> Position
forall a. HasPosition a => a -> Position
getPosition -> Position
pos) = Position -> Get Word32 -> Either String Word32
forall a. Position -> Get a -> Either String a
runGet Position
pos Get Word32
G.getWord32le
{-# INLINE readWord64 #-}
readWord64 :: HasPosition a => a -> Either ReadError Word64
readWord64 :: a -> Either String Word64
readWord64 (a -> Position
forall a. HasPosition a => a -> Position
getPosition -> Position
pos) = Position -> Get Word64 -> Either String Word64
forall a. Position -> Get a -> Either String a
runGet Position
pos Get Word64
G.getWord64le
{-# INLINE readFloat #-}
readFloat :: HasPosition a => a -> Either ReadError Float
readFloat :: a -> Either String Float
readFloat (a -> Position
forall a. HasPosition a => a -> Position
getPosition -> Position
pos) = Position -> Get Float -> Either String Float
forall a. Position -> Get a -> Either String a
runGet Position
pos Get Float
G.getFloatle
{-# INLINE readDouble #-}
readDouble :: HasPosition a => a -> Either ReadError Double
readDouble :: a -> Either String Double
readDouble (a -> Position
forall a. HasPosition a => a -> Position
getPosition -> Position
pos) = Position -> Get Double -> Either String Double
forall a. Position -> Get a -> Either String a
runGet Position
pos Get Double
G.getDoublele
{-# INLINE readBool #-}
readBool :: HasPosition a => a -> Either ReadError Bool
readBool :: a -> Either String Bool
readBool a
p = Word8 -> Bool
word8ToBool (Word8 -> Bool) -> Either String Word8 -> Either String Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> Either String Word8
forall a. HasPosition a => a -> Either String Word8
readWord8 a
p
{-# INLINE word8ToBool #-}
word8ToBool :: Word8 -> Bool
word8ToBool :: Word8 -> Bool
word8ToBool Word8
0 = Bool
False
word8ToBool Word8
_ = Bool
True
readPrimVector ::
(Int32 -> Position -> Vector a)
-> PositionInfo
-> Either ReadError (Vector a)
readPrimVector :: (Int32 -> Position -> Vector a)
-> PositionInfo -> Either String (Vector a)
readPrimVector Int32 -> Position -> Vector a
vecConstructor (PositionInfo -> Position
posCurrent -> Position
pos) = do
Position
vecPos <- Position -> Either String Position
forall pos. HasPosition pos => pos -> Either String pos
readUOffsetAndSkip Position
pos
Int32
vecLength <- Position -> Either String Int32
forall a. HasPosition a => a -> Either String Int32
readInt32 Position
vecPos
Vector a -> Either String (Vector a)
forall a b. b -> Either a b
Right (Vector a -> Either String (Vector a))
-> Vector a -> Either String (Vector a)
forall a b. (a -> b) -> a -> b
$! Int32 -> Position -> Vector a
vecConstructor Int32
vecLength (Position -> Int64 -> Position
forall a i. (HasPosition a, Integral i) => a -> i -> a
move Position
vecPos (Int64
forall a. Num a => a
int32Size :: Int64))
readTableVector :: PositionInfo -> Either ReadError (Vector (Table a))
readTableVector :: PositionInfo -> Either String (Vector (Table a))
readTableVector PositionInfo
pos = do
PositionInfo
vecPos <- PositionInfo -> Either String PositionInfo
forall pos. HasPosition pos => pos -> Either String pos
readUOffsetAndSkip PositionInfo
pos
Int32
vecLength <- PositionInfo -> Either String Int32
forall a. HasPosition a => a -> Either String Int32
readInt32 PositionInfo
vecPos
Vector (Table a) -> Either String (Vector (Table a))
forall a b. b -> Either a b
Right (Vector (Table a) -> Either String (Vector (Table a)))
-> Vector (Table a) -> Either String (Vector (Table a))
forall a b. (a -> b) -> a -> b
$! Int32 -> PositionInfo -> Vector (Table a)
forall a. Int32 -> PositionInfo -> Vector (Table a)
VectorTable Int32
vecLength (PositionInfo -> Int64 -> PositionInfo
forall a i. (HasPosition a, Integral i) => a -> i -> a
move PositionInfo
vecPos (Int64
forall a. Num a => a
int32Size :: Int64))
readUnionVector ::
(Positive Word8 -> PositionInfo -> Either ReadError (Union a))
-> PositionInfo
-> PositionInfo
-> Either ReadError (Vector (Union a))
readUnionVector :: (Positive Word8 -> PositionInfo -> Either String (Union a))
-> PositionInfo -> PositionInfo -> Either String (Vector (Union a))
readUnionVector Positive Word8 -> PositionInfo -> Either String (Union a)
readUnion PositionInfo
typesPos PositionInfo
valuesPos =
do
Vector Word8
typesVec <- (Int32 -> Position -> Vector Word8)
-> PositionInfo -> Either String (Vector Word8)
forall a.
(Int32 -> Position -> Vector a)
-> PositionInfo -> Either String (Vector a)
readPrimVector Int32 -> Position -> Vector Word8
VectorWord8 PositionInfo
typesPos
PositionInfo
valuesVec <- PositionInfo -> Either String PositionInfo
forall pos. HasPosition pos => pos -> Either String pos
readUOffsetAndSkip PositionInfo
valuesPos
Vector (Union a) -> Either String (Vector (Union a))
forall a b. b -> Either a b
Right (Vector (Union a) -> Either String (Vector (Union a)))
-> Vector (Union a) -> Either String (Vector (Union a))
forall a b. (a -> b) -> a -> b
$! Vector Word8
-> PositionInfo
-> (Positive Word8 -> PositionInfo -> Either String (Union a))
-> Vector (Union a)
forall a.
Vector Word8
-> PositionInfo
-> (Positive Word8 -> PositionInfo -> Either String (Union a))
-> Vector (Union a)
VectorUnion
Vector Word8
typesVec
(PositionInfo -> Int64 -> PositionInfo
forall a i. (HasPosition a, Integral i) => a -> i -> a
move PositionInfo
valuesVec (Int64
forall a. Num a => a
int32Size :: Int64))
Positive Word8 -> PositionInfo -> Either String (Union a)
readUnion
{-# INLINE readText #-}
readText :: HasPosition a => a -> Either ReadError Text
readText :: a -> Either String Text
readText (a -> Position
forall a. HasPosition a => a -> Position
getPosition -> Position
pos) =
Either String (Either String Text) -> Either String Text
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Either String (Either String Text) -> Either String Text)
-> Either String (Either String Text) -> Either String Text
forall a b. (a -> b) -> a -> b
$ Position
-> Get (Either String Text) -> Either String (Either String Text)
forall a. Position -> Get a -> Either String a
runGet Position
pos (Get (Either String Text) -> Either String (Either String Text))
-> Get (Either String Text) -> Either String (Either String Text)
forall a b. (a -> b) -> a -> b
$ do
Int32
uoffset <- Get Int32
G.getInt32le
Int -> Get ()
G.skip (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int32 @Int (Int32
uoffset Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
forall a. Num a => a
uoffsetSize))
Get (Either String Text)
readText'
{-# INLINE readText' #-}
readText' :: Get (Either ReadError Text)
readText' :: Get (Either String Text)
readText' = do
Int32
strLength <- Get Int32
G.getInt32le
ByteString
bs <- Int -> Get ByteString
G.getByteString (Int -> Get ByteString) -> Int -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int32 @Int Int32
strLength
Either String Text -> Get (Either String Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Text -> Get (Either String Text))
-> Either String Text -> Get (Either String Text)
forall a b. (a -> b) -> a -> b
$! case ByteString -> Either UnicodeException Text
T.decodeUtf8' ByteString
bs of
Right Text
t -> Text -> Either String Text
forall a b. b -> Either a b
Right Text
t
Left (T.DecodeError String
msg Maybe Word8
byteMaybe) ->
case Maybe Word8
byteMaybe of
Just Word8
byte -> String -> Either String Text
forall a b. a -> Either a b
Left (String -> Either String Text) -> String -> Either String Text
forall a b. (a -> b) -> a -> b
$ String
"UTF8 decoding error (byte " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word8 -> String
forall a. Show a => a -> String
show Word8
byte String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"): " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msg
Maybe Word8
Nothing -> String -> Either String Text
forall a b. a -> Either a b
Left (String -> Either String Text) -> String -> Either String Text
forall a b. (a -> b) -> a -> b
$ String
"UTF8 decoding error: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msg
Left UnicodeException
_ -> String -> Either String Text
forall a. HasCallStack => String -> a
error String
"the impossible happened"
{-# INLINE readTable #-}
readTable :: PositionInfo -> Either ReadError (Table t)
readTable :: PositionInfo -> Either String (Table t)
readTable = PositionInfo -> Either String PositionInfo
forall pos. HasPosition pos => pos -> Either String pos
readUOffsetAndSkip (PositionInfo -> Either String PositionInfo)
-> (PositionInfo -> Either String (Table t))
-> PositionInfo
-> Either String (Table t)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> PositionInfo -> Either String (Table t)
forall t. PositionInfo -> Either String (Table t)
readTable'
{-# INLINE readTable' #-}
readTable' :: PositionInfo -> Either ReadError (Table t)
readTable' :: PositionInfo -> Either String (Table t)
readTable' PositionInfo
tablePos =
PositionInfo -> Either String Int32
forall a. HasPosition a => a -> Either String Int32
readInt32 PositionInfo
tablePos Either String Int32
-> (Int32 -> Table t) -> Either String (Table t)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Int32
soffset ->
let vtableOffsetFromRoot :: Int32
vtableOffsetFromRoot = OffsetFromRoot -> Int32
coerce (PositionInfo -> OffsetFromRoot
posOffsetFromRoot PositionInfo
tablePos) Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
soffset
vtable :: Position
vtable = Position -> Int32 -> Position
forall a i. (HasPosition a, Integral i) => a -> i -> a
move (PositionInfo -> Position
posRoot PositionInfo
tablePos) Int32
vtableOffsetFromRoot
in Position -> PositionInfo -> Table t
forall a. Position -> PositionInfo -> Table a
Table Position
vtable PositionInfo
tablePos
{-# INLINE readStruct #-}
readStruct :: HasPosition a => a -> Struct s
readStruct :: a -> Struct s
readStruct = Position -> Struct s
forall a. Position -> Struct a
Struct (Position -> Struct s) -> (a -> Position) -> a -> Struct s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Position
forall a. HasPosition a => a -> Position
getPosition
{-# INLINE tableIndexToVOffset #-}
tableIndexToVOffset :: Table t -> TableIndex -> Either ReadError (Maybe VOffset)
tableIndexToVOffset :: Table t -> TableIndex -> Either String (Maybe VOffset)
tableIndexToVOffset Table{Position
PositionInfo
tablePos :: PositionInfo
vtable :: Position
tablePos :: forall a. Table a -> PositionInfo
vtable :: forall a. Table a -> Position
..} TableIndex
ix =
Position -> Get (Maybe VOffset) -> Either String (Maybe VOffset)
forall a. Position -> Get a -> Either String a
runGet Position
vtable (Get (Maybe VOffset) -> Either String (Maybe VOffset))
-> Get (Maybe VOffset) -> Either String (Maybe VOffset)
forall a b. (a -> b) -> a -> b
$ do
Word16
vtableSize <- Get Word16
G.getWord16le
let vtableIndex :: Word16
vtableIndex = Word16
4 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ (TableIndex -> Word16
unTableIndex TableIndex
ix Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
* Word16
2)
if Word16
vtableIndex Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word16
vtableSize
then Maybe VOffset -> Get (Maybe VOffset)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe VOffset
forall a. Maybe a
Nothing
else do
Int -> Get ()
G.skip (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word16 @Int Word16
vtableIndex Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
Get Word16
G.getWord16le Get Word16 -> (Word16 -> Maybe VOffset) -> Get (Maybe VOffset)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
Word16
0 -> Maybe VOffset
forall a. Maybe a
Nothing
Word16
word16 -> VOffset -> Maybe VOffset
forall a. a -> Maybe a
Just (Word16 -> VOffset
VOffset Word16
word16)
{-# INLINE readUOffsetAndSkip #-}
readUOffsetAndSkip :: HasPosition pos => pos -> Either ReadError pos
readUOffsetAndSkip :: pos -> Either String pos
readUOffsetAndSkip pos
pos =
pos -> Int32 -> pos
forall a i. (HasPosition a, Integral i) => a -> i -> a
move pos
pos (Int32 -> pos) -> Either String Int32 -> Either String pos
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> pos -> Either String Int32
forall a. HasPosition a => a -> Either String Int32
readInt32 pos
pos
{-# INLINE runGet #-}
runGet :: ByteString -> Get a -> Either ReadError a
runGet :: Position -> Get a -> Either String a
runGet Position
bs Get a
get =
case Get a
-> Position
-> Either (Position, Int64, String) (Position, Int64, a)
forall a.
Get a
-> Position
-> Either (Position, Int64, String) (Position, Int64, a)
G.runGetOrFail Get a
get Position
bs of
Right (Position
_, Int64
_, a
a) -> a -> Either String a
forall a b. b -> Either a b
Right a
a
Left (Position
_, Int64
_, String
msg) -> String -> Either String a
forall a b. a -> Either a b
Left String
msg
{-# NOINLINE missingField #-}
missingField :: String -> Either ReadError a
missingField :: String -> Either String a
missingField String
fieldName =
String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"Missing required table field: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
fieldName
{-# INLINE byteStringSafeIndex #-}
byteStringSafeIndex :: ByteString -> Int32 -> Either ReadError Word8
byteStringSafeIndex :: Position -> Int32 -> Either String Word8
byteStringSafeIndex !Position
cs0 !Int32
i =
Position -> Int32 -> Either String Word8
forall a. IsString a => Position -> Int32 -> Either a Word8
index' Position
cs0 Int32
i
where index' :: Position -> Int32 -> Either a Word8
index' Position
BSL.Empty Int32
_ = a -> Either a Word8
forall a b. a -> Either a b
Left a
"not enough bytes"
index' (BSL.Chunk ByteString
c Position
cs) Int32
n
| Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int32 @Int Int32
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= ByteString -> Int
BS.length ByteString
c =
Position -> Int32 -> Either a Word8
index' Position
cs (Int32
n Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Int32 (ByteString -> Int
BS.length ByteString
c))
| Bool
otherwise = Word8 -> Either a Word8
forall a b. b -> Either a b
Right (Word8 -> Either a Word8) -> Word8 -> Either a Word8
forall a b. (a -> b) -> a -> b
$! ByteString -> Int -> Word8
BSU.unsafeIndex ByteString
c (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int32 @Int Int32
n)