mu-protobuf 0.4.1.0 → 0.4.2.0

raw patch · 4 files changed

+50/−12 lines, 4 filesdep ~mu-schemaPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: mu-schema

API changes (from Hackage documentation)

Files

• mu-protobuf.cabal +1/−1
• src/Mu/Adapter/ProtoBuf.hs +27/−2
• src/Mu/Quasi/ProtoBuf.hs +18/−5
• test/ProtoBuf.hs +4/−4

@@ -1,5 +1,5 @@ name:          mu-protobuf-version:       0.4.1.0+version:       0.4.2.0 synopsis:   Protocol Buffers serialization and gRPC schema import for Mu microservices 

@@ -205,6 +205,7 @@  -- Embedded terms class ProtoBridgeEmbedTerm (sch :: Schema tn fn) (t :: TypeDef tn fn) where+  embedDefaultOneFieldValue :: Maybe (Term sch t)   termToEmbedProto :: FieldNumber -> Term sch t -> PBEnc.MessageBuilder   embedProtoToOneFieldValue :: PBDec.Parser PBDec.RawPrimitive (Term sch t)   -- support for packed encodings@@ -257,6 +258,7 @@  instance ProtoBridgeTerm sch ('DRecord name args)          => ProtoBridgeEmbedTerm sch ('DRecord name args) where+  embedDefaultOneFieldValue = Nothing   termToEmbedProto fid v = PBEnc.embedded fid (termToProto v)   embedProtoToOneFieldValue = PBDec.embedded' (protoToTerm @_ @_ @sch @('DRecord name args))   supportsPackingTerm _ = False@@ -271,8 +273,10 @@   termToProto = error "protobuf requires wrapping enums in a message"   protoToTerm = error "protobuf requires wrapping enums in a message" -instance ProtoBridgeEnum sch name choices+instance ( ProtoBridgeEnum sch name choices+         , FindZeroEnum sch name choices )          => ProtoBridgeEmbedTerm sch ('DEnum name choices) where+  embedDefaultOneFieldValue = Just $ TEnum $ findZeroEnum @_ @_ @sch @name @choices   termToEmbedProto fid (TEnum v) = PBEnc.int32 fid (enumToProto @_ @_ @sch @name v)   embedProtoToOneFieldValue = PBDec.int32 >>= fmap TEnum . protoToEnum @_ @_ @sch @name   supportsPackingTerm _ = True@@ -296,6 +300,27 @@     | otherwise      = S <$> protoToEnum @_ @_ @sch @ty n     where enumValue = fromIntegral (natVal (Proxy @(FindProtoBufId sch ty c))) +class FindZeroEnum (sch :: Schema tn fn) (ty :: tn) (choices :: [ChoiceDef fn]) where+  findZeroEnum :: NS Proxy choices+class FindZeroEnum_ (sch :: Schema tn fn) (ty :: tn) (thisChoice :: ChoiceDef fn) (pbId :: Nat) (restOfChoices :: [ChoiceDef fn]) where+  findZeroEnum_ :: NS Proxy (thisChoice ': restOfChoices)++instance TypeError ('Text "could not find value 0 for enum")+         => FindZeroEnum sch ty '[] where+  findZeroEnum = error "this should never be called"+instance (FindZeroEnum_ sch ty ('ChoiceDef this) (FindProtoBufId sch ty this) rest)+         => FindZeroEnum sch ty ('ChoiceDef this ': rest) where+  findZeroEnum+    = findZeroEnum_ @_ @_ @sch @ty @('ChoiceDef this) @(FindProtoBufId sch ty this) @rest++instance {-# OVERLAPPABLE #-}+         (FindZeroEnum sch ty rest)+         => FindZeroEnum_ sch ty this n rest where+  findZeroEnum_ = S (findZeroEnum @_ @_ @sch @ty @rest)+instance {-# OVERLAPS #-}+         FindZeroEnum_ sch ty this 0 rest where+  findZeroEnum_ = Z Proxy+ -- SIMPLE -- ------ @@ -409,7 +434,7 @@  instance ProtoBridgeEmbedTerm sch (sch :/: t)          => ProtoBridgeOneFieldValue sch ('TSchematic t) where-  defaultOneFieldValue = Nothing+  defaultOneFieldValue = FSchematic <$> embedDefaultOneFieldValue   oneFieldValueToProto fid (FSchematic v) = termToEmbedProto fid v   protoToOneFieldValue = FSchematic <$> embedProtoToOneFieldValue   supportsPacking _ = supportsPackingTerm (Proxy @(Term sch (sch :/: t)))

@@ -65,8 +65,17 @@ schemaFromProtoBuf :: P.ProtoBuf -> Q (Type, Type) schemaFromProtoBuf P.ProtoBuf {P.types = tys} = do   let decls = flattenDecls (("", tys) :| []) tys-  (schTys, anns) <- unzip <$> mapM pbTypeDeclToType decls+  (schTys, anns) <- unzip <$> mapM (pbTypeDeclToType $ shouldOptional decls) decls   pure (typesToList schTys, typesToList (concat anns))+  where+    shouldOptional :: [P.TypeDeclaration] -> P.TypeName -> Bool+    shouldOptional [] _ = error "this should never happen"+    shouldOptional (P.DMessage nm _ _ _ _ : _) this+      | nm == last this = True+    shouldOptional (P.DEnum nm _ _ : _) this+      | nm == last this = False+    shouldOptional (_ : rest) this+      = shouldOptional rest this  flattenDecls :: NonEmpty (P.Identifier, [P.TypeDeclaration]) -> [P.TypeDeclaration] -> [P.TypeDeclaration] flattenDecls (currentScope :| higherScopes) = concatMap flattenDecl@@ -113,8 +122,8 @@         "" -> x         _  -> fst currentScope <> "." <> x -pbTypeDeclToType :: P.TypeDeclaration -> Q (Type, [Type])-pbTypeDeclToType (P.DEnum name _ fields) = do+pbTypeDeclToType :: (P.TypeName -> Bool) -> P.TypeDeclaration -> Q (Type, [Type])+pbTypeDeclToType _ (P.DEnum name _ fields) = do   (tys, anns) <- unzip <$> mapM pbChoiceToType fields   (,) <$> [t|'DEnum $(textToStrLit name) $(pure $ typesToList tys)|] <*> pure anns   where@@ -122,7 +131,7 @@     pbChoiceToType (P.EnumField nm number _)       = (,) <$> [t|'ChoiceDef $(textToStrLit nm) |]             <*> [t|'AnnField $(textToStrLit name) $(textToStrLit nm) ('ProtoBufId $(intToLit number) '[]) |]-pbTypeDeclToType (P.DMessage name _ _ fields _) = do+pbTypeDeclToType shouldOptional (P.DMessage name _ _ fields _) = do   (tys, anns) <- unzip <$> mapM pbMsgFieldToType fields   (,) <$> [t|'DRecord $(textToStrLit name) $(pure $ typesToList tys)|] <*> pure anns   where@@ -131,8 +140,12 @@     -- it's possible to distinguish whether it's missing on wire     -- or should be set to the default, so use Option     -- +info -> https://github.com/higherkindness/mu-haskell/pull/130#issuecomment-596433307-    pbMsgFieldToType (P.NormalField P.Single ty@(P.TOther _) nm n opts) =+    pbMsgFieldToType (P.NormalField P.Single ty@(P.TOther innerTy) nm n opts)+        | shouldOptional innerTy =         (,) <$> [t| 'FieldDef $(textToStrLit nm) ('TOption $(pbFieldTypeToType ty)) |]+            <*> [t| 'AnnField $(textToStrLit name) $(textToStrLit nm) ('ProtoBufId $(intToLit n) $(typesToList <$> mapM pbOption opts)) |]+        | otherwise =+        (,) <$> [t| 'FieldDef $(textToStrLit nm) $(pbFieldTypeToType ty) |]             <*> [t| 'AnnField $(textToStrLit name) $(textToStrLit nm) ('ProtoBufId $(intToLit n) $(typesToList <$> mapM pbOption opts)) |]     pbMsgFieldToType (P.NormalField P.Single ty nm n opts) =         (,) <$> [t| 'FieldDef $(textToStrLit nm) $(pbFieldTypeToType ty) |]

@@ -25,7 +25,7 @@   = MPerson { firstName     :: T.Text             , lastName      :: T.Text             , age           :: Maybe Int-            , gender        :: Maybe Gender+            , gender        :: Gender             , address       :: MAddress             , lucky_numbers :: [Int]             , things        :: M.Map T.Text Int }@@ -54,7 +54,7 @@      , 'AnnField "gender" "gender7" ('ProtoBufId 11 '[])      , 'AnnField "gender" "gender8" ('ProtoBufId 12 '[])      , 'AnnField "gender" "gender9" ('ProtoBufId 13 '[])-     , 'AnnField "gender" "unspecified" ('ProtoBufId 14 '[])+     , 'AnnField "gender" "unspecified" ('ProtoBufId 0 '[])      , 'AnnField "address" "postcode" ('ProtoBufId 1 '[])      , 'AnnField "address" "country"  ('ProtoBufId 2 '[])      , 'AnnField "person" "firstName" ('ProtoBufId 1 '[])@@ -70,11 +70,11 @@  examplePerson1, examplePerson2 :: MPerson examplePerson1 = MPerson "Haskellio" "Gómez"-                         (Just 30) (Just Male)+                         (Just 30) Male                          exampleAddress [1,2,3]                          (M.fromList [("pepe", 1), ("juan", 2)]) examplePerson2 = MPerson "Cuarenta" "Siete"-                         Nothing Nothing+                         Nothing Unspecified                          exampleAddress [] M.empty  main :: IO ()