bond-haskell 0.1.1.1 → 0.1.2.0

raw patch · 6 files changed

+101/−77 lines, 6 filesdep ~bond-haskell-compilersetup-changedPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: bond-haskell-compiler

API changes (from Hackage documentation)

Files

• Setup.hs +2/−1
• bond-haskell.cabal +4/−3
• src/Data/Bond.hs +3/−1
• src/Data/Bond/Internal/Enum.hs +10/−0
• src/Data/Bond/Internal/Imports.hs +2/−0
• test/Spec.hs +80/−72

@@ -74,7 +74,7 @@                         else return True     when needSchemaRegen $ do         extras <- getProgramOutput verbosity hbc ["-h", "-o", buildDir lbi, "--hsboot", "-n", "bond=Data.Bond.Schema", schemaPath </> "bond.bond", schemaPath </> "bond_const.bond"]-        createDirectoryIfMissing False outPath+        createDirectoryIfMissing True (takeDirectory schemaFlag)         writeFile schemaFlag extras      -- generate json schemas for unittests@@ -110,4 +110,5 @@                             return True     when needSchemaRegen $ do         extras <- getProgramOutput verbosity hbc $ ["-o", outDir] ++ schemaFiles+        createDirectoryIfMissing True (takeDirectory flagFile)         writeFile flagFile extras

@@ -1,5 +1,5 @@ name:                bond-haskell-version:             0.1.1.1+version:             0.1.2.0 synopsis:            Runtime support for BOND serialization description:         Bond is a cross-platform framework for handling schematized                      data. It supports cross-language de/serialization and@@ -8,7 +8,7 @@                      .                      This package contains a runtime library used by generated                      Haskell code.-homepage:            http://github.com/rblaze/bond-haskell-runtime#readme+homepage:            http://github.com/rblaze/bond-haskell#readme license:             BSD3 license-file:        LICENSE author:              Andrey Sverdlichenko <blaze@ruddy.ru>@@ -47,6 +47,7 @@                        Data.Bond.Internal.Cast                        Data.Bond.Internal.CompactBinaryProto                        Data.Bond.Internal.Default+                       Data.Bond.Internal.Enum                        Data.Bond.Internal.FastBinaryProto                        Data.Bond.Internal.JsonProto                        Data.Bond.Internal.MarshalUtils@@ -60,7 +61,7 @@                        Data.Bond.Internal.Utils                        Data.Bond.Internal.Utils   build-depends:       base >= 4.7 && < 5-                     , bond-haskell-compiler >= 0.1.1.0 && < 0.1.2+                     , bond-haskell-compiler >= 0.1.2.0 && < 0.1.3                      , aeson                      , array                      , binary >= 0.7.0.0

@@ -30,7 +30,7 @@     , marshalValue     , BondedException(..)     -- * Runtime-schema operations-    -- |Some generic applications may need to work with Bond schemas unknown+    -- |Generic applications may need to work with Bond schemas unknown     -- at compile-time. In order to address such scenarios Bond defines a     -- type 'Data.Bond.Schema.SchemaDef' to represent schemas in stoorage     -- and transfer.@@ -38,6 +38,7 @@     -- Haskell library uses 'StructSchema' internally for performance     -- reasons and provides conversion functions.     , BondStruct(getSchema)+    , BondEnum(..)     , assembleSchema     , checkStructSchema     , defaultStruct@@ -74,6 +75,7 @@ import Data.Bond.Internal.Bonded import Data.Bond.Internal.CompactBinaryProto import Data.Bond.Internal.Default+import Data.Bond.Internal.Enum import Data.Bond.Internal.FastBinaryProto import Data.Bond.Internal.JsonProto import Data.Bond.Internal.Protocol

@@ -0,0 +1,10 @@+module Data.Bond.Internal.Enum where++import Data.Text++-- |Bond enumeration class containing utility functions.+class BondEnum a where+    -- |Convert constant value to name.+    toName :: a -> Maybe Text+    -- |Convert constant name to value.+    fromName :: Text -> Maybe a

