From 76e46199a43659066c7c03165a7b68190692ddea Mon Sep 17 00:00:00 2001 From: Yoo Chung Date: Wed, 11 Sep 2024 01:51:10 +0000 Subject: [PATCH 1/3] Use per-edition feature defaults instead of syntax type to control behavior. --- .../Data/ProtoLens/Compiler/Definitions.hs | 106 +++++++++++------- .../ProtoLens/Compiler/Editions/Features.hs | 2 +- 2 files changed, 67 insertions(+), 41 deletions(-) diff --git a/proto-lens-protoc/app/Data/ProtoLens/Compiler/Definitions.hs b/proto-lens-protoc/app/Data/ProtoLens/Compiler/Definitions.hs index 68c17f47..af812ad8 100644 --- a/proto-lens-protoc/app/Data/ProtoLens/Compiler/Definitions.hs +++ b/proto-lens-protoc/app/Data/ProtoLens/Compiler/Definitions.hs @@ -51,6 +51,7 @@ import Data.Maybe (catMaybes, fromMaybe) import Data.Monoid ((<>)) #endif import Data.ProtoLens.Labels () +import Data.ProtoLens.Compiler.Editions.Features (featuresForEdition) import qualified Data.Semigroup as Semigroup import qualified Data.Set as Set import Data.String (IsString(..)) @@ -64,8 +65,13 @@ import Data.Tree import Lens.Family2 ((^.), (^..), toListOf) import Proto.Google.Protobuf.Descriptor ( DescriptorProto + , Edition(..) , EnumDescriptorProto , EnumValueDescriptorProto + , FeatureSet + , FeatureSet'FieldPresence(..) + , FeatureSet'EnumType(..) + , FeatureSet'RepeatedFieldEncoding(..) , FieldDescriptorProto , FieldDescriptorProto'Label(..) , FieldDescriptorProto'Type(..) @@ -93,16 +99,29 @@ import GHC.SourceGen -- either from this or another file). type Env n = Map.Map Text (Definition n) -data SyntaxType = Proto2 | Proto3 | Editions - deriving (Show, Eq) +{-| Returns the edition for the file. -fileSyntaxType :: FileDescriptorProto -> SyntaxType -fileSyntaxType f = case f ^. #syntax of - "proto2" -> Proto2 - "proto3" -> Proto3 - "editions" -> Editions - "" -> Proto2 -- The proto compiler doesn't set syntax for proto2 files. - s -> error $ "Unknown syntax type " ++ show s +For proto2 and proto3 files, 'EDITION_PROTO2' and 'EDITION_PROTO3' are returned, +respectively, which will map to the equivalent feature set compatible with +proto2 and proto3. + +>>> fileEdition $ defMessage & #syntax .~ "proto2" +EDITION_PROTO2 +>>> fileEdition $ defMessage & #syntax .~ "proto3" +EDITION_PROTO3 + +-} +fileEdition :: FileDescriptorProto -> Edition +fileEdition f = case f ^. #syntax of + "editions" -> f ^. #edition + "proto3" -> EDITION_PROTO3 + "proto2" -> EDITION_PROTO2 + "" -> EDITION_PROTO2 + s -> error $ "Unknown syntax type " ++ show s + +{-| Returns the feature defaults for the file. -} +fileFeatures :: FileDescriptorProto -> FeatureSet +fileFeatures f = featuresForEdition $ fileEdition f data Definition n = Message (MessageInfo n) | Enum (EnumInfo n) deriving Functor @@ -309,7 +328,7 @@ collectDefinitions fd = let p -> "." <> p <> "." hsPrefix = "" in Map.fromList $ concatMap flatten $ - messageAndEnumDefs (fileSyntaxType fd) + messageAndEnumDefs (fileFeatures fd) protoPrefix hsPrefix Map.empty (fd ^. #messageType) (fd ^. #enumType) @@ -337,7 +356,7 @@ collectServices fd = fmap (toServiceInfo $ fd ^. #package) $ fd ^. #service } messageAndEnumDefs :: - SyntaxType -> Text -> String + FeatureSet -> Text -> String -> GroupMap -- ^ Group fields of the parent message (if any). -> [DescriptorProto] @@ -345,17 +364,17 @@ messageAndEnumDefs :: -> Forest (Text, Definition OccNameStr) -- ^ Organized as a list of trees, to make it possible for callers -- to get the immediate child nested types. -messageAndEnumDefs syntaxType protoPrefix hsPrefix groups messages enums - = map (messageDefs syntaxType protoPrefix hsPrefix groups) messages +messageAndEnumDefs features protoPrefix hsPrefix groups messages enums + = map (messageDefs features protoPrefix hsPrefix groups) messages ++ map (flip Node [] -- Enums have no sub-definitions - . enumDef syntaxType protoPrefix hsPrefix) + . enumDef features protoPrefix hsPrefix) enums -- | Generate the definitions for a message and its nested types (if any). -messageDefs :: SyntaxType -> Text -> String -> GroupMap -> DescriptorProto +messageDefs :: FeatureSet -> Text -> String -> GroupMap -> DescriptorProto -> Tree (Text, Definition OccNameStr) -messageDefs syntaxType protoPrefix hsPrefix groups d +messageDefs features protoPrefix hsPrefix groups d = Node (protoName, thisDef) subDefs where protoName = protoPrefix <> d ^. #name @@ -371,7 +390,7 @@ messageDefs syntaxType protoPrefix hsPrefix groups d , messageDescriptor = d , messageFields = map (PlainFieldInfo <$> - (fieldKind syntaxType mapEntries) <*> (fieldInfo hsPrefix')) + (fieldKind features mapEntries) <*> (fieldInfo hsPrefix')) $ Map.findWithDefault [] Nothing allFields , messageOneofFields = collectOneofFields hsPrefix' d allFields , messageUnknownFields = @@ -379,7 +398,7 @@ messageDefs syntaxType protoPrefix hsPrefix groups d , groupFieldNumber = Map.lookup protoName groups } subDefs = messageAndEnumDefs - syntaxType + features (protoName <> ".") hsPrefix' (collectGroupFields $ d ^. #field) @@ -427,15 +446,19 @@ fieldInfo hsPrefix f = FieldInfo } fieldKind :: - SyntaxType -> Map.Map Text MapEntryInfo -> FieldDescriptorProto + FeatureSet -> Map.Map Text MapEntryInfo -> FieldDescriptorProto -> FieldKind -fieldKind syntaxType mapEntries f = case f ^. #label of - FieldDescriptorProto'LABEL_OPTIONAL - | syntaxType == Proto3 - && f ^. #type' /= FieldDescriptorProto'TYPE_MESSAGE - && not (f ^. #proto3Optional) - -> OptionalValueField - | otherwise -> OptionalMaybeField +fieldKind features mapEntries f = case f ^. #label of + FieldDescriptorProto'LABEL_OPTIONAL -> + case features ^. #fieldPresence of + FeatureSet'IMPLICIT + | f ^. #type' /= FieldDescriptorProto'TYPE_MESSAGE + && not (f ^. #proto3Optional) + -> OptionalValueField + | otherwise -> OptionalMaybeField + FeatureSet'EXPLICIT -> OptionalMaybeField + FeatureSet'LEGACY_REQUIRED -> RequiredField + _ -> error $ "Has unknown field presence: " ++ show (f ^. #name) FieldDescriptorProto'LABEL_REQUIRED -> RequiredField FieldDescriptorProto'LABEL_REPEATED | Just entryInfo <- Map.lookup (f ^. #typeName) mapEntries @@ -446,10 +469,11 @@ fieldKind syntaxType mapEntries f = case f ^. #label of | f ^. #type' `elem` unpackableTypes = NotPackable | packedByDefault = Packed | otherwise = Packable - -- If the "packed" attribute isn't set, then default to packed if proto3. - -- Unfortunately, protoc doesn't implement this logic for us automatically. - packedByDefault = fromMaybe (syntaxType == Proto3) - $ f ^. #options . #maybe'packed + + packedByDefault = + fromMaybe (features ^. #repeatedFieldEncoding == FeatureSet'PACKED) + $ f ^. #options . #maybe'packed + unpackableTypes = [ FieldDescriptorProto'TYPE_MESSAGE , FieldDescriptorProto'TYPE_GROUP @@ -603,9 +627,9 @@ reservedKeywords = Set.fromList $ ] -- | Generate the definition for an enum type. -enumDef :: SyntaxType -> Text -> String -> EnumDescriptorProto +enumDef :: FeatureSet -> Text -> String -> EnumDescriptorProto -> (Text, Definition OccNameStr) -enumDef syntaxType protoPrefix hsPrefix d = let +enumDef features protoPrefix hsPrefix d = let mkText n = protoPrefix <> n mkHsName n = fromString $ hsPrefix ++ case hsName n of ('_':xs) -> 'X':xs @@ -613,14 +637,16 @@ enumDef syntaxType protoPrefix hsPrefix d = let in (mkText (d ^. #name) , Enum EnumInfo { enumName = mkHsName (d ^. #name) - , enumUnrecognized = if syntaxType == Proto2 - then Nothing - else Just EnumUnrecognizedInfo - { unrecognizedName - = mkHsName (d ^. #name <> "'Unrecognized") - , unrecognizedValueName - = mkHsName (d ^. #name <> "'UnrecognizedValue") - } + , enumUnrecognized = case features ^. #enumType of + FeatureSet'CLOSED -> Nothing + FeatureSet'OPEN -> + Just EnumUnrecognizedInfo + { unrecognizedName + = mkHsName (d ^. #name <> "'Unrecognized") + , unrecognizedValueName + = mkHsName (d ^. #name <> "'UnrecognizedValue") + } + _ -> error $ "Has unknown enum type: " ++ show (d ^. #name) , enumDescriptor = d , enumValues = collectEnumValues mkHsName $ d ^. #value }) diff --git a/proto-lens-protoc/app/Data/ProtoLens/Compiler/Editions/Features.hs b/proto-lens-protoc/app/Data/ProtoLens/Compiler/Editions/Features.hs index 9f523a88..474c6d77 100644 --- a/proto-lens-protoc/app/Data/ProtoLens/Compiler/Editions/Features.hs +++ b/proto-lens-protoc/app/Data/ProtoLens/Compiler/Editions/Features.hs @@ -48,7 +48,7 @@ for a particular edition. featuresForEditionFromDefaults :: FeatureSetDefaults -> Edition -> FeatureSet featuresForEditionFromDefaults defaults edition | (d : _) <- candidates = (d ^. #overridableFeatures) `mergedInto` (d ^. #fixedFeatures) - | otherwise = defMessage + | otherwise = error $ "Unsupported edition with tag number: " ++ show (fromEnum edition) where candidates = dropWhile (\d -> d ^. #edition > edition) recentFirst From 864c986d09122e6276834b5e89e57b5c9a3bcae6 Mon Sep 17 00:00:00 2001 From: Yoo Chung Date: Wed, 2 Oct 2024 14:53:13 +0000 Subject: [PATCH 2/3] Use (Either Text a) for reporting errors when determining features for an edition. --- .../Data/ProtoLens/Compiler/Definitions.hs | 37 +++++----- .../ProtoLens/Compiler/Editions/Features.hs | 16 +++-- .../app/Data/ProtoLens/Compiler/Plugin.hs | 49 ++++++------- proto-lens-protoc/app/protoc-gen-haskell.hs | 72 ++++++++++--------- 4 files changed, 95 insertions(+), 79 deletions(-) diff --git a/proto-lens-protoc/app/Data/ProtoLens/Compiler/Definitions.hs b/proto-lens-protoc/app/Data/ProtoLens/Compiler/Definitions.hs index af812ad8..5bf40638 100644 --- a/proto-lens-protoc/app/Data/ProtoLens/Compiler/Definitions.hs +++ b/proto-lens-protoc/app/Data/ProtoLens/Compiler/Definitions.hs @@ -111,17 +111,17 @@ EDITION_PROTO2 EDITION_PROTO3 -} -fileEdition :: FileDescriptorProto -> Edition +fileEdition :: FileDescriptorProto -> Either Text Edition fileEdition f = case f ^. #syntax of - "editions" -> f ^. #edition - "proto3" -> EDITION_PROTO3 - "proto2" -> EDITION_PROTO2 - "" -> EDITION_PROTO2 - s -> error $ "Unknown syntax type " ++ show s + "editions" -> Right $ f ^. #edition + "proto3" -> Right EDITION_PROTO3 + "proto2" -> Right EDITION_PROTO2 + "" -> Right EDITION_PROTO2 + s -> Left $ "Unknown syntax type " <> T.pack (show s) {-| Returns the feature defaults for the file. -} -fileFeatures :: FileDescriptorProto -> FeatureSet -fileFeatures f = featuresForEdition $ fileEdition f +fileFeatures :: FileDescriptorProto -> Either Text FeatureSet +fileFeatures f = fileEdition f >>= featuresForEdition data Definition n = Message (MessageInfo n) | Enum (EnumInfo n) deriving Functor @@ -321,16 +321,17 @@ definedType ty = fromMaybe err . Map.lookup ty -- | Collect all the definitions in the given file (including definitions -- nested in other messages), and assign Haskell names to them. -collectDefinitions :: FileDescriptorProto -> Env OccNameStr -collectDefinitions fd = let - protoPrefix = case fd ^. #package of - "" -> "." - p -> "." <> p <> "." - hsPrefix = "" - in Map.fromList $ concatMap flatten $ - messageAndEnumDefs (fileFeatures fd) - protoPrefix hsPrefix Map.empty - (fd ^. #messageType) (fd ^. #enumType) +collectDefinitions :: FileDescriptorProto -> Either Text (Env OccNameStr) +collectDefinitions fd = do + let protoPrefix = case fd ^. #package of + "" -> "." + p -> "." <> p <> "." + let hsPrefix = "" + features <- fileFeatures fd + return $ Map.fromList $ concatMap flatten $ + messageAndEnumDefs + features protoPrefix hsPrefix Map.empty + (fd ^. #messageType) (fd ^. #enumType) collectServices :: FileDescriptorProto -> [ServiceInfo] collectServices fd = fmap (toServiceInfo $ fd ^. #package) $ fd ^. #service diff --git a/proto-lens-protoc/app/Data/ProtoLens/Compiler/Editions/Features.hs b/proto-lens-protoc/app/Data/ProtoLens/Compiler/Editions/Features.hs index 474c6d77..8433faf5 100644 --- a/proto-lens-protoc/app/Data/ProtoLens/Compiler/Editions/Features.hs +++ b/proto-lens-protoc/app/Data/ProtoLens/Compiler/Editions/Features.hs @@ -5,6 +5,7 @@ -- https://developers.google.com/open-source/licenses/bsd {-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedStrings #-} {-| Module: Data.ProtoLens.Compiler.Editions.Features @@ -22,6 +23,8 @@ import Control.Applicative ((<|>)) import Data.ProtoLens (defMessage) import Data.ProtoLens.Compiler.Editions.Defaults (nativeDefaults) import Data.ProtoLens.Labels () +import qualified Data.Text as T +import Data.Text (Text) import Lens.Family2 ((^.), (.~), (&)) import Proto.Google.Protobuf.Descriptor ( Edition @@ -34,7 +37,7 @@ Returns the native feature set defaults for the given edition. Native features refer to the fields directly defined by 'FeatureSet'. Features defined as extensions of 'FeatureSet' would be custom features. -} -featuresForEdition :: Edition -> FeatureSet +featuresForEdition :: Edition -> Either Text FeatureSet featuresForEdition = featuresForEditionFromDefaults nativeDefaults {-| @@ -45,10 +48,15 @@ If extensions were supported, this could be used directly to resolve custom features defined as extensions of 'FeatureSet' for a particular edition. -} -featuresForEditionFromDefaults :: FeatureSetDefaults -> Edition -> FeatureSet +featuresForEditionFromDefaults + :: FeatureSetDefaults + -> Edition + -> Either Text FeatureSet featuresForEditionFromDefaults defaults edition - | (d : _) <- candidates = (d ^. #overridableFeatures) `mergedInto` (d ^. #fixedFeatures) - | otherwise = error $ "Unsupported edition with tag number: " ++ show (fromEnum edition) + | (d : _) <- candidates = + Right $ (d ^. #overridableFeatures) `mergedInto` (d ^. #fixedFeatures) + | otherwise = + Left $ "Unsupported edition. Tag number: " <> (T.pack . show . fromEnum) edition where candidates = dropWhile (\d -> d ^. #edition > edition) recentFirst diff --git a/proto-lens-protoc/app/Data/ProtoLens/Compiler/Plugin.hs b/proto-lens-protoc/app/Data/ProtoLens/Compiler/Plugin.hs index 84eb0a10..44753c16 100644 --- a/proto-lens-protoc/app/Data/ProtoLens/Compiler/Plugin.hs +++ b/proto-lens-protoc/app/Data/ProtoLens/Compiler/Plugin.hs @@ -44,33 +44,34 @@ data ProtoFile = ProtoFile -- Given a list of FileDescriptorProtos, collect information about each file -- into a map of 'ProtoFile's keyed by 'ProtoFileName'. -analyzeProtoFiles :: [FileDescriptorProto] -> Map ProtoFileName ProtoFile -analyzeProtoFiles files = - Map.fromList [ (f ^. #name, ingestFile f) | f <- files ] +analyzeProtoFiles :: [FileDescriptorProto] -> Either Text (Map ProtoFileName ProtoFile) +analyzeProtoFiles files = do + -- The definitions in each input proto file, indexed by filename. + definitionsByName <- mapM collectDefinitions filesByName + let servicesByName = fmap collectServices filesByName + let exportsByName = transitiveExports files + let exportedEnvs = fmap (foldMap (definitionsByName !)) exportsByName + + let ingestFile f = ProtoFile + { descriptor = f + , haskellModule = m + , definitions = definitionsByName ! n + , services = servicesByName ! n + , exportedEnv = qualifyEnv m $ exportedEnvs ! n + , publicImports = [moduleNames ! i | i <- reexported] + } + where + n = f ^. #name + m = moduleNames ! n + reexported = + [ (f ^. #dependency) !! fromIntegral i + | i <- f ^. #publicDependency + ] + + return $ Map.fromList [ (f ^. #name, ingestFile f) | f <- files ] where filesByName = Map.fromList [(f ^. #name, f) | f <- files] moduleNames = fmap fdModuleName filesByName - -- The definitions in each input proto file, indexed by filename. - definitionsByName = fmap collectDefinitions filesByName - servicesByName = fmap collectServices filesByName - exportsByName = transitiveExports files - exportedEnvs = fmap (foldMap (definitionsByName !)) exportsByName - - ingestFile f = ProtoFile - { descriptor = f - , haskellModule = m - , definitions = definitionsByName ! n - , services = servicesByName ! n - , exportedEnv = qualifyEnv m $ exportedEnvs ! n - , publicImports = [moduleNames ! i | i <- reexported] - } - where - n = f ^. #name - m = moduleNames ! n - reexported = - [ (f ^. #dependency) !! fromIntegral i - | i <- f ^. #publicDependency - ] collectEnvFromDeps :: [ProtoFileName] -> Map ProtoFileName ProtoFile -> Env RdrNameStr collectEnvFromDeps deps filesByName = diff --git a/proto-lens-protoc/app/protoc-gen-haskell.hs b/proto-lens-protoc/app/protoc-gen-haskell.hs index b483d97c..9a7698db 100644 --- a/proto-lens-protoc/app/protoc-gen-haskell.hs +++ b/proto-lens-protoc/app/protoc-gen-haskell.hs @@ -36,7 +36,7 @@ import System.Environment (getProgName) import System.Exit (exitWith, ExitCode(..)) import System.IO as IO -import Data.ProtoLens.Compiler.Generate.Commented (CommentedModule, getModuleName) +import Data.ProtoLens.Compiler.Generate.Commented (getModuleName) import Data.ProtoLens.Compiler.Generate import Data.ProtoLens.Compiler.Plugin @@ -72,41 +72,47 @@ makeResponse dflags prog request = let features = [ CodeGeneratorResponse'FEATURE_PROTO3_OPTIONAL , CodeGeneratorResponse'FEATURE_SUPPORTS_EDITIONS ] - in defMessage - & #supportedFeatures .~ - (foldl (.|.) zeroBits $ fmap (toEnum . fromEnum) features) - -- Do not process actual Protobuf Editions files yet. - & #minimumEdition .~ fromIntegral (fromEnum EDITION_LEGACY) - & #maximumEdition .~ fromIntegral (fromEnum EDITION_LEGACY) - & #file .~ [ defMessage - & #name .~ outputName - & #content .~ outputContent - | (outputName, outputContent) <- outputFiles - ] - + preamble = defMessage + & #supportedFeatures .~ + (foldl (.|.) zeroBits $ fmap (toEnum . fromEnum) features) + -- Do not process actual Protobuf Editions files yet. + & #minimumEdition .~ fromIntegral (fromEnum EDITION_LEGACY) + & #maximumEdition .~ fromIntegral (fromEnum EDITION_LEGACY) + in case outputFiles of + Right fs -> preamble & #file .~ + [ defMessage + & #name .~ outputName + & #content .~ outputContent + | (outputName, outputContent) <- fs + ] + Left e -> preamble & #error .~ e generateFiles :: DynFlags -> (FileDescriptorProto -> Text) - -> [FileDescriptorProto] -> [ProtoFileName] -> [(Text, Text)] -generateFiles dflags header files toGenerate = let - filesByName = analyzeProtoFiles files - -- The contents of the generated Haskell file for a given .proto file. - modulesToBuild :: ProtoFile -> [CommentedModule] - modulesToBuild f = let - deps = descriptor f ^. #dependency - imports = Set.toAscList $ Set.fromList - $ map (haskellModule . (filesByName !)) deps - in generateModule (haskellModule f) (descriptor f) imports + -> [FileDescriptorProto] -> [ProtoFileName] + -> Either Text [(Text, Text)] +generateFiles dflags header files toGenerate = do + filesByName <- analyzeProtoFiles files + + let modulesToBuild f = + generateModule (haskellModule f) (descriptor f) imports (publicImports f) - (definitions f) - (collectEnvFromDeps deps filesByName) - (services f) - in [ ( moduleFilePath $ pack $ showPpr dflags (getModuleName modul) - , header (descriptor f) <> pack (showPpr dflags modul) - ) - | fileName <- toGenerate - , let f = filesByName ! fileName - , modul <- modulesToBuild f - ] + (definitions f) + (collectEnvFromDeps deps filesByName) + (services f) + where + deps = descriptor f ^. #dependency + imports = Set.toAscList $ Set.fromList + $ map (haskellModule . (filesByName !)) deps + + + -- The contents of the generated Haskell file for a given .proto file. + return [ ( moduleFilePath $ pack $ showPpr dflags (getModuleName modul) + , header (descriptor f) <> pack (showPpr dflags modul) + ) + | fileName <- toGenerate + , let f = filesByName ! fileName + , modul <- modulesToBuild f + ] moduleFilePath :: Text -> Text moduleFilePath n = T.replace "." "/" n <> ".hs" From 9d277cc58f518200541cb547f86e119723ab2c16 Mon Sep 17 00:00:00 2001 From: Yoo Chung Date: Wed, 2 Oct 2024 15:04:34 +0000 Subject: [PATCH 3/3] Update example for fileEdition. --- proto-lens-protoc/app/Data/ProtoLens/Compiler/Definitions.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/proto-lens-protoc/app/Data/ProtoLens/Compiler/Definitions.hs b/proto-lens-protoc/app/Data/ProtoLens/Compiler/Definitions.hs index 5bf40638..5695a6ca 100644 --- a/proto-lens-protoc/app/Data/ProtoLens/Compiler/Definitions.hs +++ b/proto-lens-protoc/app/Data/ProtoLens/Compiler/Definitions.hs @@ -106,9 +106,9 @@ respectively, which will map to the equivalent feature set compatible with proto2 and proto3. >>> fileEdition $ defMessage & #syntax .~ "proto2" -EDITION_PROTO2 +Right EDITION_PROTO2 >>> fileEdition $ defMessage & #syntax .~ "proto3" -EDITION_PROTO3 +Right EDITION_PROTO3 -} fileEdition :: FileDescriptorProto -> Either Text Edition