Support enums in type registry.

proto-lens-protoc/app/Data/ProtoLens/Compiler/Generate.hs

@@ -132,7 +132,8 @@ generateModule modName fdesc imports publicImports definitions importedEnv servi
     generateDecls (protoName, Message m)
         = generateMessageDecls fieldModName env (stripDotPrefix protoName) m
        ++ map uncommented (concatMap (generatePrisms env) (messageOneofFields m))
-    generateDecls (_, Enum e) = map uncommented $ generateEnumDecls e
+    generateDecls (qualifiedEnumName, Enum e) =
+        map uncommented $ generateEnumDecls (stripDotPrefix qualifiedEnumName) e
     generateExports (Message m) = generateMessageExports m
                                ++ concatMap generatePrismExports (messageOneofFields m)
     generateExports (Enum e) = generateEnumExports e
@@ -428,8 +429,8 @@ generateEnumExports e = [thingAll n, thingWith n aliases] ++ proto3NewType
 generateServiceExports :: ServiceInfo -> IE'
 generateServiceExports si = thingAll $ unqual $ fromString $ T.unpack $ serviceName si
 
-generateEnumDecls :: EnumInfo OccNameStr -> [HsDecl']
-generateEnumDecls info =
+generateEnumDecls :: T.Text -> EnumInfo OccNameStr -> [HsDecl']
+generateEnumDecls qualifiedEnumName info =
     -- Proto3-only:
     -- newtype FooEnum'UnrecognizedValue = FooEnum'UnrecognizedValue Data.Int.Int32
     --   deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, Prelude.Read)
@@ -513,6 +514,7 @@ generateEnumDecls info =
               ++ [guard (var "Prelude.otherwise") $ var "Prelude.>>="
                                       @@ (var "Text.Read.readMaybe" @@ var "k")
                                       @@ var "Data.ProtoLens.maybeToEnum"]
+        , funBind "enumName" $ match [wildP] $ var "Data.Text.pack" @@ string (T.unpack qualifiedEnumName)
         ]
 
       -- instance Bounded Foo where

proto-lens-protoc/app/Proto/Google/Protobuf/Descriptor.hs

@@ -3357,6 +3357,7 @@ instance Data.ProtoLens.MessageEnum FieldDescriptorProto'Label where
     = Prelude.Just FieldDescriptorProto'LABEL_REPEATED
     | Prelude.otherwise
     = (Prelude.>>=) (Text.Read.readMaybe k) Data.ProtoLens.maybeToEnum
+  enumName _ = Data.Text.pack "google.protobuf.FieldDescriptorProto.Label"
 instance Prelude.Bounded FieldDescriptorProto'Label where
   minBound = FieldDescriptorProto'LABEL_OPTIONAL
   maxBound = FieldDescriptorProto'LABEL_REPEATED
@@ -3490,6 +3491,7 @@ instance Data.ProtoLens.MessageEnum FieldDescriptorProto'Type where
     = Prelude.Just FieldDescriptorProto'TYPE_SINT64
     | Prelude.otherwise
     = (Prelude.>>=) (Text.Read.readMaybe k) Data.ProtoLens.maybeToEnum
+  enumName _ = Data.Text.pack "google.protobuf.FieldDescriptorProto.Type"
 instance Prelude.Bounded FieldDescriptorProto'Type where
   minBound = FieldDescriptorProto'TYPE_DOUBLE
   maxBound = FieldDescriptorProto'TYPE_SINT64
@@ -4077,6 +4079,7 @@ instance Data.ProtoLens.MessageEnum FieldOptions'CType where
     = Prelude.Just FieldOptions'STRING_PIECE
     | Prelude.otherwise
     = (Prelude.>>=) (Text.Read.readMaybe k) Data.ProtoLens.maybeToEnum
+  enumName _ = Data.Text.pack "google.protobuf.FieldOptions.CType"
 instance Prelude.Bounded FieldOptions'CType where
   minBound = FieldOptions'STRING
   maxBound = FieldOptions'STRING_PIECE
@@ -4128,6 +4131,7 @@ instance Data.ProtoLens.MessageEnum FieldOptions'JSType where
     | (Prelude.==) k "JS_NUMBER" = Prelude.Just FieldOptions'JS_NUMBER
     | Prelude.otherwise
     = (Prelude.>>=) (Text.Read.readMaybe k) Data.ProtoLens.maybeToEnum
+  enumName _ = Data.Text.pack "google.protobuf.FieldOptions.JSType"
 instance Prelude.Bounded FieldOptions'JSType where
   minBound = FieldOptions'JS_NORMAL
   maxBound = FieldOptions'JS_NUMBER
@@ -6692,6 +6696,7 @@ instance Data.ProtoLens.MessageEnum FileOptions'OptimizeMode where
     = Prelude.Just FileOptions'LITE_RUNTIME
     | Prelude.otherwise
     = (Prelude.>>=) (Text.Read.readMaybe k) Data.ProtoLens.maybeToEnum