@@ -1,5 +1,6 @@ module Data.Bond.Internal.Imports      ( module X+    , BondEnum(..)     , BondStruct(..)     , BondType(..)     , Hashable@@ -13,6 +14,7 @@ import Data.Bond.TypedSchema as X import Data.Bond.Types as X import Data.Bond.Internal.Default as X+import Data.Bond.Internal.Enum import Data.Bond.Internal.OrdinalSet import Data.Bond.Internal.Protocol import Data.Bond.Internal.Utils as X

@@ -4,6 +4,7 @@ import Unittest.Compat.Another.Another import Unittest.Compat.BasicTypes import Unittest.Compat.Compat+import Unittest.Compat.EnumType1 import Unittest.Simple.Inner as Inner import Unittest.Simple.Outer as Outer import Unittest.Simple.Reqopt as ReqOpt@@ -65,94 +66,92 @@  tests :: TestTree tests = testGroup "Haskell runtime tests"-    [ testGroup "Runtime schema tests"+    [ testGroup "Enum tests"+        [ testCase "check enum value to name conversion" checkEnumNames+        ]+    , testGroup "Runtime schema tests"         [ testCase "check saved Compat schema matching our schema" matchCompatSchemaDef,           testCase "check gbc-generated SchemaDef schema matching our schema" matchGeneratedSchemaDef,           testCase "check compile/decompile schema is identity" checkCompileIdentity,           testCase "defaultStruct is correct" checkDefaultStruct-        ],-      testGroup "Runtime schema validation tests"-        [ testCaseInfo "loop in inheritance chain" $ checkSchemaError "inheritance_loop.json",-          testCaseInfo "non-struct in inheritance chain" $ checkSchemaError "inherit_from_int.json",-          testCaseInfo "index out of range" $ checkSchemaError "index_out_of_range.json",-          testCaseInfo "field type mismatch" $-            checkSchemaMismatch (Proxy :: Proxy Outer) $ Struct Nothing $ M.fromList [(Ordinal 10, BOOL True)],-          testCaseInfo "field type mismatch in field struct" $+        ]+    , testGroup "Runtime schema validation tests"+        [ testCaseInfo "loop in inheritance chain" $ checkSchemaError "inheritance_loop.json"+        , testCaseInfo "non-struct in inheritance chain" $ checkSchemaError "inherit_from_int.json"+        , testCaseInfo "index out of range" $ checkSchemaError "index_out_of_range.json"+        , testCaseInfo "field type mismatch" $+            checkSchemaMismatch (Proxy :: Proxy Outer) $ Struct Nothing $ M.fromList [(Ordinal 10, BOOL True)]+        , testCaseInfo "field type mismatch in field struct" $             checkSchemaMismatch (Proxy :: Proxy Outer) $ Struct Nothing $ M.fromList-              [-                (Ordinal 20, STRUCT $ Struct Nothing $ M.fromList [(Ordinal 10, BOOL True)])-              ],-          testCaseInfo "type mismatch in list" $+              [ (Ordinal 20, STRUCT $ Struct Nothing $ M.fromList [(Ordinal 10, BOOL True)])+              ]+        , testCaseInfo "type mismatch in list" $             checkSchemaMismatch (Proxy :: Proxy Outer) $-                Struct Nothing $ M.fromList [(Ordinal 40, LIST bT_BOOL [])],-          testCaseInfo "type mismatch in list element struct" $+                Struct Nothing $ M.fromList [(Ordinal 40, LIST bT_BOOL [])]+        , testCaseInfo "type mismatch in list element struct" $             checkSchemaMismatch (Proxy :: Proxy Outer) $                 Struct Nothing $ M.fromList [(Ordinal 40, LIST bT_STRUCT-                  [-                    STRUCT $ Struct (Just $ Struct Nothing M.empty) $ M.fromList [(Ordinal 10, BOOL True)]-                  ])],-          testCaseInfo "type mismatch in set" $+                  [ STRUCT $ Struct (Just $ Struct Nothing M.empty) $ M.fromList [(Ordinal 10, BOOL True)]+                  ])]+        , testCaseInfo "type mismatch in set" $             checkSchemaMismatch (Proxy :: Proxy Outer) $-                Struct Nothing $ M.fromList [(Ordinal 50, SET bT_BOOL [])],-          testCaseInfo "type mismatch in map key" $+                Struct Nothing $ M.fromList [(Ordinal 50, SET bT_BOOL [])]+        , testCaseInfo "type mismatch in map key" $             checkSchemaMismatch (Proxy :: Proxy Outer) $-                Struct Nothing $ M.fromList [(Ordinal 60, MAP bT_BOOL bT_STRUCT [])],-          testCaseInfo "type mismatch in map value" $+                Struct Nothing $ M.fromList [(Ordinal 60, MAP bT_BOOL bT_STRUCT [])]+        , testCaseInfo "type mismatch in map value" $             checkSchemaMismatch (Proxy :: Proxy Outer) $-                Struct Nothing $ M.fromList [(Ordinal 60, MAP bT_UINT32 bT_BOOL [])],-          testCaseInfo "type mismatch in map element key" $+                Struct Nothing $ M.fromList [(Ordinal 60, MAP bT_UINT32 bT_BOOL [])]+        , testCaseInfo "type mismatch in map element key" $             checkSchemaMismatch (Proxy :: Proxy Outer) $                 Struct Nothing $ M.fromList [(Ordinal 60, MAP bT_UINT32 bT_STRUCT-                  [-                    (BOOL True, STRUCT $ Struct (Just $ Struct Nothing M.empty) M.empty)-                  ])],-          testCaseInfo "type mismatch in map element value" $+                  [ (BOOL True, STRUCT $ Struct (Just $ Struct Nothing M.empty) M.empty)+                  ])]+        , testCaseInfo "type mismatch in map element value" $             checkSchemaMismatch (Proxy :: Proxy Outer) $                 Struct Nothing $ M.fromList [(Ordinal 60, MAP bT_UINT32 bT_STRUCT-                  [-                    (UINT32 42, BOOL True)-                  ])],-          testCaseInfo "type mismatch in map element field" $+                  [ (UINT32 42, BOOL True)+                  ])]+        , testCaseInfo "type mismatch in map element field" $             checkSchemaMismatch (Proxy :: Proxy Outer) $                 Struct Nothing $ M.fromList [(Ordinal 60, MAP bT_UINT32 bT_STRUCT-                  [-                    (UINT32 42, STRUCT $ Struct (Just $ Struct Nothing M.empty) $ M.fromList [(Ordinal 10, BOOL True)])-                  ])],-          testCaseInfo "schema too deep for struct" $-            checkSchemaMismatch (Proxy :: Proxy Inner) $ Struct Nothing M.empty,-          testCase "shallow schema" checkShallowSchema-        ],-      testGroup "Protocol tests" $-        (map testTagged taggedProtocols) ++-        (map testSimple simpleProtocols) ++-          [ testGroup "JSON"-            [ testJson "read/write original Compat value" "compat.json.dat",-              testJson "read/write golden Compat value" "golden.json.dat",---              testJsonWithSchema "read/write original Compat value with schema" "compat.json.dat",-              testJsonWithSchema "read/write golden Compat value with schema" "golden.json.dat",---              testJsonWithRuntimeSchema "read/write original Compat value with runtime schema" "compat.json.dat",-              testJsonWithRuntimeSchema "read/write golden Compat value with runtime schema" "golden.json.dat",-              testCase "read BasicTypes value" $-                readAsType JsonProto (Proxy :: Proxy BasicTypes) "compat.json.dat",-              testCase "read Another value" $-                readAsType JsonProto (Proxy :: Proxy Another) "compat.json.dat",-              testCaseInfo "fail to read with required field missing" $ jsonFailToReadMissingRequired,-              testCaseInfo "fail to write nothing to required field" $ failToWriteRequiredNothing JsonProto-            ],-          testGroup "Marshalling"-            [ testCase "read/write SchemaDef value" readSchema,-              testCase "read/write SchemaDef value with schema" readSchemaWithSchema,-              testCase "read/write SchemaDef value w/o schema" readSchemaTagged-            ],-          testGroup "Cross-tests" crossTests,-          testGroup "Bonded recoding" bondedRecodeTests-        ],-      testGroup "ZigZag encoding"-        [ testProperty "Int16" zigzagInt16,-          testProperty "Int32" zigzagInt32,-          testProperty "Int64" zigzagInt64,-          testProperty "Word64" zigzagWord64+                  [ (UINT32 42, STRUCT $ Struct (Just $ Struct Nothing M.empty) $ M.fromList [(Ordinal 10, BOOL True)])+                  ])]+        , testCaseInfo "schema too deep for struct" $+            checkSchemaMismatch (Proxy :: Proxy Inner) $ Struct Nothing M.empty+        , testCase "shallow schema" checkShallowSchema         ]+    , testGroup "Protocol tests" $+        map testTagged taggedProtocols +++        map testSimple simpleProtocols +++            [ testGroup "JSON"+                [ testJson "read/write original Compat value" "compat.json.dat"+                ,  testJson "read/write golden Compat value" "golden.json.dat"+--              , testJsonWithSchema "read/write original Compat value with schema" "compat.json.dat"+                , testJsonWithSchema "read/write golden Compat value with schema" "golden.json.dat"+--              , testJsonWithRuntimeSchema "read/write original Compat value with runtime schema" "compat.json.dat"+                , testJsonWithRuntimeSchema "read/write golden Compat value with runtime schema" "golden.json.dat"+                , testCase "read BasicTypes value" $+                    readAsType JsonProto (Proxy :: Proxy BasicTypes) "compat.json.dat"+                , testCase "read Another value" $+                    readAsType JsonProto (Proxy :: Proxy Another) "compat.json.dat"+                , testCaseInfo "fail to read with required field missing" jsonFailToReadMissingRequired+                , testCaseInfo "fail to write nothing to required field" $ failToWriteRequiredNothing JsonProto+                ]+            , testGroup "Marshalling"+                [ testCase "read/write SchemaDef value" readSchema+                , testCase "read/write SchemaDef value with schema" readSchemaWithSchema+                , testCase "read/write SchemaDef value w/o schema" readSchemaTagged+                ]+            , testGroup "Cross-tests" crossTests+            , testGroup "Bonded recoding" bondedRecodeTests+            ]+    , testGroup "ZigZag encoding"+        [ testProperty "Int16" zigzagInt16+        , testProperty "Int32" zigzagInt32+        , testProperty "Int64" zigzagInt64+        , testProperty "Word64" zigzagWord64+        ]     ]     where     testTagged (TaggedProtoWrapper name proto dat) = testGroup name@@ -398,12 +397,12 @@ failToReadMissingRequired p = assertWithMsg $ do     let struct = Struct Nothing M.empty     out <- hoistEither $ bondWriteTagged p struct-    checkHasError $ (bondRead p out :: Either String Reqopt)+    checkHasError (bondRead p out :: Either String Reqopt)  jsonFailToReadMissingRequired :: IO String jsonFailToReadMissingRequired = assertWithMsg $ do     let dat = BL8.pack "{}"-    checkHasError $ (bondRead JsonProto dat :: Either String Reqopt)+    checkHasError (bondRead JsonProto dat :: Either String Reqopt)  failToReadMissingRequiredWithSchema :: BondTaggedProto t => t -> IO String failToReadMissingRequiredWithSchema p = assertWithMsg $ do@@ -450,6 +449,15 @@     assertEqual "struct is not as expected"         (Struct Nothing $ M.fromList [(Ordinal 10, INT8 5), (Ordinal 20, STRING "")])         defStruct++checkEnumNames :: Assertion+checkEnumNames = do+    assertEqual "positive enum value not translated to name" (Just "EnumValue1") (toName (EnumType1 5))+    assertEqual "negative enum value not translated to name" (Just "EnumValue3") (toName (EnumType1 (-10)))+    assertEqual "unknown enum value translated to name" Nothing (toName (EnumType1 42))+    assertEqual "enum name not translated to positive value" (Just (EnumType1 5)) (fromName "EnumValue1")+    assertEqual "enum name not translated to negative value" (Just (EnumType1 (-10))) (fromName "EnumValue3")+    assertEqual "unknown enum name translated to value" Nothing (fromName "undefined" :: Maybe EnumType1)  zigzagInt16 :: Int16 -> Bool zigzagInt16 x = x == fromZigZag (toZigZag x)