{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UnliftedFFITypes #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

{-# OPTIONS_HADDOCK not-home #-}

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

module FlatBuffers.Internal.Write where

import           Control.Monad.State.Strict

import           Data.Bits                           ( (.&.), complement )
import qualified Data.ByteString                     as BS
import           Data.ByteString.Builder             ( Builder )
import qualified Data.ByteString.Builder             as B
import qualified Data.ByteString.Lazy                as BSL
import           Data.Coerce                         ( coerce )
import           Data.Int
import qualified Data.List                           as L
import qualified Data.Map.Strict                     as M
import           Data.MonoTraversable                ( Element, MonoFoldable )
import qualified Data.MonoTraversable                as Mono
import           Data.Monoid                         ( Sum(..) )
import           Data.Semigroup                      ( Max(..) )
import           Data.Text                           ( Text )
import qualified Data.Text.Array                     as A
import qualified Data.Text.Encoding                  as T
import qualified Data.Text.Internal                  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

import           Foreign.C.Types                     ( CSize(CSize) )

import           GHC.Base                            ( ByteArray# )

import           System.IO.Unsafe                    ( unsafeDupablePerformIO )


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 Position
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 { 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
  = Some
      {-# UNPACK #-} !Word8
      !(State FBState Position)
  | None


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

{-# INLINE encodeState #-}
encodeState :: FBState -> WriteTable a -> BSL.ByteString
encodeState :: FBState -> WriteTable a -> ByteString
encodeState FBState
state (WriteTable State FBState Position
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 Position
pos <- State FBState Position
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 -> Position -> FBState -> FBState
alignTo Alignment
maxAlignment Position
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
$ Position -> FBState -> FBState
uoffsetFrom Position
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 :: WriteTable a -> ByteString
encodeWithFileIdentifier =
  FBState -> FileIdentifier -> WriteTable a -> ByteString
forall a. FBState -> FileIdentifier -> WriteTable a -> ByteString
encodeStateWithFileIdentifier (Builder
-> BufferSize
-> Max Alignment
-> Map ByteString Position
-> FBState
FBState Builder
forall a. Monoid a => a
mempty (Position -> BufferSize
forall a. a -> Sum a
Sum Position
0) (Alignment -> Max Alignment
forall a. a -> Max a
Max Alignment
1) Map ByteString Position
forall a. Monoid a => a
mempty) (HasFileIdentifier a => FileIdentifier
forall a. HasFileIdentifier a => FileIdentifier
getFileIdentifier @a)

{-# INLINE encodeStateWithFileIdentifier #-}
encodeStateWithFileIdentifier :: FBState -> FileIdentifier -> WriteTable a -> BSL.ByteString
encodeStateWithFileIdentifier :: FBState -> FileIdentifier -> WriteTable a -> ByteString
encodeStateWithFileIdentifier FBState
state FileIdentifier
fi (WriteTable State FBState Position
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 Position
pos <- State FBState Position
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 -> Position -> FBState -> FBState
alignTo Alignment
maxAlignment (Position
forall a. Num a => a
uoffsetSize Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
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
$ Position -> FBState -> FBState
uoffsetFrom Position
pos
    )
    FBState
state


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

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

{-# INLINE writeFileIdentifier #-}
writeFileIdentifier :: FileIdentifier -> FBState -> FBState
writeFileIdentifier :: FileIdentifier -> FBState -> FBState
writeFileIdentifier FileIdentifier
fi = Position -> Builder -> FBState -> FBState
write Position
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 (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 :: (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 :: 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 (f :: * -> *) a. Applicative f => a -> f a
pure ((FBState -> FBState) -> WriteTableField)
-> (FBState -> FBState) -> WriteTableField
forall a b. (a -> b) -> a -> b
$! Position -> Builder -> FBState -> FBState
write Position
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 -> Position -> FBState -> FBState
alignTo Alignment
forall a. Num a => a
word8Size Position
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 (f :: * -> *) a. Applicative f => a -> f a
pure ((FBState -> FBState) -> WriteTableField)
-> (FBState -> FBState) -> WriteTableField
forall a b. (a -> b) -> a -> b
$! Position -> Builder -> FBState -> FBState
write Position
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 -> Position -> FBState -> FBState
alignTo Alignment
forall a. Num a => a
word16Size Position
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 (f :: * -> *) a. Applicative f => a -> f a
pure ((FBState -> FBState) -> WriteTableField)
-> (FBState -> FBState) -> WriteTableField
forall a b. (a -> b) -> a -> b
$! Position -> Builder -> FBState -> FBState
write Position
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 -> Position -> FBState -> FBState
alignTo Alignment
forall a. Num a => a
word32Size Position
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 (f :: * -> *) a. Applicative f => a -> f a
pure ((FBState -> FBState) -> WriteTableField)
-> (FBState -> FBState) -> WriteTableField
forall a b. (a -> b) -> a -> b
$! Position -> Builder -> FBState -> FBState
write Position
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 -> Position -> FBState -> FBState
alignTo Alignment
forall a. Num a => a
word64Size Position
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 (f :: * -> *) a. Applicative f => a -> f a
pure ((FBState -> FBState) -> WriteTableField)
-> (FBState -> FBState) -> WriteTableField
forall a b. (a -> b) -> a -> b
$! Position -> Builder -> FBState -> FBState
write Position
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 -> Position -> FBState -> FBState
alignTo Alignment
forall a. Num a => a
int8Size Position
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 (f :: * -> *) a. Applicative f => a -> f a
pure ((FBState -> FBState) -> WriteTableField)
-> (FBState -> FBState) -> WriteTableField
forall a b. (a -> b) -> a -> b
$! Position -> Builder -> FBState -> FBState
write Position
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 -> Position -> FBState -> FBState
alignTo Alignment
forall a. Num a => a
int16Size Position
0

{-# INLINE writeInt32TableField #-}
writeInt32TableField :: Int32 -> WriteTableField
writeInt32TableField :: Position -> WriteTableField
writeInt32TableField Position
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 (f :: * -> *) a. Applicative f => a -> f a
pure ((FBState -> FBState) -> WriteTableField)
-> (FBState -> FBState) -> WriteTableField
forall a b. (a -> b) -> a -> b
$! Position -> Builder -> FBState -> FBState
write Position
forall a. Num a => a
int32Size (Position -> Builder
B.int32LE Position
n) (FBState -> FBState) -> (FBState -> FBState) -> FBState -> FBState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alignment -> Position -> FBState -> FBState
alignTo Alignment
forall a. Num a => a
int32Size Position
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 (f :: * -> *) a. Applicative f => a -> f a
pure ((FBState -> FBState) -> WriteTableField)
-> (FBState -> FBState) -> WriteTableField
forall a b. (a -> b) -> a -> b
$! Position -> Builder -> FBState -> FBState
write Position
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 -> Position -> FBState -> FBState
alignTo Alignment
forall a. Num a => a
int64Size Position
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 (f :: * -> *) a. Applicative f => a -> f a
pure ((FBState -> FBState) -> WriteTableField)
-> (FBState -> FBState) -> WriteTableField
forall a b. (a -> b) -> a -> b
$! Position -> Builder -> FBState -> FBState
write Position
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 -> Position -> FBState -> FBState
alignTo Alignment
forall a. Num a => a
floatSize Position
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 (f :: * -> *) a. Applicative f => a -> f a
pure ((FBState -> FBState) -> WriteTableField)
-> (FBState -> FBState) -> WriteTableField
forall a b. (a -> b) -> a -> b
$! Position -> Builder -> FBState -> FBState
write Position
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 -> Position -> FBState -> FBState
alignTo Alignment
forall a. Num a => a
doubleSize Position
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' (Position -> FBState -> FBState
writeInt32 Position
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 -> Position -> FBState -> FBState
alignTo Alignment
forall a. Num a => a
int32Size (Position
len Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
1))
  State FBState (FBState -> FBState)
uoffsetFromHere
  where
    len :: Position
len = Text -> Position
utf8length Text
text
    encodeText :: FBState -> FBState
encodeText FBState
fbs =
      FBState
fbs
        -- strings must have a trailing zero
        { builder :: Builder
builder = Text -> Builder
T.encodeUtf8Builder Text
text Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
B.word8 Word8
0 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FBState -> Builder
builder FBState
fbs
        , bufferSize :: BufferSize
bufferSize = Position -> BufferSize
forall a. a -> Sum a
Sum Position
len BufferSize -> BufferSize -> BufferSize
forall a. Semigroup a => a -> a -> a
<> Position -> BufferSize
forall a. a -> Sum a
Sum Position
1 BufferSize -> BufferSize -> BufferSize
forall a. Semigroup a => a -> a -> a
<> FBState -> BufferSize
bufferSize FBState
fbs
        }

{-# INLINE writeTableTableField #-}
writeTableTableField :: WriteTable a -> WriteTableField
writeTableTableField :: WriteTable a -> WriteTableField
writeTableTableField (WriteTable State FBState Position
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
  Position
loc <- State FBState Position
writeTable
  (FBState -> FBState) -> State FBState (FBState -> FBState)
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
$! Position -> FBState -> FBState
uoffsetFrom Position
loc

{-# INLINE writeStructTableField #-}
writeStructTableField :: forall a. IsStruct a => WriteStruct a -> WriteTableField
writeStructTableField :: WriteStruct a -> WriteTableField
writeStructTableField (WriteStruct Builder
b) =
  Alignment -> InlineSize -> Builder -> WriteTableField
writeStructTableField' (IsStruct a => Alignment
forall a. IsStruct a => Alignment
structAlignmentOf @a) (IsStruct a => InlineSize
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 (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 -> Position -> FBState -> FBState
alignTo Alignment
structAlignment Position
0
  where
    writeStruct :: FBState -> FBState
writeStruct FBState
fbs = FBState
fbs
      { builder :: Builder
builder = Builder
structBuilder Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FBState -> Builder
builder FBState
fbs
      , bufferSize :: BufferSize
bufferSize = FBState -> BufferSize
bufferSize FBState
fbs BufferSize -> BufferSize -> BufferSize
forall a. Semigroup a => a -> a -> a
<> Position -> BufferSize
forall a. a -> Sum a
Sum (InlineSize -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral @InlineSize @Int32 InlineSize
structSize)
      }

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

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


{-# INLINE writeUnionTypeTableField #-}
writeUnionTypeTableField :: WriteUnion a -> WriteTableField
writeUnionTypeTableField :: WriteUnion a -> WriteTableField
writeUnionTypeTableField !WriteUnion a
wu =
  case WriteUnion a
wu of
    WriteUnion a
None             -> WriteTableField
missing
    Some Word8
unionType State FBState Position
_ -> Word8 -> WriteTableField
writeWord8TableField Word8
unionType


{-# INLINE writeUnionValueTableField #-}
writeUnionValueTableField :: WriteUnion a -> WriteTableField
writeUnionValueTableField :: WriteUnion a -> WriteTableField
writeUnionValueTableField !WriteUnion a
wu =
  case WriteUnion a
wu of
    WriteUnion a
None              -> WriteTableField
missing
    Some Word8
_ State FBState Position
unionValue -> WriteTable Any -> WriteTableField
forall a. WriteTable a -> WriteTableField
writeTableTableField (State FBState Position -> WriteTable Any
forall a. State FBState Position -> WriteTable a
WriteTable State FBState Position
unionValue)

-- | Constructs a missing union table field / vector element.
{-# INLINE none #-}
none :: WriteUnion a
none :: WriteUnion a
none = WriteUnion a
forall a. WriteUnion a
None

{-# INLINE writeUnion #-}
writeUnion :: Word8 -> WriteTable a -> WriteUnion b
writeUnion :: Word8 -> WriteTable a -> WriteUnion b
writeUnion Word8
n (WriteTable State FBState Position
st) = Word8 -> State FBState Position -> WriteUnion b
forall a. Word8 -> State FBState Position -> WriteUnion a
Some Word8
n State FBState Position
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
* Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Word16 ([Word16] -> 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
coerce Word16
tableSize)
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Word16 -> Builder) -> [Word16] -> Builder
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
coerce) [Word16]
fieldVOffsets
      )


{-# INLINE writeTable #-}
writeTable :: [WriteTableField] -> WriteTable a
writeTable :: [WriteTableField] -> WriteTable a
writeTable [WriteTableField]
fields = State FBState Position -> WriteTable a
forall a. State FBState Position -> WriteTable a
WriteTable (State FBState Position -> WriteTable a)
-> State FBState Position -> 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)
sequence ([WriteTableField] -> [State FBState (FBState -> FBState)]
coerce [WriteTableField]
fields)

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

  [Position]
inlineFieldPositions <-
    [FBState -> FBState]
-> ((FBState -> FBState) -> State FBState Position)
-> StateT FBState Identity [Position]
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 Position)
 -> StateT FBState Identity [Position])
-> ((FBState -> FBState) -> State FBState Position)
-> StateT FBState Identity [Position]
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 Position -> State FBState Position
forall (f :: * -> *) a. Applicative f => a -> f a
pure Position
0
        else Position -> State FBState Position
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BufferSize -> Position
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 -> Position -> FBState -> FBState
alignTo Alignment
forall a. Num a => a
soffsetSize Position
0
  Position
tableFieldsPosition <- (FBState -> Position) -> State FBState Position
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (BufferSize -> Position
forall a. Sum a -> a
getSum (BufferSize -> Position)
-> (FBState -> BufferSize) -> FBState -> Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FBState -> BufferSize
bufferSize)

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

  -- TODO: trim trailing 0 voffsets

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

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

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

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

  where
    writeVtable :: Map ByteString Position
-> ByteString -> Position -> FBState -> FBState
writeVtable Map ByteString Position
newCache ByteString
newVtable Position
newVtableSize FBState
fbs = FBState
fbs
      { cache :: Map ByteString Position
cache = Map ByteString Position
newCache
      , builder :: Builder
builder = ByteString -> Builder
B.lazyByteString ByteString
newVtable Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FBState -> Builder
builder FBState
fbs
      , bufferSize :: BufferSize
bufferSize = FBState -> BufferSize
bufferSize FBState
fbs BufferSize -> BufferSize -> BufferSize
forall a. Semigroup a => a -> a -> a
<> Position -> BufferSize
forall a. a -> Sum a
Sum Position
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 :: Position -> FBState -> FBState
writeVtableSoffset Position
newVtableSize = Position -> FBState -> FBState
writeInt32 Position
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' :: mono -> WriteVector a
fromMonoFoldable' mono
xs = Position -> mono -> WriteVector a
forall a mono.
(WriteVectorElement a, MonoFoldable mono, Element mono ~ a) =>
Position -> mono -> WriteVector a
fromMonoFoldable (Int -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Position) -> Int -> Position
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 :: Position -> [a] -> WriteVector a
fromList = Position -> [a] -> WriteVector a
forall a mono.
(WriteVectorElement a, MonoFoldable mono, Element mono ~ a) =>
Position -> mono -> WriteVector a
fromMonoFoldable

-- | `fromMonoFoldable'` specialized to list
fromList' :: WriteVectorElement a => [a] -> WriteVector a
fromList' :: [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 :: a -> WriteVector a
singleton a
a = Position -> [a] -> WriteVector a
forall a. WriteVectorElement a => Position -> [a] -> WriteVector a
fromList Position
1 [a
a]

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


newtype FromFoldable f a = FromFoldable (f a)
  deriving newtype a -> FromFoldable f a -> Bool
FromFoldable f m -> m
FromFoldable f a -> [a]
FromFoldable f a -> Bool
FromFoldable f a -> Int
FromFoldable f a -> a
FromFoldable f a -> a
FromFoldable f a -> a
FromFoldable f a -> a
(a -> m) -> FromFoldable f a -> m
(a -> m) -> FromFoldable f a -> m
(a -> b -> b) -> b -> FromFoldable f a -> b
(a -> b -> b) -> b -> FromFoldable f a -> b
(b -> a -> b) -> b -> FromFoldable f a -> b
(b -> a -> b) -> b -> FromFoldable f a -> b
(a -> a -> a) -> FromFoldable f a -> a
(a -> a -> a) -> FromFoldable f a -> a
(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
product :: FromFoldable f a -> a
$cproduct :: forall (f :: * -> *) a.
(Foldable f, Num a) =>
FromFoldable f a -> a
sum :: FromFoldable f a -> a
$csum :: forall (f :: * -> *) a.
(Foldable f, Num a) =>
FromFoldable f a -> a
minimum :: FromFoldable f a -> a
$cminimum :: forall (f :: * -> *) a.
(Foldable f, Ord a) =>
FromFoldable f a -> a
maximum :: FromFoldable f a -> a
$cmaximum :: forall (f :: * -> *) a.
(Foldable f, Ord a) =>
FromFoldable f a -> a
elem :: a -> FromFoldable f a -> Bool
$celem :: forall (f :: * -> *) a.
(Foldable f, Eq a) =>
a -> FromFoldable f a -> Bool
length :: FromFoldable f a -> Int
$clength :: forall (f :: * -> *) a. Foldable f => FromFoldable f a -> Int
null :: FromFoldable f a -> Bool
$cnull :: forall (f :: * -> *) a. Foldable f => FromFoldable f a -> Bool
toList :: FromFoldable f a -> [a]
$ctoList :: forall (f :: * -> *) a. Foldable f => FromFoldable f a -> [a]
foldl1 :: (a -> a -> a) -> FromFoldable f a -> a
$cfoldl1 :: forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> FromFoldable f a -> a
foldr1 :: (a -> a -> a) -> FromFoldable f a -> a
$cfoldr1 :: forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> FromFoldable f a -> a
foldl' :: (b -> a -> b) -> b -> FromFoldable f a -> b
$cfoldl' :: forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> FromFoldable f a -> b
foldl :: (b -> a -> b) -> b -> FromFoldable f a -> b
$cfoldl :: forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> FromFoldable f a -> b
foldr' :: (a -> b -> b) -> b -> FromFoldable f a -> b
$cfoldr' :: forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> FromFoldable f a -> b
foldr :: (a -> b -> b) -> b -> FromFoldable f a -> b
$cfoldr :: forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> FromFoldable f a -> b
foldMap' :: (a -> m) -> FromFoldable f a -> m
$cfoldMap' :: forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> FromFoldable f a -> m
foldMap :: (a -> m) -> FromFoldable f a -> m
$cfoldMap :: forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> FromFoldable f a -> m
fold :: FromFoldable f m -> m
$cfold :: forall (f :: * -> *) m.
(Foldable f, Monoid m) =>
FromFoldable f m -> m
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 :: Position -> f a -> WriteVector a
fromFoldable Position
n = Position -> FromFoldable f a -> WriteVector a
forall a mono.
(WriteVectorElement a, MonoFoldable mono, Element mono ~ a) =>
Position -> mono -> WriteVector a
fromMonoFoldable Position
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' :: 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
$!
    Position -> FBState -> FBState
writeInt32 Position
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 -> Position -> FBState -> FBState
alignTo Alignment
forall a. Num a => a
int32Size Position
len
  State FBState (FBState -> FBState)
uoffsetFromHere
  where
    len :: Position
len = Int -> Position
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 :: Builder
builder = ByteString -> Builder
B.byteString ByteString
bs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FBState -> Builder
builder FBState
fbs
        , bufferSize :: BufferSize
bufferSize = FBState -> BufferSize
bufferSize FBState
fbs BufferSize -> BufferSize -> BufferSize
forall a. Semigroup a => a -> a -> a
<> Position -> BufferSize
forall a. a -> Sum a
Sum Position
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
$!
    Position -> FBState -> FBState
writeInt32 Position
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 -> Position -> FBState -> FBState
alignTo Alignment
forall a. Num a => a
int32Size Position
len
  State FBState (FBState -> FBState)
uoffsetFromHere
  where
    len :: Position
len = Int64 -> Position
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 :: Builder
builder = ByteString -> Builder
B.lazyByteString ByteString
bs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FBState -> Builder
builder FBState
fbs
        , bufferSize :: BufferSize
bufferSize = FBState -> BufferSize
bufferSize FBState
fbs BufferSize -> BufferSize -> BufferSize
forall a. Semigroup a => a -> a -> a
<> Position -> BufferSize
forall a. a -> Sum a
Sum Position
len
        }

{-# INLINE inlineVector #-}
inlineVector ::
     (MonoFoldable mono, Element mono ~ a)
  => (a -> Builder)
  -> Alignment
  -> InlineSize
  -> Int32
  -> mono
  -> WriteTableField
inlineVector :: (a -> Builder)
-> Alignment -> InlineSize -> Position -> mono -> WriteTableField
inlineVector a -> Builder
build Alignment
elemAlignment InlineSize
elemSize Position
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
$!
    Position -> FBState -> FBState
writeInt32 Position
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 -> Position -> FBState -> FBState
alignTo (Alignment -> Alignment
coerce Alignment
elemAlignment Alignment -> Alignment -> Alignment
forall a. Ord a => a -> a -> a
`max` Alignment
forall a. Num a => a
int32Size) Position
vecByteLength

  State FBState (FBState -> FBState)
uoffsetFromHere
  where
    vecByteLength :: Position
vecByteLength = Position
elemCount Position -> Position -> Position
forall a. Num a => a -> a -> a
* InlineSize -> Position
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
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 :: Builder
builder = Builder
vecBuilder Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> FBState -> Builder
builder FBState
fbs
        , bufferSize :: BufferSize
bufferSize = FBState -> BufferSize
bufferSize FBState
fbs BufferSize -> BufferSize -> BufferSize
forall a. Semigroup a => a -> a -> a
<> Position -> BufferSize
forall a. a -> Sum a
Sum Position
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 :: Position -> mono -> WriteVector Word8
fromMonoFoldable Position
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 -> Position -> mono -> WriteTableField
forall mono a.
(MonoFoldable mono, Element mono ~ a) =>
(a -> Builder)
-> Alignment -> InlineSize -> Position -> mono -> WriteTableField
inlineVector Word8 -> Builder
B.word8 Alignment
forall a. Num a => a
word8Size InlineSize
forall a. Num a => a
word8Size Position
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 :: Position -> mono -> WriteVector Word16
fromMonoFoldable Position
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 -> Position -> mono -> WriteTableField
forall mono a.
(MonoFoldable mono, Element mono ~ a) =>
(a -> Builder)
-> Alignment -> InlineSize -> Position -> mono -> WriteTableField
inlineVector Word16 -> Builder
B.word16LE Alignment
forall a. Num a => a
word16Size InlineSize
forall a. Num a => a
word16Size Position
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 :: Position -> mono -> WriteVector Word32
fromMonoFoldable Position
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 -> Position -> mono -> WriteTableField
forall mono a.
(MonoFoldable mono, Element mono ~ a) =>
(a -> Builder)
-> Alignment -> InlineSize -> Position -> mono -> WriteTableField
inlineVector Word32 -> Builder
B.word32LE Alignment
forall a. Num a => a
word32Size InlineSize
forall a. Num a => a
word32Size Position
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 :: Position -> mono -> WriteVector Word64
fromMonoFoldable Position
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 -> Position -> mono -> WriteTableField
forall mono a.
(MonoFoldable mono, Element mono ~ a) =>
(a -> Builder)
-> Alignment -> InlineSize -> Position -> mono -> WriteTableField
inlineVector Word64 -> Builder
B.word64LE Alignment
forall a. Num a => a
word64Size InlineSize
forall a. Num a => a
word64Size Position
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 :: Position -> mono -> WriteVector Int8
fromMonoFoldable Position
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 -> Position -> mono -> WriteTableField
forall mono a.
(MonoFoldable mono, Element mono ~ a) =>
(a -> Builder)
-> Alignment -> InlineSize -> Position -> mono -> WriteTableField
inlineVector Int8 -> Builder
B.int8 Alignment
forall a. Num a => a
int8Size InlineSize
forall a. Num a => a
int8Size Position
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 :: Position -> mono -> WriteVector Int16
fromMonoFoldable Position
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 -> Position -> mono -> WriteTableField
forall mono a.
(MonoFoldable mono, Element mono ~ a) =>
(a -> Builder)
-> Alignment -> InlineSize -> Position -> mono -> WriteTableField
inlineVector Int16 -> Builder
B.int16LE Alignment
forall a. Num a => a
int16Size InlineSize
forall a. Num a => a
int16Size Position
n

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

  {-# INLINE fromMonoFoldable #-}
  fromMonoFoldable :: (MonoFoldable mono, Element mono ~ Int32) => Int32 -> mono -> WriteVector Int32
  fromMonoFoldable :: Position -> mono -> WriteVector Position
fromMonoFoldable Position
n = WriteTableField -> WriteVector Position
WriteVectorInt32 (WriteTableField -> WriteVector Position)
-> (mono -> WriteTableField) -> mono -> WriteVector Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Position -> Builder)
-> Alignment -> InlineSize -> Position -> mono -> WriteTableField
forall mono a.
(MonoFoldable mono, Element mono ~ a) =>
(a -> Builder)
-> Alignment -> InlineSize -> Position -> mono -> WriteTableField
inlineVector Position -> Builder
B.int32LE Alignment
forall a. Num a => a
int32Size InlineSize
forall a. Num a => a
int32Size Position
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 :: Position -> mono -> WriteVector Int64
fromMonoFoldable Position
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 -> Position -> mono -> WriteTableField
forall mono a.
(MonoFoldable mono, Element mono ~ a) =>
(a -> Builder)
-> Alignment -> InlineSize -> Position -> mono -> WriteTableField
inlineVector Int64 -> Builder
B.int64LE Alignment
forall a. Num a => a
int64Size InlineSize
forall a. Num a => a
int64Size Position
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 :: Position -> mono -> WriteVector Float
fromMonoFoldable Position
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 -> Position -> mono -> WriteTableField
forall mono a.
(MonoFoldable mono, Element mono ~ a) =>
(a -> Builder)
-> Alignment -> InlineSize -> Position -> mono -> WriteTableField
inlineVector Float -> Builder
B.floatLE Alignment
forall a. Num a => a
floatSize InlineSize
forall a. Num a => a
floatSize Position
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 :: Position -> mono -> WriteVector Double
fromMonoFoldable Position
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 -> Position -> mono -> WriteTableField
forall mono a.
(MonoFoldable mono, Element mono ~ a) =>
(a -> Builder)
-> Alignment -> InlineSize -> Position -> mono -> WriteTableField
inlineVector Double -> Builder
B.doubleLE Alignment
forall a. Num a => a
doubleSize InlineSize
forall a. Num a => a
doubleSize Position
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 :: Position -> mono -> WriteVector Bool
fromMonoFoldable Position
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 -> Position -> mono -> WriteTableField
forall mono a.
(MonoFoldable mono, Element mono ~ a) =>
(a -> Builder)
-> Alignment -> InlineSize -> Position -> 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 Position
n

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

  {-# INLINE fromMonoFoldable #-}
  fromMonoFoldable :: (MonoFoldable mono, Element mono ~ WriteStruct a) => Int32 -> mono -> WriteVector (WriteStruct a)
  fromMonoFoldable :: Position -> mono -> WriteVector (WriteStruct a)
fromMonoFoldable Position
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 -> Position -> mono -> WriteTableField
forall mono a.
(MonoFoldable mono, Element mono ~ a) =>
(a -> Builder)
-> Alignment -> InlineSize -> Position -> mono -> WriteTableField
inlineVector WriteStruct a -> Builder
coerce (IsStruct a => Alignment
forall a. IsStruct a => Alignment
structAlignmentOf @a) (IsStruct a => InlineSize
forall a. IsStruct a => InlineSize
structSizeOf @a) Position
n


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

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

data OffsetInfo = OffsetInfo
  { OffsetInfo -> Position
oiIndex   :: {-# UNPACK #-} !Int32
  , OffsetInfo -> [Position]
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 :: Position -> mono -> WriteVector Text
fromMonoFoldable Position
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 :: Builder
builder = Builder
builder2
            , bufferSize :: BufferSize
bufferSize = BufferSize
bsize2
            , maxAlign :: Max Alignment
maxAlign = FBState -> Max Alignment
maxAlign FBState
fbs Max Alignment -> Max Alignment -> Max Alignment
forall a. Semigroup a => a -> a -> a
<> Alignment -> Max Alignment
forall a. a -> Max a
Max Alignment
forall a. Num a => a
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
Mono.ofoldr
                (\Element mono
t (TextInfos [TextInfo]
infos BufferSize
bsize) ->
                  let textLength :: Position
textLength = Text -> Position
utf8length Text
Element mono
t
                      padding :: Position
padding = Alignment -> Position -> BufferSize -> Position
calcPadding Alignment
4 (Position
textLength Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
1) BufferSize
bsize
                      newBsize :: BufferSize
newBsize = BufferSize
bsize BufferSize -> BufferSize -> BufferSize
forall a. Semigroup a => a -> a -> a
<> Position -> BufferSize
forall a. a -> Sum a
Sum (Position
padding Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
textLength Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
1 Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
4)
                  in  [TextInfo] -> BufferSize -> TextInfos
TextInfos (Text -> Position -> Position -> Position -> TextInfo
TextInfo Text
Element mono
t Position
textLength Position
padding (BufferSize -> Position
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 (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
                (\(TextInfo Text
t Position
tlength Position
padding Position
_) Builder
b ->
                  Position -> Builder
B.int32LE Position
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
<> Position -> Builder
buildPadding Position
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 :: Position
vectorPadding = Alignment -> Position -> BufferSize -> Position
calcPadding Alignment
forall a. Num a => a
int32Size Position
0 BufferSize
bsize1
            bsize2 :: BufferSize
bsize2 = BufferSize
bsize1 BufferSize -> BufferSize -> BufferSize
forall a. Semigroup a => a -> a -> a
<> Position -> BufferSize
forall a. a -> Sum a
Sum Position
vectorPadding
            builder2 :: Builder
builder2 = Position -> Builder
buildPadding Position
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 Position
_ [Position]
offsets =
              (TextInfo -> OffsetInfo -> OffsetInfo)
-> OffsetInfo -> [TextInfo] -> OffsetInfo
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
                (\(TextInfo Text
_ Position
_ Position
_ Position
position) (OffsetInfo Position
ix [Position]
os) ->
                  Position -> [Position] -> OffsetInfo
OffsetInfo
                    (Position
ix Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
1)
                    (BufferSize -> Position
forall a. Sum a -> a
getSum BufferSize
bsize1 Position -> Position -> Position
forall a. Num a => a -> a -> a
+ (Position
ix Position -> Position -> Position
forall a. Num a => a -> a -> a
* Position
4) Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
4 Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
position Position -> [Position] -> [Position]
forall a. a -> [a] -> [a]
: [Position]
os)
                )
                (Position -> [Position] -> OffsetInfo
OffsetInfo Position
0 [])
                [TextInfo]
textInfos

            bsize2 :: BufferSize
bsize2 = BufferSize
bsize1 BufferSize -> BufferSize -> BufferSize
forall a. Semigroup a => a -> a -> a
<> Position -> BufferSize
forall a. a -> Sum a
Sum (Position
elemCount Position -> Position -> Position
forall a. Num a => a -> a -> a
* Position
4)
            builder2 :: Builder
builder2 =
              (Position -> Builder -> Builder)
-> Builder -> [Position] -> Builder
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
                (\Position
o Builder
b -> Position -> Builder
B.int32LE Position
o Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b)
                Builder
forall a. Monoid a => a
mempty
                [Position]
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) =
        (Position -> Builder
B.int32LE Position
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 -> [Position]
tiTablePositions :: ![Position]
  }

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

  {-# INLINE fromMonoFoldable #-}
  fromMonoFoldable :: (MonoFoldable mono, Element mono ~ WriteTable a) => Int32 -> mono -> WriteVector (WriteTable a)
  fromMonoFoldable :: Position -> mono -> WriteVector (WriteTable a)
fromMonoFoldable Position
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 [Position]
positions) =
          (Element mono -> TableInfo -> TableInfo)
-> TableInfo -> mono -> TableInfo
forall mono b.
MonoFoldable mono =>
(Element mono -> b -> b) -> b -> mono -> b
Mono.ofoldr
            (\(WriteTable writeTable) (TableInfo FBState
fbs [Position]
positions) ->
              let (Position
pos, FBState
fbs') = State FBState Position -> FBState -> (Position, FBState)
forall s a. State s a -> s -> (a, s)
runState State FBState Position
writeTable FBState
fbs
              in  FBState -> [Position] -> TableInfo
TableInfo FBState
fbs' (Position
pos Position -> [Position] -> [Position]
forall a. a -> [a] -> [a]
: [Position]
positions)
            )
            (FBState -> [Position] -> 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 -> Position -> FBState -> FBState
alignTo Alignment
forall a. Num a => a
int32Size Position
0 FBState
fbs2

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

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

data Vecs a = Vecs ![Word8] ![Maybe (State FBState Position)]

data UnionTableInfo = UnionTableInfo
  { UnionTableInfo -> FBState
utiState          :: !FBState
  , UnionTableInfo -> [Maybe Position]
utiTablePositions :: ![Maybe 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 :: Position -> mono -> WriteVector (WriteUnion a)
fromMonoFoldable Position
elemCount mono
unions =
    let Vecs [Word8]
types [Maybe (State FBState Position)]
values =
          (Element mono -> Vecs Any -> Vecs Any)
-> Vecs Any -> mono -> Vecs Any
forall mono b.
MonoFoldable mono =>
(Element mono -> b -> b) -> b -> mono -> b
Mono.ofoldr
            Element mono -> Vecs Any -> Vecs Any
forall a a a. WriteUnion a -> Vecs a -> Vecs a
go
            ([Word8] -> [Maybe (State FBState Position)] -> Vecs Any
forall a. [Word8] -> [Maybe (State FBState Position)] -> Vecs a
Vecs [] [])
            mono
unions
        go :: WriteUnion a -> Vecs a -> Vecs a
go WriteUnion a
writeUnion (Vecs [Word8]
types [Maybe (State FBState Position)]
values) =
          case WriteUnion a
writeUnion of
            WriteUnion a
None         -> [Word8] -> [Maybe (State FBState Position)] -> Vecs a
forall a. [Word8] -> [Maybe (State FBState Position)] -> Vecs a
Vecs (Word8
0 Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [Word8]
types) (Maybe (State FBState Position)
forall a. Maybe a
Nothing Maybe (State FBState Position)
-> [Maybe (State FBState Position)]
-> [Maybe (State FBState Position)]
forall a. a -> [a] -> [a]
: [Maybe (State FBState Position)]
values)
            Some Word8
typ State FBState Position
val -> [Word8] -> [Maybe (State FBState Position)] -> Vecs a
forall a. [Word8] -> [Maybe (State FBState Position)] -> Vecs a
Vecs (Word8
typ Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [Word8]
types) (State FBState Position -> Maybe (State FBState Position)
forall a. a -> Maybe a
Just State FBState Position
val Maybe (State FBState Position)
-> [Maybe (State FBState Position)]
-> [Maybe (State FBState Position)]
forall a. a -> [a] -> [a]
: [Maybe (State FBState Position)]
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 [Maybe Position]
positions) =
                    (Maybe (State FBState Position)
 -> UnionTableInfo -> UnionTableInfo)
-> UnionTableInfo
-> [Maybe (State FBState Position)]
-> UnionTableInfo
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
                      (\Maybe (State FBState Position)
unionTableOpt (UnionTableInfo FBState
fbs [Maybe Position]
positions) ->
                        case Maybe (State FBState Position)
unionTableOpt of
                          Just State FBState Position
t ->
                            let (Position
pos, FBState
fbs') = State FBState Position -> FBState -> (Position, FBState)
forall s a. State s a -> s -> (a, s)
runState State FBState Position
t FBState
fbs
                            in  FBState -> [Maybe Position] -> UnionTableInfo
UnionTableInfo FBState
fbs' (Position -> Maybe Position
forall a. a -> Maybe a
Just Position
pos Maybe Position -> [Maybe Position] -> [Maybe Position]
forall a. a -> [a] -> [a]
: [Maybe Position]
positions)
                          Maybe (State FBState Position)
Nothing ->
                            FBState -> [Maybe Position] -> UnionTableInfo
UnionTableInfo FBState
fbs (Maybe Position
forall a. Maybe a
Nothing Maybe Position -> [Maybe Position] -> [Maybe Position]
forall a. a -> [a] -> [a]
: [Maybe Position]
positions)
                      )
                      (FBState -> [Maybe Position] -> UnionTableInfo
UnionTableInfo FBState
fbs1 [])
                      [Maybe (State FBState Position)]
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 -> Position -> FBState -> FBState
alignTo Alignment
forall a. Num a => a
int32Size Position
0 FBState
fbs2


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

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

    in  WriteTableField -> WriteTableField -> WriteVector (WriteUnion a)
forall a.
WriteTableField -> WriteTableField -> WriteVector (WriteUnion a)
WriteVectorUnion (WriteVector Word8 -> WriteTableField
coerce (WriteVector Word8 -> WriteTableField)
-> WriteVector Word8 -> WriteTableField
forall a b. (a -> b) -> a -> b
$ Position -> [Word8] -> WriteVector Word8
forall a mono.
(WriteVectorElement a, MonoFoldable mono, Element mono ~ a) =>
Position -> mono -> WriteVector a
fromMonoFoldable Position
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 -> Position -> BufferSize -> Position
calcPadding !Alignment
n !Position
additionalBytes (Sum Position
size) =
  (Position -> Position
forall a. Bits a => a -> a
complement (Position
size Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
additionalBytes) Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
1) Position -> Position -> Position
forall a. Bits a => a -> a -> a
.&. (Alignment -> Position
forall a b. (Integral a, Num b) => a -> b
fromIntegral Alignment
n Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
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 -> Position -> FBState -> FBState
alignTo !Alignment
n !Position
additionalBytes fbs :: FBState
fbs@(FBState Builder
b BufferSize
bsize Max Alignment
ma Map ByteString Position
cache) =
  if Position
padding Position -> Position -> Bool
forall a. Eq a => a -> a -> Bool
== Position
0
    then FBState
fbs { maxAlign :: Max Alignment
maxAlign = Max Alignment
ma Max Alignment -> Max Alignment -> Max Alignment
forall a. Semigroup a => a -> a -> a
<> Alignment -> Max Alignment
coerce Alignment
n }
    else Builder
-> BufferSize
-> Max Alignment
-> Map ByteString Position
-> FBState
FBState
            (Position -> Builder
buildPadding Position
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
<> Position -> BufferSize
forall a. a -> Sum a
Sum Position
padding)
            (Max Alignment
ma Max Alignment -> Max Alignment -> Max Alignment
forall a. Semigroup a => a -> a -> a
<> Alignment -> Max Alignment
coerce Alignment
n)
            Map ByteString Position
cache
  where
    padding :: Position
padding = Alignment -> Position -> BufferSize -> Position
calcPadding Alignment
n Position
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 (Position -> FBState -> FBState
uoffsetFrom (Position -> FBState -> FBState)
-> (FBState -> Position) -> FBState -> FBState -> FBState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BufferSize -> Position
coerce (BufferSize -> Position)
-> (FBState -> BufferSize) -> FBState -> Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FBState -> BufferSize
bufferSize)

{-# INLINE uoffsetFrom #-}
uoffsetFrom :: Position -> FBState -> FBState
uoffsetFrom :: Position -> FBState -> FBState
uoffsetFrom Position
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 -> Position -> FBState -> FBState
alignTo Alignment
forall a. Num a => a
int32Size Position
0 FBState
fbs
    writeUOffset :: FBState -> FBState
writeUOffset FBState
fbs =
      let currentPos :: Position
currentPos = (FBState -> BufferSize) -> FBState -> Position
coerce FBState -> BufferSize
bufferSize FBState
fbs
      in  Position -> FBState -> FBState
writeInt32 (Position
currentPos Position -> Position -> Position
forall a. Num a => a -> a -> a
- Position
pos Position -> Position -> Position
forall a. Num a => a -> a -> a
+ Position
forall a. Num a => a
uoffsetSize) FBState
fbs

{-# INLINE utf8length #-}
utf8length :: Text -> Int32
utf8length :: Text -> Position
utf8length (TI.Text Array
arr Int
off Int
len)
  | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0  = Position
0
  | Bool
otherwise = IO Position -> Position
forall a. IO a -> a
unsafeDupablePerformIO (IO Position -> Position) -> IO Position -> Position
forall a b. (a -> b) -> a -> b
$
    ByteArray# -> CSize -> CSize -> IO Position
c_length_utf8 (Array -> ByteArray#
A.aBA Array
arr) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)

foreign import ccall unsafe "_hs_text_length_utf8" c_length_utf8
  :: ByteArray# -> CSize -> CSize -> IO Int32