{-# OPTIONS_HADDOCK not-home #-}

{- HLINT ignore writeTable uoffsetFrom "Eta reduce" -}

module FlatBuffers.Internal.Write where

import Control.Monad (forM)
import Control.Monad.State.Strict
  (MonadState(..), State, StateT(..), execState, gets, modify', runState)

import Data.Bits (complement, (.&.))
import Data.ByteString qualified as BS
import Data.ByteString.Builder (Builder)
import Data.ByteString.Builder qualified as B
import Data.ByteString.Lazy qualified as BSL
import Data.Coerce (coerce)
import Data.Int
import Data.List qualified as L
import Data.Map.Strict qualified as M
import Data.Monoid (Sum(..))
import Data.MonoTraversable (Element, MonoFoldable)
import Data.MonoTraversable qualified as Mono
import Data.Semigroup (Max(..))
import Data.Text (Text)
import Data.Text.Encoding qualified as T
import Data.Text.Internal qualified as TI
import Data.Word

import FlatBuffers.Internal.Build
import FlatBuffers.Internal.Constants
import FlatBuffers.Internal.FileIdentifier
  (FileIdentifier(unFileIdentifier), HasFileIdentifier(getFileIdentifier))
import FlatBuffers.Internal.Types

type BufferSize = Sum Int32

-- | The position of something in a buffer, expressed as the number of bytes counting from the end.
type Position = Int32

data FBState = FBState
  { FBState -> Builder
builder    :: !Builder
  , FBState -> BufferSize
bufferSize :: {-# UNPACK #-} !BufferSize
  , FBState -> Max Alignment
maxAlign   :: {-# UNPACK #-} !(Max Alignment)
  , FBState -> Map ByteString Int32
cache      :: !(M.Map BSL.ByteString Position)
  }

newtype WriteTableField = WriteTableField { WriteTableField -> State FBState (FBState -> FBState)
unWriteTableField :: State FBState (FBState -> FBState) }

-- | A struct to be written to a flatbuffer.
newtype WriteStruct a = WriteStruct { forall a. WriteStruct a -> Builder
buildStruct :: Builder }

-- | A table to be written to a flatbuffer.
newtype WriteTable a = WriteTable (State FBState Position)

-- | A union to be written to a flatbuffer.
data WriteUnion a = WriteUnion
  { forall a. WriteUnion a -> Word8
wuUnionType :: {-# UNPACK #-} !Word8
  , forall a. WriteUnion a -> State FBState Int32
wuUnionValue :: !(State FBState Position)
  }

-- | Serializes a flatbuffer table as a lazy `BSL.ByteString`.
{-# INLINE encode #-}
encode :: WriteTable a -> BSL.ByteString
encode :: forall a. WriteTable a -> ByteString
encode = FBState -> WriteTable a -> ByteString
forall a. FBState -> WriteTable a -> ByteString
encodeState (Builder
-> BufferSize -> Max Alignment -> Map ByteString Int32 -> FBState
FBState Builder
forall a. Monoid a => a
mempty (Int32 -> BufferSize
forall a. a -> Sum a
Sum Int32
0) (Alignment -> Max Alignment
forall a. a -> Max a
Max Alignment
1) Map ByteString Int32
forall a. Monoid a => a
mempty)

{-# INLINE encodeState #-}
encodeState :: FBState -> WriteTable a -> BSL.ByteString
encodeState :: forall a. FBState -> WriteTable a -> ByteString
encodeState FBState
state (WriteTable State FBState Int32
writeTable) =
  Builder -> ByteString
B.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
  FBState -> Builder
builder (FBState -> Builder) -> FBState -> Builder
forall a b. (a -> b) -> a -> b
$
  State FBState () -> FBState -> FBState
forall s a. State s a -> s -> s
execState
    (do Int32
pos <- State FBState Int32
writeTable
        Alignment
maxAlignment <- (FBState -> Alignment) -> StateT FBState Identity Alignment
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Max Alignment -> Alignment
forall a. Max a -> a
getMax (Max Alignment -> Alignment)
-> (FBState -> Max Alignment) -> FBState -> Alignment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FBState -> Max Alignment
maxAlign)
        (FBState -> FBState) -> State FBState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((FBState -> FBState) -> State FBState ())
-> (FBState -> FBState) -> State FBState ()
forall a b. (a -> b) -> a -> b
$ Alignment -> Int32 -> FBState -> FBState
alignTo Alignment
maxAlignment Int32
forall a. Num a => a
uoffsetSize
        (FBState -> FBState) -> State FBState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((FBState -> FBState) -> State FBState ())
-> (FBState -> FBState) -> State FBState ()
forall a b. (a -> b) -> a -> b
$ Int32 -> FBState -> FBState
uoffsetFrom Int32
pos
    )
    FBState
state

-- | Serializes a flatbuffer table as a lazy `BSL.ByteString` and adds a File Identifier.
{-# INLINE encodeWithFileIdentifier #-}
encodeWithFileIdentifier :: forall a. HasFileIdentifier a => WriteTable a -> BSL.ByteString
encodeWithFileIdentifier :: forall a. HasFileIdentifier a => WriteTable a -> ByteString
encodeWithFileIdentifier =
  FBState -> FileIdentifier -> WriteTable a -> ByteString
forall a. FBState -> FileIdentifier -> WriteTable a -> ByteString
encodeStateWithFileIdentifier (Builder
-> BufferSize -> Max Alignment -> Map ByteString Int32 -> FBState
FBState Builder
forall a. Monoid a => a
mempty (Int32 -> BufferSize
forall a. a -> Sum a
Sum Int32
0) (Alignment -> Max Alignment
forall a. a -> Max a
Max Alignment
1) Map ByteString Int32
forall a. Monoid a => a
mempty) (forall a. HasFileIdentifier a => FileIdentifier
getFileIdentifier @a)

{-# INLINE encodeStateWithFileIdentifier #-}
encodeStateWithFileIdentifier :: FBState -> FileIdentifier -> WriteTable a -> BSL.ByteString
encodeStateWithFileIdentifier :: forall a. FBState -> FileIdentifier -> WriteTable a -> ByteString
encodeStateWithFileIdentifier FBState
state FileIdentifier
fi (WriteTable State FBState Int32
writeTable) =
  Builder -> ByteString
B.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
  FBState -> Builder
builder (FBState -> Builder) -> FBState -> Builder
forall a b. (a -> b) -> a -> b
$
  State FBState () -> FBState -> FBState
forall s a. State s a -> s -> s
execState
    (do Int32
pos <- State FBState Int32
writeTable
        Alignment
maxAlignment <- (FBState -> Alignment) -> StateT FBState Identity Alignment
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Max Alignment -> Alignment
forall a. Max a -> a
getMax (Max Alignment -> Alignment)
-> (FBState -> Max Alignment) -> FBState -> Alignment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FBState -> Max Alignment
maxAlign)
        (FBState -> FBState) -> State FBState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((FBState -> FBState) -> State FBState ())
-> (FBState -> FBState) -> State FBState ()
forall a b. (a -> b) -> a -> b
$ Alignment -> Int32 -> FBState -> FBState
alignTo Alignment
maxAlignment (Int32
forall a. Num a => a
uoffsetSize Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
forall a. Num a => a
fileIdentifierSize)
        (FBState -> FBState) -> State FBState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((FBState -> FBState) -> State FBState ())
-> (FBState -> FBState) -> State FBState ()
forall a b. (a -> b) -> a -> b
$ FileIdentifier -> FBState -> FBState
writeFileIdentifier FileIdentifier
fi
        (FBState -> FBState) -> State FBState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((FBState -> FBState) -> State FBState ())
-> (FBState -> FBState) -> State FBState ()
forall a b. (a -> b) -> a -> b
$ Int32 -> FBState -> FBState
uoffsetFrom Int32
pos
    )
    FBState
state


-- | Writes something (unaligned) to the buffer.
{-# INLINE write #-}
write :: Int32 -> Builder -> FBState -> FBState
write :: Int32 -> Builder -> FBState -> FBState
write Int32
bsize Builder
b FBState
fbs = FBState
fbs
  { builder = b <> builder fbs
  , bufferSize = bufferSize fbs <> Sum bsize
  }

-- | Writes a 32-bit int (unaligned) to the buffer.
{-# INLINE writeInt32 #-}
writeInt32 :: Int32 -> FBState -> FBState
writeInt32 :: Int32 -> FBState -> FBState
writeInt32 Int32
n = Int32 -> Builder -> FBState -> FBState
write Int32
forall a. Num a => a
int32Size (Int32 -> Builder
B.int32LE Int32
n)

{-# INLINE writeFileIdentifier #-}
writeFileIdentifier :: FileIdentifier -> FBState -> FBState
writeFileIdentifier :: FileIdentifier -> FBState -> FBState
writeFileIdentifier FileIdentifier
fi = Int32 -> Builder -> FBState -> FBState
write Int32
forall a. Num a => a
fileIdentifierSize (ByteString -> Builder
B.byteString (FileIdentifier -> ByteString
unFileIdentifier FileIdentifier
fi))

{-# INLINE missing #-}
missing :: WriteTableField
missing :: WriteTableField
missing = State FBState (FBState -> FBState) -> WriteTableField
WriteTableField (State FBState (FBState -> FBState) -> WriteTableField)
-> ((FBState -> FBState) -> State FBState (FBState -> FBState))
-> (FBState -> FBState)
-> WriteTableField
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FBState -> FBState) -> State FBState (FBState -> FBState)
forall a. a -> StateT FBState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((FBState -> FBState) -> WriteTableField)
-> (FBState -> FBState) -> WriteTableField
forall a b. (a -> b) -> a -> b
$! FBState -> FBState
forall a. a -> a
id

{-# INLINE deprecated #-}
deprecated :: WriteTableField
deprecated :: WriteTableField
deprecated = WriteTableField
missing

{-# INLINE optional #-}
optional :: (a -> WriteTableField) -> (Maybe a -> WriteTableField)
optional :: forall a. (a -> WriteTableField) -> Maybe a -> WriteTableField
optional = WriteTableField
-> (a -> WriteTableField) -> Maybe a -> WriteTableField
forall b a. b -> (a -> b) -> Maybe a -> b
maybe WriteTableField
missing

{-# INLINE optionalDef #-}
optionalDef :: Eq a => a -> (a -> WriteTableField) -> (Maybe a -> WriteTableField)
optionalDef :: forall a.
Eq a =>
a -> (a -> WriteTableField) -> Maybe a -> WriteTableField
optionalDef a
dflt a -> WriteTableField
write Maybe a
ma =
  case Maybe a
ma of
    Just a
a | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
dflt -> a -> WriteTableField
write a
a
    Maybe a
_                  -> WriteTableField
missing


{-# INLINE writeWord8TableField #-}
writeWord8TableField :: Word8 -> WriteTableField
writeWord8TableField :: Word8 -> WriteTableField
writeWord8TableField Word8
n = State FBState (FBState -> FBState) -> WriteTableField
WriteTableField (State FBState (FBState -> FBState) -> WriteTableField)
-> ((FBState -> FBState) -> State FBState (FBState -> FBState))
-> (FBState -> FBState)
-> WriteTableField
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FBState -> FBState) -> State FBState (FBState -> FBState)
forall a. a -> StateT FBState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((FBState -> FBState) -> WriteTableField)
-> (FBState -> FBState) -> WriteTableField
forall a b. (a -> b) -> a -> b
$! Int32 -> Builder -> FBState -> FBState
write Int32
forall a. Num a => a
word8Size (Word8 -> Builder
B.word8 Word8
n) (FBState -> FBState) -> (FBState -> FBState) -> FBState -> FBState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alignment -> Int32 -> FBState -> FBState
alignTo Alignment
forall a. Num a => a
word8Size Int32
0

{-# INLINE writeWord16TableField #-}
writeWord16TableField :: Word16 -> WriteTableField
writeWord16TableField :: Word16 -> WriteTableField
writeWord16TableField Word16
n = State FBState (FBState -> FBState) -> WriteTableField
WriteTableField (State FBState (FBState -> FBState) -> WriteTableField)
-> ((FBState -> FBState) -> State FBState (FBState -> FBState))
-> (FBState -> FBState)
-> WriteTableField
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FBState -> FBState) -> State FBState (FBState -> FBState)
forall a. a -> StateT FBState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((FBState -> FBState) -> WriteTableField)
-> (FBState -> FBState) -> WriteTableField
forall a b. (a -> b) -> a -> b
$! Int32 -> Builder -> FBState -> FBState
write Int32
forall a. Num a => a
word16Size (Word16 -> Builder
B.word16LE Word16
n) (FBState -> FBState) -> (FBState -> FBState) -> FBState -> FBState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alignment -> Int32 -> FBState -> FBState
alignTo Alignment
forall a. Num a => a
word16Size Int32
0

{-# INLINE writeWord32TableField #-}
writeWord32TableField :: Word32 -> WriteTableField
writeWord32TableField :: Word32 -> WriteTableField
writeWord32TableField Word32
n = State FBState (FBState -> FBState) -> WriteTableField
WriteTableField (State FBState (FBState -> FBState) -> WriteTableField)
-> ((FBState -> FBState) -> State FBState (FBState -> FBState))
-> (FBState -> FBState)
-> WriteTableField
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FBState -> FBState) -> State FBState (FBState -> FBState)
forall a. a -> StateT FBState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((FBState -> FBState) -> WriteTableField)
-> (FBState -> FBState) -> WriteTableField
forall a b. (a -> b) -> a -> b
$! Int32 -> Builder -> FBState -> FBState
write Int32
forall a. Num a => a
word32Size (Word32 -> Builder
B.word32LE Word32
n) (FBState -> FBState) -> (FBState -> FBState) -> FBState -> FBState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alignment -> Int32 -> FBState -> FBState
alignTo Alignment
forall a. Num a => a
word32Size Int32
0

{-# INLINE writeWord64TableField #-}
writeWord64TableField :: Word64 -> WriteTableField
writeWord64TableField :: Word64 -> WriteTableField
writeWord64TableField Word64
n = State FBState (FBState -> FBState) -> WriteTableField
WriteTableField (State FBState (FBState -> FBState) -> WriteTableField)
-> ((FBState -> FBState) -> State FBState (FBState -> FBState))
-> (FBState -> FBState)
-> WriteTableField
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FBState -> FBState) -> State FBState (FBState -> FBState)
forall a. a -> StateT FBState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((FBState -> FBState) -> WriteTableField)
-> (FBState -> FBState) -> WriteTableField
forall a b. (a -> b) -> a -> b
$! Int32 -> Builder -> FBState -> FBState
write Int32
forall a. Num a => a
word64Size (Word64 -> Builder
B.word64LE Word64
n) (FBState -> FBState) -> (FBState -> FBState) -> FBState -> FBState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alignment -> Int32 -> FBState -> FBState
alignTo Alignment
forall a. Num a => a
word64Size Int32
0

{-# INLINE writeInt8TableField #-}
writeInt8TableField :: Int8 -> WriteTableField
writeInt8TableField :: Int8 -> WriteTableField
writeInt8TableField Int8
n = State FBState (FBState -> FBState) -> WriteTableField
WriteTableField (State FBState (FBState -> FBState) -> WriteTableField)
-> ((FBState -> FBState) -> State FBState (FBState -> FBState))
-> (FBState -> FBState)
-> WriteTableField
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FBState -> FBState) -> State FBState (FBState -> FBState)
forall a. a -> StateT FBState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((FBState -> FBState) -> WriteTableField)
-> (FBState -> FBState) -> WriteTableField
forall a b. (a -> b) -> a -> b
$! Int32 -> Builder -> FBState -> FBState
write Int32
forall a. Num a => a
int8Size (Int8 -> Builder
B.int8 Int8
n) (FBState -> FBState) -> (FBState -> FBState) -> FBState -> FBState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alignment -> Int32 -> FBState -> FBState
alignTo Alignment
forall a. Num a => a
int8Size Int32
0

{-# INLINE writeInt16TableField #-}
writeInt16TableField :: Int16 -> WriteTableField
writeInt16TableField :: Int16 -> WriteTableField
writeInt16TableField Int16
n = State FBState (FBState -> FBState) -> WriteTableField
WriteTableField (State FBState (FBState -> FBState) -> WriteTableField)
-> ((FBState -> FBState) -> State FBState (FBState -> FBState))
-> (FBState -> FBState)
-> WriteTableField
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FBState -> FBState) -> State FBState (FBState -> FBState)
forall a. a -> StateT FBState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((FBState -> FBState) -> WriteTableField)
-> (FBState -> FBState) -> WriteTableField
forall a b. (a -> b) -> a -> b
$! Int32 -> Builder -> FBState -> FBState
write Int32
forall a. Num a => a
int16Size (Int16 -> Builder
B.int16LE Int16
n) (FBState -> FBState) -> (FBState -> FBState) -> FBState -> FBState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alignment -> Int32 -> FBState -> FBState
alignTo Alignment
forall a. Num a => a
int16Size Int32
0

{-# INLINE writeInt32TableField #-}
writeInt32TableField :: Int32 -> WriteTableField
writeInt32TableField :: Int32 -> WriteTableField
writeInt32TableField Int32
n = State FBState (FBState -> FBState) -> WriteTableField
WriteTableField (State FBState (FBState -> FBState) -> WriteTableField)
-> ((FBState -> FBState) -> State FBState (FBState -> FBState))
-> (FBState -> FBState)
-> WriteTableField
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FBState -> FBState) -> State FBState (FBState -> FBState)
forall a. a -> StateT FBState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((FBState -> FBState) -> WriteTableField)
-> (FBState -> FBState) -> WriteTableField
forall a b. (a -> b) -> a -> b
$! Int32 -> Builder -> FBState -> FBState
write Int32
forall a. Num a => a
int32Size (Int32 -> Builder
B.int32LE Int32
n) (FBState -> FBState) -> (FBState -> FBState) -> FBState -> FBState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alignment -> Int32 -> FBState -> FBState
alignTo Alignment
forall a. Num a => a
int32Size Int32
0

{-# INLINE writeInt64TableField #-}
writeInt64TableField :: Int64 -> WriteTableField
writeInt64TableField :: Int64 -> WriteTableField
writeInt64TableField Int64
n = State FBState (FBState -> FBState) -> WriteTableField
WriteTableField (State FBState (FBState -> FBState) -> WriteTableField)
-> ((FBState -> FBState) -> State FBState (FBState -> FBState))
-> (FBState -> FBState)
-> WriteTableField
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FBState -> FBState) -> State FBState (FBState -> FBState)
forall a. a -> StateT FBState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((FBState -> FBState) -> WriteTableField)
-> (FBState -> FBState) -> WriteTableField
forall a b. (a -> b) -> a -> b
$! Int32 -> Builder -> FBState -> FBState
write Int32
forall a. Num a => a
int64Size (Int64 -> Builder
B.int64LE Int64
n) (FBState -> FBState) -> (FBState -> FBState) -> FBState -> FBState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alignment -> Int32 -> FBState -> FBState
alignTo Alignment
forall a. Num a => a
int64Size Int32
0

{-# INLINE writeFloatTableField #-}
writeFloatTableField :: Float -> WriteTableField
writeFloatTableField :: Float -> WriteTableField
writeFloatTableField Float
n = State FBState (FBState -> FBState) -> WriteTableField
WriteTableField (State FBState (FBState -> FBState) -> WriteTableField)
-> ((FBState -> FBState) -> State FBState (FBState -> FBState))
-> (FBState -> FBState)
-> WriteTableField
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FBState -> FBState) -> State FBState (FBState -> FBState)
forall a. a -> StateT FBState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((FBState -> FBState) -> WriteTableField)
-> (FBState -> FBState) -> WriteTableField
forall a b. (a -> b) -> a -> b
$! Int32 -> Builder -> FBState -> FBState
write Int32
forall a. Num a => a
floatSize (Float -> Builder
B.floatLE Float
n) (FBState -> FBState) -> (FBState -> FBState) -> FBState -> FBState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alignment -> Int32 -> FBState -> FBState
alignTo Alignment
forall a. Num a => a
floatSize Int32
0

{-# INLINE writeDoubleTableField #-}
writeDoubleTableField :: Double -> WriteTableField
writeDoubleTableField :: Double -> WriteTableField
writeDoubleTableField Double
n = State FBState (FBState -> FBState) -> WriteTableField
WriteTableField (State FBState (FBState -> FBState) -> WriteTableField)
-> ((FBState -> FBState) -> State FBState (FBState -> FBState))
-> (FBState -> FBState)
-> WriteTableField
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FBState -> FBState) -> State FBState (FBState -> FBState)
forall a. a -> StateT FBState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((FBState -> FBState) -> WriteTableField)
-> (FBState -> FBState) -> WriteTableField
forall a b. (a -> b) -> a -> b
$! Int32 -> Builder -> FBState -> FBState
write Int32
forall a. Num a => a
doubleSize (Double -> Builder
B.doubleLE Double
n) (FBState -> FBState) -> (FBState -> FBState) -> FBState -> FBState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alignment -> Int32 -> FBState -> FBState
alignTo Alignment
forall a. Num a => a
doubleSize Int32
0

{-# INLINE writeBoolTableField #-}
writeBoolTableField :: Bool -> WriteTableField
writeBoolTableField :: Bool -> WriteTableField
writeBoolTableField = Word8 -> WriteTableField
writeWord8TableField (Word8 -> WriteTableField)
-> (Bool -> Word8) -> Bool -> WriteTableField
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Word8
boolToWord8

{-# INLINE writeTextTableField #-}
writeTextTableField :: Text -> WriteTableField
writeTextTableField :: Text -> WriteTableField
writeTextTableField Text
text = State FBState (FBState -> FBState) -> WriteTableField
WriteTableField (State FBState (FBState -> FBState) -> WriteTableField)
-> State FBState (FBState -> FBState) -> WriteTableField
forall a b. (a -> b) -> a -> b
$ do
  (FBState -> FBState) -> State FBState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (Int32 -> FBState -> FBState
writeInt32 Int32
len (FBState -> FBState) -> (FBState -> FBState) -> FBState -> FBState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FBState -> FBState
encodeText (FBState -> FBState) -> (FBState -> FBState) -> FBState -> FBState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alignment -> Int32 -> FBState -> FBState
alignTo Alignment
forall a. Num a => a
int32Size (Int32
len Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
1))
  State FBState (FBState -> FBState)
uoffsetFromHere
  where
    len :: Int32
len = Text -> Int32
utf8length Text
text
    encodeText :: FBState -> FBState
encodeText FBState
fbs =
      FBState
fbs
        -- strings must have a trailing zero
        { builder = T.encodeUtf8Builder text <> B.word8 0 <> builder fbs
        , bufferSize = Sum len <> Sum 1 <> bufferSize fbs
        }

{-# INLINE writeTableTableField #-}
writeTableTableField :: WriteTable a -> WriteTableField
writeTableTableField :: forall a. WriteTable a -> WriteTableField
writeTableTableField (WriteTable State FBState Int32
writeTable) = State FBState (FBState -> FBState) -> WriteTableField
WriteTableField (State FBState (FBState -> FBState) -> WriteTableField)
-> State FBState (FBState -> FBState) -> WriteTableField
forall a b. (a -> b) -> a -> b
$ do
  Int32
loc <- State FBState Int32
writeTable
  (FBState -> FBState) -> State FBState (FBState -> FBState)
forall a. a -> StateT FBState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((FBState -> FBState) -> State FBState (FBState -> FBState))
-> (FBState -> FBState) -> State FBState (FBState -> FBState)
forall a b. (a -> b) -> a -> b
$! Int32 -> FBState -> FBState
uoffsetFrom Int32
loc

{-# INLINE writeStructTableField #-}
writeStructTableField :: forall a. IsStruct a => WriteStruct a -> WriteTableField
writeStructTableField :: forall a. IsStruct a => WriteStruct a -> WriteTableField
writeStructTableField (WriteStruct Builder
b) =
  Alignment -> InlineSize -> Builder -> WriteTableField
writeStructTableField' (forall a. IsStruct a => Alignment
structAlignmentOf @a) (forall a. IsStruct a => InlineSize
structSizeOf @a) Builder
b

{-# INLINE writeStructTableField' #-}
writeStructTableField' :: Alignment -> InlineSize -> Builder -> WriteTableField
writeStructTableField' :: Alignment -> InlineSize -> Builder -> WriteTableField
writeStructTableField' Alignment
structAlignment InlineSize
structSize Builder
structBuilder =
  State FBState (FBState -> FBState) -> WriteTableField
WriteTableField (State FBState (FBState -> FBState) -> WriteTableField)
-> ((FBState -> FBState) -> State FBState (FBState -> FBState))
-> (FBState -> FBState)
-> WriteTableField
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FBState -> FBState) -> State FBState (FBState -> FBState)
forall a. a -> StateT FBState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((FBState -> FBState) -> WriteTableField)
-> (FBState -> FBState) -> WriteTableField
forall a b. (a -> b) -> a -> b
$! FBState -> FBState
writeStruct (FBState -> FBState) -> (FBState -> FBState) -> FBState -> FBState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alignment -> Int32 -> FBState -> FBState
alignTo Alignment
structAlignment Int32
0
  where
    writeStruct :: FBState -> FBState
writeStruct FBState
fbs = FBState
fbs
      { builder = structBuilder <> builder fbs
      , bufferSize = bufferSize fbs <> Sum (fromIntegral @InlineSize @Int32 structSize)
      }

{-# INLINE writeUnionTypesVectorTableField #-}
writeUnionTypesVectorTableField :: WriteVector (WriteUnion a) -> WriteTableField
writeUnionTypesVectorTableField :: forall a. WriteVector (WriteUnion a) -> WriteTableField
writeUnionTypesVectorTableField (WriteVectorUnion WriteTableField
tf WriteTableField
_) = WriteTableField
tf

{-# INLINE writeUnionValuesVectorTableField #-}
writeUnionValuesVectorTableField :: WriteVector (WriteUnion a) -> WriteTableField
writeUnionValuesVectorTableField :: forall a. WriteVector (WriteUnion a) -> WriteTableField
writeUnionValuesVectorTableField (WriteVectorUnion WriteTableField
_ WriteTableField
tf) = WriteTableField
tf


{-# INLINE writeUnionTypeTableField #-}
writeUnionTypeTableField :: WriteUnion a -> WriteTableField
writeUnionTypeTableField :: forall a. WriteUnion a -> WriteTableField
writeUnionTypeTableField WriteUnion a
wu = Word8 -> WriteTableField
writeWord8TableField WriteUnion a
wu.wuUnionType

{-# INLINE writeUnionValueTableField #-}
writeUnionValueTableField :: WriteUnion a -> WriteTableField
writeUnionValueTableField :: forall a. WriteUnion a -> WriteTableField
writeUnionValueTableField WriteUnion a
wu = WriteTable Any -> WriteTableField
forall a. WriteTable a -> WriteTableField
writeTableTableField (State FBState Int32 -> WriteTable Any
forall a. State FBState Int32 -> WriteTable a
WriteTable WriteUnion a
wu.wuUnionValue)

{-# INLINE writeUnion #-}
writeUnion :: Word8 -> WriteTable a -> WriteUnion b
writeUnion :: forall a b. Word8 -> WriteTable a -> WriteUnion b
writeUnion Word8
n (WriteTable State FBState Int32
st) = Word8 -> State FBState Int32 -> WriteUnion b
forall a. Word8 -> State FBState Int32 -> WriteUnion a
WriteUnion Word8
n State FBState Int32
st

{-# INLINE vtable #-}
vtable :: [Word16] -> Word16 -> BSL.ByteString
vtable :: [Word16] -> Word16 -> ByteString
vtable [Word16]
fieldVOffsets Word16
tableSize = ByteString
bytestring
  where
    vtableSize :: Word16
vtableSize = Word16
forall a. Num a => a
voffsetSize Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
forall a. Num a => a
voffsetSize Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
forall a. Num a => a
voffsetSize Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Word16 ([Word16] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [Word16]
fieldVOffsets)
    bytestring :: ByteString
bytestring = Builder -> ByteString
B.toLazyByteString
      (  Word16 -> Builder
B.word16LE Word16
vtableSize
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
B.word16LE (Word16 -> Word16
forall a b. Coercible a b => a -> b
coerce Word16
tableSize)
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Word16 -> Builder) -> [Word16] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Word16 -> Builder
B.word16LE (Word16 -> Builder) -> (Word16 -> Word16) -> Word16 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Word16
forall a b. Coercible a b => a -> b
coerce) [Word16]
fieldVOffsets
      )


{-# INLINE writeTable #-}
writeTable :: [WriteTableField] -> WriteTable a
writeTable :: forall a. [WriteTableField] -> WriteTable a
writeTable [WriteTableField]
fields = State FBState Int32 -> WriteTable a
forall a. State FBState Int32 -> WriteTable a
WriteTable (State FBState Int32 -> WriteTable a)
-> State FBState Int32 -> WriteTable a
forall a b. (a -> b) -> a -> b
$ do

  [FBState -> FBState]
inlineFields <- [State FBState (FBState -> FBState)]
-> StateT FBState Identity [FBState -> FBState]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([WriteTableField] -> [State FBState (FBState -> FBState)]
forall a b. Coercible a b => a -> b
coerce [WriteTableField]
fields)

  -- table
  Int32
tableEnd <- (FBState -> Int32) -> State FBState Int32
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (BufferSize -> Int32
forall a. Sum a -> a
getSum (BufferSize -> Int32)
-> (FBState -> BufferSize) -> FBState -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FBState -> BufferSize
bufferSize)

  [Int32]
inlineFieldPositions <-
    [FBState -> FBState]
-> ((FBState -> FBState) -> State FBState Int32)
-> StateT FBState Identity [Int32]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FBState -> FBState]
inlineFields (((FBState -> FBState) -> State FBState Int32)
 -> StateT FBState Identity [Int32])
-> ((FBState -> FBState) -> State FBState Int32)
-> StateT FBState Identity [Int32]
forall a b. (a -> b) -> a -> b
$ \FBState -> FBState
f -> do
      BufferSize
before <- (FBState -> BufferSize) -> StateT FBState Identity BufferSize
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FBState -> BufferSize
bufferSize
      (FBState -> FBState) -> State FBState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' FBState -> FBState
f
      BufferSize
after <- (FBState -> BufferSize) -> StateT FBState Identity BufferSize
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FBState -> BufferSize
bufferSize
      if BufferSize
after BufferSize -> BufferSize -> Bool
forall a. Eq a => a -> a -> Bool
== BufferSize
before
        then Int32 -> State FBState Int32
forall a. a -> StateT FBState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int32
0
        else Int32 -> State FBState Int32
forall a. a -> StateT FBState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BufferSize -> Int32
forall a. Sum a -> a
getSum BufferSize
after)

  (FBState -> FBState) -> State FBState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((FBState -> FBState) -> State FBState ())
-> (FBState -> FBState) -> State FBState ()
forall a b. (a -> b) -> a -> b
$ Alignment -> Int32 -> FBState -> FBState
alignTo Alignment
forall a. Num a => a
soffsetSize Int32
0
  Int32
tableFieldsPosition <- (FBState -> Int32) -> State FBState Int32
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (BufferSize -> Int32
forall a. Sum a -> a
getSum (BufferSize -> Int32)
-> (FBState -> BufferSize) -> FBState -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FBState -> BufferSize
bufferSize)

  let tablePosition :: Int32
tablePosition = Int32
tableFieldsPosition Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
forall a. Num a => a
soffsetSize
  -- Note: This might overflow if the table has too many fields
  let tableSize :: Word16
tableSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int32 @Word16 (Int32 -> Word16) -> Int32 -> Word16
forall a b. (a -> b) -> a -> b
$ Int32
tablePosition Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
tableEnd
  let fieldVOffsets :: [Word16]
fieldVOffsets = ((Int32 -> Word16) -> [Int32] -> [Word16])
-> [Int32] -> (Int32 -> Word16) -> [Word16]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int32 -> Word16) -> [Int32] -> [Word16]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Int32]
inlineFieldPositions ((Int32 -> Word16) -> [Word16]) -> (Int32 -> Word16) -> [Word16]
forall a b. (a -> b) -> a -> b
$ \case
                  Int32
0 -> Word16
0
                  -- Note: This might overflow if the table has too many fields
                  Int32
fieldPosition -> forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int32 @Word16 (Int32
tablePosition Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
fieldPosition)

  -- TODO: trim trailing 0 voffsets

  let newVtable :: ByteString
newVtable = [Word16] -> Word16 -> ByteString
vtable [Word16]
fieldVOffsets Word16
tableSize
  let newVtableSize :: Int32
newVtableSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int64 @Int32 (ByteString -> Int64
BSL.length ByteString
newVtable)
  let newVtablePosition :: Int32
newVtablePosition = Int32
tablePosition Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
newVtableSize

  Map ByteString Int32
map <- (FBState -> Map ByteString Int32)
-> StateT FBState Identity (Map ByteString Int32)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets FBState -> Map ByteString Int32
cache
  case (ByteString -> Int32 -> Int32 -> Int32)
-> ByteString
-> Int32
-> Map ByteString Int32
-> (Maybe Int32, Map ByteString Int32)
forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> (Maybe a, Map k a)
M.insertLookupWithKey (\ByteString
_k Int32
_new Int32
old -> Int32
old) ByteString
newVtable Int32
newVtablePosition Map ByteString Int32
map of
    (Maybe Int32
Nothing, Map ByteString Int32
map') ->
      -- vtable, pointer to vtable, update the cache
      (FBState -> FBState) -> State FBState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (Map ByteString Int32 -> ByteString -> Int32 -> FBState -> FBState
writeVtable Map ByteString Int32
map' ByteString
newVtable Int32
newVtableSize (FBState -> FBState) -> (FBState -> FBState) -> FBState -> FBState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> FBState -> FBState
writeVtableSoffset Int32
newVtableSize)

    (Just Int32
oldVtablePosition, Map ByteString Int32
_) ->
      -- pointer to vtable
      (FBState -> FBState) -> State FBState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((FBState -> FBState) -> State FBState ())
-> (Int32 -> FBState -> FBState) -> Int32 -> State FBState ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> FBState -> FBState
writeInt32 (Int32 -> FBState -> FBState)
-> (Int32 -> Int32) -> Int32 -> FBState -> FBState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int32
forall a. Num a => a -> a
negate (Int32 -> State FBState ()) -> Int32 -> State FBState ()
forall a b. (a -> b) -> a -> b
$ Int32
tablePosition Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
oldVtablePosition

  Int32 -> State FBState Int32
forall a. a -> StateT FBState Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int32 -> State FBState Int32) -> Int32 -> State FBState Int32
forall a b. (a -> b) -> a -> b
$! Int32
tablePosition

  where
    writeVtable :: Map ByteString Int32 -> ByteString -> Int32 -> FBState -> FBState
writeVtable Map ByteString Int32
newCache ByteString
newVtable Int32
newVtableSize FBState
fbs = FBState
fbs
      { cache = newCache
      , builder = B.lazyByteString newVtable <> builder fbs
      , bufferSize = bufferSize fbs <> Sum newVtableSize
      }

    -- The vtable is located right before the table, so the offset
    -- between the table and the vtable is equal to the vtable size
    writeVtableSoffset :: Int32 -> FBState -> FBState
writeVtableSoffset Int32
newVtableSize = Int32 -> FBState -> FBState
writeInt32 Int32
newVtableSize



class WriteVectorElement a where

  -- | A vector to be written to a flatbuffer.
  data WriteVector a

  -- | Constructs a flatbuffers vector.
  --
  -- If @n@ is larger than the length of @xs@, this will result in a malformed buffer.
  -- If @n@ is smaller than the length of @xs@, all elements of @xs@ will still be written to the buffer,
  -- but the client will only be able to read the first @n@ elements.
  --
  -- Note: `fromMonoFoldable` asks for the collection's length to be passed in as an argument rather than use `Mono.olength` because:
  --
  -- 1. `Mono.olength` is often O(n), and in some use cases there may be a better way to know the collection's length ahead of time.
  -- 2. Calling `Mono.olength` inside `fromMonoFoldable` can inhibit some fusions which would otherwise be possible.
  --
  -- @since 0.2.0.0


  -- Implementer's note:
  -- To elaborate on point 2., here's an example.
  -- This version of `fromMonoFoldable` that calls `Mono.olength` internally:
  --
  -- > encodeUserIds' :: [User] -> BSL.ByteString
  -- > encodeUserIds' = encode . userIdsTable $ fromMonoFoldable (userId <$> users))
  -- >
  -- > {-# INLINE fromMonoFoldable #-}
  -- > fromMonoFoldable xs =
  -- >   let length = Mono.olength xs
  -- >       buffer = foldr ... ... xs
  -- >   in  ...
  --
  -- ...prevents `<$>` and `foldr` from being fused, and so it's much slower than when the length is passed in:
  --
  -- > encodeUserIds :: [User] -> BSL.ByteString
  -- > encodeUserIds = encode . userIdsTable $ fromMonoFoldable (userId <$> users) (fromIntegral (Mono.olength users))
  -- >
  -- > {-# INLINE fromMonoFoldable #-}
  -- > fromMonoFoldable xs length =
  -- >   let buffer = foldr ... ... xs
  -- >   in  ...
  fromMonoFoldable ::
       (MonoFoldable mono, Element mono ~ a)
    => Int32      -- ^ @n@: the number of elements in @xs@
    -> mono       -- ^ @xs@: a collection
    -> WriteVector a

-- | Convenience function, equivalent to:
--
-- > fromMonoFoldable' xs = fromMonoFoldable (fromIntegral (olength xs)) xs
--
-- In some cases it may be slower than using `fromMonoFoldable` directly.
--
-- @since 0.2.0.0
{-# INLINE fromMonoFoldable' #-}
fromMonoFoldable' :: (WriteVectorElement a, MonoFoldable mono, Element mono ~ a) => mono -> WriteVector a
fromMonoFoldable' :: forall a mono.
(WriteVectorElement a, MonoFoldable mono, Element mono ~ a) =>
mono -> WriteVector a
fromMonoFoldable' mono
xs = Int32 -> mono -> WriteVector a
forall mono.
(MonoFoldable mono, Element mono ~ a) =>
Int32 -> mono -> WriteVector a
forall a mono.
(WriteVectorElement a, MonoFoldable mono, Element mono ~ a) =>
Int32 -> mono -> WriteVector a
fromMonoFoldable (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ mono -> Int
forall mono. MonoFoldable mono => mono -> Int
Mono.olength mono
xs) mono
xs

-- | `fromMonoFoldable` specialized to list
fromList :: WriteVectorElement a => Int32 -> [a] -> WriteVector a
fromList :: forall a. WriteVectorElement a => Int32 -> [a] -> WriteVector a
fromList = Int32 -> [a] -> WriteVector a
forall mono.
(MonoFoldable mono, Element mono ~ a) =>
Int32 -> mono -> WriteVector a
forall a mono.
(WriteVectorElement a, MonoFoldable mono, Element mono ~ a) =>
Int32 -> mono -> WriteVector a
fromMonoFoldable

-- | `fromMonoFoldable'` specialized to list
fromList' :: WriteVectorElement a => [a] -> WriteVector a
fromList' :: forall a. WriteVectorElement a => [a] -> WriteVector a
fromList' = [a] -> WriteVector a
forall a mono.
(WriteVectorElement a, MonoFoldable mono, Element mono ~ a) =>
mono -> WriteVector a
fromMonoFoldable'

-- | Creates a flatbuffers vector with a single element
singleton :: WriteVectorElement a => a -> WriteVector a
singleton :: forall a. WriteVectorElement a => a -> WriteVector a
singleton a
a = Int32 -> [a] -> WriteVector a
forall a. WriteVectorElement a => Int32 -> [a] -> WriteVector a
fromList Int32
1 [a
a]

-- | Creates an empty flatbuffers vector
empty :: WriteVectorElement a => WriteVector a
empty :: forall a. WriteVectorElement a => WriteVector a
empty = Int32 -> [a] -> WriteVector a
forall a. WriteVectorElement a => Int32 -> [a] -> WriteVector a
fromList Int32
0 []


newtype FromFoldable f a = FromFoldable (f a)
  deriving newtype (forall m. Monoid m => FromFoldable f m -> m)
-> (forall m a. Monoid m => (a -> m) -> FromFoldable f a -> m)
-> (forall m a. Monoid m => (a -> m) -> FromFoldable f a -> m)
-> (forall a b. (a -> b -> b) -> b -> FromFoldable f a -> b)
-> (forall a b. (a -> b -> b) -> b -> FromFoldable f a -> b)
-> (forall b a. (b -> a -> b) -> b -> FromFoldable f a -> b)
-> (forall b a. (b -> a -> b) -> b -> FromFoldable f a -> b)
-> (forall a. (a -> a -> a) -> FromFoldable f a -> a)
-> (forall a. (a -> a -> a) -> FromFoldable f a -> a)
-> (forall a. FromFoldable f a -> [a])
-> (forall a. FromFoldable f a -> Bool)
-> (forall a. FromFoldable f a -> Int)
-> (forall a. Eq a => a -> FromFoldable f a -> Bool)
-> (forall a. Ord a => FromFoldable f a -> a)
-> (forall a. Ord a => FromFoldable f a -> a)
-> (forall a. Num a => FromFoldable f a -> a)
-> (forall a. Num a => FromFoldable f a -> a)
-> Foldable (FromFoldable f)
forall a. Eq a => a -> FromFoldable f a -> Bool
forall a. Num a => FromFoldable f a -> a
forall a. Ord a => FromFoldable f a -> a
forall m. Monoid m => FromFoldable f m -> m
forall a. FromFoldable f a -> Bool
forall a. FromFoldable f a -> Int
forall a. FromFoldable f a -> [a]
forall a. (a -> a -> a) -> FromFoldable f a -> a
forall m a. Monoid m => (a -> m) -> FromFoldable f a -> m
forall b a. (b -> a -> b) -> b -> FromFoldable f a -> b
forall a b. (a -> b -> b) -> b -> FromFoldable f a -> b
forall (f :: * -> *) a.
(Foldable f, Eq a) =>
a -> FromFoldable f a -> Bool
forall (f :: * -> *) a.
(Foldable f, Num a) =>
FromFoldable f a -> a
forall (f :: * -> *) a.
(Foldable f, Ord a) =>
FromFoldable f a -> a
forall (f :: * -> *) m.
(Foldable f, Monoid m) =>
FromFoldable f m -> m
forall (f :: * -> *) a. Foldable f => FromFoldable f a -> Bool
forall (f :: * -> *) a. Foldable f => FromFoldable f a -> Int
forall (f :: * -> *) a. Foldable f => FromFoldable f a -> [a]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> FromFoldable f a -> a
forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> FromFoldable f a -> m
forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> FromFoldable f a -> b
forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> FromFoldable f a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall (f :: * -> *) m.
(Foldable f, Monoid m) =>
FromFoldable f m -> m
fold :: forall m. Monoid m => FromFoldable f m -> m
$cfoldMap :: forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> FromFoldable f a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> FromFoldable f a -> m
$cfoldMap' :: forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> FromFoldable f a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> FromFoldable f a -> m
$cfoldr :: forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> FromFoldable f a -> b
foldr :: forall a b. (a -> b -> b) -> b -> FromFoldable f a -> b
$cfoldr' :: forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> FromFoldable f a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> FromFoldable f a -> b
$cfoldl :: forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> FromFoldable f a -> b
foldl :: forall b a. (b -> a -> b) -> b -> FromFoldable f a -> b
$cfoldl' :: forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> FromFoldable f a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> FromFoldable f a -> b
$cfoldr1 :: forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> FromFoldable f a -> a
foldr1 :: forall a. (a -> a -> a) -> FromFoldable f a -> a
$cfoldl1 :: forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> FromFoldable f a -> a
foldl1 :: forall a. (a -> a -> a) -> FromFoldable f a -> a
$ctoList :: forall (f :: * -> *) a. Foldable f => FromFoldable f a -> [a]
toList :: forall a. FromFoldable f a -> [a]
$cnull :: forall (f :: * -> *) a. Foldable f => FromFoldable f a -> Bool
null :: forall a. FromFoldable f a -> Bool
$clength :: forall (f :: * -> *) a. Foldable f => FromFoldable f a -> Int
length :: forall a. FromFoldable f a -> Int
$celem :: forall (f :: * -> *) a.
(Foldable f, Eq a) =>
a -> FromFoldable f a -> Bool
elem :: forall a. Eq a => a -> FromFoldable f a -> Bool
$cmaximum :: forall (f :: * -> *) a.
(Foldable f, Ord a) =>
FromFoldable f a -> a
maximum :: forall a. Ord a => FromFoldable f a -> a
$cminimum :: forall (f :: * -> *) a.
(Foldable f, Ord a) =>
FromFoldable f a -> a
minimum :: forall a. Ord a => FromFoldable f a -> a
$csum :: forall (f :: * -> *) a.
(Foldable f, Num a) =>
FromFoldable f a -> a
sum :: forall a. Num a => FromFoldable f a -> a
$cproduct :: forall (f :: * -> *) a.
(Foldable f, Num a) =>
FromFoldable f a -> a
product :: forall a. Num a => FromFoldable f a -> a
Foldable

type instance Element (FromFoldable f a) = a
instance Foldable f => MonoFoldable (FromFoldable f a)

-- | `fromMonoFoldable` for types that implement `Foldable` but not `MonoFoldable`.
fromFoldable :: (WriteVectorElement a, Foldable f) => Int32 -> f a -> WriteVector a
fromFoldable :: forall a (f :: * -> *).
(WriteVectorElement a, Foldable f) =>
Int32 -> f a -> WriteVector a
fromFoldable Int32
n = Int32 -> FromFoldable f a -> WriteVector a
forall mono.
(MonoFoldable mono, Element mono ~ a) =>
Int32 -> mono -> WriteVector a
forall a mono.
(WriteVectorElement a, MonoFoldable mono, Element mono ~ a) =>
Int32 -> mono -> WriteVector a
fromMonoFoldable Int32
n (FromFoldable f a -> WriteVector a)
-> (f a -> FromFoldable f a) -> f a -> WriteVector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> FromFoldable f a
forall (f :: * -> *) a. f a -> FromFoldable f a
FromFoldable

-- | `fromMonoFoldable'` for types that implement `Foldable` but not `MonoFoldable`.
fromFoldable' :: (WriteVectorElement a, Foldable f) => f a -> WriteVector a
fromFoldable' :: forall a (f :: * -> *).
(WriteVectorElement a, Foldable f) =>
f a -> WriteVector a
fromFoldable' = FromFoldable f a -> WriteVector a
forall a mono.
(WriteVectorElement a, MonoFoldable mono, Element mono ~ a) =>
mono -> WriteVector a
fromMonoFoldable' (FromFoldable f a -> WriteVector a)
-> (f a -> FromFoldable f a) -> f a -> WriteVector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> FromFoldable f a
forall (f :: * -> *) a. f a -> FromFoldable f a
FromFoldable

-- | Efficiently creates a vector from a `BS.ByteString`.
-- Large `BS.ByteString`s are inserted directly, but small ones are copied to ensure that the generated chunks are large on average.
--
-- @since 0.2.0.0
fromByteString :: BS.ByteString -> WriteVector Word8
fromByteString :: ByteString -> WriteVector Word8
fromByteString ByteString
bs = WriteTableField -> WriteVector Word8
WriteVectorWord8 (WriteTableField -> WriteVector Word8)
-> (State FBState (FBState -> FBState) -> WriteTableField)
-> State FBState (FBState -> FBState)
-> WriteVector Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State FBState (FBState -> FBState) -> WriteTableField
WriteTableField (State FBState (FBState -> FBState) -> WriteVector Word8)
-> State FBState (FBState -> FBState) -> WriteVector Word8
forall a b. (a -> b) -> a -> b
$ do
  (FBState -> FBState) -> State FBState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((FBState -> FBState) -> State FBState ())
-> (FBState -> FBState) -> State FBState ()
forall a b. (a -> b) -> a -> b
$!
    Int32 -> FBState -> FBState
writeInt32 Int32
len (FBState -> FBState) -> (FBState -> FBState) -> FBState -> FBState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FBState -> FBState
writeByteString (FBState -> FBState) -> (FBState -> FBState) -> FBState -> FBState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alignment -> Int32 -> FBState -> FBState
alignTo Alignment
forall a. Num a => a
int32Size Int32
len
  State FBState (FBState -> FBState)
uoffsetFromHere
  where
    len :: Int32
len = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Int32 (ByteString -> Int
BS.length ByteString
bs)
    writeByteString :: FBState -> FBState
writeByteString FBState
fbs =
      FBState
fbs
        { builder = B.byteString bs <> builder fbs
        , bufferSize = bufferSize fbs <> Sum len
        }

-- | Efficiently creates a vector from a lazy `BSL.ByteString`.
--  Large chunks of the `BSL.ByteString` are inserted directly, but small ones are copied to ensure that the generated chunks are large on average.
--
-- @since 0.2.0.0
fromLazyByteString :: BSL.ByteString -> WriteVector Word8
fromLazyByteString :: ByteString -> WriteVector Word8
fromLazyByteString ByteString
bs = WriteTableField -> WriteVector Word8
WriteVectorWord8 (WriteTableField -> WriteVector Word8)
-> (State FBState (FBState -> FBState) -> WriteTableField)
-> State FBState (FBState -> FBState)
-> WriteVector Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State FBState (FBState -> FBState) -> WriteTableField
WriteTableField (State FBState (FBState -> FBState) -> WriteVector Word8)
-> State FBState (FBState -> FBState) -> WriteVector Word8
forall a b. (a -> b) -> a -> b
$ do
  (FBState -> FBState) -> State FBState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((FBState -> FBState) -> State FBState ())
-> (FBState -> FBState) -> State FBState ()
forall a b. (a -> b) -> a -> b
$!
    Int32 -> FBState -> FBState
writeInt32 Int32
len (FBState -> FBState) -> (FBState -> FBState) -> FBState -> FBState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FBState -> FBState
writeByteString (FBState -> FBState) -> (FBState -> FBState) -> FBState -> FBState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alignment -> Int32 -> FBState -> FBState
alignTo Alignment
forall a. Num a => a
int32Size Int32
len
  State FBState (FBState -> FBState)
uoffsetFromHere
  where
    len :: Int32
len = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int64 @Int32 (ByteString -> Int64
BSL.length ByteString
bs)
    writeByteString :: FBState -> FBState
writeByteString FBState
fbs =
      FBState
fbs
        { builder = B.lazyByteString bs <> builder fbs
        , bufferSize = bufferSize fbs <> Sum len
        }

{-# INLINE inlineVector #-}
inlineVector ::
     (MonoFoldable mono, Element mono ~ a)
  => (a -> Builder)
  -> Alignment
  -> InlineSize
  -> Int32
  -> mono
  -> WriteTableField
inlineVector :: forall mono a.
(MonoFoldable mono, Element mono ~ a) =>
(a -> Builder)
-> Alignment -> InlineSize -> Int32 -> mono -> WriteTableField
inlineVector a -> Builder
build Alignment
elemAlignment InlineSize
elemSize Int32
elemCount mono
elems = State FBState (FBState -> FBState) -> WriteTableField
WriteTableField (State FBState (FBState -> FBState) -> WriteTableField)
-> State FBState (FBState -> FBState) -> WriteTableField
forall a b. (a -> b) -> a -> b
$ do
  (FBState -> FBState) -> State FBState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((FBState -> FBState) -> State FBState ())
-> (FBState -> FBState) -> State FBState ()
forall a b. (a -> b) -> a -> b
$!
    Int32 -> FBState -> FBState
writeInt32 Int32
elemCount (FBState -> FBState) -> (FBState -> FBState) -> FBState -> FBState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FBState -> FBState
writeVec (FBState -> FBState) -> (FBState -> FBState) -> FBState -> FBState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alignment -> Int32 -> FBState -> FBState
alignTo (Alignment -> Alignment
forall a b. Coercible a b => a -> b
coerce Alignment
elemAlignment Alignment -> Alignment -> Alignment
forall a. Ord a => a -> a -> a
`max` Alignment
forall a. Num a => a
int32Size) Int32
vecByteLength

  State FBState (FBState -> FBState)
uoffsetFromHere
  where
    vecByteLength :: Int32
vecByteLength = Int32
elemCount Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral @InlineSize @Int32 InlineSize
elemSize
    vecBuilder :: Builder
vecBuilder = (Element mono -> Builder -> Builder) -> Builder -> mono -> Builder
forall mono b.
MonoFoldable mono =>
(Element mono -> b -> b) -> b -> mono -> b
forall b. (Element mono -> b -> b) -> b -> mono -> b
Mono.ofoldr (\Element mono
a Builder
b -> a -> Builder
build a
Element mono
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b) Builder
forall a. Monoid a => a
mempty mono
elems
    writeVec :: FBState -> FBState
writeVec FBState
fbs =
      FBState
fbs
        { builder = vecBuilder <> builder fbs
        , bufferSize = bufferSize fbs <> Sum vecByteLength
        }

instance WriteVectorElement Word8 where
  newtype WriteVector Word8 = WriteVectorWord8 { WriteVector Word8 -> WriteTableField
writeVectorWord8TableField :: WriteTableField }

  {-# INLINE fromMonoFoldable #-}
  fromMonoFoldable :: (MonoFoldable mono, Element mono ~ Word8) => Int32 -> mono -> WriteVector Word8
  fromMonoFoldable :: forall mono.
(MonoFoldable mono, Element mono ~ Word8) =>
Int32 -> mono -> WriteVector Word8
fromMonoFoldable Int32
n = WriteTableField -> WriteVector Word8
WriteVectorWord8 (WriteTableField -> WriteVector Word8)
-> (mono -> WriteTableField) -> mono -> WriteVector Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Builder)
-> Alignment -> InlineSize -> Int32 -> mono -> WriteTableField
forall mono a.
(MonoFoldable mono, Element mono ~ a) =>
(a -> Builder)
-> Alignment -> InlineSize -> Int32 -> mono -> WriteTableField
inlineVector Word8 -> Builder
B.word8 Alignment
forall a. Num a => a
word8Size InlineSize
forall a. Num a => a
word8Size Int32
n

instance WriteVectorElement Word16 where
  newtype WriteVector Word16 = WriteVectorWord16 { WriteVector Word16 -> WriteTableField
writeVectorWord16TableField :: WriteTableField }

  {-# INLINE fromMonoFoldable #-}
  fromMonoFoldable :: (MonoFoldable mono, Element mono ~ Word16) => Int32 -> mono -> WriteVector Word16
  fromMonoFoldable :: forall mono.
(MonoFoldable mono, Element mono ~ Word16) =>
Int32 -> mono -> WriteVector Word16
fromMonoFoldable Int32
n = WriteTableField -> WriteVector Word16
WriteVectorWord16 (WriteTableField -> WriteVector Word16)
-> (mono -> WriteTableField) -> mono -> WriteVector Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word16 -> Builder)
-> Alignment -> InlineSize -> Int32 -> mono -> WriteTableField
forall mono a.
(MonoFoldable mono, Element mono ~ a) =>
(a -> Builder)
-> Alignment -> InlineSize -> Int32 -> mono -> WriteTableField
inlineVector Word16 -> Builder
B.word16LE Alignment
forall a. Num a => a
word16Size InlineSize
forall a. Num a => a
word16Size Int32
n

instance WriteVectorElement Word32 where
  newtype WriteVector Word32 = WriteVectorWord32 { WriteVector Word32 -> WriteTableField
writeVectorWord32TableField :: WriteTableField }

  {-# INLINE fromMonoFoldable #-}
  fromMonoFoldable :: (MonoFoldable mono, Element mono ~ Word32) => Int32 -> mono -> WriteVector Word32
  fromMonoFoldable :: forall mono.
(MonoFoldable mono, Element mono ~ Word32) =>
Int32 -> mono -> WriteVector Word32
fromMonoFoldable Int32
n = WriteTableField -> WriteVector Word32
WriteVectorWord32 (WriteTableField -> WriteVector Word32)
-> (mono -> WriteTableField) -> mono -> WriteVector Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32 -> Builder)
-> Alignment -> InlineSize -> Int32 -> mono -> WriteTableField
forall mono a.
(MonoFoldable mono, Element mono ~ a) =>
(a -> Builder)
-> Alignment -> InlineSize -> Int32 -> mono -> WriteTableField
inlineVector Word32 -> Builder
B.word32LE Alignment
forall a. Num a => a
word32Size InlineSize
forall a. Num a => a
word32Size Int32
n

instance WriteVectorElement Word64 where
  newtype WriteVector Word64 = WriteVectorWord64 { WriteVector Word64 -> WriteTableField
writeVectorWord64TableField :: WriteTableField }

  {-# INLINE fromMonoFoldable #-}
  fromMonoFoldable :: (MonoFoldable mono, Element mono ~ Word64) => Int32 -> mono -> WriteVector Word64
  fromMonoFoldable :: forall mono.
(MonoFoldable mono, Element mono ~ Word64) =>
Int32 -> mono -> WriteVector Word64
fromMonoFoldable Int32
n = WriteTableField -> WriteVector Word64
WriteVectorWord64 (WriteTableField -> WriteVector Word64)
-> (mono -> WriteTableField) -> mono -> WriteVector Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Builder)
-> Alignment -> InlineSize -> Int32 -> mono -> WriteTableField
forall mono a.
(MonoFoldable mono, Element mono ~ a) =>
(a -> Builder)
-> Alignment -> InlineSize -> Int32 -> mono -> WriteTableField
inlineVector Word64 -> Builder
B.word64LE Alignment
forall a. Num a => a
word64Size InlineSize
forall a. Num a => a
word64Size Int32
n

instance WriteVectorElement Int8 where
  newtype WriteVector Int8 = WriteVectorInt8 { WriteVector Int8 -> WriteTableField
writeVectorInt8TableField :: WriteTableField }

  {-# INLINE fromMonoFoldable #-}
  fromMonoFoldable :: (MonoFoldable mono, Element mono ~ Int8) => Int32 -> mono -> WriteVector Int8
  fromMonoFoldable :: forall mono.
(MonoFoldable mono, Element mono ~ Int8) =>
Int32 -> mono -> WriteVector Int8
fromMonoFoldable Int32
n = WriteTableField -> WriteVector Int8
WriteVectorInt8 (WriteTableField -> WriteVector Int8)
-> (mono -> WriteTableField) -> mono -> WriteVector Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int8 -> Builder)
-> Alignment -> InlineSize -> Int32 -> mono -> WriteTableField
forall mono a.
(MonoFoldable mono, Element mono ~ a) =>
(a -> Builder)
-> Alignment -> InlineSize -> Int32 -> mono -> WriteTableField
inlineVector Int8 -> Builder
B.int8 Alignment
forall a. Num a => a
int8Size InlineSize
forall a. Num a => a
int8Size Int32
n

instance WriteVectorElement Int16 where
  newtype WriteVector Int16 = WriteVectorInt16 { WriteVector Int16 -> WriteTableField
writeVectorInt16TableField :: WriteTableField }

  {-# INLINE fromMonoFoldable #-}
  fromMonoFoldable :: (MonoFoldable mono, Element mono ~ Int16) => Int32 -> mono -> WriteVector Int16
  fromMonoFoldable :: forall mono.
(MonoFoldable mono, Element mono ~ Int16) =>
Int32 -> mono -> WriteVector Int16
fromMonoFoldable Int32
n = WriteTableField -> WriteVector Int16
WriteVectorInt16 (WriteTableField -> WriteVector Int16)
-> (mono -> WriteTableField) -> mono -> WriteVector Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int16 -> Builder)
-> Alignment -> InlineSize -> Int32 -> mono -> WriteTableField
forall mono a.
(MonoFoldable mono, Element mono ~ a) =>
(a -> Builder)
-> Alignment -> InlineSize -> Int32 -> mono -> WriteTableField
inlineVector Int16 -> Builder
B.int16LE Alignment
forall a. Num a => a
int16Size InlineSize
forall a. Num a => a
int16Size Int32
n

instance WriteVectorElement Int32 where
  newtype WriteVector Int32 = WriteVectorInt32 { WriteVector Int32 -> WriteTableField
writeVectorInt32TableField :: WriteTableField }

  {-# INLINE fromMonoFoldable #-}
  fromMonoFoldable :: (MonoFoldable mono, Element mono ~ Int32) => Int32 -> mono -> WriteVector Int32
  fromMonoFoldable :: forall mono.
(MonoFoldable mono, Element mono ~ Int32) =>
Int32 -> mono -> WriteVector Int32
fromMonoFoldable Int32
n = WriteTableField -> WriteVector Int32
WriteVectorInt32 (WriteTableField -> WriteVector Int32)
-> (mono -> WriteTableField) -> mono -> WriteVector Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int32 -> Builder)
-> Alignment -> InlineSize -> Int32 -> mono -> WriteTableField
forall mono a.
(MonoFoldable mono, Element mono ~ a) =>
(a -> Builder)
-> Alignment -> InlineSize -> Int32 -> mono -> WriteTableField
inlineVector Int32 -> Builder
B.int32LE Alignment
forall a. Num a => a
int32Size InlineSize
forall a. Num a => a
int32Size Int32
n

instance WriteVectorElement Int64 where
  newtype WriteVector Int64 = WriteVectorInt64 { WriteVector Int64 -> WriteTableField
writeVectorInt64TableField :: WriteTableField }

  {-# INLINE fromMonoFoldable #-}
  fromMonoFoldable :: (MonoFoldable mono, Element mono ~ Int64) => Int32 -> mono -> WriteVector Int64
  fromMonoFoldable :: forall mono.
(MonoFoldable mono, Element mono ~ Int64) =>
Int32 -> mono -> WriteVector Int64
fromMonoFoldable Int32
n = WriteTableField -> WriteVector Int64
WriteVectorInt64 (WriteTableField -> WriteVector Int64)
-> (mono -> WriteTableField) -> mono -> WriteVector Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64 -> Builder)
-> Alignment -> InlineSize -> Int32 -> mono -> WriteTableField
forall mono a.
(MonoFoldable mono, Element mono ~ a) =>
(a -> Builder)
-> Alignment -> InlineSize -> Int32 -> mono -> WriteTableField
inlineVector Int64 -> Builder
B.int64LE Alignment
forall a. Num a => a
int64Size InlineSize
forall a. Num a => a
int64Size Int32
n

instance WriteVectorElement Float where
  newtype WriteVector Float = WriteVectorFloat { WriteVector Float -> WriteTableField
writeVectorFloatTableField :: WriteTableField }

  {-# INLINE fromMonoFoldable #-}
  fromMonoFoldable :: (MonoFoldable mono, Element mono ~ Float) => Int32 -> mono -> WriteVector Float
  fromMonoFoldable :: forall mono.
(MonoFoldable mono, Element mono ~ Float) =>
Int32 -> mono -> WriteVector Float
fromMonoFoldable Int32
n = WriteTableField -> WriteVector Float
WriteVectorFloat (WriteTableField -> WriteVector Float)
-> (mono -> WriteTableField) -> mono -> WriteVector Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> Builder)
-> Alignment -> InlineSize -> Int32 -> mono -> WriteTableField
forall mono a.
(MonoFoldable mono, Element mono ~ a) =>
(a -> Builder)
-> Alignment -> InlineSize -> Int32 -> mono -> WriteTableField
inlineVector Float -> Builder
B.floatLE Alignment
forall a. Num a => a
floatSize InlineSize
forall a. Num a => a
floatSize Int32
n

instance WriteVectorElement Double where
  newtype WriteVector Double = WriteVectorDouble { WriteVector Double -> WriteTableField
writeVectorDoubleTableField :: WriteTableField }

  {-# INLINE fromMonoFoldable #-}
  fromMonoFoldable :: (MonoFoldable mono, Element mono ~ Double) => Int32 -> mono -> WriteVector Double
  fromMonoFoldable :: forall mono.
(MonoFoldable mono, Element mono ~ Double) =>
Int32 -> mono -> WriteVector Double
fromMonoFoldable Int32
n = WriteTableField -> WriteVector Double
WriteVectorDouble (WriteTableField -> WriteVector Double)
-> (mono -> WriteTableField) -> mono -> WriteVector Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Builder)
-> Alignment -> InlineSize -> Int32 -> mono -> WriteTableField
forall mono a.
(MonoFoldable mono, Element mono ~ a) =>
(a -> Builder)
-> Alignment -> InlineSize -> Int32 -> mono -> WriteTableField
inlineVector Double -> Builder
B.doubleLE Alignment
forall a. Num a => a
doubleSize InlineSize
forall a. Num a => a
doubleSize Int32
n

instance WriteVectorElement Bool where
  newtype WriteVector Bool = WriteVectorBool { WriteVector Bool -> WriteTableField
writeVectorBoolTableField :: WriteTableField }

  {-# INLINE fromMonoFoldable #-}
  fromMonoFoldable :: (MonoFoldable mono, Element mono ~ Bool) => Int32 -> mono -> WriteVector Bool
  fromMonoFoldable :: forall mono.
(MonoFoldable mono, Element mono ~ Bool) =>
Int32 -> mono -> WriteVector Bool
fromMonoFoldable Int32
n = WriteTableField -> WriteVector Bool
WriteVectorBool (WriteTableField -> WriteVector Bool)
-> (mono -> WriteTableField) -> mono -> WriteVector Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Builder)
-> Alignment -> InlineSize -> Int32 -> mono -> WriteTableField
forall mono a.
(MonoFoldable mono, Element mono ~ a) =>
(a -> Builder)
-> Alignment -> InlineSize -> Int32 -> mono -> WriteTableField
inlineVector (Word8 -> Builder
B.word8 (Word8 -> Builder) -> (Bool -> Word8) -> Bool -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Word8
boolToWord8) Alignment
forall a. Num a => a
word8Size InlineSize
forall a. Num a => a
word8Size Int32
n

instance IsStruct a => WriteVectorElement (WriteStruct a) where
  newtype WriteVector (WriteStruct a) = WriteVectorStruct { forall a. WriteVector (WriteStruct a) -> WriteTableField
writeVectorStructTableField :: WriteTableField }

  {-# INLINE fromMonoFoldable #-}
  fromMonoFoldable :: (MonoFoldable mono, Element mono ~ WriteStruct a) => Int32 -> mono -> WriteVector (WriteStruct a)
  fromMonoFoldable :: forall mono.
(MonoFoldable mono, Element mono ~ WriteStruct a) =>
Int32 -> mono -> WriteVector (WriteStruct a)
fromMonoFoldable Int32
n = WriteTableField -> WriteVector (WriteStruct a)
forall a. WriteTableField -> WriteVector (WriteStruct a)
WriteVectorStruct (WriteTableField -> WriteVector (WriteStruct a))
-> (mono -> WriteTableField) -> mono -> WriteVector (WriteStruct a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WriteStruct a -> Builder)
-> Alignment -> InlineSize -> Int32 -> mono -> WriteTableField
forall mono a.
(MonoFoldable mono, Element mono ~ a) =>
(a -> Builder)
-> Alignment -> InlineSize -> Int32 -> mono -> WriteTableField
inlineVector WriteStruct a -> Builder
forall a b. Coercible a b => a -> b
coerce (forall a. IsStruct a => Alignment
structAlignmentOf @a) (forall a. IsStruct a => InlineSize
structSizeOf @a) Int32
n


data TextInfos = TextInfos ![TextInfo] {-# UNPACK #-} !BufferSize

data TextInfo = TextInfo
  { TextInfo -> Text
tiText     :: !Text
  , TextInfo -> Int32
tiUtf8len  :: {-# UNPACK #-} !Int32
  , TextInfo -> Int32
tiPadding  :: {-# UNPACK #-} !Int32
  , TextInfo -> Int32
tiPosition :: {-# UNPACK #-} !Position
  }

data OffsetInfo = OffsetInfo
  { OffsetInfo -> Int32
oiIndex   :: {-# UNPACK #-} !Int32
  , OffsetInfo -> [Int32]
oiOffsets :: ![Int32]
  }

instance WriteVectorElement Text where
  newtype WriteVector Text = WriteVectorText { WriteVector Text -> WriteTableField
writeVectorTextTableField :: WriteTableField }

  {-# INLINE fromMonoFoldable #-}
  fromMonoFoldable :: (MonoFoldable mono, Element mono ~ Text) => Int32 -> mono -> WriteVector Text
  fromMonoFoldable :: forall mono.
(MonoFoldable mono, Element mono ~ Text) =>
Int32 -> mono -> WriteVector Text
fromMonoFoldable Int32
elemCount mono
texts = WriteTableField -> WriteVector Text
WriteVectorText (WriteTableField -> WriteVector Text)
-> (State FBState (FBState -> FBState) -> WriteTableField)
-> State FBState (FBState -> FBState)
-> WriteVector Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State FBState (FBState -> FBState) -> WriteTableField
WriteTableField (State FBState (FBState -> FBState) -> WriteVector Text)
-> State FBState (FBState -> FBState) -> WriteVector Text
forall a b. (a -> b) -> a -> b
$ do
    (FBState -> FBState) -> State FBState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' ((FBState -> FBState) -> State FBState ())
-> (FBState -> FBState) -> State FBState ()
forall a b. (a -> b) -> a -> b
$ \FBState
fbs ->
      let (Builder
builder2, BufferSize
bsize2) =
            (Builder, BufferSize) -> (Builder, BufferSize)
writeVectorSizePrefix ((Builder, BufferSize) -> (Builder, BufferSize))
-> ((Builder, BufferSize) -> (Builder, BufferSize))
-> (Builder, BufferSize)
-> (Builder, BufferSize)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder, BufferSize, [TextInfo]) -> (Builder, BufferSize)
writeOffsets ((Builder, BufferSize, [TextInfo]) -> (Builder, BufferSize))
-> ((Builder, BufferSize) -> (Builder, BufferSize, [TextInfo]))
-> (Builder, BufferSize)
-> (Builder, BufferSize)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder, BufferSize, [TextInfo])
-> (Builder, BufferSize, [TextInfo])
align ((Builder, BufferSize, [TextInfo])
 -> (Builder, BufferSize, [TextInfo]))
-> ((Builder, BufferSize) -> (Builder, BufferSize, [TextInfo]))
-> (Builder, BufferSize)
-> (Builder, BufferSize, [TextInfo])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder, BufferSize) -> (Builder, BufferSize, [TextInfo])
writeStrings ((Builder, BufferSize) -> (Builder, BufferSize))
-> (Builder, BufferSize) -> (Builder, BufferSize)
forall a b. (a -> b) -> a -> b
$ (FBState -> Builder
builder FBState
fbs, FBState -> BufferSize
bufferSize FBState
fbs)
      in  FBState
fbs
            { builder = builder2
            , bufferSize = bsize2
            , maxAlign = maxAlign fbs <> Max int32Size
            }
    State FBState (FBState -> FBState)
uoffsetFromHere
    where
      writeStrings :: (Builder, BufferSize) -> (Builder, BufferSize, [TextInfo])
      writeStrings :: (Builder, BufferSize) -> (Builder, BufferSize, [TextInfo])
writeStrings (Builder
builder1, BufferSize
bsize1) =
          -- Collect info about the strings.
          -- NOTE: this loop *could* be merged with the one below, but
          -- we have loops dedicated to merging Builders to avoid wrapping Builders in data structures.
          -- See "Performance tips": http://hackage.haskell.org/package/fast-builder-0.1.0.1/docs/Data-ByteString-FastBuilder.html
        let TextInfos [TextInfo]
textInfos BufferSize
bsize2 =
              (Element mono -> TextInfos -> TextInfos)
-> TextInfos -> mono -> TextInfos
forall mono b.
MonoFoldable mono =>
(Element mono -> b -> b) -> b -> mono -> b
forall b. (Element mono -> b -> b) -> b -> mono -> b
Mono.ofoldr
                (\Element mono
t (TextInfos [TextInfo]
infos BufferSize
bsize) ->
                  let textLength :: Int32
textLength = Text -> Int32
utf8length Text
Element mono
t
                      padding :: Int32
padding = Alignment -> Int32 -> BufferSize -> Int32
calcPadding Alignment
4 (Int32
textLength Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
1) BufferSize
bsize
                      newBsize :: BufferSize
newBsize = BufferSize
bsize BufferSize -> BufferSize -> BufferSize
forall a. Semigroup a => a -> a -> a
<> Int32 -> BufferSize
forall a. a -> Sum a
Sum (Int32
padding Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
textLength Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
1 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
4)
                  in  [TextInfo] -> BufferSize -> TextInfos
TextInfos (Text -> Int32 -> Int32 -> Int32 -> TextInfo
TextInfo Text
Element mono
t Int32
textLength Int32
padding (BufferSize -> Int32
forall a. Sum a -> a
getSum BufferSize
newBsize) TextInfo -> [TextInfo] -> [TextInfo]
forall a. a -> [a] -> [a]
: [TextInfo]
infos) BufferSize
newBsize
                )
                ([TextInfo] -> BufferSize -> TextInfos
TextInfos [] BufferSize
bsize1)
                mono
texts

            builder2 :: Builder
builder2 =
              (TextInfo -> Builder -> Builder)
-> Builder -> [TextInfo] -> Builder
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
                (\(TextInfo Text
t Int32
tlength Int32
padding Int32
_) Builder
b ->
                  Int32 -> Builder
B.int32LE Int32
tlength
                  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
T.encodeUtf8Builder Text
t
                  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
B.word8 Word8
0 -- strings must have a trailing zero
                  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int32 -> Builder
buildPadding Int32
padding
                  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b
                )
                Builder
forall a. Monoid a => a
mempty
                [TextInfo]
textInfos
        in (Builder
builder2 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
builder1, BufferSize
bsize2, [TextInfo]
textInfos)

      align :: (Builder, BufferSize, [TextInfo]) -> (Builder, BufferSize, [TextInfo])
      align :: (Builder, BufferSize, [TextInfo])
-> (Builder, BufferSize, [TextInfo])
align (Builder
builder1, BufferSize
bsize1, [TextInfo]
textInfos) =
        let vectorPadding :: Int32
vectorPadding = Alignment -> Int32 -> BufferSize -> Int32
calcPadding Alignment
forall a. Num a => a
int32Size Int32
0 BufferSize
bsize1
            bsize2 :: BufferSize
bsize2 = BufferSize
bsize1 BufferSize -> BufferSize -> BufferSize
forall a. Semigroup a => a -> a -> a
<> Int32 -> BufferSize
forall a. a -> Sum a
Sum Int32
vectorPadding
            builder2 :: Builder
builder2 = Int32 -> Builder
buildPadding Int32
vectorPadding
        in  (Builder
builder2 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
builder1, BufferSize
bsize2, [TextInfo]
textInfos)

      writeOffsets :: (Builder, BufferSize, [TextInfo]) -> (Builder, BufferSize)
      writeOffsets :: (Builder, BufferSize, [TextInfo]) -> (Builder, BufferSize)
writeOffsets (Builder
builder1, BufferSize
bsize1, [TextInfo]
textInfos) =
        let OffsetInfo Int32
_ [Int32]
offsets =
              (TextInfo -> OffsetInfo -> OffsetInfo)
-> OffsetInfo -> [TextInfo] -> OffsetInfo
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
                (\(TextInfo Text
_ Int32
_ Int32
_ Int32
position) (OffsetInfo Int32
ix [Int32]
os) ->
                  Int32 -> [Int32] -> OffsetInfo
OffsetInfo
                    (Int32
ix Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
1)
                    (BufferSize -> Int32
forall a. Sum a -> a
getSum BufferSize
bsize1 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ (Int32
ix Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
4) Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
4 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
position Int32 -> [Int32] -> [Int32]
forall a. a -> [a] -> [a]
: [Int32]
os)
                )
                (Int32 -> [Int32] -> OffsetInfo
OffsetInfo Int32
0 [])
                [TextInfo]
textInfos

            bsize2 :: BufferSize
bsize2 = BufferSize
bsize1 BufferSize -> BufferSize -> BufferSize
forall a. Semigroup a => a -> a -> a
<> Int32 -> BufferSize
forall a. a -> Sum a
Sum (Int32
elemCount Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
4)
            builder2 :: Builder
builder2 =
              (Int32 -> Builder -> Builder) -> Builder -> [Int32] -> Builder
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
                (\Int32
o Builder
b -> Int32 -> Builder
B.int32LE Int32
o Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b)
                Builder
forall a. Monoid a => a
mempty
                [Int32]
offsets
        in  (Builder
builder2 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
builder1, BufferSize
bsize2)

      writeVectorSizePrefix :: (Builder, BufferSize) -> (Builder, BufferSize)
      writeVectorSizePrefix :: (Builder, BufferSize) -> (Builder, BufferSize)
writeVectorSizePrefix (Builder
builder1, BufferSize
bsize1) =
        (Int32 -> Builder
B.int32LE Int32
elemCount Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
builder1, BufferSize
bsize1 BufferSize -> BufferSize -> BufferSize
forall a. Num a => a -> a -> a
+ BufferSize
forall a. Num a => a
int32Size)



data TableInfo = TableInfo
  { TableInfo -> FBState
tiState          :: !FBState
  , TableInfo -> [Int32]
tiTablePositions :: ![Position]
  }

instance WriteVectorElement (WriteTable a) where
  newtype WriteVector (WriteTable a) = WriteVectorTable { forall a. WriteVector (WriteTable a) -> WriteTableField
writeVectorTableTableField :: WriteTableField }

  {-# INLINE fromMonoFoldable #-}
  fromMonoFoldable :: (MonoFoldable mono, Element mono ~ WriteTable a) => Int32 -> mono -> WriteVector (WriteTable a)
  fromMonoFoldable :: forall mono.
(MonoFoldable mono, Element mono ~ WriteTable a) =>
Int32 -> mono -> WriteVector (WriteTable a)
fromMonoFoldable Int32
elemCount mono
tables = WriteTableField -> WriteVector (WriteTable a)
forall a. WriteTableField -> WriteVector (WriteTable a)
WriteVectorTable (WriteTableField -> WriteVector (WriteTable a))
-> (State FBState (FBState -> FBState) -> WriteTableField)
-> State FBState (FBState -> FBState)
-> WriteVector (WriteTable a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State FBState (FBState -> FBState) -> WriteTableField
WriteTableField (State FBState (FBState -> FBState) -> WriteVector (WriteTable a))
-> State FBState (FBState -> FBState) -> WriteVector (WriteTable a)
forall a b. (a -> b) -> a -> b
$ do
    FBState
fbs1 <- StateT FBState Identity FBState
forall s (m :: * -> *). MonadState s m => m s
get
    let !(TableInfo FBState
fbs2 [Int32]
positions) =
          (Element mono -> TableInfo -> TableInfo)
-> TableInfo -> mono -> TableInfo
forall mono b.
MonoFoldable mono =>
(Element mono -> b -> b) -> b -> mono -> b
forall b. (Element mono -> b -> b) -> b -> mono -> b
Mono.ofoldr
            (\(WriteTable State FBState Int32
writeTable) (TableInfo FBState
fbs [Int32]
positions) ->
              let (Int32
pos, FBState
fbs') = State FBState Int32 -> FBState -> (Int32, FBState)
forall s a. State s a -> s -> (a, s)
runState State FBState Int32
writeTable FBState
fbs
              in  FBState -> [Int32] -> TableInfo
TableInfo FBState
fbs' (Int32
pos Int32 -> [Int32] -> [Int32]
forall a. a -> [a] -> [a]
: [Int32]
positions)
            )
            (FBState -> [Int32] -> TableInfo
TableInfo FBState
fbs1 [])
            mono
tables
    FBState -> State FBState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (FBState -> State FBState ()) -> FBState -> State FBState ()
forall a b. (a -> b) -> a -> b
$! Alignment -> Int32 -> FBState -> FBState
alignTo Alignment
forall a. Num a => a
int32Size Int32
0 FBState
fbs2

    -- Write offsets
    Int32
bsize <- (FBState -> Int32) -> State FBState Int32
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (BufferSize -> Int32
forall a. Sum a -> a
getSum (BufferSize -> Int32)
-> (FBState -> BufferSize) -> FBState -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FBState -> BufferSize
bufferSize)
    let OffsetInfo Int32
_ [Int32]
offsets =
          (Int32 -> OffsetInfo -> OffsetInfo)
-> OffsetInfo -> [Int32] -> OffsetInfo
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
            (\Int32
position (OffsetInfo Int32
ix [Int32]
os) ->
              Int32 -> [Int32] -> OffsetInfo
OffsetInfo
                (Int32
ix Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
1)
                (Int32
bsize Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ (Int32
ix Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
4) Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
4 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
position Int32 -> [Int32] -> [Int32]
forall a. a -> [a] -> [a]
: [Int32]
os)
            )
            (Int32 -> [Int32] -> OffsetInfo
OffsetInfo Int32
0 [])
            [Int32]
positions

    WriteVector Int32 -> State FBState (FBState -> FBState)
forall a b. Coercible a b => a -> b
coerce (WriteVector Int32 -> State FBState (FBState -> FBState))
-> WriteVector Int32 -> State FBState (FBState -> FBState)
forall a b. (a -> b) -> a -> b
$ Int32 -> [Int32] -> WriteVector Int32
forall mono.
(MonoFoldable mono, Element mono ~ Int32) =>
Int32 -> mono -> WriteVector Int32
forall a mono.
(WriteVectorElement a, MonoFoldable mono, Element mono ~ a) =>
Int32 -> mono -> WriteVector a
fromMonoFoldable Int32
elemCount [Int32]
offsets

data Vecs a = Vecs ![Word8] ![State FBState Position]

data UnionTableInfo = UnionTableInfo
  { UnionTableInfo -> FBState
utiState          :: !FBState
  , UnionTableInfo -> [Int32]
utiTablePositions :: ![Position]
  }

instance WriteVectorElement (WriteUnion a) where
  data WriteVector (WriteUnion a) = WriteVectorUnion !WriteTableField !WriteTableField

  {-# INLINE fromMonoFoldable #-}
  fromMonoFoldable :: (MonoFoldable mono, Element mono ~ WriteUnion a) => Int32 -> mono -> WriteVector (WriteUnion a)
  fromMonoFoldable :: forall mono.
(MonoFoldable mono, Element mono ~ WriteUnion a) =>
Int32 -> mono -> WriteVector (WriteUnion a)
fromMonoFoldable Int32
elemCount mono
unions =
    let Vecs [Word8]
types [State FBState Int32]
values =
          (Element mono -> Vecs a -> Vecs a) -> Vecs a -> mono -> Vecs a
forall mono b.
MonoFoldable mono =>
(Element mono -> b -> b) -> b -> mono -> b
forall b. (Element mono -> b -> b) -> b -> mono -> b
Mono.ofoldr
            Element mono -> Vecs a -> Vecs a
WriteUnion a -> Vecs a -> Vecs a
go
            ([Word8] -> [State FBState Int32] -> Vecs a
forall a. [Word8] -> [State FBState Int32] -> Vecs a
Vecs [] [])
            mono
unions

        go :: WriteUnion a -> Vecs a -> Vecs a
        go :: WriteUnion a -> Vecs a -> Vecs a
go WriteUnion a
writeUnion (Vecs [Word8]
types [State FBState Int32]
values) =
          [Word8] -> [State FBState Int32] -> Vecs a
forall a. [Word8] -> [State FBState Int32] -> Vecs a
Vecs (WriteUnion a
writeUnion.wuUnionType Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [Word8]
types) (WriteUnion a
writeUnion.wuUnionValue State FBState Int32
-> [State FBState Int32] -> [State FBState Int32]
forall a. a -> [a] -> [a]
: [State FBState Int32]
values)

        writeUnionTables :: WriteTableField
        writeUnionTables :: WriteTableField
writeUnionTables = State FBState (FBState -> FBState) -> WriteTableField
WriteTableField (State FBState (FBState -> FBState) -> WriteTableField)
-> State FBState (FBState -> FBState) -> WriteTableField
forall a b. (a -> b) -> a -> b
$ do
              FBState
fbs1 <- StateT FBState Identity FBState
forall s (m :: * -> *). MonadState s m => m s
get
              let !(UnionTableInfo FBState
fbs2 [Int32]
positions) =
                    (State FBState Int32 -> UnionTableInfo -> UnionTableInfo)
-> UnionTableInfo -> [State FBState Int32] -> UnionTableInfo
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
                      (\State FBState Int32
unionTable (UnionTableInfo FBState
fbs [Int32]
positions) ->
                          let (Int32
pos, FBState
fbs') = State FBState Int32 -> FBState -> (Int32, FBState)
forall s a. State s a -> s -> (a, s)
runState State FBState Int32
unionTable FBState
fbs
                          in  FBState -> [Int32] -> UnionTableInfo
UnionTableInfo FBState
fbs' (Int32
pos Int32 -> [Int32] -> [Int32]
forall a. a -> [a] -> [a]
: [Int32]
positions)
                      )
                      (FBState -> [Int32] -> UnionTableInfo
UnionTableInfo FBState
fbs1 [])
                      [State FBState Int32]
values
              FBState -> State FBState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (FBState -> State FBState ()) -> FBState -> State FBState ()
forall a b. (a -> b) -> a -> b
$! Alignment -> Int32 -> FBState -> FBState
alignTo Alignment
forall a. Num a => a
int32Size Int32
0 FBState
fbs2


              -- Write offsets
              Int32
bsize <- (FBState -> Int32) -> State FBState Int32
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (BufferSize -> Int32
forall a. Sum a -> a
getSum (BufferSize -> Int32)
-> (FBState -> BufferSize) -> FBState -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FBState -> BufferSize
bufferSize)
              let OffsetInfo Int32
_ [Int32]
offsets =
                    (Int32 -> OffsetInfo -> OffsetInfo)
-> OffsetInfo -> [Int32] -> OffsetInfo
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
                      (\Int32
position (OffsetInfo Int32
ix [Int32]
os) ->
                        let offset :: Int32
offset = Int32
bsize Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ (Int32
ix Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
4) Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
4 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
position
                        in  Int32 -> [Int32] -> OffsetInfo
OffsetInfo
                              (Int32
ix Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
1)
                              (Int32
offset Int32 -> [Int32] -> [Int32]
forall a. a -> [a] -> [a]
: [Int32]
os)
                      )
                      (Int32 -> [Int32] -> OffsetInfo
OffsetInfo Int32
0 [])
                      [Int32]
positions

              WriteVector Int32 -> State FBState (FBState -> FBState)
forall a b. Coercible a b => a -> b
coerce (WriteVector Int32 -> State FBState (FBState -> FBState))
-> WriteVector Int32 -> State FBState (FBState -> FBState)
forall a b. (a -> b) -> a -> b
$ Int32 -> [Int32] -> WriteVector Int32
forall mono.
(MonoFoldable mono, Element mono ~ Int32) =>
Int32 -> mono -> WriteVector Int32
forall a mono.
(WriteVectorElement a, MonoFoldable mono, Element mono ~ a) =>
Int32 -> mono -> WriteVector a
fromMonoFoldable Int32
elemCount [Int32]
offsets

    in  WriteTableField -> WriteTableField -> WriteVector (WriteUnion a)
forall a.
WriteTableField -> WriteTableField -> WriteVector (WriteUnion a)
WriteVectorUnion (WriteVector Word8 -> WriteTableField
forall a b. Coercible a b => a -> b
coerce (WriteVector Word8 -> WriteTableField)
-> WriteVector Word8 -> WriteTableField
forall a b. (a -> b) -> a -> b
$ Int32 -> [Word8] -> WriteVector Word8
forall mono.
(MonoFoldable mono, Element mono ~ Word8) =>
Int32 -> mono -> WriteVector Word8
forall a mono.
(WriteVectorElement a, MonoFoldable mono, Element mono ~ a) =>
Int32 -> mono -> WriteVector a
fromMonoFoldable Int32
elemCount [Word8]
types) WriteTableField
writeUnionTables



-- | Calculate how much 0-padding is needed so that, after writing @additionalBytes@,
-- the buffer becomes aligned to @n@ bytes.
{-# INLINE calcPadding #-}
calcPadding :: Alignment {- ^ n -} -> Int32 {- ^ additionalBytes -} -> BufferSize -> Int32
calcPadding :: Alignment -> Int32 -> BufferSize -> Int32
calcPadding !Alignment
n !Int32
additionalBytes (Sum Int32
size) =
  (Int32 -> Int32
forall a. Bits a => a -> a
complement (Int32
size Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
additionalBytes) Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
1) Int32 -> Int32 -> Int32
forall a. Bits a => a -> a -> a
.&. (Alignment -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Alignment
n Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
1)

-- | Add enough 0-padding so that the buffer becomes aligned to @n@ after writing @additionalBytes@.
{-# INLINE alignTo #-}
alignTo :: Alignment{- ^ n -} -> Int32 {- ^ additionalBytes -} -> FBState -> FBState
alignTo :: Alignment -> Int32 -> FBState -> FBState
alignTo !Alignment
n !Int32
additionalBytes fbs :: FBState
fbs@(FBState Builder
b BufferSize
bsize Max Alignment
ma Map ByteString Int32
cache) =
  if Int32
padding Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
0
    then FBState
fbs { maxAlign = ma <> coerce n }
    else Builder
-> BufferSize -> Max Alignment -> Map ByteString Int32 -> FBState
FBState
            (Int32 -> Builder
buildPadding Int32
padding Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b)
            (BufferSize
bsize BufferSize -> BufferSize -> BufferSize
forall a. Semigroup a => a -> a -> a
<> Int32 -> BufferSize
forall a. a -> Sum a
Sum Int32
padding)
            (Max Alignment
ma Max Alignment -> Max Alignment -> Max Alignment
forall a. Semigroup a => a -> a -> a
<> Alignment -> Max Alignment
forall a b. Coercible a b => a -> b
coerce Alignment
n)
            Map ByteString Int32
cache
  where
    padding :: Int32
padding = Alignment -> Int32 -> BufferSize -> Int32
calcPadding Alignment
n Int32
additionalBytes BufferSize
bsize


{-# INLINE uoffsetFromHere #-}
uoffsetFromHere :: State FBState (FBState -> FBState)
uoffsetFromHere :: State FBState (FBState -> FBState)
uoffsetFromHere = (FBState -> FBState -> FBState)
-> State FBState (FBState -> FBState)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Int32 -> FBState -> FBState
uoffsetFrom (Int32 -> FBState -> FBState)
-> (FBState -> Int32) -> FBState -> FBState -> FBState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferSize -> Int32
forall a b. Coercible a b => a -> b
coerce (BufferSize -> Int32)
-> (FBState -> BufferSize) -> FBState -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FBState -> BufferSize
bufferSize)

{-# INLINE uoffsetFrom #-}
uoffsetFrom :: Position -> FBState -> FBState
uoffsetFrom :: Int32 -> FBState -> FBState
uoffsetFrom Int32
pos = FBState -> FBState
writeUOffset (FBState -> FBState) -> (FBState -> FBState) -> FBState -> FBState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FBState -> FBState
align
  where
    align :: FBState -> FBState
align FBState
fbs = Alignment -> Int32 -> FBState -> FBState
alignTo Alignment
forall a. Num a => a
int32Size Int32
0 FBState
fbs
    writeUOffset :: FBState -> FBState
writeUOffset FBState
fbs =
      let currentPos :: Int32
currentPos = (FBState -> BufferSize) -> FBState -> Int32
forall a b. Coercible a b => a -> b
coerce FBState -> BufferSize
bufferSize FBState
fbs
      in  Int32 -> FBState -> FBState
writeInt32 (Int32
currentPos Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
pos Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
forall a. Num a => a
uoffsetSize) FBState
fbs

{-# INLINE utf8length #-}
utf8length :: Text -> Int32
utf8length :: Text -> Int32
utf8length (TI.Text Array
_array Int
_offset Int
len) = forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Int32 Int
len