proto3-suite 0.4.1 → 0.4.2

raw patch · 12 files changed

+326/−17 lines, 12 filesdep +timedep ~proto3-wiredep ~tastybinary-addedPVP ok

version bump matches the API change (PVP)

Dependencies added: time

Dependency ranges changed: proto3-wire, tasty

API changes (from Hackage documentation)

Files

• gen/TestProto.hs +89/−3
• gen/TestProtoImport.hs +4/−3
• gen/TestProtoOneof.hs +4/−3
• gen/TestProtoOneofImport.hs +4/−3
• proto3-suite.cabal +5/−2
• src/Google/Protobuf/Timestamp.hs +167/−0
• src/Proto3/Suite/Class.hs +31/−0
• src/Proto3/Suite/DotProto/Generate.hs +4/−3
• test-files/with_repeated_signed.bin binary
• tests/ArbitraryGeneratedTestTypes.hs +3/−0
• tests/Main.hs +3/−0
• tests/TestCodeGen.hs +12/−0

@@ -4,9 +4,10 @@ {-# LANGUAGE GADTs             #-} {-# LANGUAGE TypeApplications  #-} {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-unused-imports #-}-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}-{-# OPTIONS_GHC -fno-warn-unused-matches #-}+{-# OPTIONS_GHC -fno-warn-unused-imports       #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing       #-}+{-# OPTIONS_GHC -fno-warn-unused-matches       #-}+{-# OPTIONS_GHC -fno-warn-missing-export-lists #-}  -- | Generated by Haskell protocol buffer compiler. DO NOT EDIT! @@ -1133,6 +1134,91 @@                                                      HsJSONPB.insOrdFromList                                                        [("repeatedField1",                                                          withRepetitionRepeatedField1)]}})+ +data WithRepeatedSigned = WithRepeatedSigned{withRepeatedSignedR32+                                             :: Hs.Vector Hs.Int32,+                                             withRepeatedSignedR64 :: Hs.Vector Hs.Int64}+                        deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic, Hs.NFData)+ +instance HsProtobuf.Named WithRepeatedSigned where+        nameOf _ = (Hs.fromString "WithRepeatedSigned")+ +instance HsProtobuf.HasDefault WithRepeatedSigned+ +instance HsProtobuf.Message WithRepeatedSigned where+        encodeMessage _+          WithRepeatedSigned{withRepeatedSignedR32 = withRepeatedSignedR32,+                             withRepeatedSignedR64 = withRepeatedSignedR64}+          = (Hs.mconcat+               [(HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 1)+                   (Hs.coerce @(Hs.Vector Hs.Int32)+                      @(HsProtobuf.PackedVec (HsProtobuf.Signed Hs.Int32))+                      withRepeatedSignedR32)),+                (HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 2)+                   (Hs.coerce @(Hs.Vector Hs.Int64)+                      @(HsProtobuf.PackedVec (HsProtobuf.Signed Hs.Int64))+                      withRepeatedSignedR64))])+        decodeMessage _+          = (Hs.pure WithRepeatedSigned) <*>+              (Hs.coerce @(_ (HsProtobuf.PackedVec (HsProtobuf.Signed Hs.Int32)))+                 @(_ (Hs.Vector Hs.Int32))+                 (HsProtobuf.at HsProtobuf.decodeMessageField+                    (HsProtobuf.FieldNumber 1)))+              <*>+              (Hs.coerce @(_ (HsProtobuf.PackedVec (HsProtobuf.Signed Hs.Int64)))+                 @(_ (Hs.Vector Hs.Int64))+                 (HsProtobuf.at HsProtobuf.decodeMessageField+                    (HsProtobuf.FieldNumber 2)))+        dotProto _+          = [(HsProtobuf.DotProtoField (HsProtobuf.FieldNumber 1)+                (HsProtobuf.Repeated HsProtobuf.SInt32)+                (HsProtobuf.Single "r32")+                []+                ""),+             (HsProtobuf.DotProtoField (HsProtobuf.FieldNumber 2)+                (HsProtobuf.Repeated HsProtobuf.SInt64)+                (HsProtobuf.Single "r64")+                []+                "")]+ +instance HsJSONPB.ToJSONPB WithRepeatedSigned where+        toJSONPB (WithRepeatedSigned f1 f2)+          = (HsJSONPB.object ["r32" .= f1, "r64" .= f2])+        toEncodingPB (WithRepeatedSigned f1 f2)+          = (HsJSONPB.pairs ["r32" .= f1, "r64" .= f2])+ +instance HsJSONPB.FromJSONPB WithRepeatedSigned where+        parseJSONPB+          = (HsJSONPB.withObject "WithRepeatedSigned"+               (\ obj ->+                  (Hs.pure WithRepeatedSigned) <*> obj .: "r32" <*> obj .: "r64"))+ +instance HsJSONPB.ToJSON WithRepeatedSigned where+        toJSON = HsJSONPB.toAesonValue+        toEncoding = HsJSONPB.toAesonEncoding+ +instance HsJSONPB.FromJSON WithRepeatedSigned where+        parseJSON = HsJSONPB.parseJSONPB+ +instance HsJSONPB.ToSchema WithRepeatedSigned where+        declareNamedSchema _+          = do let declare_r32 = HsJSONPB.declareSchemaRef+               withRepeatedSignedR32 <- declare_r32 Proxy.Proxy+               let declare_r64 = HsJSONPB.declareSchemaRef+               withRepeatedSignedR64 <- declare_r64 Proxy.Proxy+               let _ = Hs.pure WithRepeatedSigned <*> HsJSONPB.asProxy declare_r32+                         <*> HsJSONPB.asProxy declare_r64+               Hs.return+                 (HsJSONPB.NamedSchema{HsJSONPB._namedSchemaName =+                                         Hs.Just "WithRepeatedSigned",+                                       HsJSONPB._namedSchemaSchema =+                                         Hs.mempty{HsJSONPB._schemaParamSchema =+                                                     Hs.mempty{HsJSONPB._paramSchemaType =+                                                                 Hs.Just HsJSONPB.SwaggerObject},+                                                   HsJSONPB._schemaProperties =+                                                     HsJSONPB.insOrdFromList+                                                       [("r32", withRepeatedSignedR32),+                                                        ("r64", withRepeatedSignedR64)]}})   data WithFixed = WithFixed{withFixedFixed1 :: Hs.Word32,                            withFixedFixed2 :: Hs.Int32, withFixedFixed3 :: Hs.Word64,

@@ -4,9 +4,10 @@ {-# LANGUAGE GADTs             #-} {-# LANGUAGE TypeApplications  #-} {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-unused-imports #-}-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}-{-# OPTIONS_GHC -fno-warn-unused-matches #-}+{-# OPTIONS_GHC -fno-warn-unused-imports       #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing       #-}+{-# OPTIONS_GHC -fno-warn-unused-matches       #-}+{-# OPTIONS_GHC -fno-warn-missing-export-lists #-}  -- | Generated by Haskell protocol buffer compiler. DO NOT EDIT! 

@@ -4,9 +4,10 @@ {-# LANGUAGE GADTs             #-} {-# LANGUAGE TypeApplications  #-} {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-unused-imports #-}-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}-{-# OPTIONS_GHC -fno-warn-unused-matches #-}+{-# OPTIONS_GHC -fno-warn-unused-imports       #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing       #-}+{-# OPTIONS_GHC -fno-warn-unused-matches       #-}+{-# OPTIONS_GHC -fno-warn-missing-export-lists #-}  -- | Generated by Haskell protocol buffer compiler. DO NOT EDIT! 

@@ -4,9 +4,10 @@ {-# LANGUAGE GADTs             #-} {-# LANGUAGE TypeApplications  #-} {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-unused-imports #-}-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}-{-# OPTIONS_GHC -fno-warn-unused-matches #-}+{-# OPTIONS_GHC -fno-warn-unused-imports       #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing       #-}+{-# OPTIONS_GHC -fno-warn-unused-matches       #-}+{-# OPTIONS_GHC -fno-warn-missing-export-lists #-}  -- | Generated by Haskell protocol buffer compiler. DO NOT EDIT! 

@@ -1,5 +1,5 @@ name:                proto3-suite-version:             0.4.1+version:             0.4.2 synopsis:            A low level library for writing out data in the Protocol Buffers wire format license:             Apache-2.0 author:              Awake Security@@ -44,6 +44,8 @@                        Proto3.Suite.Tutorial                        Proto3.Suite.Types +                       Google.Protobuf.Timestamp+                        Proto3.Suite.DotProto.Internal                        Proto3.Suite.JSONPB.Class @@ -70,11 +72,12 @@                        parsers >= 0.12 && <0.13,                        pretty ==1.1.*,                        pretty-show >= 1.6.12 && < 2.0,-                       proto3-wire == 1.2.*,+                       proto3-wire >= 1.2.2 && < 1.3,                        QuickCheck >=2.10 && <2.15,                        quickcheck-instances < 0.4,                        safe ==0.3.*,                        system-filepath,+                       time,                        text >= 0.2 && <1.3,                        transformers >=0.4 && <0.6,                        turtle,

@@ -0,0 +1,167 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-export-lists #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-- | This module has been initialized using+-- https://github.com/protocolbuffers/protobuf/blob/master/src/google/protobuf/timestamp.proto+--+-- The ToJSONPB and FromJSONPB instances have been modified to+-- be compatible with the json rfc3339 encoding+module Google.Protobuf.Timestamp where++import Control.Applicative ((<$>), (<*>), (<|>))+import qualified Control.Applicative as Hs+import qualified Control.DeepSeq as Hs+import qualified Control.Monad as Hs+import qualified Data.Aeson as Aeson+import qualified Data.Aeson.Encoding as Aeson+import qualified Data.Aeson.Types as Aeson+import qualified Data.ByteString as Hs+import qualified Data.Coerce as Hs+import qualified Data.Int as Hs (Int16, Int32, Int64)+import qualified Data.List.NonEmpty as Hs (NonEmpty (..))+import qualified Data.Map as Hs (Map, mapKeysMonotonic)+import qualified Data.Proxy as Proxy+import qualified Data.String as Hs (fromString)+import qualified Data.Text.Lazy as Hs (Text)+import qualified Data.Text.Lazy as Text+import qualified Data.Time.Clock as Time+import qualified Data.Time.Clock.System as Time+import qualified Data.Time.Format as Time+import qualified Data.Vector as Hs (Vector)+import qualified Data.Word as Hs (Word16, Word32, Word64)+import qualified GHC.Enum as Hs+import qualified GHC.Generics as Hs+import qualified Proto3.Suite.Class as HsProtobuf+import qualified Proto3.Suite.DotProto as HsProtobuf+import Proto3.Suite.JSONPB ((.:), (.=))+import qualified Proto3.Suite.JSONPB as HsJSONPB+import qualified Proto3.Suite.Types as HsProtobuf+import qualified Proto3.Wire as HsProtobuf+import qualified Unsafe.Coerce as Hs+import qualified Prelude as Hs++data Timestamp = Timestamp+  { timestampSeconds :: Hs.Int64,+    timestampNanos :: Hs.Int32+  }+  deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic, Hs.NFData)++instance HsProtobuf.Named Timestamp where+  nameOf _ = Hs.fromString "Timestamp"++instance HsProtobuf.HasDefault Timestamp++instance HsProtobuf.Message Timestamp where+  encodeMessage+    _+    Timestamp+      { timestampSeconds = timestampSeconds,+        timestampNanos = timestampNanos+      } =+      Hs.mconcat+        [ HsProtobuf.encodeMessageField+            (HsProtobuf.FieldNumber 1)+            timestampSeconds,+          HsProtobuf.encodeMessageField+            (HsProtobuf.FieldNumber 2)+            timestampNanos+        ]++  decodeMessage _ =+    Timestamp+      <$> HsProtobuf.at+        HsProtobuf.decodeMessageField+        (HsProtobuf.FieldNumber 1)+      <*> HsProtobuf.at+        HsProtobuf.decodeMessageField+        (HsProtobuf.FieldNumber 2)++  dotProto _ =+    [ HsProtobuf.DotProtoField+        (HsProtobuf.FieldNumber 1)+        (HsProtobuf.Prim HsProtobuf.Int64)+        (HsProtobuf.Single "seconds")+        []+        "",+      HsProtobuf.DotProtoField+        (HsProtobuf.FieldNumber 2)+        (HsProtobuf.Prim HsProtobuf.Int32)+        (HsProtobuf.Single "nanos")+        []+        ""+    ]++rfc3339Format :: Hs.String+rfc3339Format = "%FT%TZ"++fromUTCTime :: Time.UTCTime -> Timestamp+fromUTCTime utc = Timestamp sec (Hs.fromInteger (Hs.toInteger nano))+  where+    Time.MkSystemTime sec nano = Time.utcToSystemTime utc++toUTCTime :: Timestamp -> Time.UTCTime+toUTCTime (Timestamp sec nano) = Time.systemToUTCTime systemTime+  where+    systemTime = Time.MkSystemTime sec (Hs.fromInteger (Hs.toInteger nano))++fromRFC3339 :: Hs.Text -> Hs.Maybe Timestamp+fromRFC3339 txt = do+  Time.MkSystemTime sec nano <- Time.utcToSystemTime <$> utcM+  Hs.pure (Timestamp sec (Hs.fromInteger (Hs.toInteger nano)))+  where+    utcM = Time.parseTimeM Hs.False Time.defaultTimeLocale rfc3339Format (Text.unpack txt)++toRFC3339 :: Timestamp -> Hs.Text+toRFC3339 ts = Text.pack (Time.formatTime Time.defaultTimeLocale rfc3339Format (toUTCTime ts))++instance HsJSONPB.ToJSONPB Timestamp where+  toJSONPB ts _opt = HsJSONPB.String (Text.toStrict (toRFC3339 ts))++instance HsJSONPB.FromJSONPB Timestamp where+  parseJSONPB = Aeson.withText "Timestamp" tryParse+    where+      tryParse txt = Hs.maybe Hs.mzero Hs.pure (fromRFC3339 (Text.fromStrict txt))++instance HsJSONPB.ToJSON Timestamp where+  toJSON = HsJSONPB.toAesonValue+  toEncoding = HsJSONPB.toAesonEncoding++instance HsJSONPB.FromJSON Timestamp where+  parseJSON = HsJSONPB.parseJSONPB++instance HsJSONPB.ToSchema Timestamp where+  declareNamedSchema _ =+    do+      let declare_seconds = HsJSONPB.declareSchemaRef+      timestampSeconds <- declare_seconds Proxy.Proxy+      let declare_nanos = HsJSONPB.declareSchemaRef+      timestampNanos <- declare_nanos Proxy.Proxy+      let _ =+            Timestamp <$> HsJSONPB.asProxy declare_seconds+              <*> HsJSONPB.asProxy declare_nanos+      Hs.return+        ( HsJSONPB.NamedSchema+            { HsJSONPB._namedSchemaName =+                Hs.Just "Timestamp",+              HsJSONPB._namedSchemaSchema =+                Hs.mempty+                  { HsJSONPB._schemaParamSchema =+                      Hs.mempty+                        { HsJSONPB._paramSchemaType =+                            Hs.Just HsJSONPB.SwaggerObject+                        },+                    HsJSONPB._schemaProperties =+                      HsJSONPB.insOrdFromList+                        [ ("seconds", timestampSeconds),+                          ("nanos", timestampNanos)+                        ]+                  }+            }+        )

@@ -576,6 +576,37 @@   decodeMessageField = decodePacked Decode.packedVarints   protoType _ = messageField (Repeated Int64) (Just DotProto.PackedField) +instance MessageField (PackedVec (Signed Int32)) where+  encodeMessageField fn = omittingDefault (Encode.packedVarintsV zigZag fn) . coerce @_ @(Vector Int32)+    where+      zigZag = fromIntegral . Encode.zigZagEncode++  decodeMessageField = decodePacked (fmap (fmap zagZig) Decode.packedVarints)+    where+      -- This type signature is important: `Decode.zigZagDecode` will not undo+      -- `Encode.zigZagEncode` if given a signed value with the high order bit+      -- set. So we don't allow GHC to infer a signed input type.+      zagZig :: Word32 -> Signed Int32+      zagZig = Signed . fromIntegral . Decode.zigZagDecode++  protoType _ = messageField (Repeated SInt32) (Just DotProto.PackedField)++instance MessageField (PackedVec (Signed Int64)) where+  encodeMessageField fn = omittingDefault (Encode.packedVarintsV zigZag fn) . coerce @_ @(Vector Int64)+    where+      zigZag = fromIntegral . Encode.zigZagEncode++  decodeMessageField = decodePacked (fmap (fmap zagZig) Decode.packedVarints)+    where+      -- This type signature is important: `Decode.zigZagDecode` will not undo+      -- `Encode.zigZagEncode` if given a signed value with the high order bit+      -- set. So we don't allow GHC to infer a signed input type.+      zagZig :: Word64 -> Signed Int64+      zagZig = Signed . fromIntegral . Decode.zigZagDecode++  protoType _ = messageField (Repeated SInt64) (Just DotProto.PackedField)++ instance MessageField (PackedVec (Fixed Word32)) where   encodeMessageField fn = omittingDefault (Encode.packedFixed32V id fn) . coerce @_ @(Vector Word32)   decodeMessageField = coerce @(Parser RawField (PackedVec Word32))

@@ -124,9 +124,10 @@       {-# LANGUAGE GADTs             #-}       {-# LANGUAGE TypeApplications  #-}       {-# LANGUAGE OverloadedStrings #-}-      {-# OPTIONS_GHC -fno-warn-unused-imports #-}-      {-# OPTIONS_GHC -fno-warn-name-shadowing #-}-      {-# OPTIONS_GHC -fno-warn-unused-matches #-}+      {-# OPTIONS_GHC -fno-warn-unused-imports       #-}+      {-# OPTIONS_GHC -fno-warn-name-shadowing       #-}+      {-# OPTIONS_GHC -fno-warn-unused-matches       #-}+      {-# OPTIONS_GHC -fno-warn-missing-export-lists #-}        -- | Generated by Haskell protocol buffer compiler. DO NOT EDIT!     |]

binary file changed (absent → 14 bytes)

@@ -46,6 +46,9 @@ instance Arbitrary WithRepetition where   arbitrary = WithRepetition <$> arbitrary +instance Arbitrary WithRepeatedSigned where+  arbitrary = WithRepeatedSigned <$> arbitrary <*> arbitrary+ instance Arbitrary WithFixed where   arbitrary = WithFixed <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary 

@@ -92,6 +92,7 @@   , testProperty "WithEnum"            (prop :: MsgProp TP.WithEnum)   , testProperty "WithNesting"         (prop :: MsgProp TP.WithNesting)   , testProperty "WithRepetition"      (prop :: MsgProp TP.WithRepetition)+  , testProperty "WithRepeatedSigned"  (prop :: MsgProp TP.WithRepeatedSigned)   , testProperty "WithFixed"           (prop :: MsgProp TP.WithFixed)   , testProperty "WithBytes"           (prop :: MsgProp TP.WithBytes)   , testProperty "AllPackedTypes"      (prop :: MsgProp TP.AllPackedTypes)@@ -132,6 +133,7 @@   , check "with_enum0.bin"            $ TP.WithEnum $ Enumerated $ Right $ TP.WithEnum_TestEnumENUM1   , check "with_enum1.bin"            $ TP.WithEnum $ Enumerated $ Right $ TP.WithEnum_TestEnumENUM2   , check "with_repetition.bin"       $ TP.WithRepetition [1..5]+  , check "with_repeated_signed.bin"  $ TP.WithRepeatedSigned [0,1,-1,2,-2] [0,1,-1,2,-2]   , check "with_bytes.bin"            $ TP.WithBytes (BC.pack "abc") (fromList $ map BC.pack ["abc","123"])   , check "with_nesting_repeated.bin" $ TP.WithNestingRepeated                                           [ TP.WithNestingRepeated_Nested "123abc" 123456 [1,2,3,4] [5,6,7,8]@@ -186,6 +188,7 @@   , check "with_enum0.bin"            $ TP.WithEnum $ Enumerated $ Right $ TP.WithEnum_TestEnumENUM1   , check "with_enum1.bin"            $ TP.WithEnum $ Enumerated $ Right $ TP.WithEnum_TestEnumENUM2   , check "with_repetition.bin"       $ TP.WithRepetition [1..5]+  , check "with_repeated_signed.bin"  $ TP.WithRepeatedSigned [0,1,-1,2,-2] [0,1,-1,2,-2]   , check "with_fixed.bin"            $ TP.WithFixed 16 (-123) 4096 (-4096)   , check "with_bytes.bin"            $ TP.WithBytes (BC.pack "abc") (fromList $ map BC.pack ["abc","123"])   , check "with_packing.bin"          $ TP.WithPacking [1,2,3] [1,2,3]

@@ -19,6 +19,7 @@ import           Data.Swagger                   (ToSchema) import qualified Data.Swagger import qualified Data.Text                      as T+import           Google.Protobuf.Timestamp      (Timestamp(..)) import           Prelude                        hiding (FilePath) import           Proto3.Suite.DotProto.Generate import           Proto3.Suite.DotProto          (fieldLikeName, prefixedEnumFieldName, typeLikeName)@@ -37,12 +38,23 @@   [ camelCaseMessageNames   , camelCaseMessageFieldNames   , don'tAlterEnumFieldNames+  , knownTypeMessages   {-    - These tests have been temporarily removed to pass CI.   , simpleEncodeDotProto   , simpleDecodeDotProto   -}   ]++knownTypeMessages :: TestTree+knownTypeMessages =+  testGroup+    "KnownType custom codec"+    [ testCase "Timestamp rfc3339 json encoding"+        $ encode defaultOptions (Timestamp 0 0) @?= "\"1970-01-01T00:00:00Z\""+    , testCase "Timestamp rfc3339 json decoding"+        $ eitherDecode "\"1970-01-01T00:00:00Z\"" @?= Right (Timestamp 0 0)+    ]  camelCaseMessageNames :: TestTree camelCaseMessageNames = testGroup "CamelCasing of message names"