+  enumName _ = Data.Text.pack "google.protobuf.FileOptions.OptimizeMode"
 instance Prelude.Bounded FileOptions'OptimizeMode where
   minBound = FileOptions'SPEED
   maxBound = FileOptions'LITE_RUNTIME
@@ -8235,6 +8240,7 @@ instance Data.ProtoLens.MessageEnum MethodOptions'IdempotencyLevel where
     = Prelude.Just MethodOptions'IDEMPOTENT
     | Prelude.otherwise
     = (Prelude.>>=) (Text.Read.readMaybe k) Data.ProtoLens.maybeToEnum
+  enumName _ = Data.Text.pack "google.protobuf.MethodOptions.IdempotencyLevel"
 instance Prelude.Bounded MethodOptions'IdempotencyLevel where
   minBound = MethodOptions'IDEMPOTENCY_UNKNOWN
   maxBound = MethodOptions'IDEMPOTENT
@@ -13145,4 +13151,4 @@ packedFileDescriptor
     \\SI\n\
     \\a\EOT\DC4\ETX\NUL\STX\ETX\SOH\DC2\EOT\240\ACK\DC3\SYN\n\
     \\SI\n\
-    \\a\EOT\DC4\ETX\NUL\STX\ETX\ETX\DC2\EOT\240\ACK\EM\SUB"
+    \\a\EOT\DC4\ETX\NUL\STX\ETX\ETX\DC2\EOT\240\ACK\EM\SUB"

proto-lens/src/Data/ProtoLens/Message.hs

@@ -34,8 +34,11 @@ module Data.ProtoLens.Message (
     -- * Proto registries
     Registry,
     register,
+    registerEnum,
     lookupRegistered,
+    lookupRegisteredEnum,
     SomeMessageType(..),
+    SomeEnumType(..),
     -- * Any messages
     matchAnyMessage,
     AnyMessageDescriptor(..),
@@ -267,6 +270,9 @@ class (Enum a, Bounded a) => MessageEnum a where
     -- | Convert the given 'String' to an enum value. Returns 'Nothing' if
     -- no corresponding value was defined in the .proto file.
     readEnum :: String -> Maybe a
+    -- | A unique identifier for this type, of the format
+    -- @"packagename.enumname"@.
+    enumName :: Proxy a -> T.Text
 
 -- | Utility function for building a message from a default value.
 -- For example:
@@ -317,25 +323,40 @@ reverseRepeatedFields fields x0
 -- Registries can be combined using their 'Monoid' instance.
 --
 -- See the @withRegistry@ functions in 'Data.ProtoLens.TextFormat'
-newtype Registry = Registry (Map.Map T.Text SomeMessageType)
+newtype Registry = Registry (Map.Map T.Text SomeMessageType, Map.Map T.Text SomeEnumType)
     deriving (Semigroup.Semigroup, Monoid)
 
 -- | Build a 'Registry' containing a single proto type.
 --
 --   Example:
 -- > register (Proxy :: Proxy Proto.My.Proto.Type)
 register :: forall msg . Message msg => Proxy msg -> Registry
-register p = Registry $ Map.singleton (messageName (Proxy @msg)) (SomeMessageType p)
+register p = Registry (Map.singleton (messageName p) (SomeMessageType p), Map.empty)
+
+-- | Build a 'Registry' containing a single enum type.
+--
+--   Example:
+-- > registerEnum (Proxy :: Proxy Proto.My.Proto.EnumType)
+registerEnum :: forall e . MessageEnum e => Proxy e -> Registry
+registerEnum p = Registry (Map.empty, Map.singleton (enumName p) (SomeEnumType p))
 
 -- | Look up a message type by name (e.g.,
 -- @"type.googleapis.com/google.protobuf.FloatValue"@). The URL corresponds to
 -- the field @google.protobuf.Any.type_url@.
 lookupRegistered :: T.Text -> Registry -> Maybe SomeMessageType
-lookupRegistered n (Registry m) = Map.lookup (snd $ T.breakOnEnd "/" n) m
+lookupRegistered n (Registry (m, _)) = Map.lookup (snd $ T.breakOnEnd "/" n) m
+
+-- | Look up a enum type by name (e.g.,
+-- @"type.googleapis.com/google.protobuf.Syntax"@).
+lookupRegisteredEnum :: T.Text -> Registry -> Maybe SomeEnumType
+lookupRegisteredEnum n (Registry (_, m)) = Map.lookup (snd $ T.breakOnEnd "/" n) m
 
 data SomeMessageType where
     SomeMessageType :: Message msg => Proxy msg -> SomeMessageType
 
+data SomeEnumType where
+    SomeEnumType :: MessageEnum e => Proxy e -> SomeEnumType
+
 -- TODO: recursively
 discardUnknownFields :: Message msg => msg -> msg
 discardUnknownFields = set unknownFields []