proto3-suite 0.6.0 → 0.7.0
raw patch · 15 files changed
+482/−253 lines, 15 filesdep +record-hasfielddep ~aesondep ~dhalldep ~quickcheck-instances
Dependencies added: record-hasfield
Dependency ranges changed: aeson, dhall, quickcheck-instances, swagger2, text
Files
- CHANGELOG.md +8/−0
- proto3-suite.cabal +11/−10
- src/Proto3/Suite/Class.hs +119/−49
- src/Proto3/Suite/DhallPB.hs +2/−0
- src/Proto3/Suite/DotProto/Generate.hs +50/−2
- src/Proto3/Suite/DotProto/Generate/Swagger.hs +15/−14
- src/Proto3/Suite/DotProto/Generate/Syntax.hs +4/−5
- src/Proto3/Suite/JSONPB/Class.hs +39/−29
- src/Proto3/Suite/Tutorial.hs +6/−5
- src/Proto3/Suite/Types.hs +12/−2
- tests/ArbitraryGeneratedTestTypes.hs +0/−5
- tests/Main.hs +6/−6
- tests/TestCodeGen.hs +208/−126
- tests/decode.sh +1/−0
- tests/encode.sh +1/−0
CHANGELOG.md view
@@ -1,3 +1,11 @@+# 0.7.0+* Support GHC 9.2, 9.4.+* Support proto files without a package declaration.+* Modify "Eq (Enumerated a)" to identify "Enumerated (Right e)"+ with "Enumerated (Left (fromProtoEnum e))" because those two+ values encode to the same octet sequence. They are already+ equivalent as arguments to "isDefault @(Enumerated e)".+* Derive Data and Generic instances for Protobuf AST types. # 0.6.0 * Support use of ShortText as the Haskell type of a protobuf string.
proto3-suite.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: proto3-suite-version: 0.6.0+version: 0.7.0 synopsis: A higher-level API to the proto3-wire library description: This library provides a higher-level API to <https://github.com/awakesecurity/proto3-wire the `proto3-wire` library>@@ -56,13 +56,13 @@ if flag(dhall) exposed-modules: Proto3.Suite.DhallPB- build-depends: dhall >=1.13 && < 1.39+ build-depends: dhall >=1.13 && < 1.43 cpp-options: -DDHALL if flag(swagger) exposed-modules: Proto3.Suite.DotProto.Generate.Swagger Proto3.Suite.DotProto.Generate.Swagger.Wrappers- build-depends: swagger2 >=2.1.6 && <2.8+ build-depends: swagger2 >=2.1.6 && <2.9 cpp-options: -DSWAGGER if flag(swagger-wrapper-format) hs-source-dirs: src/swagger-wrapper-format@@ -71,7 +71,7 @@ if flag(large-records) -- large-records support uses newer Dhall APIs. So we need at least 1.34.- build-depends: dhall >=1.34 && < 1.39,+ build-depends: dhall >=1.34 && < 1.43, large-generics, large-records cpp-options: -DLARGE_RECORDS@@ -99,7 +99,7 @@ other-modules: Turtle.Compat - build-depends: aeson >= 1.1.1.0 && < 2.1,+ build-depends: aeson >= 1.1.1.0 && < 2.2, aeson-pretty, attoparsec >= 0.13.0.1, base >=4.8 && <5.0,@@ -124,12 +124,12 @@ pretty-show >= 1.6.12 && < 2.0, proto3-wire >= 1.2.2 && < 1.5, QuickCheck >=2.10 && <2.15,- quickcheck-instances < 0.4,+ quickcheck-instances >=0.3.26 && < 0.4, safe ==0.3.*, split, system-filepath, time,- text >= 0.2 && <1.3,+ text >= 0.2 && <2.1, text-short >=0.1.3 && <0.2, transformers >=0.4 && <0.6, turtle < 1.6.0 || >= 1.6.1 && < 1.7.0,@@ -152,7 +152,7 @@ if flag(dhall) other-modules: TestDhall- build-depends: dhall >=1.13 && < 1.39+ build-depends: dhall >=1.13 && < 1.43 cpp-options: -DDHALL if flag(swagger)@@ -191,7 +191,7 @@ Test.Proto.Parse.Option build-depends:- aeson >= 1.1.1.0 && < 2.1+ aeson >= 1.1.1.0 && < 2.2 , attoparsec >= 0.13.0.1 , base >=4.8 && <5.0 , base64-bytestring >= 1.0.0.1 && < 1.3@@ -209,11 +209,12 @@ , proto3-suite , proto3-wire >= 1.2 && < 1.5 , QuickCheck >=2.10 && <2.15+ , record-hasfield , tasty >= 0.11 && <1.5 , tasty-hedgehog , tasty-hunit >= 0.9 && <0.11 , tasty-quickcheck >= 0.8.4 && <0.11- , text >= 0.2 && <1.3+ , text >= 0.2 && <2.1 , text-short >=0.1.3 && <0.2 , transformers >=0.4 && <0.6 , turtle
src/Proto3/Suite/Class.hs view
@@ -57,6 +57,7 @@ -- > Right msg -> msg {-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DefaultSignatures #-}@@ -107,6 +108,7 @@ import qualified Data.Foldable as Foldable import Data.Functor (($>)) import Data.Int (Int32, Int64)+import Data.Kind (Type) import qualified Data.Map as M import Data.Maybe (fromMaybe, isNothing) import Data.Proxy (Proxy (..))@@ -115,7 +117,6 @@ import qualified Data.Text.Lazy as TL import qualified Data.Text.Short as TS import qualified Data.Traversable as TR-import qualified Data.Vector as Vector import Data.Vector (Vector) import Data.Word (Word32, Word64) import GHC.Exts (fromList, Proxy#, proxy#)@@ -229,7 +230,7 @@ def = codeToEnumerated 0 isDefault = (== 0) . codeFromEnumerated -deriving via (a :: *) instance HasDefault a => HasDefault (Wrapped a)+deriving via (a :: Type) instance HasDefault a => HasDefault (Wrapped a) instance HasDefault (UnpackedVec a) where def = mempty@@ -266,7 +267,7 @@ def = M.empty isDefault = M.null -class GenericHasDefault (f :: * -> *) where+class GenericHasDefault (f :: Type -> Type) where genericDef :: f x instance HasDefault f => GenericHasDefault (K1 i f) where genericDef = K1 (def @f)@@ -301,7 +302,7 @@ default nameOf :: (IsString string, GenericNamed (Rep a)) => Proxy# a -> string nameOf _ = genericNameOf (proxy# :: Proxy# (Rep a)) -class GenericNamed (f :: * -> *) where+class GenericNamed (f :: Type -> Type) where genericNameOf :: IsString string => Proxy# f -> string instance Datatype d => GenericNamed (M1 D d f) where@@ -367,7 +368,7 @@ where enumField (name, value) = DotProtoEnumField (Single name) value [] -class GenericFinite (f :: * -> *) where+class GenericFinite (f :: Type -> Type) where genericEnumerate :: IsString string => [(string, f p)] instance ( GenericFinite f@@ -426,107 +427,126 @@ unsafeCoerceOver = unsafeCoerce instance Primitive Int32 where- encodePrimitive = Encode.int32+ encodePrimitive !num = Encode.int32 num+ {-# INLINE encodePrimitive #-} decodePrimitive = Decode.int32 primType _ = Int32 instance Primitive Int64 where- encodePrimitive = Encode.int64+ encodePrimitive !num = Encode.int64 num+ {-# INLINE encodePrimitive #-} decodePrimitive = Decode.int64 primType _ = Int64 instance Primitive Word32 where- encodePrimitive = Encode.uint32+ encodePrimitive !num = Encode.uint32 num+ {-# INLINE encodePrimitive #-} decodePrimitive = Decode.uint32 primType _ = UInt32 instance Primitive Word64 where- encodePrimitive = Encode.uint64+ encodePrimitive !num = Encode.uint64 num+ {-# INLINE encodePrimitive #-} decodePrimitive = Decode.uint64 primType _ = UInt64 instance Primitive (Signed Int32) where- encodePrimitive num = Encode.sint32 num . coerce+ encodePrimitive !num = Encode.sint32 num . coerce+ {-# INLINE encodePrimitive #-} decodePrimitive = coerce Decode.sint32 primType _ = SInt32 instance Primitive (Signed Int64) where- encodePrimitive num = Encode.sint64 num . coerce+ encodePrimitive !num = Encode.sint64 num . coerce+ {-# INLINE encodePrimitive #-} decodePrimitive = coerce Decode.sint64 primType _ = SInt64 instance Primitive (Fixed Word32) where- encodePrimitive num = Encode.fixed32 num . coerce+ encodePrimitive !num = Encode.fixed32 num . coerce+ {-# INLINE encodePrimitive #-} decodePrimitive = coerce Decode.fixed32 primType _ = Fixed32 instance Primitive (Fixed Word64) where- encodePrimitive num = Encode.fixed64 num . coerce+ encodePrimitive !num = Encode.fixed64 num . coerce+ {-# INLINE encodePrimitive #-} decodePrimitive = coerce Decode.fixed64 primType _ = Fixed64 instance Primitive (Signed (Fixed Int32)) where- encodePrimitive num = Encode.sfixed32 num . coerce+ encodePrimitive !num = Encode.sfixed32 num . coerce+ {-# INLINE encodePrimitive #-} decodePrimitive = coerce Decode.sfixed32 primType _ = SFixed32 instance Primitive (Signed (Fixed Int64)) where- encodePrimitive num = Encode.sfixed64 num . coerce+ encodePrimitive !num = Encode.sfixed64 num . coerce+ {-# INLINE encodePrimitive #-} decodePrimitive = coerce Decode.sfixed64 primType _ = SFixed64 instance Primitive Bool where- encodePrimitive = Encode.bool+ encodePrimitive !num = Encode.bool num+ {-# INLINE encodePrimitive #-} decodePrimitive = Decode.bool primType _ = Bool instance Primitive Float where- encodePrimitive = Encode.float+ encodePrimitive !num = Encode.float num+ {-# INLINE encodePrimitive #-} decodePrimitive = Decode.float primType _ = Float instance Primitive Double where- encodePrimitive = Encode.double+ encodePrimitive !num = Encode.double num+ {-# INLINE encodePrimitive #-} decodePrimitive = Decode.double primType _ = Double instance Primitive T.Text where- encodePrimitive fn = Encode.text fn . TL.fromStrict+ encodePrimitive !fn = Encode.text fn . TL.fromStrict+ {-# INLINE encodePrimitive #-} decodePrimitive = fmap TL.toStrict Decode.text primType _ = String deriving via T.Text instance Primitive (Proto3.Suite.Types.String T.Text) instance Primitive TL.Text where- encodePrimitive = Encode.text+ encodePrimitive !num = Encode.text num+ {-# INLINE encodePrimitive #-} decodePrimitive = Decode.text primType _ = String deriving via TL.Text instance Primitive (Proto3.Suite.Types.String TL.Text) instance Primitive TS.ShortText where- encodePrimitive = Encode.shortText+ encodePrimitive !num = Encode.shortText num+ {-# INLINE encodePrimitive #-} decodePrimitive = Decode.shortText primType _ = String deriving via TS.ShortText instance Primitive (Proto3.Suite.Types.String TS.ShortText) instance Primitive B.ByteString where- encodePrimitive = Encode.byteString+ encodePrimitive !num = Encode.byteString num+ {-# INLINE encodePrimitive #-} decodePrimitive = Decode.byteString primType _ = Bytes deriving via B.ByteString instance Primitive (Proto3.Suite.Types.Bytes B.ByteString) instance Primitive BL.ByteString where- encodePrimitive = Encode.lazyByteString+ encodePrimitive !num = Encode.lazyByteString num+ {-# INLINE encodePrimitive #-} decodePrimitive = Decode.lazyByteString primType _ = Bytes deriving via BL.ByteString instance Primitive (Proto3.Suite.Types.Bytes BL.ByteString) instance forall e. (Named e, ProtoEnum e) => Primitive (Enumerated e) where- encodePrimitive num = either (Encode.int32 num) (Encode.enum num) . enumerated+ encodePrimitive !num = either (Encode.int32 num) (Encode.enum num) . enumerated+ {-# INLINE encodePrimitive #-} decodePrimitive = coerce @(Parser RawPrimitive (Either Int32 e)) @(Parser RawPrimitive (Enumerated e))@@ -534,7 +554,8 @@ primType _ = Named (Single (nameOf (proxy# :: Proxy# e))) instance (Primitive a) => Primitive (ForceEmit a) where- encodePrimitive num = encodePrimitive num . forceEmit+ encodePrimitive !num = encodePrimitive num . forceEmit+ {-# INLINE encodePrimitive #-} decodePrimitive = coerce @(Parser RawPrimitive a) @(Parser RawPrimitive (ForceEmit a)) decodePrimitive primType _ = primType (proxy# :: Proxy# a) @@ -549,9 +570,10 @@ default encodeMessageField :: (HasDefault a, Primitive a) => FieldNumber -> a -> Encode.MessageBuilder- encodeMessageField num x+ encodeMessageField !num x | isDefault x = mempty | otherwise = encodePrimitive num x+ {-# INLINE encodeMessageField #-} default decodeMessageField :: (HasDefault a, Primitive a) => Parser RawField a decodeMessageField = one decodePrimitive def@@ -603,7 +625,12 @@ instance (Named e, ProtoEnum e) => MessageField (Enumerated e) instance (Ord k, Primitive k, MessageField k, Primitive v, MessageField v) => MessageField (M.Map k v) where- encodeMessageField num = foldMap (Encode.embedded num . encodeMessage (fieldNumber 1)) . M.toList+ encodeMessageField !num = go op+ where+ go f = foldMap f . M.toList+ op = Encode.embedded num . encodeMessage (fieldNumber 1)+ {-# INLINABLE op #-} -- To allow specialization to a particular type class or field number.+ {-# INLINE encodeMessageField #-} -- Data.Map.fromList will retain the last key/value mapping. From the spec: --@@ -614,7 +641,12 @@ protoType _ = messageField (Map (primType (proxy# :: Proxy# k)) (primType (proxy# :: Proxy# v))) Nothing instance {-# OVERLAPS #-} (Ord k, Primitive k, Named v, Message v, MessageField k) => MessageField (M.Map k (Nested v)) where- encodeMessageField num = foldMap (Encode.embedded num . encodeMessage (fieldNumber 1)) . M.toList+ encodeMessageField !num = go op+ where+ go f = foldMap f . M.toList+ op = Encode.embedded num . encodeMessage (fieldNumber 1)+ {-# INLINABLE op #-} -- To allow specialization to a particular type class or field number.+ {-# INLINE encodeMessageField #-} -- Data.Map.fromList will retain the last key/value mapping. From the spec: --@@ -625,23 +657,38 @@ protoType _ = messageField (Map (primType (proxy# :: Proxy# k)) (Named . Single $ nameOf (proxy# :: Proxy# v))) Nothing instance (HasDefault a, Primitive a) => MessageField (ForceEmit a) where- encodeMessageField = encodePrimitive+ encodeMessageField !num = encodePrimitive num+ {-# INLINE encodeMessageField #-} instance (Named a, Message a) => MessageField (Nested a) where- encodeMessageField num = foldMap (Encode.embedded num . encodeMessage (fieldNumber 1))- . coerce @(Nested a) @(Maybe a)+ encodeMessageField !num = go op+ where+ go f = foldMap f . coerce @(Nested a) @(Maybe a)+ op = Encode.embedded num . encodeMessage (fieldNumber 1)+ {-# INLINABLE op #-} -- To allow specialization to a particular type class or field number.+ {-# INLINE encodeMessageField #-} decodeMessageField = coerce @(Parser RawField (Maybe a)) @(Parser RawField (Nested a)) (Decode.embedded (decodeMessage (fieldNumber 1))) protoType _ = messageField (Prim . Named . Single $ nameOf (proxy# :: Proxy# a)) Nothing instance Primitive a => MessageField (UnpackedVec a) where- encodeMessageField fn = Encode.vectorMessageBuilder (encodePrimitive fn) . unpackedvec+ encodeMessageField !fn = go op+ where+ go f = Encode.vectorMessageBuilder f . unpackedvec+ op = encodePrimitive fn+ {-# INLINABLE op #-} -- To allow specialization to a particular type class or field number.+ {-# INLINE encodeMessageField #-} decodeMessageField = UnpackedVec . fromList . Foldable.toList <$> repeated decodePrimitive protoType _ = messageField (Repeated $ primType (proxy# :: Proxy# a)) (Just UnpackedField) instance forall a. (Named a, Message a) => MessageField (NestedVec a) where- encodeMessageField fn = Encode.vectorMessageBuilder (Encode.embedded fn . encodeMessage (fieldNumber 1)) . nestedvec+ encodeMessageField !fn = go op+ where+ go f = Encode.vectorMessageBuilder f . nestedvec+ op = Encode.embedded fn . encodeMessage (fieldNumber 1)+ {-# INLINABLE op #-} -- To allow specialization to a particular type class or field number.+ {-# INLINE encodeMessageField #-} decodeMessageField = fmap (coerce @(Vector a) @(NestedVec a) . fromList . Foldable.toList) (repeated (Decode.embedded' oneMsg))@@ -651,12 +698,16 @@ protoType _ = messageField (NestedRepeated . Named . Single $ nameOf (proxy# :: Proxy# a)) Nothing instance (Named e, ProtoEnum e) => MessageField (PackedVec (Enumerated e)) where- encodeMessageField fn = omittingDefault (Encode.packedVarintsV fromIntegral fn) . Vector.map codeFromEnumerated . packedvec+ encodeMessageField !fn =+ omittingDefault (Encode.packedVarintsV (fromIntegral . codeFromEnumerated) fn)+ . packedvec+ {-# INLINE encodeMessageField #-} -- Let 'Encode.packedVarintsV' figure out how much to inline. decodeMessageField = decodePacked (map (codeToEnumerated . fromIntegral) <$> Decode.packedVarints @Word64) protoType _ = messageField (Repeated . Named . Single $ nameOf (proxy# :: Proxy# e)) (Just PackedField) instance MessageField (PackedVec Bool) where- encodeMessageField fn = omittingDefault (Encode.packedBoolsV id fn) . packedvec+ encodeMessageField !fn = omittingDefault (Encode.packedBoolsV id fn) . packedvec+ {-# INLINE encodeMessageField #-} -- Let 'Encode.packedBoolsV' figure out how much to inline. decodeMessageField = fmap (fmap toBool) (decodePacked Decode.packedVarints) where toBool :: Word64 -> Bool@@ -665,29 +716,35 @@ protoType _ = messageField (Repeated Bool) (Just PackedField) instance MessageField (PackedVec Word32) where- encodeMessageField fn = omittingDefault (Encode.packedVarintsV fromIntegral fn) . packedvec+ encodeMessageField !fn = omittingDefault (Encode.packedVarintsV fromIntegral fn) . packedvec+ {-# INLINE encodeMessageField #-} -- Let 'Encode.packedVarintsV' figure out how much to inline. decodeMessageField = decodePacked Decode.packedVarints protoType _ = messageField (Repeated UInt32) (Just PackedField) instance MessageField (PackedVec Word64) where- encodeMessageField fn = omittingDefault (Encode.packedVarintsV id fn) . packedvec+ encodeMessageField !fn = omittingDefault (Encode.packedVarintsV id fn) . packedvec+ {-# INLINE encodeMessageField #-} -- Let 'Encode.packedVarintsV' figure out how much to inline. decodeMessageField = decodePacked Decode.packedVarints protoType _ = messageField (Repeated UInt64) (Just PackedField) instance MessageField (PackedVec Int32) where- encodeMessageField fn = omittingDefault (Encode.packedVarintsV fromIntegral fn) . packedvec+ encodeMessageField !fn = omittingDefault (Encode.packedVarintsV fromIntegral fn) . packedvec+ {-# INLINE encodeMessageField #-} -- Let 'Encode.packedVarintsV' figure out how much to inline. decodeMessageField = decodePacked Decode.packedVarints protoType _ = messageField (Repeated Int32) (Just PackedField) instance MessageField (PackedVec Int64) where- encodeMessageField fn = omittingDefault (Encode.packedVarintsV fromIntegral fn) . packedvec+ encodeMessageField !fn = omittingDefault (Encode.packedVarintsV fromIntegral fn) . packedvec+ {-# INLINE encodeMessageField #-} -- Let 'Encode.packedVarintsV' figure out how much to inline. decodeMessageField = decodePacked Decode.packedVarints protoType _ = messageField (Repeated Int64) (Just PackedField) instance MessageField (PackedVec (Signed Int32)) where- encodeMessageField fn = omittingDefault (Encode.packedVarintsV zigZag fn) . coerce @_ @(Vector Int32)+ encodeMessageField !fn =+ omittingDefault (Encode.packedVarintsV zigZag fn) . coerce @_ @(Vector Int32) where zigZag = fromIntegral . Encode.zigZagEncode+ {-# INLINE encodeMessageField #-} -- Let 'Encode.packedVarintsV' figure out how much to inline. decodeMessageField = decodePacked (fmap (fmap zagZig) Decode.packedVarints) where@@ -700,9 +757,11 @@ protoType _ = messageField (Repeated SInt32) (Just PackedField) instance MessageField (PackedVec (Signed Int64)) where- encodeMessageField fn = omittingDefault (Encode.packedVarintsV zigZag fn) . coerce @_ @(Vector Int64)+ encodeMessageField !fn =+ omittingDefault (Encode.packedVarintsV zigZag fn) . coerce @_ @(Vector Int64) where zigZag = fromIntegral . Encode.zigZagEncode+ {-# INLINE encodeMessageField #-} -- Let 'Encode.packedVarintsV' figure out how much to inline. decodeMessageField = decodePacked (fmap (fmap zagZig) Decode.packedVarints) where@@ -716,45 +775,56 @@ instance MessageField (PackedVec (Fixed Word32)) where- encodeMessageField fn = omittingDefault (Encode.packedFixed32V id fn) . coerce @_ @(Vector Word32)+ encodeMessageField !fn =+ omittingDefault (Encode.packedFixed32V id fn) . coerce @_ @(Vector Word32)+ {-# INLINE encodeMessageField #-} -- Let 'Encode.packedFixed32V' figure out how much to inline. decodeMessageField = coerce @(Parser RawField (PackedVec Word32)) @(Parser RawField (PackedVec (Fixed Word32))) (decodePacked Decode.packedFixed32) protoType _ = messageField (Repeated Fixed32) (Just PackedField) instance MessageField (PackedVec (Fixed Word64)) where- encodeMessageField fn = omittingDefault (Encode.packedFixed64V id fn) . coerce @_ @(Vector Word64)+ encodeMessageField !fn =+ omittingDefault (Encode.packedFixed64V id fn) . coerce @_ @(Vector Word64)+ {-# INLINE encodeMessageField #-} -- Let 'Encode.packedFixed64V' figure out how much to inline. decodeMessageField = coerce @(Parser RawField (PackedVec Word64)) @(Parser RawField (PackedVec (Fixed Word64))) (decodePacked Decode.packedFixed64) protoType _ = messageField (Repeated Fixed64) (Just PackedField) instance MessageField (PackedVec (Signed (Fixed Int32))) where- encodeMessageField fn = omittingDefault (Encode.packedFixed32V fromIntegral fn) . coerce @_ @(Vector Int32)+ encodeMessageField !fn =+ omittingDefault (Encode.packedFixed32V fromIntegral fn) . coerce @_ @(Vector Int32)+ {-# INLINE encodeMessageField #-} -- Let 'Encode.packedFixed32V' figure out how much to inline. decodeMessageField = coerce @(Parser RawField (PackedVec Int32)) @(Parser RawField (PackedVec (Signed (Fixed Int32)))) (decodePacked Decode.packedFixed32) protoType _ = messageField (Repeated SFixed32) (Just PackedField) instance MessageField (PackedVec (Signed (Fixed Int64))) where- encodeMessageField fn = omittingDefault (Encode.packedFixed64V fromIntegral fn) . coerce @_ @(Vector Int64)+ encodeMessageField !fn =+ omittingDefault (Encode.packedFixed64V fromIntegral fn) . coerce @_ @(Vector Int64)+ {-# INLINE encodeMessageField #-} -- Let 'Encode.packedFixed64V' figure out how much to inline. decodeMessageField = coerce @(Parser RawField (PackedVec Int64)) @(Parser RawField (PackedVec (Signed (Fixed Int64)))) (decodePacked Decode.packedFixed64) protoType _ = messageField (Repeated SFixed64) (Just PackedField) instance MessageField (PackedVec Float) where- encodeMessageField fn = omittingDefault (Encode.packedFloatsV id fn) . packedvec+ encodeMessageField !fn = omittingDefault (Encode.packedFloatsV id fn) . packedvec+ {-# INLINE encodeMessageField #-} -- Let 'Encode.packedFloatsV' figure out how much to inline. decodeMessageField = decodePacked Decode.packedFloats protoType _ = messageField (Repeated Float) (Just PackedField) instance MessageField (PackedVec Double) where- encodeMessageField fn = omittingDefault (Encode.packedDoublesV id fn) . packedvec+ encodeMessageField !fn = omittingDefault (Encode.packedDoublesV id fn) . packedvec+ {-# INLINE encodeMessageField #-} -- Let 'Encode.packedDoublesV' figure out how much to inline. decodeMessageField = decodePacked Decode.packedDoubles protoType _ = messageField (Repeated Double) (Just PackedField) instance (MessageField e, KnownSymbol comments) => MessageField (e // comments) where- encodeMessageField fn = encodeMessageField fn . unCommented+ encodeMessageField !fn = encodeMessageField fn . unCommented+ {-# INLINE encodeMessageField #-} decodeMessageField = coerce @(Parser RawField e) @(Parser RawField (Commented comments e)) decodeMessageField@@ -915,7 +985,7 @@ -- * Generic Instances -class GenericMessage (f :: * -> *) where+class GenericMessage (f :: Type -> Type) where type GenericFieldCount f :: Nat genericEncodeMessage :: FieldNumber -> f a -> Encode.MessageBuilder
src/Proto3/Suite/DhallPB.hs view
@@ -156,11 +156,13 @@ -------------------------------------------------------------------------------- -- Inject integer scalar types +#if !(MIN_VERSION_dhall(1,41,0)) instance Dhall.ToDhall Int32 where injectWith = fmap (contramap toInteger) Dhall.injectWith instance Dhall.ToDhall Int64 where injectWith = fmap (contramap toInteger) Dhall.injectWith+#endif instance Dhall.ToDhall (Fixed Int32) where injectWith = fmap (contramap fixed) Dhall.injectWith
src/Proto3/Suite/DotProto/Generate.hs view
@@ -38,7 +38,8 @@ import Control.Applicative import Control.Lens ((&), ix, over, has, filtered)-import Control.Monad.Except+import Control.Monad.Except (MonadError(..), runExceptT)+import Control.Monad.IO.Class (MonadIO(..)) import Data.Char import Data.Coerce import Data.Either (partitionEithers)@@ -71,6 +72,9 @@ import qualified Turtle.Compat as Turtle (encodeString) import Turtle (FilePath, (</>), (<.>)) +-- $setup+-- >>> :set -XTypeApplications+ -------------------------------------------------------------------------------- --@@ -787,10 +791,12 @@ [ recDecl_ (HsIdent messageName) flds ] defaultMessageDeriving +#ifdef SWAGGER let getName = \case DotProtoMessageField fld -> (: []) <$> getFieldNameForSchemaInstanceDeclaration fld DotProtoMessageOneOf ident _ -> (: []) . (Nothing, ) <$> dpIdentUnqualName ident _ -> pure []+#endif messageDataDecl <- mkDataDecl <$> foldMapM (messagePartFieldD messageName) messageParts @@ -922,7 +928,13 @@ [HsPWildCard, HsPRec (unqual_ msgName) punnedFieldsP] (HsUnGuardedRhs encodeMessageE) [] - encodeMessageE = apply mconcatE [HsList encodedFields]+ encodeMessageE = case encodedFields of+ [] -> memptyE+ (field : fields) -> foldl op (paren field) fields+ where op fs f = apply (apply mappendE [fs]) [paren f]+ -- NOTE: We use a left fold because this way the leftmost field+ -- is the most nested and the rightmost field--the one to be written+ -- first by the right-to-left builder--is the one that is least nested. punnedFieldsP = map (fp . coerce . recordFieldName) qualifiedFields where fp nm = HsPFieldPat (unqual_ nm) (HsPVar (HsIdent nm))@@ -1963,9 +1975,45 @@ RegularRecords -> [] LargeRecords -> [ importDecl_ (m "Data.Record.Generic") & qualified lrNS & everything+ -- "large-records" stopped exporting "grnf"; we try+ -- to get it directly from "large-generics" if we can.+ --+ -- Ideally we would generate CPP conditionals so that+ -- the version check happens when the generated code+ -- is built, but as yet it is unclear how to do that.+ --+ -- As a result, we have to enable the version check+ -- based on the package version available when building+ -- compile-proto-file, and only if large record support+ -- is enabled in the library code.+#ifdef LARGE_RECORDS+#if MIN_VERSION_large_generics(0,2,1)+ , importDecl_ (m "Data.Record.Generic.NFData") & qualified lrNS & everything+#endif+#endif , importDecl_ (m "Data.Record.Generic.Rep") & qualified lrNS & everything , importDecl_ (m "Data.Record.Generic.Rep.Internal") & qualified lrNS & everything , importDecl_ (m "Data.Record.Plugin.Runtime") & qualified lrNS & everything+ -- <https://hackage.haskell.org/package/large-records-0.4/changelog>+ -- says that as of large-records-0.4 the plugin does not generate+ -- imports, and that "code must now import Data.Record.Plugin to+ -- bring largeRecord into scope (necessary for ANN annotations)."+ -- We also seem to need to import some Prelude identifiers.+ --+ -- Ideally we would generate CPP conditionals so that+ -- the version check happens when the generated code+ -- is built, but as yet it is unclear how to do that.+ --+ -- As a result, we have to enable the version check+ -- based on the package version available when building+ -- compile-proto-file, and only if large record support+ -- is enabled in the library code.+#ifdef LARGE_RECORDS+#if MIN_VERSION_large_records(0,4,0)+ , importDecl_ (m "Data.Record.Plugin") & unqualified & selecting [i"largeRecord"]+ , importDecl_ (m "Prelude") & unqualified & selecting [i"Eq", i"Int", i"Ord", i"Show", i"error"]+#endif+#endif ] where m = Module
src/Proto3/Suite/DotProto/Generate/Swagger.hs view
@@ -1,14 +1,15 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DerivingVia #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE MonoLocalBinds #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-}@@ -53,10 +54,10 @@ insOrdFromList = Data.HashMap.Strict.InsOrd.fromList -- Distinctions between varint and fixed-width formats do not matter to JSONPB.-deriving via a instance ToSchema a => ToSchema (Fixed a)+deriving newtype instance ToSchema a => ToSchema (Fixed a) -- Zig-zag encoding issues do not matter to JSONPB.-deriving via a instance ToSchema a => ToSchema (Signed a)+deriving newtype instance ToSchema a => ToSchema (Signed a) -- Packed/unpacked distinctions do not matter to JSONPB. deriving via (V.Vector a) instance ToSchema a => ToSchema (NestedVec a)@@ -65,7 +66,7 @@ -- Unless and until the overlapping instances for @Maybe (Wrapped _)@ -- are selected, the schema is unaffected by 'Wrapped'.-deriving via a instance ToSchema a => ToSchema (Wrapped a)+deriving newtype instance ToSchema a => ToSchema (Wrapped a) instance ToSchema (Proto3.Suite.Types.String a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy String)
src/Proto3/Suite/DotProto/Generate/Syntax.hs view
@@ -107,10 +107,9 @@ dotProtoFieldC, primC, repeatedC, nestedRepeatedC, namedC, mapC, fieldNumberC, singleC, dotsC, pathC, qualifiedC, anonymousC, dotProtoOptionC,- identifierC, stringLitC, intLitC, floatLitC, boolLitC, trueC, falseC,- nothingC, justC, forceEmitC, mconcatE, encodeMessageFieldE,- fromStringE, decodeMessageFieldE, pureE, returnE, memptyE, msumE, atE, oneofE,- fmapE :: HsExp+ identifierC, stringLitC, intLitC, floatLitC, boolLitC, trueC, falseC, nothingC,+ justC, forceEmitC, encodeMessageFieldE, fromStringE, decodeMessageFieldE,+ pureE, returnE, mappendE, memptyE, msumE, atE, oneofE, fmapE :: HsExp dotProtoFieldC = HsVar (protobufASTName "DotProtoField") primC = HsVar (protobufASTName "Prim")@@ -140,10 +139,10 @@ falseC = HsVar (haskellName "False") nothingC = HsVar (haskellName "Nothing") justC = HsVar (haskellName "Just")-mconcatE = HsVar (haskellName "mconcat") fromStringE = HsVar (haskellName "fromString") pureE = HsVar (haskellName "pure") returnE = HsVar (haskellName "return")+mappendE = HsVar (haskellName "mappend") memptyE = HsVar (haskellName "mempty") msumE = HsVar (haskellName "msum") fmapE = HsVar (haskellName "fmap")
src/Proto3/Suite/JSONPB/Class.hs view
@@ -1,15 +1,16 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingVia #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedLists #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | Support for the "JSONPB" canonical JSON encoding described at@@ -73,7 +74,9 @@ (.!=)) import qualified Data.Aeson.Encoding as E import qualified Data.Aeson.Encoding.Internal as E+#if !MIN_VERSION_aeson(2,1,0) import qualified Data.Aeson.Internal as A (formatError, iparse)+#endif #if MIN_VERSION_aeson(2,0,0) import qualified Data.Aeson.Key as A #endif@@ -82,7 +85,14 @@ Series, explicitParseField, explicitParseFieldMaybe,- object, toJSONKeyText,+#if MIN_VERSION_aeson(2,1,0)+ formatError,+ iparse,+#endif+ object,+#if !(MIN_VERSION_aeson(2,0,2))+ toJSONKeyText,+#endif typeMismatch,) import qualified Data.Attoparsec.ByteString as Atto (skipWhile) import qualified Data.Attoparsec.ByteString.Char8 as Atto (Parser, endOfInput)@@ -154,10 +164,10 @@ parseJSONPB = pure -- | JSONPB format shortcuts Google wrappers types.-deriving via a instance FromJSONPB a => FromJSONPB (Wrapped a)+deriving newtype instance FromJSONPB a => FromJSONPB (Wrapped a) -- | JSONPB format shortcuts Google wrappers types.-deriving via a instance ToJSONPB a => ToJSONPB (Wrapped a)+deriving newtype instance ToJSONPB a => ToJSONPB (Wrapped a) -- * JSONPB codec entry points @@ -219,13 +229,13 @@ => A.Object -> Key -> A.Parser a parseField = A.explicitParseField parseJSONPB --- | >>> isDefault (def @E.Encoding)+-- | >>> isDefault (def :: E.Encoding) -- True instance HasDefault E.Encoding where def = E.empty isDefault = E.nullEncoding --- | >>> isDefault (def @A.Value)+-- | >>> isDefault (def :: A.Value) -- True instance HasDefault A.Value where def = A.Null@@ -398,12 +408,12 @@ parseJSONPB = parseNumOrDecimalString "int64 / sint64" -- Distinctions between varint and fixed-width formats do not matter to JSONPB.-deriving via a instance FromJSONPB a => FromJSONPB (Fixed a)-deriving via a instance ToJSONPB a => ToJSONPB (Fixed a)+deriving newtype instance FromJSONPB a => FromJSONPB (Fixed a)+deriving newtype instance ToJSONPB a => ToJSONPB (Fixed a) -- Zig-zag encoding issues do not matter to JSONPB.-deriving via a instance FromJSONPB a => FromJSONPB (Signed a)-deriving via a instance ToJSONPB a => ToJSONPB (Signed a)+deriving newtype instance FromJSONPB a => FromJSONPB (Signed a)+deriving newtype instance ToJSONPB a => ToJSONPB (Signed a) -------------------------------------------------------------------------------- -- Floating point scalar types@@ -449,8 +459,8 @@ instance FromJSONPB TS.ShortText where parseJSONPB = fmap TS.fromText . A.parseJSON -deriving via a instance ToJSONPB a => ToJSONPB (Proto3.Suite.Types.String a)-deriving via a instance FromJSONPB a => FromJSONPB (Proto3.Suite.Types.String a)+deriving newtype instance ToJSONPB a => ToJSONPB (Proto3.Suite.Types.String a)+deriving newtype instance FromJSONPB a => FromJSONPB (Proto3.Suite.Types.String a) -- bytes @@ -469,8 +479,8 @@ parseJSONPB (A.String b64enc) = pure . B64.decodeLenient . T.encodeUtf8 $ b64enc parseJSONPB v = A.typeMismatch "bytes" v -deriving via a instance ToJSONPB a => ToJSONPB (Proto3.Suite.Types.Bytes a)-deriving via a instance FromJSONPB a => FromJSONPB (Proto3.Suite.Types.Bytes a)+deriving newtype instance ToJSONPB a => ToJSONPB (Proto3.Suite.Types.Bytes a)+deriving newtype instance FromJSONPB a => FromJSONPB (Proto3.Suite.Types.Bytes a) -------------------------------------------------------------------------------- -- Enumerated types@@ -543,11 +553,11 @@ -------------------------------------------------------------------------------- -- Instances for map -deriving via a instance A.FromJSONKey a => A.FromJSONKey (Fixed a)-deriving via a instance A.ToJSONKey a => A.ToJSONKey (Fixed a)+deriving newtype instance A.FromJSONKey a => A.FromJSONKey (Fixed a)+deriving newtype instance A.ToJSONKey a => A.ToJSONKey (Fixed a) -deriving via a instance A.FromJSONKey a => A.FromJSONKey (Signed a)-deriving via a instance A.ToJSONKey a => A.ToJSONKey (Signed a)+deriving newtype instance A.FromJSONKey a => A.FromJSONKey (Signed a)+deriving newtype instance A.ToJSONKey a => A.ToJSONKey (Signed a) deriving via T.Text instance A.FromJSONKey (Proto3.Suite.Types.String T.Text) deriving via T.Text instance A.ToJSONKey (Proto3.Suite.Types.String T.Text)
src/Proto3/Suite/Tutorial.hs view
@@ -1,8 +1,6 @@ -- | -- = Tutorial ----- >>> :set -XOverloadedStrings--- -- This module contains a worked example of encoding and decoding messages, -- and exporting a corresponding .proto file from Haskell types. --@@ -41,6 +39,9 @@ enum, message, packageFromDefs, toProtoFileDef) import Proto3.Wire.Class (ProtoEnum) +-- $setup+-- >>> :set -XOverloadedStrings+ -- | -- == Defining Message Types --@@ -65,7 +66,7 @@ -- -- We can also decode messages using `fromByteString`: ----- >>> Proto3.Suite.fromByteString "\b*\DC2\SOH{" :: Either [Proto3.Suite..Decode.Parser.ParseError] Foo+-- >>> Proto3.Suite.fromByteString "\b*\DC2\SOH{" :: Either Proto3.Wire.Decode.ParseError Foo -- Right (Foo {fooX = 42, fooY = PackedVec {packedvec = [123]}}) data Foo = Foo { fooX :: Word32@@ -125,12 +126,12 @@ -- } -- message Foo { -- uint32 fooX = 1;--- repeated int32 fooY = 2 [packed=true];+-- repeated int32 fooY = 2 [packed = true]; -- } -- message Bar { -- Shape barShape = 1; -- Foo barFoo = 2;--- repeated Foo foos = 3 [packed=false];+-- repeated Foo foos = 3; -- } protoFile :: String
src/Proto3/Suite/Types.hs view
@@ -35,6 +35,7 @@ import Control.DeepSeq (NFData) import GHC.Exts (IsList(..)) import GHC.Generics+import Data.Function (on) import Data.Int (Int32) import qualified Data.Vector as V import GHC.TypeLits (Symbol)@@ -55,8 +56,17 @@ -- | 'Enumerated' lifts any type with an 'IsEnum' instance so that it can be encoded -- with 'HasEncoding'. newtype Enumerated a = Enumerated { enumerated :: Either Int32 a }- deriving (Show, Eq, Ord, Generic, NFData- , Functor, Foldable, Traversable)+ deriving (Show, Generic, NFData, Functor, Foldable, Traversable)++-- | We consider two enumerated values to be equal if they serialize to the same code.+instance ProtoEnum a => Eq (Enumerated a) where+ (==) = (==) `on` either id fromProtoEnum . enumerated+ {-# INLINABLE (==) #-}++-- | We compare two enumerated values by comparing the code to which they serialize.+instance ProtoEnum a => Ord (Enumerated a) where+ compare = compare `on` either id fromProtoEnum . enumerated+ {-# INLINABLE compare #-} instance ProtoEnum a => Arbitrary (Enumerated a) where arbitrary = do
tests/ArbitraryGeneratedTestTypes.hs view
@@ -4,7 +4,6 @@ module ArbitraryGeneratedTestTypes where import Data.String (fromString)-import qualified Data.Text.Short as TS import qualified Data.Vector as V import qualified Proto3.Suite.Types as DotProto import Test.QuickCheck (listOf)@@ -14,10 +13,6 @@ import qualified TestProtoImport import qualified TestProtoOneof import qualified TestProtoOneofImport--instance Arbitrary TS.ShortText where- arbitrary = fmap TS.fromText arbitrary- shrink = map TS.fromText . shrink . TS.toText instance Arbitrary Trivial where arbitrary = Trivial <$> arbitrary
tests/Main.hs view
@@ -66,9 +66,8 @@ docTests = testCase "doctests" $ do putStrLn "Running all doctests..." Test.DocTest.doctest- [ "-isrc"- , "-itests"- , "-igen"+ [ "--verbose"+ , "-isrc" #ifdef SWAGGER #ifdef SWAGGER_WRAPPER_FORMAT , "-isrc/swagger-wrapper-format"@@ -85,8 +84,9 @@ , "-DLARGE_RECORDS" #endif , "src/Proto3/Suite/DotProto/Internal.hs"+ , "src/Proto3/Suite/DotProto/Generate.hs" , "src/Proto3/Suite/JSONPB/Class.hs"- , "tests/TestCodeGen.hs"+ , "src/Proto3/Suite/Tutorial.hs" ] --------------------------------------------------------------------------------@@ -327,11 +327,11 @@ ++ "\n\nInitial AST:\n\n" dotProtoRoundtripExtend :: TestTree-dotProtoRoundtripExtend = +dotProtoRoundtripExtend = let expected :: DotProto expected = DotProto [] [] DotProtoNoPackage [] (DotProtoMeta (Path ("test-files" NE.:| ["test_proto_extend"]))) in testCase- "Round-trip for a message extension" + "Round-trip for a message extension" (testDotProtoRoundtrip expected) --------------------------------------------------------------------------------
tests/TestCodeGen.hs view
@@ -1,6 +1,8 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE CPP #-}+{-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}@@ -12,7 +14,6 @@ import Control.Monad import qualified Data.Aeson import qualified Data.ByteString.Lazy as LBS-import qualified Data.ByteString.Lazy.Char8 as LBS8 import Data.Proxy (Proxy(..)) import Data.String (IsString) import Data.Swagger (ToSchema)@@ -22,21 +23,30 @@ tyConName, typeRep) import Google.Protobuf.Timestamp (Timestamp(..)) import Prelude hiding (FilePath)+import Proto3.Suite.Class (def) import Proto3.Suite.DotProto.Generate import Proto3.Suite.DotProto (fieldLikeName, prefixedEnumFieldName, typeLikeName) import Proto3.Suite.JSONPB (FromJSONPB (..), Options (..),- ToJSONPB (..), eitherDecode,- encode, defaultOptions)+ ToJSONPB (..), defaultOptions,+ eitherDecode, encode,+ jsonPBOptions)+import Proto3.Suite.Types (Enumerated(..)) import System.Exit import Test.Tasty import Test.Tasty.HUnit (testCase, (@?=))+import Test.Tasty.QuickCheck (Arbitrary, (===), testProperty) import qualified Turtle import qualified Turtle.Format as F+import qualified TestProto+import qualified TestProtoOneof import qualified TestProtoWrappers codeGenTests :: TestTree codeGenTests = testGroup "Code generator unit tests"- [ swaggerWrapperFormat+ [ jsonpbTests+ , swaggerTests+ , hasDefaultTests+ , swaggerWrapperFormat , pascalCaseMessageNames , camelCaseMessageFieldNames , don'tAlterEnumFieldNames@@ -65,17 +75,17 @@ "{\"properties\":{\"wrapper\":{\"format\":\"FloatValue\",\"type\":\"number\"}},\"type\":\"object\"}" "{\"properties\":{\"wrapper\":{\"format\":\"float\",\"type\":\"number\"}},\"type\":\"object\"}" , expectSchema @TestProtoWrappers.TestInt64Value- "{\"properties\":{\"wrapper\":{\"maximum\":9223372036854775807,\"format\":\"Int64Value\",\"minimum\":-9223372036854775808,\"type\":\"integer\"}},\"type\":\"object\"}"- "{\"properties\":{\"wrapper\":{\"maximum\":9223372036854775807,\"format\":\"int64\",\"minimum\":-9223372036854775808,\"type\":\"integer\"}},\"type\":\"object\"}"+ "{\"properties\":{\"wrapper\":{\"format\":\"Int64Value\",\"maximum\":9223372036854775807,\"minimum\":-9223372036854775808,\"type\":\"integer\"}},\"type\":\"object\"}"+ "{\"properties\":{\"wrapper\":{\"format\":\"int64\",\"maximum\":9223372036854775807,\"minimum\":-9223372036854775808,\"type\":\"integer\"}},\"type\":\"object\"}" , expectSchema @TestProtoWrappers.TestUInt64Value- "{\"properties\":{\"wrapper\":{\"maximum\":18446744073709551615,\"format\":\"UInt64Value\",\"minimum\":0,\"type\":\"integer\"}},\"type\":\"object\"}"- "{\"properties\":{\"wrapper\":{\"maximum\":18446744073709551615,\"minimum\":0,\"type\":\"integer\"}},\"type\":\"object\"}"+ "{\"properties\":{\"wrapper\":{\"format\":\"UInt64Value\",\"maximum\":18446744073709551615,\"minimum\":0,\"type\":\"integer\"}},\"type\":\"object\"}"+ "{\"properties\":{\"wrapper\":{\"format\":\"int64\",\"maximum\":18446744073709551615,\"minimum\":0,\"type\":\"integer\"}},\"type\":\"object\"}" , expectSchema @TestProtoWrappers.TestInt32Value- "{\"properties\":{\"wrapper\":{\"maximum\":2147483647,\"format\":\"Int32Value\",\"minimum\":-2147483648,\"type\":\"integer\"}},\"type\":\"object\"}"- "{\"properties\":{\"wrapper\":{\"maximum\":2147483647,\"format\":\"int32\",\"minimum\":-2147483648,\"type\":\"integer\"}},\"type\":\"object\"}"+ "{\"properties\":{\"wrapper\":{\"format\":\"Int32Value\",\"maximum\":2147483647,\"minimum\":-2147483648,\"type\":\"integer\"}},\"type\":\"object\"}"+ "{\"properties\":{\"wrapper\":{\"format\":\"int32\",\"maximum\":2147483647,\"minimum\":-2147483648,\"type\":\"integer\"}},\"type\":\"object\"}" , expectSchema @TestProtoWrappers.TestUInt32Value- "{\"properties\":{\"wrapper\":{\"maximum\":4294967295,\"format\":\"UInt32Value\",\"minimum\":0,\"type\":\"integer\"}},\"type\":\"object\"}"- "{\"properties\":{\"wrapper\":{\"maximum\":4294967295,\"minimum\":0,\"type\":\"integer\"}},\"type\":\"object\"}"+ "{\"properties\":{\"wrapper\":{\"format\":\"UInt32Value\",\"maximum\":4294967295,\"minimum\":0,\"type\":\"integer\"}},\"type\":\"object\"}"+ "{\"properties\":{\"wrapper\":{\"format\":\"int32\",\"maximum\":4294967295,\"minimum\":0,\"type\":\"integer\"}},\"type\":\"object\"}" , expectSchema @TestProtoWrappers.TestBoolValue "{\"properties\":{\"wrapper\":{\"format\":\"BoolValue\",\"type\":\"boolean\"}},\"type\":\"object\"}" "{\"properties\":{\"wrapper\":{\"type\":\"boolean\"}},\"type\":\"object\"}"@@ -174,11 +184,11 @@ compileTestDotProtos recStyle decodedStringType -- Compile our generated encoder- let args = [hsTmpDir]+ let encodeCmd = "tests/encode.sh " <> hsTmpDir #if DHALL- ++ ["-DDHALL"]+ <> " -DDHALL" #endif- Turtle.proc "tests/encode.sh" args empty >>= (@?= ExitSuccess)+ Turtle.shell encodeCmd empty >>= (@?= ExitSuccess) -- The python encoder test exits with a special error code to indicate -- all tests were successful@@ -200,11 +210,11 @@ compileTestDotProtos recStyle decodedStringType -- Compile our generated decoder- let args = [hsTmpDir]+ let decodeCmd = "tests/decode.sh " <> hsTmpDir #if DHALL- ++ ["-DDHALL"]+ <> " -DDHALL" #endif- Turtle.proc "tests/decode.sh" args empty >>= (@?= ExitSuccess)+ Turtle.shell decodeCmd empty >>= (@?= ExitSuccess) setPythonPath let cmd = "python tests/send_simple_dot_proto.py " <> format <> " | FORMAT=" <> format <> " " <> hsTmpDir <> "/simpleDecodeDotProto "@@ -227,7 +237,8 @@ compileTestDotProtos recStyle decodedStringType = do Turtle.mktree hsTmpDir Turtle.mktree pyTmpDir- let protoFiles =+ let protoFiles :: [Turtle.FilePath]+ protoFiles = [ "test_proto.proto" , "test_proto_import.proto" , "test_proto_oneof.proto"@@ -259,111 +270,151 @@ Turtle.touch (pyTmpDir Turtle.</> "__init__.py") --- * Doctests for JSONPB---- $setup--- >>> import qualified Data.Text.Lazy as TL--- >>> import qualified Data.Vector as V--- >>> import Proto3.Suite--- >>> import Proto3.Suite.JSONPB--- >>> import TestProto--- >>> import TestProtoOneof--- >>> import TestProtoWrappers--- >>> :set -XOverloadedStrings--- >>> :set -XOverloadedLists--- >>> :set -XTypeApplications--- >>> let jsonPB = jsonPBOptions--- >>> let json = defaultOptions+jsonpbTests :: TestTree+jsonpbTests = testGroup "JSONPB tests"+ [ testGroup "Round-trip tests"+ [ roundTripTest @TestProto.Trivial+ , roundTripTest @TestProto.MultipleFields+ , roundTripTest @TestProto.SignedInts+ , testProperty "roundTrip (SignedInts minBound minBound)" $+ roundTrip (TestProto.SignedInts minBound minBound)+ , testProperty "roundTrip (SignedInts maxBound maxBound)" $+ roundTrip (TestProto.SignedInts maxBound maxBound)+ , testProperty "roundTrip . WithEnum . Enumerated . Right" $+ roundTrip . TestProto.WithEnum . Enumerated . Right+ , roundTripTest @TestProto.WithNesting+ , roundTripTest @TestProto.WithNestingRepeated+ , roundTripTest @TestProto.WithNestingRepeatedInts+ , roundTripTest @TestProto.WithBytes+ , roundTripTest @TestProto.OutOfOrderFields+ , roundTripTest @TestProto.UsingImported+ , roundTripTest @TestProto.Wrapped+ , roundTripTest @TestProtoOneof.Something+ , roundTripTest @TestProtoOneof.WithImported+ ]+ , testGroup "Specific encoding tests" $+ let jsonPB = jsonPBOptions+ json = defaultOptions+ in+ [ encodesAs jsonPB (TestProto.MultipleFields 0 0 0 0 "" False) "{}"+ , encodesAs json (TestProto.MultipleFields 0 2.0 0 0 "" True) "{\"multiFieldDouble\":0.0,\"multiFieldFloat\":2.0,\"multiFieldInt32\":0,\"multiFieldInt64\":\"0\",\"multiFieldString\":\"\",\"multiFieldBool\":true}"+ , encodesAs jsonPB (TestProto.SignedInts minBound minBound)+ "{\"signed32\":-2147483648,\"signed64\":\"-9223372036854775808\"}"+ , encodesAs jsonPB (TestProto.SignedInts maxBound maxBound)+ "{\"signed32\":2147483647,\"signed64\":\"9223372036854775807\"}"+ , encodesAs jsonPB (TestProto.WithEnum (Enumerated (Right TestProto.WithEnum_TestEnumENUM1)))+ "{}"+ , encodesAs json (TestProto.WithEnum (Enumerated (Right TestProto.WithEnum_TestEnumENUM1)))+ "{\"enumField\":\"ENUM1\"}"+ , encodesAs jsonPB (TestProto.WithEnum (Enumerated (Right TestProto.WithEnum_TestEnumENUM3)))+ "{\"enumField\":\"ENUM3\"}"+ , encodesAs jsonPB (TestProto.WithNesting $ Just $ TestProto.WithNesting_Nested "" 0 [1,2] [66,99])+ "{\"nestedMessage\":{\"nestedPacked\":[1,2],\"nestedUnpacked\":[66,99]}}"+ , encodesAs jsonPB (TestProtoOneof.Something 42 99 (Just (TestProtoOneof.SomethingPickOneName "")))+ "{\"value\":\"42\",\"another\":99,\"name\":\"\"}"+ , encodesAs jsonPB (TestProtoOneof.Something 42 99 (Just (TestProtoOneof.SomethingPickOneSomeid 0)))+ "{\"value\":\"42\",\"another\":99,\"someid\":0}"+ , encodesAs jsonPB (TestProtoOneof.Something 42 99 (Just (TestProtoOneof.SomethingPickOneDummyMsg1 (TestProtoOneof.DummyMsg 66))))+ "{\"value\":\"42\",\"another\":99,\"dummyMsg1\":{\"dummy\":66}}"+ , encodesAs jsonPB (TestProtoOneof.Something 42 99 (Just (TestProtoOneof.SomethingPickOneDummyMsg2 (TestProtoOneof.DummyMsg 67))))+ "{\"value\":\"42\",\"another\":99,\"dummyMsg2\":{\"dummy\":67}}"+ , encodesAs jsonPB (TestProtoOneof.Something 42 99 (Just (TestProtoOneof.SomethingPickOneDummyEnum (Enumerated (Right TestProtoOneof.DummyEnumDUMMY0)))))+ "{\"value\":\"42\",\"another\":99,\"dummyEnum\":\"DUMMY0\"}"+ , encodesAs jsonPB (TestProtoOneof.Something 42 99 Nothing)+ "{\"value\":\"42\",\"another\":99}"+ , encodesAs json (TestProtoOneof.Something 42 99 (Just (TestProtoOneof.SomethingPickOneName "")))+ "{\"value\":\"42\",\"another\":99,\"pickOne\":{\"name\":\"\"}}"+ , encodesAs json (TestProtoOneof.Something 42 99 (Just (TestProtoOneof.SomethingPickOneSomeid 0)))+ "{\"value\":\"42\",\"another\":99,\"pickOne\":{\"someid\":0}}"+ , encodesAs json (TestProtoOneof.Something 42 99 (Just (TestProtoOneof.SomethingPickOneDummyMsg1 (TestProtoOneof.DummyMsg 66))))+ "{\"value\":\"42\",\"another\":99,\"pickOne\":{\"dummyMsg1\":{\"dummy\":66}}}"+ , encodesAs json (TestProtoOneof.Something 42 99 (Just (TestProtoOneof.SomethingPickOneDummyMsg2 (TestProtoOneof.DummyMsg 67))))+ "{\"value\":\"42\",\"another\":99,\"pickOne\":{\"dummyMsg2\":{\"dummy\":67}}}"+ , encodesAs json (TestProtoOneof.Something 42 99 (Just (TestProtoOneof.SomethingPickOneDummyEnum (Enumerated (Right TestProtoOneof.DummyEnumDUMMY0)))))+ "{\"value\":\"42\",\"another\":99,\"pickOne\":{\"dummyEnum\":\"DUMMY0\"}}"+ , encodesAs json (TestProtoOneof.Something 42 99 Nothing)+ "{\"value\":\"42\",\"another\":99,\"pickOne\":null}"+ ]+ , testGroup "Specific decoding tests" $+ [ decodesAs "{\"signed32\":2147483647,\"signed64\":\"9223372036854775807\"}"+ (TestProto.SignedInts 2147483647 9223372036854775807)+ , decodesAs "{\"enumField\":\"ENUM3\"}" (TestProto.WithEnum (Enumerated (Right TestProto.WithEnum_TestEnumENUM3)))+ , decodesAs "{\"enumField\":null}"+ (TestProto.WithEnum (Enumerated (Right TestProto.WithEnum_TestEnumENUM1)))+ , decodesAs "{}"+ (TestProto.WithEnum (Enumerated (Right TestProto.WithEnum_TestEnumENUM1)))+ , decodesAs "{\"nestedMessage\":{}}"+ (TestProto.WithNesting $ Just $ TestProto.WithNesting_Nested "" 0 [] [])+ , testGroup "JSONPB"+ [ decodesAs "{\"value\":\"42\",\"another\":99,\"someid\":66}"+ (TestProtoOneof.Something 42 99 (Just (TestProtoOneof.SomethingPickOneSomeid 66)))+ , decodesAs "{\"value\":\"42\",\"another\":99,\"name\":\"foo\"}"+ (TestProtoOneof.Something 42 99 (Just (TestProtoOneof.SomethingPickOneName "foo")))+ , decodesAs "{\"value\":\"42\",\"another\":99,\"dummyMsg1\":{\"dummy\":41}}"+ (TestProtoOneof.Something 42 99 (Just (TestProtoOneof.SomethingPickOneDummyMsg1 (TestProtoOneof.DummyMsg 41))))+ , decodesAs "{\"value\":\"42\",\"another\":99,\"dummyMsg2\":{\"dummy\":43}}"+ (TestProtoOneof.Something 42 99 (Just (TestProtoOneof.SomethingPickOneDummyMsg2 (TestProtoOneof.DummyMsg 43))))+ , decodesAs "{\"value\":\"42\",\"another\":99,\"dummyEnum\":\"DUMMY0\"}"+ (TestProtoOneof.Something 42 99 (Just (TestProtoOneof.SomethingPickOneDummyEnum (Enumerated (Right TestProtoOneof.DummyEnumDUMMY0)))))+ , decodesAs "{\"value\":\"42\",\"another\":99}"+ (TestProtoOneof.Something 42 99 Nothing)+ ]+ , testGroup "JSON"+ [ decodesAs "{\"value\":\"42\",\"another\":99,\"pickOne\":{\"name\":\"\"}}"+ (TestProtoOneof.Something 42 99 (Just (TestProtoOneof.SomethingPickOneName "")))+ , decodesAs "{\"value\":\"42\",\"another\":99,\"pickOne\":{\"someid\":0}}"+ (TestProtoOneof.Something 42 99 (Just (TestProtoOneof.SomethingPickOneSomeid 0)))+ , decodesAs "{\"value\":\"42\",\"another\":99,\"pickOne\":{\"dummyMsg1\":{\"dummy\":66}}}"+ (TestProtoOneof.Something 42 99 (Just (TestProtoOneof.SomethingPickOneDummyMsg1 (TestProtoOneof.DummyMsg 66))))+ , decodesAs "{\"value\":\"42\",\"another\":99,\"pickOne\":{\"dummyMsg2\":{\"dummy\":67}}}"+ (TestProtoOneof.Something 42 99 (Just (TestProtoOneof.SomethingPickOneDummyMsg2 (TestProtoOneof.DummyMsg 67))))+ , decodesAs "{\"value\":\"42\",\"another\":99,\"pickOne\":{\"dummyEnum\":\"DUMMY0\"}}"+ (TestProtoOneof.Something 42 99 (Just (TestProtoOneof.SomethingPickOneDummyEnum (Enumerated (Right TestProtoOneof.DummyEnumDUMMY0)))))+ , decodesAs "{\"value\":\"42\",\"another\":99,\"pickOne\":{}}" (TestProtoOneof.Something 42 99 Nothing)+ , decodesAs "{\"value\":\"42\",\"another\":99,\"pickOne\":null}" (TestProtoOneof.Something 42 99 Nothing)+ ]+ ]+ ] --- | Round-trip tests--- prop> roundTrip (x :: Trivial)--- prop> roundTrip (x :: MultipleFields)--- prop> roundTrip (x :: SignedInts)--- prop> roundTrip (SignedInts minBound minBound)--- prop> roundTrip (SignedInts maxBound maxBound)--- prop> roundTrip (WithEnum (Enumerated (Right x)))--- prop> roundTrip (x :: WithNesting)--- prop> roundTrip (x :: WithNestingRepeated)--- prop> roundTrip (x :: WithNestingRepeatedInts)--- prop> roundTrip (x :: WithBytes)--- prop> roundTrip (x :: OutOfOrderFields)--- prop> roundTrip (x :: UsingImported)--- prop> roundTrip (x :: Wrapped)--- prop> roundTrip (x :: Something)--- prop> roundTrip (x :: WithImported)+swaggerTests :: TestTree+swaggerTests = testGroup "Swagger tests"+ [ schemaOf @TestProtoOneof.Something+ "{\"properties\":{\"value\":{\"format\":\"int64\",\"maximum\":9223372036854775807,\"minimum\":-9223372036854775808,\"type\":\"integer\"},\"another\":{\"format\":\"int32\",\"maximum\":2147483647,\"minimum\":-2147483648,\"type\":\"integer\"},\"pickOne\":{\"$ref\":\"#/definitions/SomethingPickOne\"}},\"type\":\"object\"}"+ , schemaOf @TestProtoOneof.SomethingPickOne+ "{\"properties\":{\"name\":{\"type\":\"string\"},\"someid\":{\"format\":\"int32\",\"maximum\":2147483647,\"minimum\":-2147483648,\"type\":\"integer\"},\"dummyMsg1\":{\"$ref\":\"#/definitions/DummyMsg\"},\"dummyMsg2\":{\"$ref\":\"#/definitions/DummyMsg\"},\"dummyEnum\":{\"$ref\":\"#/definitions/DummyEnum\"}},\"maxProperties\":1,\"minProperties\":1,\"type\":\"object\"}"+ , schemaOf @TestProtoOneof.DummyMsg+ "{\"properties\":{\"dummy\":{\"format\":\"int32\",\"maximum\":2147483647,\"minimum\":-2147483648,\"type\":\"integer\"}},\"type\":\"object\"}"+ , schemaOf @(Enumerated TestProtoOneof.DummyEnum)+ "{\"enum\":[\"DUMMY0\",\"DUMMY1\"],\"type\":\"string\"}" --- | Specific encoding tests--- prop> encodesAs jsonPB (MultipleFields 0 0 0 0 "" False) "{}"--- prop> encodesAs json (MultipleFields 0 2.0 0 0 "" True) "{\"multiFieldDouble\":0.0,\"multiFieldFloat\":2.0,\"multiFieldInt32\":0,\"multiFieldInt64\":\"0\",\"multiFieldString\":\"\",\"multiFieldBool\":true}"--- prop> encodesAs jsonPB (SignedInts minBound minBound) "{\"signed32\":-2147483648,\"signed64\":\"-9223372036854775808\"}"--- prop> encodesAs jsonPB (SignedInts maxBound maxBound) "{\"signed32\":2147483647,\"signed64\":\"9223372036854775807\"}"--- prop> encodesAs jsonPB (WithEnum (Enumerated (Right WithEnum_TestEnumENUM1))) "{}"--- prop> encodesAs json (WithEnum (Enumerated (Right WithEnum_TestEnumENUM1))) "{\"enumField\":\"ENUM1\"}"--- prop> encodesAs jsonPB (WithEnum (Enumerated (Right WithEnum_TestEnumENUM3))) "{\"enumField\":\"ENUM3\"}"--- prop> encodesAs jsonPB (WithNesting $ Just $ WithNesting_Nested "" 0 [1,2] [66,99]) "{\"nestedMessage\":{\"nestedPacked\":[1,2],\"nestedUnpacked\":[66,99]}}"--- prop> encodesAs jsonPB (Something 42 99 (Just (SomethingPickOneName ""))) "{\"value\":\"42\",\"another\":99,\"name\":\"\"}"--- prop> encodesAs jsonPB (Something 42 99 (Just (SomethingPickOneSomeid 0))) "{\"value\":\"42\",\"another\":99,\"someid\":0}"--- prop> encodesAs jsonPB (Something 42 99 (Just (SomethingPickOneDummyMsg1 (DummyMsg 66)))) "{\"value\":\"42\",\"another\":99,\"dummyMsg1\":{\"dummy\":66}}"--- prop> encodesAs jsonPB (Something 42 99 (Just (SomethingPickOneDummyMsg2 (DummyMsg 67)))) "{\"value\":\"42\",\"another\":99,\"dummyMsg2\":{\"dummy\":67}}"--- prop> encodesAs jsonPB (Something 42 99 (Just (SomethingPickOneDummyEnum (Enumerated (Right DummyEnumDUMMY0))))) "{\"value\":\"42\",\"another\":99,\"dummyEnum\":\"DUMMY0\"}"--- prop> encodesAs jsonPB (Something 42 99 Nothing) "{\"value\":\"42\",\"another\":99}"--- prop> encodesAs json (Something 42 99 (Just (SomethingPickOneName ""))) "{\"value\":\"42\",\"another\":99,\"pickOne\":{\"name\":\"\"}}"--- prop> encodesAs json (Something 42 99 (Just (SomethingPickOneSomeid 0))) "{\"value\":\"42\",\"another\":99,\"pickOne\":{\"someid\":0}}"--- prop> encodesAs json (Something 42 99 (Just (SomethingPickOneDummyMsg1 (DummyMsg 66)))) "{\"value\":\"42\",\"another\":99,\"pickOne\":{\"dummyMsg1\":{\"dummy\":66}}}"--- prop> encodesAs json (Something 42 99 (Just (SomethingPickOneDummyMsg2 (DummyMsg 67)))) "{\"value\":\"42\",\"another\":99,\"pickOne\":{\"dummyMsg2\":{\"dummy\":67}}}"--- prop> encodesAs json (Something 42 99 (Just (SomethingPickOneDummyEnum (Enumerated (Right DummyEnumDUMMY0))))) "{\"value\":\"42\",\"another\":99,\"pickOne\":{\"dummyEnum\":\"DUMMY0\"}}"--- prop> encodesAs json (Something 42 99 Nothing) "{\"value\":\"42\",\"another\":99,\"pickOne\":null}"+ ] --- | Specific decoding tests--- prop> decodesAs "{\"signed32\":2147483647,\"signed64\":\"9223372036854775807\"}" (SignedInts 2147483647 9223372036854775807)--- prop> decodesAs "{\"enumField\":\"ENUM3\"}" (WithEnum (Enumerated (Right WithEnum_TestEnumENUM3)))--- prop> decodesAs "{\"enumField\":null}" (WithEnum (Enumerated (Right WithEnum_TestEnumENUM1)))--- prop> decodesAs "{}" (WithEnum (Enumerated (Right WithEnum_TestEnumENUM1)))--- prop> decodesAs "{\"nestedMessage\":{}}" (WithNesting $ Just $ WithNesting_Nested "" 0 [] [])------ JSONPB------ prop> decodesAs "{\"value\":\"42\",\"another\":99,\"someid\":66}" (Something 42 99 (Just (SomethingPickOneSomeid 66)))--- prop> decodesAs "{\"value\":\"42\",\"another\":99,\"name\":\"foo\"}" (Something 42 99 (Just (SomethingPickOneName "foo")))--- prop> decodesAs "{\"value\":\"42\",\"another\":99,\"dummyMsg1\":{\"dummy\":41}}" (Something 42 99 (Just (SomethingPickOneDummyMsg1 (DummyMsg 41))))--- prop> decodesAs "{\"value\":\"42\",\"another\":99,\"dummyMsg2\":{\"dummy\":43}}" (Something 42 99 (Just (SomethingPickOneDummyMsg2 (DummyMsg 43))))--- prop> decodesAs "{\"value\":\"42\",\"another\":99,\"dummyEnum\":\"DUMMY0\"}" (Something 42 99 (Just (SomethingPickOneDummyEnum (Enumerated (Right DummyEnumDUMMY0)))))--- prop> decodesAs "{\"value\":\"42\",\"another\":99}" (Something 42 99 Nothing)------ JSON------ prop> decodesAs "{\"value\":\"42\",\"another\":99,\"pickOne\":{\"name\":\"\"}}" (Something 42 99 (Just (SomethingPickOneName "")))--- prop> decodesAs "{\"value\":\"42\",\"another\":99,\"pickOne\":{\"someid\":0}}" (Something 42 99 (Just (SomethingPickOneSomeid 0)))--- prop> decodesAs "{\"value\":\"42\",\"another\":99,\"pickOne\":{\"dummyMsg1\":{\"dummy\":66}}}" (Something 42 99 (Just (SomethingPickOneDummyMsg1 (DummyMsg 66))))--- prop> decodesAs "{\"value\":\"42\",\"another\":99,\"pickOne\":{\"dummyMsg2\":{\"dummy\":67}}}" (Something 42 99 (Just (SomethingPickOneDummyMsg2 (DummyMsg 67))))--- prop> decodesAs "{\"value\":\"42\",\"another\":99,\"pickOne\":{\"dummyEnum\":\"DUMMY0\"}}" (Something 42 99 (Just (SomethingPickOneDummyEnum (Enumerated (Right DummyEnumDUMMY0)))))--- prop> decodesAs "{\"value\":\"42\",\"another\":99,\"pickOne\":{}}" (Something 42 99 Nothing)--- prop> decodesAs "{\"value\":\"42\",\"another\":99,\"pickOne\":null}" (Something 42 99 Nothing)------ Swagger------ >>> schemaOf @Something--- {"properties":{"value":{"maximum":9223372036854775807,"format":"int64","minimum":-9223372036854775808,"type":"integer"},"another":{"maximum":2147483647,"format":"int32","minimum":-2147483648,"type":"integer"},"pickOne":{"$ref":"#/definitions/SomethingPickOne"}},"type":"object"}--- >>> schemaOf @SomethingPickOne--- {"properties":{"name":{"type":"string"},"someid":{"maximum":2147483647,"format":"int32","minimum":-2147483648,"type":"integer"},"dummyMsg1":{"$ref":"#/definitions/DummyMsg"},"dummyMsg2":{"$ref":"#/definitions/DummyMsg"},"dummyEnum":{"$ref":"#/definitions/DummyEnum"}},"maxProperties":1,"minProperties":1,"type":"object"}--- >>> schemaOf @DummyMsg--- {"properties":{"dummy":{"maximum":2147483647,"format":"int32","minimum":-2147483648,"type":"integer"}},"type":"object"}--- >>> schemaOf @(Enumerated DummyEnum)--- {"type":"string","enum":["DUMMY0","DUMMY1"]}------ Generic HasDefault------ >>> def :: MultipleFields--- MultipleFields {multipleFieldsMultiFieldDouble = 0.0, multipleFieldsMultiFieldFloat = 0.0, multipleFieldsMultiFieldInt32 = 0, multipleFieldsMultiFieldInt64 = 0, multipleFieldsMultiFieldString = "", multipleFieldsMultiFieldBool = False}--- >>> def :: WithNesting--- WithNesting {withNestingNestedMessage = Nothing}--- >>> def :: WithNestingRepeated--- WithNestingRepeated {withNestingRepeatedNestedMessages = []}--- >>> def :: WithEnum--- WithEnum {withEnumEnumField = Enumerated {enumerated = Right WithEnum_TestEnumENUM1}}+hasDefaultTests :: TestTree+hasDefaultTests = testGroup "Generic HasDefault"+ [ testProperty "MultipleFields" $+ (def :: TestProto.MultipleFields) ===+ TestProto.MultipleFields {multipleFieldsMultiFieldDouble = 0.0, multipleFieldsMultiFieldFloat = 0.0, multipleFieldsMultiFieldInt32 = 0, multipleFieldsMultiFieldInt64 = 0, multipleFieldsMultiFieldString = "", multipleFieldsMultiFieldBool = False}+ , testProperty "WithNesting" $+ (def :: TestProto.WithNesting) ===+ TestProto.WithNesting {withNestingNestedMessage = Nothing}+ , testProperty "WithNestingRepeated" $+ (def :: TestProto.WithNestingRepeated) ===+ TestProto.WithNestingRepeated {withNestingRepeatedNestedMessages = []}+ , testProperty "WithEnum" $+ (def :: TestProto.WithEnum) ===+ TestProto.WithEnum {withEnumEnumField = Enumerated {enumerated = Right TestProto.WithEnum_TestEnumENUM1}}+ ] -- * Helper quickcheck props +roundTripTest ::+ forall a .+ (ToJSONPB a, FromJSONPB a, Eq a, Arbitrary a, Show a, Typeable a) =>+ TestTree+roundTripTest =+ testProperty ("roundTripTest @" ++ show (typeRep (Proxy :: Proxy a))) $+ roundTrip @a+ roundTrip :: (ToJSONPB a, FromJSONPB a, Eq a) => a -> Bool roundTrip x = roundTrip' False && roundTrip' True@@ -373,16 +424,47 @@ == Right x -encodesAs :: (ToJSONPB a)- => Options -> a -> LBS.ByteString -> Bool-encodesAs opts x bs = encode opts x == bs+encodesAs ::+ forall a .+ (ToJSONPB a, Eq a, Show a, Typeable a) =>+ Options -> a -> LBS.ByteString -> TestTree+encodesAs opts x bs = testProperty (testName "") (encode opts x === bs)+ where+ testName =+ showString "encode @" .+ showsPrec 11 (typeRep (Proxy :: Proxy a)) .+ showChar ' ' .+ showsPrec 11 opts .+ showChar ' ' .+ showsPrec 11 x .+ showString " == " .+ showsPrec 5 bs -decodesAs :: (Eq a, FromJSONPB a)- => LBS.ByteString -> a -> Bool-decodesAs bs x = eitherDecode bs == Right x+decodesAs ::+ forall a .+ (FromJSONPB a, Eq a, Show a, Typeable a) =>+ LBS.ByteString -> a -> TestTree+decodesAs bs x = testProperty (testName "") (eitherDecode bs === Right x)+ where+ testName =+ showString "eitherDecode @" .+ showsPrec 11 (typeRep (Proxy :: Proxy a)) .+ showChar ' ' .+ showsPrec 11 bs .+ showString " == Right " .+ showsPrec 11 x -schemaOf :: forall a . ToSchema a => IO ()-schemaOf = LBS8.putStrLn (lbsSchemaOf @a)+schemaOf ::+ forall a .+ (ToSchema a, Eq a, Show a, Typeable a) =>+ LBS.ByteString -> TestTree+schemaOf bs = testProperty (testName "") (lbsSchemaOf @a === bs)+ where+ testName =+ showString "lbsSchemaOf @" .+ showsPrec 11 (typeRep (Proxy :: Proxy a)) .+ showString " == " .+ showsPrec 5 bs lbsSchemaOf :: forall a . ToSchema a => LBS.ByteString lbsSchemaOf = Data.Aeson.encode (Data.Swagger.toSchema (Proxy @a))
tests/decode.sh view
@@ -1,3 +1,4 @@+#!/usr/bin/env bash set -eu hsTmpDir=$1 shift
tests/encode.sh view
@@ -1,3 +1,4 @@+#!/usr/bin/env bash set -eu hsTmpDir=$1 shift