{-# OPTIONS_GHC -Wno-incomplete-patterns #-} {- HLINT ignore "Reduce duplication" -} {- HLINT ignore "Use list comprehension" -} module FlatBuffers.Integration.RoundTripThroughFlatcSpec where import Control.Applicative (liftA3) import Data.Aeson (Value(..), object, (.=)) import Data.Aeson qualified as J import Data.Aeson.QQ.Simple (aesonQQ) import Data.Bits ((.|.)) import Data.ByteString.Lazy qualified as BSL import Data.Int import Data.Maybe (isNothing) import Data.Proxy import Data.Typeable (Typeable, typeRep) import Data.Word import Examples import FlatBuffers import FlatBuffers.Vector qualified as Vec import System.Directory qualified as Dir import System.Process qualified as Sys import TestImports {- These tests ensure our encoders/decoders are consistent with flatc's. Each test: - creates a flatbuffer using haskell's encoders - saves it to a .bin file - asks flatc to convert it to a .json file - reads the json into memory, checks it against the expected json - asks flatc to convert that .json file back to .bin - reads the flatbuffer created by flatc into memory, checks that it contains the same data as we started with. See "Using flatc as a Conversion Tool" at the bottom: https://google.github.io/flatbuffers/flatbuffers_guide_tutorial.html -} spec :: Spec spec = describe "Haskell encoders/decoders should be consistent with flatc" $ beforeAll_ (Dir.createDirectoryIfMissing True "temp") $ do describe "Primitives" $ do it "present with maxBound" $ do (json, decoded) <- flatcWithFileIdentifier $ primitives (Just maxBound) (Just maxBound) (Just maxBound) (Just maxBound) (Just maxBound) (Just maxBound) (Just maxBound) (Just maxBound) (Just 1234.56) (Just 2873242.82782) (Just True) (Just "hi 👬 bye") json `shouldBeJson` object [ "a" .= maxBound @Word8 , "b" .= maxBound @Word16 , "c" .= maxBound @Word32 , "d" .= maxBound @Word64 , "e" .= maxBound @Int8 , "f" .= maxBound @Int16 , "g" .= maxBound @Int32 , "h" .= maxBound @Int64 , "i" .= Number 1234.560059 , "j" .= Number 2873242.827819999773 , "k" .= True , "l" .= String "hi 👬 bye" ] primitivesA decoded `shouldBe` Right maxBound primitivesB decoded `shouldBe` Right maxBound primitivesC decoded `shouldBe` Right maxBound primitivesD decoded `shouldBe` Right maxBound primitivesE decoded `shouldBe` Right maxBound primitivesF decoded `shouldBe` Right maxBound primitivesG decoded `shouldBe` Right maxBound primitivesH decoded `shouldBe` Right maxBound primitivesI decoded `shouldBe` Right 1234.56 primitivesJ decoded `shouldBe` Right 2873242.82782 primitivesK decoded `shouldBe` Right True primitivesL decoded `shouldBe` Right (Just "hi 👬 bye") it "present with minBound" $ do (json, decoded) <- flatcWithFileIdentifier $ primitives (Just minBound) (Just minBound) (Just minBound) (Just minBound) (Just minBound) (Just minBound) (Just minBound) (Just minBound) (Just 1234.56) (Just 2873242.82782) (Just False) (Just "hi 👬 bye") json `shouldBeJson` object [ "e" .= minBound @Int8 , "f" .= minBound @Int16 , "g" .= minBound @Int32 , "h" .= minBound @Int64 , "i" .= Number 1234.560059 , "j" .= Number 2873242.827819999773 , "l" .= String "hi 👬 bye" ] primitivesA decoded `shouldBe` Right minBound primitivesB decoded `shouldBe` Right minBound primitivesC decoded `shouldBe` Right minBound primitivesD decoded `shouldBe` Right minBound primitivesE decoded `shouldBe` Right minBound primitivesF decoded `shouldBe` Right minBound primitivesG decoded `shouldBe` Right minBound primitivesH decoded `shouldBe` Right minBound primitivesI decoded `shouldBe` Right 1234.56 primitivesJ decoded `shouldBe` Right 2873242.82782 primitivesK decoded `shouldBe` Right False primitivesL decoded `shouldBe` Right (Just "hi 👬 bye") it "present with defaults" $ do (json, decoded) <- flatcWithFileIdentifier $ primitives (Just 0) (Just 0) (Just 0) (Just 0) (Just 0) (Just 0) (Just 0) (Just 0) (Just 0) (Just 0) (Just False) (Just "hi 👬 bye") json `shouldBeJson` object [ "l" .= String "hi 👬 bye" ] primitivesA decoded `shouldBe` Right 0 primitivesB decoded `shouldBe` Right 0 primitivesC decoded `shouldBe` Right 0 primitivesD decoded `shouldBe` Right 0 primitivesE decoded `shouldBe` Right 0 primitivesF decoded `shouldBe` Right 0 primitivesG decoded `shouldBe` Right 0 primitivesH decoded `shouldBe` Right 0 primitivesI decoded `shouldBe` Right 0 primitivesJ decoded `shouldBe` Right 0 primitivesK decoded `shouldBe` Right False primitivesL decoded `shouldBe` Right (Just "hi 👬 bye") it "missing" $ do (json, decoded) <- flatcWithFileIdentifier $ primitives Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing json `shouldBeJson` object [] primitivesA decoded `shouldBe` Right 0 primitivesB decoded `shouldBe` Right 0 primitivesC decoded `shouldBe` Right 0 primitivesD decoded `shouldBe` Right 0 primitivesE decoded `shouldBe` Right 0 primitivesF decoded `shouldBe` Right 0 primitivesG decoded `shouldBe` Right 0 primitivesH decoded `shouldBe` Right 0 primitivesI decoded `shouldBe` Right 0 primitivesJ decoded `shouldBe` Right 0 primitivesK decoded `shouldBe` Right False primitivesL decoded `shouldBe` Right Nothing describe "Enums" $ do let readStructWithEnum = (liftA3 . liftA3) (,,) structWithEnumX (fmap toColor <$> structWithEnumY) structWithEnumZ it "present" $ do (json, decoded) <- flatc $ enums (Just (fromColor ColorGray)) (Just (structWithEnum 11 (fromColor ColorRed) 22)) (Just (Vec.fromList' [fromColor ColorBlack, fromColor ColorBlue, fromColor ColorGreen])) (Just (Vec.fromList' [structWithEnum 33 (fromColor ColorRed) 44, structWithEnum 55 (fromColor ColorGreen) 66])) json `shouldBeJson` object [ "x" .= String "Gray" , "y" .= object [ "x" .= Number 11, "y" .= String "Red", "z" .= Number 22 ] , "xs" .= [ String "Black", String "Blue", String "Green" ] , "ys" .= [ object [ "x" .= Number 33, "y" .= String "Red", "z" .= Number 44 ] , object [ "x" .= Number 55, "y" .= String "Green", "z" .= Number 66 ] ] ] toColor <$> enumsX decoded `shouldBe` Right (Just ColorGray) (enumsY decoded >>= traverse readStructWithEnum) `shouldBe` Right (Just (11, Just ColorRed, 22)) (enumsXs decoded >>= traverse Vec.toList) `shouldBe` Right (Just [fromColor ColorBlack, fromColor ColorBlue, fromColor ColorGreen]) (enumsYs decoded >>= traverse Vec.toList >>= traverse (traverse readStructWithEnum)) `shouldBe` Right (Just [ (33, Just ColorRed, 44) , (55, Just ColorGreen, 66) ]) it "present with defaults" $ do (json, decoded) <- flatc $ enums (Just (fromColor ColorGreen)) Nothing Nothing Nothing json `shouldBeJson` object [ ] toColor <$> enumsX decoded `shouldBe` Right (Just ColorGreen) enumsY decoded `shouldBeRightAnd` isNothing enumsXs decoded `shouldBeRightAnd` isNothing enumsYs decoded `shouldBeRightAnd` isNothing it "missing" $ do (json, decoded) <- flatc $ enums Nothing Nothing Nothing Nothing json `shouldBeJson` object [ ] toColor <$> enumsX decoded `shouldBe` Right (Just ColorGreen) enumsY decoded `shouldBeRightAnd` isNothing enumsXs decoded `shouldBeRightAnd` isNothing enumsYs decoded `shouldBeRightAnd` isNothing describe "Enums with bit_flags" $ do it "present" $ do (json, decoded) <- flatc $ enumsBitFlags (Just (colorsRed .|. colorsGreen)) (Just (structWithEnumBitFlags (colorsGreen .|. colorsGray))) (Just (Vec.fromList' [ colorsGreen .|. colorsGray , colorsBlack .|. colorsBlue , colorsGreen ])) (Just (Vec.fromList' [ structWithEnumBitFlags (colorsGreen .|. colorsGray) , structWithEnumBitFlags (colorsBlack .|. colorsBlue) , structWithEnumBitFlags colorsGreen ])) json `shouldBeJson` object [ "x" .= String "Red Green" , "y" .= object [ "x" .= String "Green Gray" ] , "xs" .= [ String "Green Gray" , String "Blue Black" , String "Green" ] , "ys" .= [ object [ "x" .= String "Green Gray" ] , object [ "x" .= String "Blue Black" ] , object [ "x" .= String "Green" ] ] ] enumsBitFlagsX decoded `shouldBe` Right (colorsRed .|. colorsGreen) (enumsBitFlagsY decoded >>= traverse structWithEnumBitFlagsX) `shouldBe` Right (Just (colorsGreen .|. colorsGray)) (enumsBitFlagsXs decoded >>= traverse Vec.toList) `shouldBe` Right (Just [ colorsGreen .|. colorsGray , colorsBlack .|. colorsBlue , colorsGreen ]) (enumsBitFlagsYs decoded >>= traverse Vec.toList >>= traverse (traverse structWithEnumBitFlagsX)) `shouldBe` Right (Just [ colorsGreen .|. colorsGray , colorsBlack .|. colorsBlue , colorsGreen ]) it "present with defaults" $ do (json, decoded) <- flatc $ enumsBitFlags (Just 0) Nothing Nothing Nothing json `shouldBeJson` object [ ] enumsBitFlagsX decoded `shouldBe` Right 0 enumsBitFlagsY decoded `shouldBeRightAnd` isNothing enumsBitFlagsXs decoded `shouldBeRightAnd` isNothing enumsBitFlagsYs decoded `shouldBeRightAnd` isNothing it "missing" $ do (json, decoded) <- flatc $ enumsBitFlags Nothing Nothing Nothing Nothing json `shouldBeJson` object [ ] enumsBitFlagsX decoded `shouldBe` Right 0 enumsBitFlagsY decoded `shouldBeRightAnd` isNothing enumsBitFlagsXs decoded `shouldBeRightAnd` isNothing enumsBitFlagsYs decoded `shouldBeRightAnd` isNothing describe "Structs" $ do it "present" $ do let readStruct1 = (liftA3 . liftA3) (,,) struct1X struct1Y struct1Z let readStruct2 = struct2X let readStruct3 = (liftA3 . liftA3) (,,) (struct2X . struct3X) struct3Y struct3Z let readStruct4 = (liftA4 . liftA4) (,,,) (struct2X . struct4W) struct4X struct4Y struct4Z (json, decoded) <- flatc $ structs (Just (struct1 1 2 3)) (Just (struct2 11)) (Just (struct3 (struct2 22) 33 44)) (Just (struct4 (struct2 55) 66 77 True)) json `shouldBeJson` object [ "a" .= object ["x" .= Number 1, "y" .= Number 2, "z" .= Number 3] , "b" .= object ["x" .= Number 11] , "c" .= object ["x" .= object ["x" .= Number 22], "y" .= Number 33, "z" .= Number 44 ] , "d" .= object ["w" .= object ["x" .= Number 55], "x" .= Number 66, "y" .= Number 77, "z" .= True ] ] s1 <- evalRightJust $ structsA decoded s2 <- evalRightJust $ structsB decoded s3 <- evalRightJust $ structsC decoded s4 <- evalRightJust $ structsD decoded readStruct1 s1 `shouldBe` Right (1, 2, 3) readStruct2 s2 `shouldBe` Right 11 readStruct3 s3 `shouldBe` Right (22, 33, 44) readStruct4 s4 `shouldBe` Right (55, 66, 77, True) it "missing" $ do (json, decoded) <- flatc $ structs Nothing Nothing Nothing Nothing json `shouldBeJson` object [ ] structsA decoded `shouldBeRightAnd` isNothing structsB decoded `shouldBeRightAnd` isNothing structsC decoded `shouldBeRightAnd` isNothing structsD decoded `shouldBeRightAnd` isNothing describe "Nested tables" $ do it "present" $ do (json, decoded) <- flatc $ nestedTables (Just (table1 (Just (table2 (Just 11))) (Just 22))) json `shouldBeJson` object [ "x" .= object [ "x" .= object [ "x" .= Number 11 ] , "y" .= Number 22 ] ] t1 <- evalRightJust $ nestedTablesX decoded t2 <- evalRightJust $ table1X t1 table1Y t1 `shouldBe` Right 22 table2X t2 `shouldBe` Right 11 it "missing table2" $ do (json, decoded) <- flatc $ nestedTables (Just (table1 Nothing (Just 22))) json `shouldBeJson` object [ "x" .= object [ "y" .= Number 22 ] ] t1 <- evalRightJust $ nestedTablesX decoded table1X t1 `shouldBeRightAnd` isNothing table1Y t1 `shouldBe` Right 22 it "missing table1" $ do (json, decoded) <- flatc $ nestedTables Nothing json `shouldBeJson` object [] nestedTablesX decoded `shouldBeRightAnd` isNothing describe "Union" $ describe "present" $ do it "with sword" $ do (json, decoded) <- flatc $ tableWithUnion $ Just $ weaponSword $ sword $ Just "hi" json `shouldBeJson` object [ "uni" .= object [ "x" .= String "hi" ] , "uni_type" .= String "Sword" ] tableWithUnionUni decoded `shouldBeRightAndExpect` \case Just (Union (WeaponSword x)) -> swordX x `shouldBe` Right (Just "hi") it "with axe" $ do (json, decoded) <- flatc $ tableWithUnion $ Just $ weaponAxe $ axe $ Just maxBound json `shouldBeJson` object [ "uni" .= object [ "y" .= maxBound @Int32 ] , "uni_type" .= String "Axe" ] tableWithUnionUni decoded `shouldBeRightAndExpect` \case Just (Union (WeaponAxe x)) -> axeY x `shouldBe` Right maxBound it "with none" $ do (json, decoded) <- flatc $ tableWithUnion Nothing json `shouldBeJson` object [] tableWithUnionUni decoded `shouldBeRightAndExpect` \case Nothing -> pure () describe "Vectors" $ do it "non-empty" $ do (json, decoded) <- flatc $ vectors (Just (Vec.fromList' [minBound, 0, maxBound])) (Just (Vec.fromList' [minBound, 0, maxBound])) (Just (Vec.fromList' [minBound, 0, maxBound])) (Just (Vec.fromList' [minBound, 0, maxBound])) (Just (Vec.fromList' [minBound, 0, maxBound])) (Just (Vec.fromList' [minBound, 0, maxBound])) (Just (Vec.fromList' [minBound, 0, maxBound])) (Just (Vec.fromList' [minBound, 0, maxBound])) (Just (Vec.fromList' [-12e9, 0, 3.333333])) (Just (Vec.fromList' [-12e98, 0, 3.33333333333333333333])) (Just (Vec.fromList' [True, False, True])) (Just (Vec.fromList' ["hi 👬 bye", "", "world"])) json `shouldBeJson` object [ "a" .= [ minBound @Word8, 0, maxBound @Word8 ] , "b" .= [ minBound @Word16, 0, maxBound @Word16 ] , "c" .= [ minBound @Word32, 0, maxBound @Word32 ] , "d" .= [ minBound @Word64, 0, maxBound @Word64 ] , "e" .= [ minBound @Int8, 0, maxBound @Int8 ] , "f" .= [ minBound @Int16, 0, maxBound @Int16 ] , "g" .= [ minBound @Int32, 0, maxBound @Int32 ] , "h" .= [ minBound @Int64, 0, maxBound @Int64 ] , "i" .= [ Number (-12e9), Number 0, Number 3.333333 ] , "j" .= [ Number (-1.200000000000000057936847176226483074592535164143811899621896087972531077696693922075702102406987776e99), Number 0.0, Number 3.333333333333 ] , "k" .= [ True, False, True ] , "l" .= [ String "hi 👬 bye", String "", String "world"] ] (vectorsA decoded >>= traverse Vec.toList) `shouldBe` Right (Just [minBound, 0, maxBound]) (vectorsB decoded >>= traverse Vec.toList) `shouldBe` Right (Just [minBound, 0, maxBound]) (vectorsC decoded >>= traverse Vec.toList) `shouldBe` Right (Just [minBound, 0, maxBound]) (vectorsD decoded >>= traverse Vec.toList) `shouldBe` Right (Just [minBound, 0, maxBound]) (vectorsE decoded >>= traverse Vec.toList) `shouldBe` Right (Just [minBound, 0, maxBound]) (vectorsF decoded >>= traverse Vec.toList) `shouldBe` Right (Just [minBound, 0, maxBound]) (vectorsG decoded >>= traverse Vec.toList) `shouldBe` Right (Just [minBound, 0, maxBound]) (vectorsH decoded >>= traverse Vec.toList) `shouldBe` Right (Just [minBound, 0, maxBound]) (vectorsI decoded >>= traverse Vec.toList) `shouldBe` Right (Just [-12e9, 0, 3.333333]) (vectorsJ decoded >>= traverse Vec.toList) `shouldBe` Right (Just [-12e98, 0, 3.333333333333]) (vectorsK decoded >>= traverse Vec.toList) `shouldBe` Right (Just [True, False, True]) (vectorsL decoded >>= traverse Vec.toList) `shouldBe` Right (Just ["hi 👬 bye", "", "world"]) it "empty" $ do (json, decoded) <- flatc $ vectors (Just Vec.empty) (Just Vec.empty) (Just Vec.empty) (Just Vec.empty) (Just Vec.empty) (Just Vec.empty) (Just Vec.empty) (Just Vec.empty) (Just Vec.empty) (Just Vec.empty) (Just Vec.empty) (Just Vec.empty) json `shouldBeJson` object [ "a" .= [] @Value , "b" .= [] @Value , "c" .= [] @Value , "d" .= [] @Value , "e" .= [] @Value , "f" .= [] @Value , "g" .= [] @Value , "h" .= [] @Value , "i" .= [] @Value , "j" .= [] @Value , "k" .= [] @Value , "l" .= [] @Value ] (vectorsA decoded >>= traverse Vec.toList) `shouldBe` Right (Just []) (vectorsB decoded >>= traverse Vec.toList) `shouldBe` Right (Just []) (vectorsC decoded >>= traverse Vec.toList) `shouldBe` Right (Just []) (vectorsD decoded >>= traverse Vec.toList) `shouldBe` Right (Just []) (vectorsE decoded >>= traverse Vec.toList) `shouldBe` Right (Just []) (vectorsF decoded >>= traverse Vec.toList) `shouldBe` Right (Just []) (vectorsG decoded >>= traverse Vec.toList) `shouldBe` Right (Just []) (vectorsH decoded >>= traverse Vec.toList) `shouldBe` Right (Just []) (vectorsI decoded >>= traverse Vec.toList) `shouldBe` Right (Just []) (vectorsJ decoded >>= traverse Vec.toList) `shouldBe` Right (Just []) (vectorsK decoded >>= traverse Vec.toList) `shouldBe` Right (Just []) (vectorsL decoded >>= traverse Vec.toList) `shouldBe` Right (Just []) it "missing" $ do (json, decoded) <- flatc $ vectors Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing json `shouldBeJson` object [] vectorsA decoded `shouldBeRightAnd` isNothing vectorsB decoded `shouldBeRightAnd` isNothing vectorsC decoded `shouldBeRightAnd` isNothing vectorsD decoded `shouldBeRightAnd` isNothing vectorsE decoded `shouldBeRightAnd` isNothing vectorsF decoded `shouldBeRightAnd` isNothing vectorsG decoded `shouldBeRightAnd` isNothing vectorsH decoded `shouldBeRightAnd` isNothing vectorsI decoded `shouldBeRightAnd` isNothing vectorsJ decoded `shouldBeRightAnd` isNothing vectorsK decoded `shouldBeRightAnd` isNothing vectorsL decoded `shouldBeRightAnd` isNothing describe "VectorOfTables" $ do it "non empty" $ do (json, decoded) <- flatc $ vectorOfTables (Just $ Vec.fromList' [ axe (Just minBound) , axe (Just 0) , axe (Just maxBound) ] ) json `shouldBeJson` object [ "xs" .= [ object [ "y" .= minBound @Int32 ] , object [ ] , object [ "y" .= maxBound @Int32 ] ] ] xs <- evalRightJust $ vectorOfTablesXs decoded (Vec.toList xs >>= traverse axeY) `shouldBe` Right [minBound, 0, maxBound] it "empty" $ do (json, decoded) <- flatc $ vectorOfTables (Just Vec.empty) json `shouldBeJson` object [ "xs" .= [] @Value] xs <- evalRightJust $ vectorOfTablesXs decoded Vec.length xs `shouldBe` 0 it "missing" $ do (json, decoded) <- flatc $ vectorOfTables Nothing json `shouldBeJson` object [] vectorOfTablesXs decoded `shouldBeRightAnd` isNothing describe "VectorOfStructs" $ do let readStruct1 = (liftA3 . liftA3) (,,) struct1X struct1Y struct1Z let readStruct2 = struct2X let readStruct3 = (liftA3 . liftA3) (,,) (struct2X . struct3X) struct3Y struct3Z let readStruct4 = (liftA4 . liftA4) (,,,) (struct2X . struct4W) struct4X struct4Y struct4Z it "non empty" $ do (json, decoded) <- flatc $ vectorOfStructs (Just (Vec.fromList' [struct1 1 2 3, struct1 4 5 6])) (Just (Vec.fromList' [struct2 101, struct2 102, struct2 103])) (Just (Vec.fromList' [struct3 (struct2 104) 105 106, struct3 (struct2 107) 108 109, struct3 (struct2 110) 111 112])) (Just (Vec.fromList' [struct4 (struct2 120) 121 122 True, struct4 (struct2 123) 124 125 False, struct4 (struct2 126) 127 128 True])) json `shouldBeJson` object [ "as" .= [ object [ "x" .= Number 1, "y" .= Number 2, "z" .= Number 3] , object [ "x" .= Number 4, "y" .= Number 5, "z" .= Number 6] ] , "bs" .= [ object ["x" .= Number 101] , object ["x" .= Number 102] , object ["x" .= Number 103] ] , "cs" .= [ object ["x" .= object ["x" .= Number 104], "y" .= Number 105, "z" .= Number 106 ] , object ["x" .= object ["x" .= Number 107], "y" .= Number 108, "z" .= Number 109 ] , object ["x" .= object ["x" .= Number 110], "y" .= Number 111, "z" .= Number 112 ] ] , "ds" .= [ object ["w" .= object ["x" .= Number 120], "x" .= Number 121, "y" .= Number 122, "z" .= True ] , object ["w" .= object ["x" .= Number 123], "x" .= Number 124, "y" .= Number 125, "z" .= False ] , object ["w" .= object ["x" .= Number 126], "x" .= Number 127, "y" .= Number 128, "z" .= True ] ] ] as <- evalRightJust (vectorOfStructsAs decoded) >>= (evalRight . Vec.toList) bs <- evalRightJust (vectorOfStructsBs decoded) >>= (evalRight . Vec.toList) cs <- evalRightJust (vectorOfStructsCs decoded) >>= (evalRight . Vec.toList) ds <- evalRightJust (vectorOfStructsDs decoded) >>= (evalRight . Vec.toList) traverse readStruct1 as `shouldBe` Right [(1,2,3), (4,5,6)] traverse readStruct2 bs `shouldBe` Right [101, 102, 103] traverse readStruct3 cs `shouldBe` Right [(104, 105, 106), (107, 108, 109), (110, 111, 112)] traverse readStruct4 ds `shouldBe` Right [(120, 121, 122, True), (123, 124, 125, False), (126, 127, 128, True)] it "empty" $ do (json, decoded) <- flatc $ vectorOfStructs (Just Vec.empty) (Just Vec.empty) (Just Vec.empty) (Just Vec.empty) json `shouldBeJson` object [ "as" .= [] @Value, "bs" .= [] @Value, "cs" .= [] @Value, "ds" .= [] @Value ] as <- evalRightJust $ vectorOfStructsAs decoded bs <- evalRightJust $ vectorOfStructsBs decoded cs <- evalRightJust $ vectorOfStructsCs decoded ds <- evalRightJust $ vectorOfStructsCs decoded Vec.length as `shouldBe` 0 Vec.length bs `shouldBe` 0 Vec.length cs `shouldBe` 0 Vec.length ds `shouldBe` 0 it "missing" $ do (json, decoded) <- flatc $ vectorOfStructs Nothing Nothing Nothing Nothing json `shouldBeJson` object [] vectorOfStructsAs decoded `shouldBeRightAnd` isNothing vectorOfStructsBs decoded `shouldBeRightAnd` isNothing vectorOfStructsCs decoded `shouldBeRightAnd` isNothing vectorOfStructsDs decoded `shouldBeRightAnd` isNothing describe "VectorOfUnions" do it "non empty" do (json, decoded) <- flatc $ vectorOfUnions $ Just $ Vec.fromList' [ weaponSword (sword (Just "hi")) , weaponAxe (axe (Just maxBound)) , weaponSword (sword Nothing) ] json `shouldBeJson` [aesonQQ| { "xs": [ {"x": "hi"}, {"y": 2147483647}, {} ], "xs_type": [ "Sword", "Axe", "Sword" ] } |] vec <- evalRightJust $ vectorOfUnionsXs decoded [x, y, z] <- evalRight $ Vec.toList vec case x of Union (WeaponSword sword) -> swordX sword `shouldBe` Right (Just "hi") case y of Union (WeaponAxe axe) -> axeY axe `shouldBe` Right (maxBound @Int32) case z of Union (WeaponSword sword) -> swordX sword `shouldBe` Right Nothing it "empty" do (json, decoded) <- flatc $ vectorOfUnions $ Just Vec.empty json `shouldBeJson` [aesonQQ| { "xs": [], "xs_type": [] } |] vec <- evalRightJust $ vectorOfUnionsXs decoded Vec.length vec `shouldBe` 0 it "missing" do (json, decoded) <- flatc $ vectorOfUnions Nothing json `shouldBeJson` [aesonQQ|{ }|] vectorOfUnionsXs decoded `shouldBeRightAnd` isNothing describe "ScalarsWithDefaults" $ do let runTest buffer = do (json, decoded) <- flatc buffer json `shouldBeJson` object [ ] scalarsWithDefaultsA decoded `shouldBe` Right 8 scalarsWithDefaultsB decoded `shouldBe` Right 16 scalarsWithDefaultsC decoded `shouldBe` Right 32 scalarsWithDefaultsD decoded `shouldBe` Right 64 scalarsWithDefaultsE decoded `shouldBe` Right (-1) scalarsWithDefaultsF decoded `shouldBe` Right (-2) scalarsWithDefaultsG decoded `shouldBe` Right (-4) scalarsWithDefaultsH decoded `shouldBe` Right (-8) scalarsWithDefaultsI decoded `shouldBe` Right 3.9 scalarsWithDefaultsJ decoded `shouldBe` Right (-2.3e10) scalarsWithDefaultsK decoded `shouldBe` Right True scalarsWithDefaultsL decoded `shouldBe` Right False toColor <$> scalarsWithDefaultsM decoded `shouldBe` Right (Just ColorBlue) toColor <$> scalarsWithDefaultsN decoded `shouldBe` Right (Just ColorGray) scalarsWithDefaultsO decoded `shouldBe` Right 0 scalarsWithDefaultsP decoded `shouldBe` Right (colorsGreen .|. colorsBlue) scalarsWithDefaultsQ decoded `shouldBe` Right colorsRed scalarsWithDefaultsR decoded `shouldBe` Right (colorsGreen .|. colorsGray) it "present with defaults" $ runTest $ scalarsWithDefaults (Just 8) (Just 16) (Just 32) (Just 64) (Just (-1)) (Just (-2)) (Just (-4)) (Just (-8)) (Just 3.9) (Just (-2.3e10)) (Just True) (Just False) (Just (fromColor ColorBlue)) (Just (fromColor ColorGray)) (Just 0) (Just (colorsGreen .|. colorsBlue)) (Just colorsRed) (Just (colorsGreen .|. colorsGray)) it "missing" $ runTest $ scalarsWithDefaults Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing it "DeprecatedFields" $ do (json, decoded) <- flatc $ deprecatedFields (Just 1) (Just 2) (Just 3) (Just 4) (Just 5) json `shouldBeJson` object [ "a" .= Number 1 , "c" .= Number 2 , "e" .= Number 3 , "g" .= Number 4 , "i" .= Number 5 ] deprecatedFieldsA decoded `shouldBe` Right 1 deprecatedFieldsC decoded `shouldBe` Right 2 deprecatedFieldsE decoded `shouldBe` Right 3 deprecatedFieldsG decoded `shouldBe` Right 4 deprecatedFieldsI decoded `shouldBe` Right 5 it "RequiredFields" $ do let readStruct1 = (liftA3 . liftA3) (,,) struct1X struct1Y struct1Z (json, decoded) <- flatc $ requiredFields "hello" (struct1 11 22 33) (axe (Just 44)) (weaponSword (sword (Just "a"))) (Vec.fromList' [55, 66]) (Vec.singleton $ weaponSword (sword (Just "b"))) json `shouldBeJson` [aesonQQ| { "a": "hello", "b": { "x": 11, "y": 22, "z": 33 }, "c": { "y": 44 }, "d": { "x": "a" }, "d_type": "Sword", "e": [55, 66], "f": [ {"x": "b"} ], "f_type": [ "Sword" ] } |] requiredFieldsA decoded `shouldBe` Right "hello" (requiredFieldsB decoded >>= readStruct1) `shouldBe` Right (11, 22, 33) (requiredFieldsC decoded >>= axeY) `shouldBe` Right 44 requiredFieldsD decoded `shouldBeRightAndExpect` \case Union (WeaponSword x) -> swordX x `shouldBe` Right (Just "a") (requiredFieldsE decoded >>= Vec.toList) `shouldBe` Right [55, 66] (requiredFieldsF decoded >>= Vec.toList) `shouldBeRightAndExpect` \case [Union (WeaponSword x)] -> swordX x `shouldBe` Right (Just "b") flatc :: forall a. Typeable a => WriteTable a -> IO (J.Value, Table a) flatc table = flatcAux False (encode table) flatcWithFileIdentifier :: forall a. (HasFileIdentifier a, Typeable a) => WriteTable a -> IO (J.Value, Table a) flatcWithFileIdentifier table = flatcAux True (encodeWithFileIdentifier table) flatcAux :: forall a. Typeable a => Bool -> BSL.ByteString -> IO (J.Value, Table a) flatcAux withFileIdentifier bs = do let tableName = show $ typeRep (Proxy @a) BSL.writeFile "temp/a.bin" bs Sys.callProcess "flatc" $ (if not withFileIdentifier then ["--raw-binary"] else []) <> [ "-o", "./temp" , "./test/Examples/schema.fbs" , "--root-type", "examples.generated." <> tableName , "--json" , "--strict-json" , "--" , "temp/a.bin" ] json <- J.eitherDecodeFileStrict' "temp/a.json" >>= \case Left err -> fail $ "Failed to decode flatc's json:\n" <> err Right val -> pure val Sys.callProcess "cp" ["temp/a.json", "temp/b.json"] Sys.callProcess "flatc" [ "-o", "./temp" , "./test/Examples/schema.fbs" , "--root-type", "examples.generated." <> tableName , "--binary" , "--strict-json" , "temp/b.json" ] bs' <- BSL.readFile "temp/b.bin" case decode bs' of Right table -> pure (json, table) Left err -> fail err