diff --git a/Changelog.md b/Changelog.md --- a/Changelog.md +++ b/Changelog.md @@ -1,13 +1,17 @@ # Changelog for `proto-lens-protoc` -## v0.4 +## v0.4.0.1 +- Bump the dependency on `base` and `containers` to support `ghc-8.6.1`. +- Fix a GHC error on enums with a very large number of cases (#241). + +## v0.4.0.0 - Split out `proto-lens-setup` and `proto-lens-runtime` into separate packages. - Hide the constructors and record fields of message types, and make `Show` instances call `showMessageShort`. - Generate explicit `NFData` instances for each type. - Track the change to `proto-lens`: Don't use `data-default` for - defaul proto values (#194). + default proto values (#194). - Use simplified lens-labels instances. (#208) ## v0.3.1.2 diff --git a/proto-lens-protoc.cabal b/proto-lens-protoc.cabal --- a/proto-lens-protoc.cabal +++ b/proto-lens-protoc.cabal @@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: f70b96202ee9a7ec921d1b59d0317817c43f639d31fda260d34e2c74d90463df +-- hash: b29b62b3123ac364956fb075e47b5d2d3c55951136e89ff7972994217d0b2864 name: proto-lens-protoc -version: 0.4.0.0 +version: 0.4.0.1 synopsis: Protocol buffer compiler for the proto-lens library. description: Turn protocol buffer files (.proto) into Haskell files (.hs) which can be used with the proto-lens package. The library component of this package contains compiler code (namely Data.ProtoLens.Compiler.*) is not guaranteed to have stable APIs.' @@ -38,8 +38,8 @@ hs-source-dirs: src build-depends: - base >=4.9 && <4.12 - , containers ==0.5.* + base >=4.9 && <4.13 + , containers >=0.5 && <0.7 , filepath >=1.4 && <1.6 , haskell-src-exts >=1.17 && <1.21 , lens-family ==1.2.* @@ -55,9 +55,9 @@ hs-source-dirs: app build-depends: - base >=4.9 && <4.12 + base >=4.9 && <4.13 , bytestring ==0.10.* - , containers ==0.5.* + , containers >=0.5 && <0.7 , lens-family ==1.2.* , proto-lens ==0.4.* , proto-lens-protoc diff --git a/src/Data/ProtoLens/Compiler/Combinators.hs b/src/Data/ProtoLens/Compiler/Combinators.hs --- a/src/Data/ProtoLens/Compiler/Combinators.hs +++ b/src/Data/ProtoLens/Compiler/Combinators.hs @@ -200,8 +200,16 @@ type Match = Syntax.Match () -- | A simple clause of a function binding. -match :: Name -> [Pat] -> Exp -> Syntax.Match () +match :: Name -> [Pat] -> Exp -> Match match n ps e = Syntax.Match () n ps (Syntax.UnGuardedRhs () e) Nothing + +guardedMatch :: Name -> [Pat] -> [(Exp, Exp)] -> Match +guardedMatch n ps gs = + Syntax.Match () n ps + (Syntax.GuardedRhss () + $ map (\g -> Syntax.GuardedRhs () [Syntax.Qualifier () $ fst g] + (snd g)) gs) + Nothing -- | A hand-rolled type for modules, which allows comments on top-level -- declarations. diff --git a/src/Data/ProtoLens/Compiler/Generate.hs b/src/Data/ProtoLens/Compiler/Generate.hs --- a/src/Data/ProtoLens/Compiler/Generate.hs +++ b/src/Data/ProtoLens/Compiler/Generate.hs @@ -397,7 +397,17 @@ generateServiceExports si = exportAll $ unQual $ fromString $ T.unpack $ serviceName si generateEnumDecls :: SyntaxType -> EnumInfo Name -> [Decl] -generateEnumDecls Proto3 info = +generateEnumDecls syntaxType info = + -- Proto3-only: + -- newtype FooEnum'UnrecognizedValue = FooEnum'UnrecognizedValue Data.Int.Int32 + -- deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, Prelude.Read) + [ newtypeDecl unrecognizedValueName + "Data.Int.Int32" + $ deriving' ["Prelude.Eq", "Prelude.Ord", "Prelude.Show"] + | syntaxType == Proto3 + ] + ++ + -- data FooEnum -- = Enum1 -- | Enum2 @@ -405,43 +415,47 @@ -- deriving (Prelude.Show, Prelude.Eq, Prelude.Ord, Prelude.Read) [ dataDecl dataName ( (flip conDecl [] <$> constructorNames) - ++ [conDecl unrecognizedName [tyCon $ unQual unrecognizedValueName]] + ++ [ conDecl unrecognizedName [tyCon $ unQual unrecognizedValueName] + | syntaxType == Proto3 + ] ) $ deriving' ["Prelude.Show", "Prelude.Eq", "Prelude.Ord"] - -- newtype FooEnum'UnrecognizedValue = FooEnum'UnrecognizedValue Data.Int.Int32 - -- deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, Prelude.Read) - , newtypeDecl unrecognizedValueName - "Data.Int.Int32" - $ deriving' ["Prelude.Eq", "Prelude.Ord", "Prelude.Show"] - -- instance Data.ProtoLens.MessageEnum FooEnum where -- maybeToEnum 0 = Prelude.Just Enum1 -- maybeToEnum 3 = Prelude.Just Enum2 -- maybeToEnum k + -- -- Proto3: -- = Prelude.Just -- (FooEnum'Unrecognized -- (FooEnum'UnrecognizedValue (Prelude.fromIntegral k))) - -- showEnum (FooEnum'Unrecognized (FooEnum'UnrecognizedValue k)) - -- = Prelude.show k + -- -- Proto2: + -- = Nothing + -- -- showEnum Foo'Enum2 = "Enum2" -- showEnum Foo'Enum1 = "Enum1" - -- readEnum "Enum2a" = Prelude.Just Enum2a -- alias - -- readEnum "Enum2" = Prelude.Just Enum2 - -- readEnum "Enum1" = Prelude.Just Enum1 + -- showEnum (FooEnum'Unrecognized (FooEnum'UnrecognizedValue k)) + -- = Prelude.show k + -- + -- readEnum k + -- | k == "Enum2a" = Prelude.Just Enum2a -- alias + -- | k == "Enum2" = Prelude.Just Enum2 + -- | k == "Enum1" = Prelude.Just Enum1 -- readEnum k = Text.Read.readMaybe k >>= maybeToEnum , instDecl [] ("Data.ProtoLens.MessageEnum" `ihApp` [dataType]) [ [ match "maybeToEnum" [pLitInt k] $ "Prelude.Just" @@ con (unQual c) | (c, k) <- constructorNumbers ] ++ - [match "maybeToEnum" ["k"] - $ "Prelude.Just" @@ - (con (unQual unrecognizedName) - @@ (con (unQual unrecognizedValueName) - @@ ("Prelude.fromIntegral" @@ "k") - ) - ) + [ case syntaxType of + Proto2 -> match "maybeToEnum" [pWildCard] "Prelude.Nothing" + Proto3 -> match "maybeToEnum" ["k"] + $ "Prelude.Just" @@ + (con (unQual unrecognizedName) + @@ (con (unQual unrecognizedValueName) + @@ ("Prelude.fromIntegral" @@ "k") + ) + ) ] , [ match "showEnum" [pApp (unQual n) []] $ stringExp pn @@ -449,18 +463,19 @@ , let n = enumValueName v , let pn = T.unpack $ enumValueDescriptor v ^. name ] ++ - [match "showEnum" [pApp (unQual unrecognizedName) + [ match "showEnum" [pApp (unQual unrecognizedName) [pApp (unQual unrecognizedValueName) [pVar "k"]] ] $ "Prelude.show" @@ "k" + | syntaxType == Proto3 ] - , [ match "readEnum" [stringPat pn] - $ "Prelude.Just" @@ con (unQual n) - | v <- enumValues info - , let n = enumValueName v - , let pn = T.unpack $ enumValueDescriptor v ^. name - ] ++ - [match "readEnum" [pVar "k"] $ "Prelude.>>=" + , [ guardedMatch "readEnum" [pVar "k"] + [ ("Prelude.==" @@ "k" @@ stringExp pn, "Prelude.Just" @@ con (unQual n)) + | v <- enumValues info + , let n = enumValueName v + , let pn = T.unpack $ enumValueDescriptor v ^. name + ] + , match "readEnum" [pVar "k"] $ "Prelude.>>=" @@ ("Text.Read.readMaybe" @@ "k") @@ "Data.ProtoLens.maybeToEnum"] ] @@ -500,10 +515,11 @@ | (c, k) <- constructorNumbers ] ++ - [match "fromEnum" [pApp (unQual unrecognizedName) + [ match "fromEnum" [pApp (unQual unrecognizedName) [pApp (unQual unrecognizedValueName) [pVar "k"]] ] $ "Prelude.fromIntegral" @@ "k" + | syntaxType == Proto3 ] , succDecl "succ" maxBoundName succPairs , succDecl "pred" minBoundName $ map swap succPairs @@ -518,12 +534,14 @@ -- fieldDefault = FirstEnumValue , instDecl [] ("Data.ProtoLens.FieldDefault" `ihApp` [dataType]) [[match "fieldDefault" [] defaultCon]] + -- instance NFData Foo where -- rnf x__ = seq x__ () -- (Trivial since enum types are already strict) , instDecl [] ("Control.DeepSeq.NFData" `ihApp` [dataType]) [[ match "rnf" ["x__"] $ "Prelude.seq" @@ "x__" @@ "()" ]] ] ++ + -- pattern Enum2a :: FooEnum -- pattern Enum2a = Enum2 concat @@ -552,8 +570,6 @@ dataType = tyCon $ unQual dataName - - constructors :: [(Name, EnumValueDescriptorProto)] constructors = List.sortBy (comparing ((^. number) . snd)) [(n, d) | EnumValueInfo @@ -583,151 +599,12 @@ | (from, to) <- thePairs ] ++ - [match funName [pWildCard] + [ match funName [pApp (unQual unrecognizedName) [pWildCard]] ("Prelude.error" @@ stringExp (concat [ prettyPrint dataName, ".", prettyPrint funName, ": bad argument: unrecognized value" ])) - ] - -generateEnumDecls Proto2 info = - [ dataDecl dataName - [conDecl n [] | n <- constructorNames] - $ deriving' ["Prelude.Show", "Prelude.Eq", "Prelude.Ord"] - -- instance Data.ProtoLens.FieldDefault Foo where - -- fieldDefault = FirstEnumValue - , instDecl [] ("Data.ProtoLens.FieldDefault" `ihApp` [dataType]) - [[match "fieldDefault" [] defaultCon]] - -- instance MessageEnum Foo where - -- maybeToEnum 1 = Just Foo1 - -- maybeToEnum 2 = Just Foo2 - -- ... - -- maybeToEnum _ = Nothing - -- showEnum Foo1 = "Foo1" - -- showEnum Foo2 = "Foo2" - -- ... - -- readEnum "Foo1" = Just Foo1 - -- readEnum "Foo2" = Just Foo2 - -- ... - -- readEnum _ = Nothing - , instDecl [] ("Data.ProtoLens.MessageEnum" `ihApp` [dataType]) - [ - [ match "maybeToEnum" [pLitInt k] - $ "Prelude.Just" @@ con (unQual n) - | (n, k) <- constructorNumbers - ] - ++ - [ match "maybeToEnum" [pWildCard] "Prelude.Nothing" - ] - ++ - [ match "showEnum" [pVar n] $ stringExp $ T.unpack pn - | (n, pn) <- constructorProtoNames - ] - ++ - [ match "readEnum" [stringPat $ T.unpack pn] - $ "Prelude.Just" @@ con (unQual n) - | (n, pn) <- constructorProtoNames - ] - ++ - [ match "readEnum" [pWildCard] "Prelude.Nothing" - ] - ] - -- instance Enum Foo where - -- toEnum k = maybe (error ("Foo.toEnum: unknown argument for enum Foo: " - -- ++ show k)) - -- id (maybeToEnum k) - -- fromEnum Foo1 = 1 - -- fromEnum Foo2 = 2 - -- .. - -- succ FooN = error "Foo.succ: bad argument FooN." - -- succ Foo1 = Foo2 - -- succ Foo2 = Foo3 - -- .. - -- pred Foo1 = error "Foo.succ: bad argument Foo1." - -- pred Foo2 = Foo1 - -- pred Foo3 = Foo2 - -- .. - -- enumFrom = messageEnumFrom - -- enumFromTo = messageEnumFromTo - -- enumFromThen = messageEnumFromThen - -- enumFromThenTo = messageEnumFromThenTo - , instDecl [] ("Prelude.Enum" `ihApp` [dataType]) - [[match "toEnum" ["k__"] - $ "Prelude.maybe" @@ errorMessageExpr @@ "Prelude.id" - @@ ("Data.ProtoLens.maybeToEnum" @@ "k__")] - , [ match "fromEnum" [pApp (unQual c) []] $ litInt k - | (c, k) <- constructorNumbers - ] - , succDecl "succ" maxBoundName succPairs - , succDecl "pred" minBoundName $ map swap succPairs - , alias "enumFrom" "Data.ProtoLens.Message.Enum.messageEnumFrom" - , alias "enumFromTo" "Data.ProtoLens.Message.Enum.messageEnumFromTo" - , alias "enumFromThen" "Data.ProtoLens.Message.Enum.messageEnumFromThen" - , alias "enumFromThenTo" - "Data.ProtoLens.Message.Enum.messageEnumFromThenTo" - ] - -- instance Bounded Foo where - -- minBound = Foo1 - -- maxBound = FooN - , instDecl [] ("Prelude.Bounded" `ihApp` [dataType]) - [[ match "minBound" [] $ con $ unQual minBoundName - , match "maxBound" [] $ con $ unQual maxBoundName - ]] - -- instance NFData Foo where - -- rnf x__ = seq x__ () - -- (Trivial since enum types are already strict) - , instDecl [] ("Control.DeepSeq.NFData" `ihApp` [dataType]) - [[ match "rnf" ["x__"] $ "Prelude.seq" @@ "x__" @@ "()" ]] - ] - ++ - -- pattern FooAlias :: Foo - -- pattern FooAlias = FooConstructor - concat - [ [ patSynSig aliasName dataType - , patSyn (pVar aliasName) (pVar originalName) - ] - | EnumValueInfo - { enumValueName = aliasName - , enumAliasOf = Just originalName - } <- enumValues info - ] - where - dataType = tyCon $ unQual dataName - EnumInfo { enumName = dataName, enumDescriptor = ed } = info - constructors :: [(Name, EnumValueDescriptorProto)] - constructors = List.sortBy (comparing ((^. number) . snd)) - [(n, d) | EnumValueInfo - { enumValueName = n - , enumValueDescriptor = d - , enumAliasOf = Nothing - } <- enumValues info - ] - constructorNames = map fst constructors - minBoundName = head constructorNames - maxBoundName = last constructorNames - - constructorProtoNames = map (second (^. name)) constructors - constructorNumbers = map (second (fromIntegral . (^. number))) - constructors - - succPairs = zip constructorNames $ tail constructorNames - succDecl funName boundName thePairs = - match funName [pApp (unQual boundName) []] - ("Prelude.error" @@ stringExp (concat - [ prettyPrint dataName, ".", prettyPrint funName, ": bad argument " - , prettyPrint boundName, ". This value would be out of bounds." - ])) - : - [ match funName [pApp (unQual from) []] $ con $ unQual to - | (from, to) <- thePairs + | syntaxType == Proto3 ] - alias funName implName = [match funName [] implName] - - defaultCon = con $ unQual $ head constructorNames - errorMessageExpr = "Prelude.error" - @@ ("Prelude.++" @@ stringExp errorMessage - @@ ("Prelude.show" @@ "k__")) - errorMessage = "toEnum: unknown value for enum " ++ unpack (ed ^. name) - ++ ": " generateFieldDecls :: Symbol -> [Decl] generateFieldDecls xStr =