mu-protobuf 0.4.0.1 → 0.4.0.2

raw patch · 3 files changed

+67/−9 lines, 3 filesdep ~template-haskellPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

Dependency ranges changed: template-haskell

API changes (from Hackage documentation)

Files

• mu-protobuf.cabal +2/−2
• src/Mu/Adapter/ProtoBuf.hs +17/−0
• src/Mu/Quasi/ProtoBuf.hs +48/−7

@@ -1,5 +1,5 @@ name:          mu-protobuf-version:       0.4.0.1+version:       0.4.0.2 synopsis:   Protocol Buffers serialization and gRPC schema import for Mu microservices @@ -42,7 +42,7 @@     , proto3-wire             >=1.1   && < 2     , servant-client-core     >=0.16  && <0.19     , sop-core                >=0.5   && <0.6-    , template-haskell        >=2.14  && <2.16+    , template-haskell        >=2.14  && <2.17     , text                    >=1.2   && <2    hs-source-dirs:   src

@@ -44,6 +44,7 @@ import           Data.SOP                 (All) import qualified Data.Text                as T import qualified Data.Text.Lazy           as LT+import           Data.Word                (Word64, Word32) import           GHC.TypeLits import           Proto3.Wire import qualified Proto3.Wire.Decode       as PBDec@@ -418,6 +419,22 @@   supportsPacking _ = True   packedFieldValueToProto fid vs     = PBEnc.packedVarints fid $ map (\(FPrimitive i) -> fromIntegral i) vs+  protoToPackedFieldValue = map FPrimitive <$> PBDec.packedVarints++instance ProtoBridgeOneFieldValue sch ('TPrimitive Word32) where+  defaultOneFieldValue = Just $ FPrimitive 0+  oneFieldValueToProto fid (FPrimitive n) = PBEnc.uint32 fid n+  protoToOneFieldValue = FPrimitive <$> PBDec.uint32+  supportsPacking _ = True+  packedFieldValueToProto fid vs = PBEnc.packedVarints fid $ map (\(FPrimitive i) -> fromIntegral i) vs+  protoToPackedFieldValue = map FPrimitive <$> PBDec.packedVarints++instance ProtoBridgeOneFieldValue sch ('TPrimitive Word64) where+  defaultOneFieldValue = Just $ FPrimitive 0+  oneFieldValueToProto fid (FPrimitive n) = PBEnc.uint64 fid n+  protoToOneFieldValue = FPrimitive <$> PBDec.uint64+  supportsPacking _ = True+  packedFieldValueToProto fid vs = PBEnc.packedVarints fid $ map (\(FPrimitive i) -> i) vs   protoToPackedFieldValue = map FPrimitive <$> PBDec.packedVarints  -- WARNING! These instances may go out of bounds

@@ -22,7 +22,10 @@ import           Control.Monad.IO.Class import qualified Data.ByteString                 as B import           Data.Int+import qualified Data.List                       as L+import           Data.List.NonEmpty              (NonEmpty (..)) import qualified Data.Text                       as T+import           Data.Word import           Language.Haskell.TH import           Language.ProtocolBuffers.Parser import qualified Language.ProtocolBuffers.Types  as P@@ -61,17 +64,55 @@  schemaFromProtoBuf :: P.ProtoBuf -> Q (Type, Type) schemaFromProtoBuf P.ProtoBuf {P.types = tys} = do-  let decls = flattenDecls tys+  let decls = flattenDecls (("", tys) :| []) tys   (schTys, anns) <- unzip <$> mapM pbTypeDeclToType decls   pure (typesToList schTys, typesToList (concat anns)) -flattenDecls :: [P.TypeDeclaration] -> [P.TypeDeclaration]-flattenDecls = concatMap flattenDecl+flattenDecls :: NonEmpty (P.Identifier, [P.TypeDeclaration]) -> [P.TypeDeclaration] -> [P.TypeDeclaration]+flattenDecls (currentScope :| higherScopes) = concatMap flattenDecl   where-    flattenDecl d@P.DEnum {} = [d]+    flattenDecl (P.DEnum name o f) = [P.DEnum (prependCurrentScope name) o f]     flattenDecl (P.DMessage name o r fs decls) =-      P.DMessage name o r fs [] : flattenDecls decls+      let newScopeName = prependCurrentScope name+          newScopes = (newScopeName, decls) :| (currentScope : higherScopes)+      in P.DMessage newScopeName o r (scopeFieldType newScopes <$> fs) [] : flattenDecls newScopes decls +    scopeFieldType scopes (P.NormalField frep ftype fname fnum fopts) =+      P.NormalField frep (qualifyType scopes ftype) fname fnum fopts+    scopeFieldType scopes (P.OneOfField fname fields) = P.OneOfField fname (scopeFieldType scopes <$> fields)+    scopeFieldType scopes (P.MapField fkey fval fname fnumber fopts) =+      P.MapField (qualifyType scopes fkey) (qualifyType scopes fval) fname fnumber fopts++    qualifyType scopes (P.TOther ts) = P.TOther (qualifyTOther scopes ts)+    qualifyType _scopes t            = t++    qualifyTOther _scopes [] = error "This shouldn't be possible"+    qualifyTOther ((_, _) :| []) ts =+      [T.intercalate "." ts] -- Top level scope, no need to search anything, use+                             -- the name as is. Maybe we should search and fail+                             -- if a type is not found even from top level, but+                             -- that could be a lot of work as this function is+                             -- pure right now.+    qualifyTOther ((scopeName, decls) :| (restFirst : restTail)) ts =+      if L.any (hasDeclFor ts) decls+      then [T.intercalate "." (scopeName:ts)]+      else qualifyTOther (restFirst :| restTail) ts++    hasDeclFor [] _ = True+    hasDeclFor [t] (P.DEnum enumName _ _) = t == enumName+    hasDeclFor (_:_:_) P.DEnum{} = False+    hasDeclFor (t:ts) (P.DMessage msgName _ _ _ rest) =+      let nameMatch = t == msgName+          -- 'L.any' returns 'False' if 'rest' is empty, hence the 'null ts'+          -- check is required.+          restMatch = null ts || L.any (hasDeclFor ts) rest+      in nameMatch && restMatch++    prependCurrentScope x =+      case fst currentScope of+        "" -> x+        _  -> fst currentScope <> "." <> x+ pbTypeDeclToType :: P.TypeDeclaration -> Q (Type, [Type]) pbTypeDeclToType (P.DEnum name _ fields) = do   (tys, anns) <- unzip <$> mapM pbChoiceToType fields@@ -112,10 +153,10 @@      pbFieldTypeToType :: P.FieldType -> Q Type     pbFieldTypeToType P.TInt32     = [t|'TPrimitive Int32|]-    pbFieldTypeToType P.TUInt32    = fail "unsigned integers are not currently supported"+    pbFieldTypeToType P.TUInt32    = [t|'TPrimitive Word32|]     pbFieldTypeToType P.TSInt32    = [t|'TPrimitive Int32|]     pbFieldTypeToType P.TInt64     = [t|'TPrimitive Int64|]-    pbFieldTypeToType P.TUInt64    = fail "unsigned integers are not currently supported"+    pbFieldTypeToType P.TUInt64    = [t|'TPrimitive Word64|]     pbFieldTypeToType P.TSInt64    = [t|'TPrimitive Int64|]     pbFieldTypeToType P.TFixed32   = fail "fixed integers are not currently supported"     pbFieldTypeToType P.TFixed64   = fail "fixed integers are not currently supported"