Fail instead of erroring for protobuf maps

higherkindness · Dec 1, 2020 · 67cc414 · 67cc414
1 parent 38f2578
commit 67cc414
Showing 1 changed file with 9 additions and 4 deletions.
diff --git a/adapter/protobuf/src/Mu/Adapter/ProtoBuf.hs b/adapter/protobuf/src/Mu/Adapter/ProtoBuf.hs
@@ -381,11 +381,16 @@ instance ( KnownNat (FindProtoBufId sch ty name)
     where fieldId = fromInteger $ natVal (Proxy @(FindProtoBufId sch ty name))
           go = PBDec.repeated (
                  PBDec.embedded'
-                   ((,) <$> PBDec.one protoToOneFieldValue
-                              (error "key should always be present") `at` 1
-                        <*> PBDec.one protoToOneFieldValue
-                              (error "value should always be present") `at` 2))
+                   ((,) <$> fieldValueWithDefault 1
+                        <*> fieldValueWithDefault 2))
                  `at` fieldId
+          fieldValueWithDefault innerFieldId
+            = case defaultOneFieldValue of
+                Nothing
+                  -> do r <- PBDec.one (Just <$> protoToOneFieldValue) Nothing `at` innerFieldId
+                        maybe empty pure r
+                Just d
+                  -> PBDec.one protoToOneFieldValue d `at` innerFieldId <|> pure d
 
 instance {-# OVERLAPS #-}
          (ProtoBridgeUnionFieldValue (FindProtoBufOneOfIds sch ty name) sch ts)