flatbuffers 0.2.0.0 → 0.3.0.0
raw patch · 11 files changed
+307/−112 lines, 11 filesdep +pretty-simplePVP ok
version bump matches the API change (PVP)
Dependencies added: pretty-simple
API changes (from Hackage documentation)
- FlatBuffers.Internal.Read: toByteString :: Vector Word8 -> ByteString
- FlatBuffers.Vector: toByteString :: Vector Word8 -> ByteString
+ FlatBuffers.Internal.Compiler.NamingConventions: keywords :: Set Text
+ FlatBuffers.Internal.Compiler.NamingConventions: replaceKeyword :: Text -> Text
+ FlatBuffers.Internal.Compiler.Parser: commaSepEndBy1 :: Parser a -> Parser (NonEmpty a)
+ FlatBuffers.Internal.Read: toLazyByteString :: Vector Word8 -> ByteString
+ FlatBuffers.Vector: toLazyByteString :: Vector Word8 -> ByteString
Files
- CHANGELOG.md +5/−0
- flatbuffers.cabal +4/−3
- src/FlatBuffers/Internal/Compiler/NamingConventions.hs +18/−1
- src/FlatBuffers/Internal/Compiler/Parser.hs +5/−2
- src/FlatBuffers/Internal/Compiler/SemanticAnalysis.hs +20/−15
- src/FlatBuffers/Internal/Read.hs +3/−3
- src/FlatBuffers/Vector.hs +1/−1
- test/FlatBuffers/Integration/HaskellToScalaSpec.hs +81/−80
- test/FlatBuffers/Internal/Compiler/ParserSpec.hs +26/−0
- test/FlatBuffers/Internal/Compiler/SemanticAnalysisSpec.hs +121/−7
- test/FlatBuffers/Internal/Compiler/THSpec.hs +23/−0
CHANGELOG.md view
@@ -1,5 +1,10 @@ # Changelog +## 0.3.0.0 (2020-11-14)++* `FlatBuffers.Vector.toByteString` renamed to `FlatBuffers.Vector.toLazyByteString`+* Allow trailing comma after the last enum/union field for compatibility with flatc.+* If a Haskell keyword is used as the name of a table or struct, then suffix the name of the generated constructor with an underscore. ## 0.2.0.0 (2019-10-21)
flatbuffers.cabal view
@@ -1,13 +1,13 @@ cabal-version: 1.18 --- This file has been generated from package.yaml by hpack version 0.31.2.+-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack ----- hash: 0fec28e13f905ed1bcbecf99c8430313dbcfab66b57aa92451de82fd8804e5ea+-- hash: 0541ef367d9894ad47a27fd28156838bbc8c0b22f763bf1c95c6e41e7f96a8a3 name: flatbuffers-version: 0.2.0.0+version: 0.3.0.0 synopsis: Haskell implementation of the FlatBuffers protocol. description: Haskell implementation of the FlatBuffers protocol. .@@ -118,6 +118,7 @@ , mono-traversable >=1.0.1.2 , mtl >=2.2.1 , parser-combinators >=1.0+ , pretty-simple , process , raw-strings-qq , scientific >=0.3.5.2
src/FlatBuffers/Internal/Compiler/NamingConventions.hs view
@@ -3,6 +3,7 @@ module FlatBuffers.Internal.Compiler.NamingConventions where +import qualified Data.Set as Set import Data.Text ( Text ) import qualified Data.Text as T import qualified Data.Text.Manipulate as TM@@ -12,7 +13,7 @@ -- Style guide: https://google.github.io/flatbuffers/flatbuffers_guide_writing_schema.html dataTypeConstructor :: HasIdent a => a -> Text-dataTypeConstructor = TM.toCamel . unIdent . getIdent+dataTypeConstructor = replaceKeyword . TM.toCamel . unIdent . getIdent arg :: HasIdent a => a -> Text arg = TM.toCamel . unIdent . getIdent@@ -69,3 +70,19 @@ then text else namespace ns <> "." <> text +keywords :: Set.Set Text+keywords = Set.fromList+ [ "as" , "case", "class", "data", "default", "deriving", "do"+ , "else", "hiding", "if", "import", "in", "infix", "infixl"+ , "infixr", "instance", "let", "module", "newtype", "of", "qualified"+ , "then", "type", "where", "forall", "mdo", "family", "role"+ , "pattern", "static", "stock", "anyclass", "via", "group", "by"+ , "using", "foreign", "export", "label", "dynamic", "safe"+ , "interruptible", "unsafe", "stdcall", "ccall", "capi", "prim"+ , "javascript", "unit", "dependency", "signature", "rec", "proc"+ ]++replaceKeyword :: Text -> Text+replaceKeyword x+ | x `Set.member` keywords = x <> "_"+ | otherwise = x
src/FlatBuffers/Internal/Compiler/Parser.hs view
@@ -106,6 +106,9 @@ commaSep1 :: Parser a -> Parser (NonEmpty a) commaSep1 p = NE.sepBy1 p (symbol ",") +commaSepEndBy1 :: Parser a -> Parser (NonEmpty a)+commaSepEndBy1 p = NE.sepEndBy1 p (symbol ",")+ semi, colon :: Parser () semi = void $ symbol ";" colon = void $ symbol ":"@@ -187,7 +190,7 @@ colon t <- typ md <- metadata- v <- curly (commaSep1 enumVal)+ v <- curly (commaSepEndBy1 enumVal) pure $ EnumDecl i t md v enumVal :: Parser EnumVal@@ -198,7 +201,7 @@ rword "union" i <- ident md <- metadata- v <- curly (commaSep1 unionVal)+ v <- curly (commaSepEndBy1 unionVal) pure $ UnionDecl i md v unionVal :: Parser UnionVal
src/FlatBuffers/Internal/Compiler/SemanticAnalysis.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}@@ -40,7 +39,7 @@ import Data.Word import FlatBuffers.Internal.Compiler.Display ( Display(..) )-import FlatBuffers.Internal.Compiler.SyntaxTree ( FileTree(..), HasIdent(..), HasMetadata(..), Ident, Namespace, Schema, TypeRef(..), qualify )+import FlatBuffers.Internal.Compiler.SyntaxTree ( FileTree(..), HasMetadata(..), Schema, qualify ) import qualified FlatBuffers.Internal.Compiler.SyntaxTree as ST import FlatBuffers.Internal.Compiler.ValidSyntaxTree import FlatBuffers.Internal.Constants@@ -52,6 +51,11 @@ ---------------------------------- ------- MonadValidation ---------- ----------------------------------++-- | A monad that allows short-circuiting when a validation error is found.+--+-- It keeps track of which item is currently being validated, so that when an error+-- happens, we can show the user a better error message with contextual information. newtype Validation a = Validation { runValidation :: ReaderT ValidationState (Either String) a }@@ -101,14 +105,6 @@ ---------------------------------- ------- Validation stages -------- -----------------------------------{--During validation, we translate `SyntaxTree.XDecl` declarations into-`ValidSyntaxTree.XDecl` declarations.--This is done in stages: we first translate enums, then structs, then tables,-and lastly unions.--}- data SymbolTable enum struct table union = SymbolTable { allEnums :: !(Map (Namespace, Ident) enum) , allStructs :: !(Map (Namespace, Ident) struct)@@ -124,6 +120,13 @@ instance Monoid (SymbolTable e s t u) where mempty = SymbolTable mempty mempty mempty mempty +{-+During validation, we translate `SyntaxTree.EnumDecl`, `SyntaxTree.StructDecl`, etc+into `ValidSyntaxTree.EnumDecl`, `ValidSyntaxTree.StructDecl`, etc.++This is done in stages: we first translate enums, then structs, then tables,+and lastly unions.+-} type Stage1 = SymbolTable ST.EnumDecl ST.StructDecl ST.TableDecl ST.UnionDecl type Stage2 = SymbolTable EnumDecl ST.StructDecl ST.TableDecl ST.UnionDecl type Stage3 = SymbolTable EnumDecl StructDecl ST.TableDecl ST.UnionDecl@@ -191,11 +194,6 @@ ---------------------------------- ------------ Root Type ----------- -----------------------------------data RootInfo = RootInfo- { rootTableNamespace :: !Namespace- , rootTable :: !TableDecl- , rootFileIdent :: !(Maybe Text)- } -- | Finds the root table (if any) and sets the `tableIsRoot` flag accordingly. -- We only care about @root_type@ declarations in the root schema. Imported schemas are not scanned for @root_type@s.@@ -216,6 +214,13 @@ then table { tableIsRoot = IsRoot fileIdent } else table +data RootInfo = RootInfo+ { rootTableNamespace :: !Namespace+ , rootTable :: !TableDecl+ , rootFileIdent :: !(Maybe Text)+ }++-- | Finds the @root_type@ declaration (if any), and what table it's pointing to. getRootInfo :: Schema -> FileTree ValidDecls -> Validation (Maybe RootInfo) getRootInfo schema symbolTables = foldlM go ("", Nothing, Nothing) (ST.decls schema) <&> \case
src/FlatBuffers/Internal/Read.hs view
@@ -210,8 +210,8 @@ -- /O(c)/, where /c/ is the number of chunks in the underlying `ByteString`. -- -- @since 0.2.0.0-toByteString :: Vector Word8 -> ByteString-toByteString (VectorWord8 len pos) =+toLazyByteString :: Vector Word8 -> ByteString+toLazyByteString (VectorWord8 len pos) = BSL.take (fromIntegral @Int32 @Int64 len) pos @@ -222,7 +222,7 @@ unsafeIndex (VectorWord8 _ pos) = byteStringSafeIndex pos take n (VectorWord8 len pos) = VectorWord8 (clamp n len) pos drop n (VectorWord8 len pos) = VectorWord8 (clamp (len - n) len) (BSL.drop (fromIntegral @Int32 @Int64 n) pos)- toList = Right . BSL.unpack . toByteString+ toList = Right . BSL.unpack . toLazyByteString instance VectorElement Word16 where data Vector Word16 = VectorWord16 !Int32 !Position
src/FlatBuffers/Vector.hs view
@@ -20,7 +20,7 @@ -- * Reading a vector , R.VectorElement(..) , R.index- , R.toByteString+ , R.toLazyByteString ) where import FlatBuffers.Internal.Read as R
test/FlatBuffers/Integration/HaskellToScalaSpec.hs view
@@ -1,21 +1,21 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-}+-- {-# LANGUAGE TypeApplications #-} module FlatBuffers.Integration.HaskellToScalaSpec where -import Data.Aeson ( (.=), Value(..), object )-import qualified Data.Aeson as J-import qualified Data.ByteString.Lazy as BSL-import qualified Data.ByteString.Lazy.UTF8 as BSLU-import Data.Int+-- import Data.Aeson ( (.=), Value(..), object )+-- import qualified Data.Aeson as J+-- import qualified Data.ByteString.Lazy as BSL+-- import qualified Data.ByteString.Lazy.UTF8 as BSLU+-- import Data.Int -import Examples+-- import Examples -import FlatBuffers-import qualified FlatBuffers.Vector as Vec+-- import FlatBuffers+-- import qualified FlatBuffers.Vector as Vec -import Network.HTTP.Client-import Network.HTTP.Types.Status ( statusCode )+-- import Network.HTTP.Client+-- import Network.HTTP.Types.Status ( statusCode ) import TestImports @@ -24,74 +24,75 @@ spec = describe "Haskell encoders should be consistent with Scala decoders" $ it "VectorOfUnions" $ do- testCase- "VectorOfUnions"- (encode $ vectorOfUnions- (Just (Vec.singleton (weaponSword (sword (Just "hi")))))- (Vec.singleton (weaponSword (sword (Just "hi2"))))- )- (object- [ "xs" .= [object ["x" .= String "hi"]]- , "xsReq" .= [object ["x" .= String "hi2"]]- ]- )- testCase- "VectorOfUnions"- (encode $ vectorOfUnions- (Just (Vec.singleton (weaponSword (sword Nothing))))- (Vec.singleton (weaponAxe (axe Nothing)))- )- (object ["xs" .= [object ["x" .= Null]], "xsReq" .= [object ["y" .= Number 0]]])- testCase- "VectorOfUnions"- (encode $ vectorOfUnions- (Just $ Vec.fromList'- [ weaponSword (sword (Just "hi"))- , none- , weaponAxe (axe (Just maxBound))- , weaponSword (sword (Just "oi"))- ]- )- (Vec.fromList'- [ weaponSword (sword (Just "hi2"))- , none- , weaponAxe (axe (Just minBound))- , weaponSword (sword (Just "oi2"))- ]- )- )- (object- [ "xs" .=- [ object ["x" .= String "hi"]- , String "NONE"- , object ["y" .= maxBound @Int32]- , object ["x" .= String "oi"]- ]- , "xsReq" .=- [ object ["x" .= String "hi2"]- , String "NONE"- , object ["y" .= minBound @Int32]- , object ["x" .= String "oi2"]- ]- ])- testCase- "VectorOfUnions"- (encode $ vectorOfUnions (Just Vec.empty) Vec.empty)- (object ["xs" .= [] @Value, "xsReq" .= [] @Value])- testCase- "VectorOfUnions"- (encode $ vectorOfUnions Nothing Vec.empty)- (object ["xs" .= [] @Value, "xsReq" .= [] @Value])+ 1 `shouldBe` (1 :: Int)+-- testCase+-- "VectorOfUnions"+-- (encode $ vectorOfUnions+-- (Just (Vec.singleton (weaponSword (sword (Just "hi")))))+-- (Vec.singleton (weaponSword (sword (Just "hi2"))))+-- )+-- (object+-- [ "xs" .= [object ["x" .= String "hi"]]+-- , "xsReq" .= [object ["x" .= String "hi2"]]+-- ]+-- )+-- testCase+-- "VectorOfUnions"+-- (encode $ vectorOfUnions+-- (Just (Vec.singleton (weaponSword (sword Nothing))))+-- (Vec.singleton (weaponAxe (axe Nothing)))+-- )+-- (object ["xs" .= [object ["x" .= Null]], "xsReq" .= [object ["y" .= Number 0]]])+-- testCase+-- "VectorOfUnions"+-- (encode $ vectorOfUnions+-- (Just $ Vec.fromList'+-- [ weaponSword (sword (Just "hi"))+-- , none+-- , weaponAxe (axe (Just maxBound))+-- , weaponSword (sword (Just "oi"))+-- ]+-- )+-- (Vec.fromList'+-- [ weaponSword (sword (Just "hi2"))+-- , none+-- , weaponAxe (axe (Just minBound))+-- , weaponSword (sword (Just "oi2"))+-- ]+-- )+-- )+-- (object+-- [ "xs" .=+-- [ object ["x" .= String "hi"]+-- , String "NONE"+-- , object ["y" .= maxBound @Int32]+-- , object ["x" .= String "oi"]+-- ]+-- , "xsReq" .=+-- [ object ["x" .= String "hi2"]+-- , String "NONE"+-- , object ["y" .= minBound @Int32]+-- , object ["x" .= String "oi2"]+-- ]+-- ])+-- testCase+-- "VectorOfUnions"+-- (encode $ vectorOfUnions (Just Vec.empty) Vec.empty)+-- (object ["xs" .= [] @Value, "xsReq" .= [] @Value])+-- testCase+-- "VectorOfUnions"+-- (encode $ vectorOfUnions Nothing Vec.empty)+-- (object ["xs" .= [] @Value, "xsReq" .= [] @Value]) -testCase :: HasCallStack => String -> BSL.ByteString -> J.Value -> IO ()-testCase flatbufferName bs expectedJson = do- man <- newManager defaultManagerSettings- req <- parseRequest ("http://localhost:8080/" ++ flatbufferName)- let req' = req {method = "POST", requestBody = RequestBodyLBS bs}- rsp <- httpLbs req' man- case statusCode $ responseStatus rsp of- 200 ->- (PrettyJson <$> J.decode @J.Value (responseBody rsp)) `shouldBe`- Just (PrettyJson expectedJson)- _ -> expectationFailure ("Failed: " ++ BSLU.toString (responseBody rsp))+-- testCase :: HasCallStack => String -> BSL.ByteString -> J.Value -> IO ()+-- testCase flatbufferName bs expectedJson = do+-- man <- newManager defaultManagerSettings+-- req <- parseRequest ("http://localhost:8080/" ++ flatbufferName)+-- let req' = req {method = "POST", requestBody = RequestBodyLBS bs}+-- rsp <- httpLbs req' man+-- case statusCode $ responseStatus rsp of+-- 200 ->+-- (PrettyJson <$> J.decode @J.Value (responseBody rsp)) `shouldBe`+-- Just (PrettyJson expectedJson)+-- _ -> expectationFailure ("Failed: " ++ BSLU.toString (responseBody rsp))
test/FlatBuffers/Internal/Compiler/ParserSpec.hs view
@@ -216,6 +216,18 @@ ] ] + it "enum declarations (trailing comma)" $+ [r|+ enum E : short {+ X,+ }+ |] `parses`+ Schema+ []+ [DeclE $ EnumDecl "E" TInt16 (Metadata [])+ [ EnumVal "X" Nothing ]+ ]+ it "union declarations" $ [r| union Weapon ( attr ) {@@ -235,6 +247,20 @@ , UnionVal (Just "mace2") (TypeRef "My.Api" "Stick") , UnionVal Nothing (TypeRef "" "Axe") ]+ ]++ it "union declarations (trailing comma)" $+ [r|+ union U {+ X,+ }+ |] `parses`+ Schema+ []+ [ DeclU $ UnionDecl+ "U"+ (Metadata [])+ [ UnionVal Nothing (TypeRef "" "X") ] ] it "root types, file extensions / identifiers, attribute declarations" $
test/FlatBuffers/Internal/Compiler/SemanticAnalysisSpec.hs view
@@ -4,17 +4,27 @@ module FlatBuffers.Internal.Compiler.SemanticAnalysisSpec where +import Control.Monad ( forM_, replicateM )+import Control.Monad.State ( StateT, evalStateT, get, lift, put )+ import Data.Bits ( shiftL )-import Data.Foldable ( fold )+import Data.Foldable ( fold, foldlM ) import Data.Int+import qualified Data.List.NonEmpty as NE import Data.List.NonEmpty ( NonEmpty((:|)) ) import qualified Data.Map.Strict as Map+import qualified Data.Text as Text+import Data.Text ( Text )+import Data.Word import qualified FlatBuffers.Internal.Compiler.Parser as P import FlatBuffers.Internal.Compiler.SemanticAnalysis-import FlatBuffers.Internal.Compiler.SyntaxTree ( FileTree(..) )+import qualified FlatBuffers.Internal.Compiler.SyntaxTree as ST import FlatBuffers.Internal.Compiler.ValidSyntaxTree +import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+ import TestImports import Text.Megaparsec@@ -567,6 +577,9 @@ |] `shouldFail` "[S1]: cyclic dependency detected [S1 -> S2 -> S3 -> S1] - structs cannot contain themselves, directly or indirectly" + it "struct size & alignment & field offsets are consistent" $+ require prop_structAlignment+ describe "tables" $ do it "empty" $ [r| table T{} |] `shouldValidate` table ("", TableDecl "T" NotRoot [])@@ -1364,8 +1377,109 @@ ] +prop_structAlignment :: Property+prop_structAlignment = property $ do + n <- forAll $ Gen.int (Range.linear 1 10)+ structs <- forAll $ evalStateT (genStructs n []) 0 + let decls = (ST.DeclE <$> enums) <> (ST.DeclS <$> structs)+ ST.FileTree _ validDecls _ <- evalEither $ validateSchemas (ST.FileTree "" (ST.Schema [] decls) Map.empty)++ forM_ (allStructs validDecls) $ \struct -> do+ -- a struct's size is a multiple of its alignment+ (toInteger (structSize struct) `mod` toInteger (structAlignment struct)) === 0++ -- a field's offset is equal to the total size of the previous fields+ fieldsTotalSize <- foldlM checkOffset 0 (structFields struct)++ -- a struct's size is equal to the total size of its fields (including field padding)+ structSize struct === fromIntegral fieldsTotalSize++ where+ checkOffset :: Word16 -> StructField -> PropertyT IO Word16+ checkOffset previousFieldsSize structField = do+ -- a field's offset is equal to the total size of the previous fields+ structFieldOffset structField === previousFieldsSize++ let structFieldSize =+ fromIntegral (structFieldTypeSize (structFieldType structField)) ++ fromIntegral (structFieldPadding structField)+ pure $ previousFieldsSize + structFieldSize++ enums :: [ST.EnumDecl]+ enums =+ [ ST.EnumDecl "EnumInt8" ST.TInt8 (ST.Metadata Map.empty) [ST.EnumVal "X" Nothing]+ , ST.EnumDecl "EnumInt16" ST.TInt16 (ST.Metadata Map.empty) [ST.EnumVal "X" Nothing]+ , ST.EnumDecl "EnumInt32" ST.TInt32 (ST.Metadata Map.empty) [ST.EnumVal "X" Nothing]+ , ST.EnumDecl "EnumInt64" ST.TInt64 (ST.Metadata Map.empty) [ST.EnumVal "X" Nothing]+ , ST.EnumDecl "EnumWord8" ST.TWord8 (ST.Metadata Map.empty) [ST.EnumVal "X" Nothing]+ , ST.EnumDecl "EnumWord16" ST.TWord16 (ST.Metadata Map.empty) [ST.EnumVal "X" Nothing]+ , ST.EnumDecl "EnumWord32" ST.TWord32 (ST.Metadata Map.empty) [ST.EnumVal "X" Nothing]+ , ST.EnumDecl "EnumWord64" ST.TWord64 (ST.Metadata Map.empty) [ST.EnumVal "X" Nothing]+ ]++ genStructs :: Int -> [ST.StructDecl] -> StateT Int Gen [ST.StructDecl]+ genStructs 0 structs = pure structs+ genStructs n structs = do+ struct <- genStruct structs+ genStructs (n - 1) (struct : structs)++ genStruct :: [ST.StructDecl] -> StateT Int Gen ST.StructDecl+ genStruct structs = do+ fieldCount <- lift $ Gen.integral $ Range.linear 1 6+ ST.StructDecl+ <$> genIdent "struct"+ <*> pure (ST.Metadata Map.empty)+ <*> (NE.fromList <$> replicateM fieldCount (genStructField structs))++ genIdent :: Text -> StateT Int Gen Ident+ genIdent prefix = do+ lastId <- get+ let newId = lastId + 1+ put newId+ pure $ Ident $ prefix <> Text.pack (show newId)++ genStructField :: [ST.StructDecl] -> StateT Int Gen ST.StructField+ genStructField structs = do+ ident <- genIdent "field"+ structFieldType <- lift $ genStructFieldType structs++ pure $ ST.StructField+ ident+ structFieldType+ (ST.Metadata Map.empty)++ genStructFieldType :: [ST.StructDecl] -> Gen ST.Type+ genStructFieldType structs =+ Gen.choice $+ genEnumRef <> genStructRef <>+ [ pure ST.TInt8+ , pure ST.TInt16+ , pure ST.TInt32+ , pure ST.TInt64+ , pure ST.TWord8+ , pure ST.TWord16+ , pure ST.TWord32+ , pure ST.TWord64+ , pure ST.TFloat+ , pure ST.TDouble+ , pure ST.TBool+ ]+ where+ genEnumRef :: [Gen ST.Type]+ genEnumRef =+ if null enums+ then []+ else [ ST.TRef . TypeRef "" . getIdent <$> Gen.element enums ]++ genStructRef :: [Gen ST.Type]+ genStructRef =+ if null structs+ then []+ else [ ST.TRef . TypeRef "" . getIdent <$> Gen.element structs ]++ foldDecls :: [ValidDecls] -> ValidDecls foldDecls = fold @@ -1386,7 +1500,7 @@ case parse P.schema "" input of Left e -> expectationFailure $ "Parsing failed with error:\n" <> showBundle e Right schema ->- let schemas = FileTree "" schema []+ let schemas = ST.FileTree "" schema [] in case validateSchemas schemas of Right _ -> pure () Left err -> expectationFailure err@@ -1396,15 +1510,15 @@ case parse P.schema "" input of Left e -> expectationFailure $ "Parsing failed with error:\n" <> showBundle e Right schema ->- let schemas = FileTree "" schema []- in validateSchemas schemas `shouldBe` Right (FileTree "" expectation [])+ let schemas = ST.FileTree "" schema []+ in validateSchemas schemas `shouldBe` Right (ST.FileTree "" expectation []) shouldFail :: HasCallStack => String -> String -> Expectation shouldFail input expectedErrorMsg = case parse P.schema "" input of Left e -> expectationFailure $ "Parsing failed with error:\n" <> showBundle e Right schema ->- let schemas = FileTree "" schema []+ let schemas = ST.FileTree "" schema [] in validateSchemas schemas `shouldBe` Left expectedErrorMsg @@ -1414,7 +1528,7 @@ Left e -> expectationFailure $ "Parsing failed with error:\n" <> showBundle e Right (schema :| schemas) -> let importesFilepathsAndSchemas = Map.fromList (fmap (\s -> ("", s)) schemas)- fileTree = FileTree "" schema importesFilepathsAndSchemas+ fileTree = ST.FileTree "" schema importesFilepathsAndSchemas in validateSchemas fileTree `shouldBe` Left expectedErrorMsg showBundle :: (ShowErrorComponent e, Stream s) => ParseErrorBundle s e -> String
test/FlatBuffers/Internal/Compiler/THSpec.hs view
@@ -70,6 +70,14 @@ [r| table SomePerson { PersonAge: int; }|] `shouldCompileTo` expected [r| table somePerson { personAge: int; }|] `shouldCompileTo` expected + it "with keyword as name" $+ [r| table Type {} |] `shouldCompileTo`+ [d|+ data Type+ type_ :: WriteTable Type+ type_ = writeTable []+ |]+ describe "numeric fields + boolean" $ do it "normal fields" $ [r|@@ -1274,6 +1282,21 @@ s2X :: Struct S2 -> Either ReadError Int8 s2X = readStructField readInt8 0 |]++ it "with keyword as name" $+ [r| struct Type { x : byte; } |] `shouldCompileTo`+ [d|+ data Type+ instance IsStruct Type+ where structAlignmentOf = 1+ structSizeOf = 1++ type_ :: Int8 -> WriteStruct Type+ type_ x = WriteStruct (buildInt8 x)++ typeX :: Struct Type -> Either ReadError Int8+ typeX = readStructField readInt8 0+ |] describe "Unions" $ it "naming conventions" $ do