From c020f2da6f58cdfe57dbe9d3243d85e8cf8afd6d Mon Sep 17 00:00:00 2001 From: Paul Kinsky Date: Thu, 26 Oct 2017 10:59:39 -0700 Subject: [PATCH 01/15] working (or, technically, compiling) --- .../Data/ProtoLens/Compiler/Combinators.hs | 4 + .../src/Data/ProtoLens/Compiler/Generate.hs | 156 ++++++++++++------ proto-lens-tests/tests/proto3.proto | 13 +- proto-lens-tests/tests/proto3_test.hs | 20 +-- 4 files changed, 131 insertions(+), 62 deletions(-) diff --git a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Combinators.hs b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Combinators.hs index 4055465d..3e97a991 100644 --- a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Combinators.hs +++ b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Combinators.hs @@ -359,3 +359,7 @@ modifyModuleName :: (String -> String) -> ModuleName -> ModuleName modifyModuleName f (Syntax.ModuleName _ unpacked) = Syntax.ModuleName () $ f unpacked + +modifyIdent :: (String -> String) -> Name -> Name +modifyIdent f (Syntax.Ident l s) = Syntax.Ident l $ f s +modifyIdent _ x = x diff --git a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs index 76427911..b4807e94 100644 --- a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs +++ b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs @@ -259,27 +259,18 @@ generateEnumExports syntaxType e = [exportAll n, exportWith n aliases] generateEnumDecls :: SyntaxType -> EnumInfo Name -> [Decl] generateEnumDecls Proto3 info = - -- newtype Foo = Foo Int32 - [ newtypeDecl dataName "Data.Int.Int32" - $ deriving' ["Prelude.Eq", "Prelude.Ord", "Prelude.Enum", "Prelude.Bounded"] - - -- instance Show Foo where - -- showsPrec _ Value0 = "Value0" -- the Haskell name - -- showsPrec p (Foo k) = showParen (p > 10) - -- $ showString "toEnum " . shows k - , instDecl [] ("Prelude.Show" `ihApp` [dataType]) - [ [ match "showsPrec" [pWildCard, pApp (unQual n) []] - $ "Prelude.showString" @@ stringExp (prettyPrint n) - | n <- map enumValueName $ enumValues info - ] - ++ - [ match "showsPrec" ["p", pApp (unQual dataName) ["k"]] - $ "Prelude.showParen" @@ ("Prelude.>" @@ "p" @@ litInt 10) - @@ ("Prelude.." @@ ("Prelude.showString" - @@ stringExp "toEnum ") - @@ ("Prelude.shows" @@ "k")) - ] - ] + -- Judah: Just to clarify, for values with duplicate numbers, + -- we can make the first one be the “real” constructor and the rest be pattern synonyms for that constructor + -- todo: a whole shitload of groupBy type logic + [ dataDecl dataName + ( (flip conDecl [] . enumValueName <$> enumValues info) + ++ [conDecl unrecognizedName [unrecognizedValueType]] + ) + $ deriving' ["Prelude.Show", "Prelude.Eq", "Prelude.Ord"] + + , newtypeDecl unrecognizedValueName + "Data.Int.Int32" + $ deriving' ["Prelude.Eq", "Prelude.Ord", "Prelude.Show"] -- instance MessageEnum Foo where -- maybeToEnum k = Just $ toEnum k @@ -290,16 +281,9 @@ generateEnumDecls Proto3 info = , instDecl [] ("Data.ProtoLens.MessageEnum" `ihApp` [dataType]) [ [match "maybeToEnum" ["k"] $ "Prelude.Just" @@ ("Prelude.toEnum" @@ "k")] - , [ match "showEnum" [pVar n] $ stringExp pn - | v <- enumValues info - , isNothing (enumAliasOf v) - , let n = enumValueName v - , let pn = T.unpack $ enumValueDescriptor v ^. name - ] - , [ match "showEnum" [pApp (unQual dataName) ["k"]] - $ "Prelude.show" @@ "k" + , [ match "showEnum" [] + $ "Prelude.show" ] - , [ match "readEnum" [stringPat pn] $ "Prelude.Just" @@ con (unQual n) | v <- enumValues info @@ -311,28 +295,107 @@ generateEnumDecls Proto3 info = ] ] - -- proto3 enums always default to zero. + -- instance Bounded Foo where + -- minBound = Foo1 + -- maxBound = FooN + , instDecl [] ("Prelude.Bounded" `ihApp` [dataType]) + [[ match "minBound" [] $ con $ unQual minBoundName + , match "maxBound" [] $ con $ unQual maxBoundName + ]] + + -- 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 Data.Default.Class.Default Foo where + -- def = FirstEnumValue , instDecl [] ("Data.Default.Class.Default" `ihApp` [dataType]) - [[match "def" [] $ "Prelude.toEnum" @@ litInt 0]] + [[match "def" [] defaultCon]] + -- instance Data.ProtoLens.FieldDefault Foo where + -- fieldDefault = FirstEnumValue , instDecl [] ("Data.ProtoLens.FieldDefault" `ihApp` [dataType]) - [[match "fieldDefault" [] $ "Prelude.toEnum" @@ litInt 0]] + [[match "fieldDefault" [] defaultCon]] ] - ++ - -- pattern Value0 :: Foo - -- pattern Value0 = Foo 0 - concat - [ [ patSynSig n dataType - , patSyn (pVar n) - $ pApp (unQual dataName) [pLitInt k] - ] - | v <- enumValues info - , let n = enumValueName v - , let k = fromIntegral $ enumValueDescriptor v ^. number - ] + where - dataName = enumName info + EnumInfo { enumName = dataName, enumDescriptor = ed } = info + errorMessage = "toEnum: unknown value for enum " ++ unpack (ed ^. name) + ++ ": " + + errorMessageExpr = "Prelude.error" + @@ ("Prelude.++" @@ stringExp errorMessage + @@ ("Prelude.show" @@ "k__")) + alias funName implName = [match funName [] implName] + dataType = tyCon $ unQual dataName + unrecognizedValueName, unrecognizedName :: Name + unrecognizedValueName = modifyIdent (++ "'UnrecognizedValue") dataName + unrecognizedName = modifyIdent (++ "'Unrecognized") dataName + + unrecognizedValueType = tyCon $ unQual unrecognizedValueName -- this should compile fine + + constructors :: [(Name, EnumValueDescriptorProto)] + constructors = List.sortBy (comparing ((^. number) . snd)) + [(n, d) | EnumValueInfo + { enumValueName = n + , enumValueDescriptor = d + , enumAliasOf = Nothing + } <- enumValues info + ] + constructorNames = map fst constructors + defaultCon = con $ unQual $ head constructorNames + + 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 + ] + generateEnumDecls Proto2 info = [ dataDecl dataName [conDecl n [] | n <- constructorNames] @@ -433,6 +496,7 @@ generateEnumDecls Proto2 info = , enumAliasOf = Just originalName } <- enumValues info ] + where dataType = tyCon $ unQual dataName EnumInfo { enumName = dataName, enumDescriptor = ed } = info diff --git a/proto-lens-tests/tests/proto3.proto b/proto-lens-tests/tests/proto3.proto index 1e1c77a7..f8be50c6 100644 --- a/proto-lens-tests/tests/proto3.proto +++ b/proto-lens-tests/tests/proto3.proto @@ -16,17 +16,18 @@ message Foo { } Sub sub = 5; - enum FooEnum { - option allow_alias = true; - Enum1 = 0; - Enum2 = 3; - Enum2a = 3; - } FooEnum enum = 6; repeated int32 f = 7; } +enum FooEnum { + option allow_alias = true; + Enum1 = 0; + Enum2 = 3; + Enum2a = 3; +} + message Strings { bytes bytes = 1; string string = 2; diff --git a/proto-lens-tests/tests/proto3_test.hs b/proto-lens-tests/tests/proto3_test.hs index 1883f031..af63eca7 100644 --- a/proto-lens-tests/tests/proto3_test.hs +++ b/proto-lens-tests/tests/proto3_test.hs @@ -13,7 +13,7 @@ import qualified Data.ByteString.Builder as Builder import Data.Monoid ((<>)) import Proto.Proto3 ( Foo - , Foo'FooEnum(..) + , FooEnum(..) , Foo'Sub(..) , Strings ) @@ -96,25 +96,25 @@ main = testMain [ testCase "int" $ (def :: Foo) @=? (def & a .~ 0) , testCase "bytes" $ (def :: Strings) @=? (def & bytes .~ "") , testCase "string" $ (def :: Strings) @=? (def & string .~ "") - , testCase "enum" $ (def :: Foo) @=? (def & enum .~ Foo'Enum1) + , testCase "enum" $ (def :: Foo) @=? (def & enum .~ Enum1) ] -- Enums are all pattern aliases , testGroup "enum" - [ testCase "aliases are exported" $ Foo'Enum2 @=? Foo'Enum2a + [ testCase "aliases are exported" $ Enum2 @=? Enum2a , testCase "enum values" $ do - map toEnum [0, 3, 3] @=? [Foo'Enum1, Foo'Enum2, Foo'Enum2a] - ["Foo'Enum1", "Foo'Enum2", "Foo'Enum2", "toEnum 5"] - @=? map show [Foo'Enum1, Foo'Enum2, Foo'Enum2a, toEnum 5] + map toEnum [0, 3, 3] @=? [Enum1, Enum2, Enum2a] + ["Enum1", "Enum2", "Enum2", "toEnum 5"] + @=? map show [Enum1, Enum2, Enum2a, toEnum 5] ["Enum1", "Enum2", "Enum2", "6"] - @=? map showEnum [Foo'Enum1, Foo'Enum2, Foo'Enum2a, toEnum 6] - [Just Foo'Enum1, Just Foo'Enum2, Just Foo'Enum2, Nothing, Nothing] + @=? map showEnum [Enum1, Enum2, Enum2a, toEnum 6] + [Just Enum1, Just Enum2, Just Enum2, Nothing, Nothing] @=? map readEnum ["Enum1", "Enum2", "Enum2a", "4", "5"] , testCase "enum patterns" $ do assertBool "enum value" $ case toEnum 3 of - Foo'Enum2 -> True + Enum2 -> True _ -> False assertBool "enum alias" $ case toEnum 3 of - Foo'Enum2a -> True + Enum2a -> True _ -> False ] From 8205fb2bf54b3a25c734ebc8de74a1f9bad57a29 Mon Sep 17 00:00:00 2001 From: Paul Kinsky Date: Thu, 26 Oct 2017 14:25:32 -0700 Subject: [PATCH 02/15] working except for round trip to/from string logic --- .../src/Data/ProtoLens/Compiler/Generate.hs | 43 ++++++++++++++----- proto-lens-tests/tests/proto3_test.hs | 4 +- 2 files changed, 34 insertions(+), 13 deletions(-) diff --git a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs index b4807e94..3dcd06c7 100644 --- a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs +++ b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs @@ -259,11 +259,8 @@ generateEnumExports syntaxType e = [exportAll n, exportWith n aliases] generateEnumDecls :: SyntaxType -> EnumInfo Name -> [Decl] generateEnumDecls Proto3 info = - -- Judah: Just to clarify, for values with duplicate numbers, - -- we can make the first one be the “real” constructor and the rest be pattern synonyms for that constructor - -- todo: a whole shitload of groupBy type logic [ dataDecl dataName - ( (flip conDecl [] . enumValueName <$> enumValues info) + ( (flip conDecl [] <$> constructorNames) ++ [conDecl unrecognizedName [unrecognizedValueType]] ) $ deriving' ["Prelude.Show", "Prelude.Eq", "Prelude.Ord"] @@ -279,8 +276,18 @@ generateEnumDecls Proto3 info = -- readEnum "Value0" = Just (Foo 0) -- readEnum _ = Nothing , instDecl [] ("Data.ProtoLens.MessageEnum" `ihApp` [dataType]) - [ [match "maybeToEnum" ["k"] - $ "Prelude.Just" @@ ("Prelude.toEnum" @@ "k")] + [ [ 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") + ) + ) + ] , [ match "showEnum" [] $ "Prelude.show" ] @@ -329,6 +336,12 @@ generateEnumDecls Proto3 info = , [ match "fromEnum" [pApp (unQual c) []] $ litInt k | (c, k) <- constructorNumbers ] + ++ + [match "fromEnum" [pApp (unQual unrecognizedName) + [pApp (unQual unrecognizedValueName) [pVar "k"]] + ] + $ "Prelude.fromIntegral" @@ "k" + ] , succDecl "succ" maxBoundName succPairs , succDecl "pred" minBoundName $ map swap succPairs , alias "enumFrom" "Data.ProtoLens.Message.Enum.messageEnumFrom" @@ -346,7 +359,16 @@ generateEnumDecls Proto3 info = -- fieldDefault = FirstEnumValue , instDecl [] ("Data.ProtoLens.FieldDefault" `ihApp` [dataType]) [[match "fieldDefault" [] defaultCon]] - ] + ] ++ + concat + [ [ patSynSig aliasName dataType + , patSyn (pVar aliasName) (pVar originalName) + ] + | EnumValueInfo + { enumValueName = aliasName + , enumAliasOf = Just originalName + } <- enumValues info + ] where EnumInfo { enumName = dataName, enumDescriptor = ed } = info @@ -364,7 +386,7 @@ generateEnumDecls Proto3 info = unrecognizedValueName = modifyIdent (++ "'UnrecognizedValue") dataName unrecognizedName = modifyIdent (++ "'Unrecognized") dataName - unrecognizedValueType = tyCon $ unQual unrecognizedValueName -- this should compile fine + unrecognizedValueType = tyCon $ unQual unrecognizedValueName constructors :: [(Name, EnumValueDescriptorProto)] constructors = List.sortBy (comparing ((^. number) . snd)) @@ -375,14 +397,13 @@ generateEnumDecls Proto3 info = } <- enumValues info ] constructorNames = map fst constructors + defaultCon = con $ unQual $ head constructorNames minBoundName = head constructorNames maxBoundName = last constructorNames - constructorProtoNames = map (second (^. name)) constructors - constructorNumbers = map (second (fromIntegral . (^. number))) - constructors + constructorNumbers = map (second (fromIntegral . (^. number))) constructors succPairs = zip constructorNames $ tail constructorNames succDecl funName boundName thePairs = diff --git a/proto-lens-tests/tests/proto3_test.hs b/proto-lens-tests/tests/proto3_test.hs index af63eca7..dd08de96 100644 --- a/proto-lens-tests/tests/proto3_test.hs +++ b/proto-lens-tests/tests/proto3_test.hs @@ -103,9 +103,9 @@ main = testMain [ testCase "aliases are exported" $ Enum2 @=? Enum2a , testCase "enum values" $ do map toEnum [0, 3, 3] @=? [Enum1, Enum2, Enum2a] - ["Enum1", "Enum2", "Enum2", "toEnum 5"] + ["Enum1", "Enum2", "Enum2", "FooEnum'Unrecognized (FooEnum'UnrecognizedValue 5)"] @=? map show [Enum1, Enum2, Enum2a, toEnum 5] - ["Enum1", "Enum2", "Enum2", "6"] + ["Enum1", "Enum2", "Enum2", "FooEnum'Unrecognized (FooEnum'UnrecognizedValue 6)"] @=? map showEnum [Enum1, Enum2, Enum2a, toEnum 6] [Just Enum1, Just Enum2, Just Enum2, Nothing, Nothing] @=? map readEnum ["Enum1", "Enum2", "Enum2a", "4", "5"] From 84a7a0d86505ea1e12cd1587af68f8dfaef0734c Mon Sep 17 00:00:00 2001 From: Paul Kinsky Date: Thu, 26 Oct 2017 16:13:26 -0700 Subject: [PATCH 03/15] fix read/show issues, handle unrecognized value succ/pred --- proto-lens-protoc/package.yaml | 4 +-- .../src/Data/ProtoLens/Compiler/Generate.hs | 31 ++++++++++++------- proto-lens-tests/tests/proto3_test.hs | 2 +- 3 files changed, 22 insertions(+), 15 deletions(-) diff --git a/proto-lens-protoc/package.yaml b/proto-lens-protoc/package.yaml index b0b388f5..453c3aa9 100644 --- a/proto-lens-protoc/package.yaml +++ b/proto-lens-protoc/package.yaml @@ -59,8 +59,8 @@ library: - Data.Text as Data.ProtoLens.Reexport.Data.Text, - Lens.Family2 as Data.ProtoLens.Reexport.Lens.Family2, - Lens.Family2.Unchecked as Data.ProtoLens.Reexport.Lens.Family2.Unchecked, - - Lens.Labels as Data.ProtoLens.Reexport.Lens.Labels - + - Lens.Labels as Data.ProtoLens.Reexport.Lens.Labels, + - Text.Read as Data.ProtoLens.Reexport.Text.Read executables: proto-lens-protoc: diff --git a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs index 3dcd06c7..443caeb2 100644 --- a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs +++ b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs @@ -108,8 +108,8 @@ generateModule modName imports syntaxType modifyImport definitions importedEnv [ "Prelude", "Data.Int", "Data.Word" , "Data.ProtoLens", "Data.ProtoLens.Message.Enum" , "Lens.Family2", "Lens.Family2.Unchecked", "Data.Default.Class" - , "Data.Text", "Data.Map" , "Data.ByteString" - , "Lens.Labels" + , "Data.Text", "Data.Map", "Data.ByteString" + , "Lens.Labels", "Text.Read" ] ++ map importSimple imports env = Map.union (unqualifyEnv definitions) importedEnv @@ -263,11 +263,11 @@ generateEnumDecls Proto3 info = ( (flip conDecl [] <$> constructorNames) ++ [conDecl unrecognizedName [unrecognizedValueType]] ) - $ deriving' ["Prelude.Show", "Prelude.Eq", "Prelude.Ord"] + $ deriving' ["Prelude.Show", "Prelude.Eq", "Prelude.Ord, Prelude.Read"] , newtypeDecl unrecognizedValueName "Data.Int.Int32" - $ deriving' ["Prelude.Eq", "Prelude.Ord", "Prelude.Show"] + $ deriving' ["Prelude.Eq", "Prelude.Ord", "Prelude.Show, Prelude.Read"] -- instance MessageEnum Foo where -- maybeToEnum k = Just $ toEnum k @@ -288,18 +288,19 @@ generateEnumDecls Proto3 info = ) ) ] - , [ match "showEnum" [] - $ "Prelude.show" - ] + , [match "showEnum" [pApp (unQual unrecognizedName) + [pApp (unQual unrecognizedValueName) [pVar "k"]] + ] + $ "Prelude.show" @@ "k" + ] ++ + [match "showEnum" ["k"] $ "Prelude.show" @@ "k"] , [ match "readEnum" [stringPat pn] $ "Prelude.Just" @@ con (unQual n) - | v <- enumValues info + | v <- filter (not . null . enumAliasOf) $ enumValues info , let n = enumValueName v , let pn = T.unpack $ enumValueDescriptor v ^. name - ] - ++ - [ match "readEnum" [pWildCard] "Prelude.Nothing" - ] + ] ++ + [match "readEnum" ["k"] $ "Text.Read.readMaybe" @@ "k"] ] -- instance Bounded Foo where @@ -416,6 +417,12 @@ generateEnumDecls Proto3 info = [ match funName [pApp (unQual from) []] $ con $ unQual to | (from, to) <- thePairs ] + ++ + [match funName [pWildCard] + ("Prelude.error" @@ stringExp (concat + [ prettyPrint dataName, ".", prettyPrint funName, ": bad argument: unrecognized value" + ])) + ] generateEnumDecls Proto2 info = [ dataDecl dataName diff --git a/proto-lens-tests/tests/proto3_test.hs b/proto-lens-tests/tests/proto3_test.hs index dd08de96..67b6b4b7 100644 --- a/proto-lens-tests/tests/proto3_test.hs +++ b/proto-lens-tests/tests/proto3_test.hs @@ -105,7 +105,7 @@ main = testMain map toEnum [0, 3, 3] @=? [Enum1, Enum2, Enum2a] ["Enum1", "Enum2", "Enum2", "FooEnum'Unrecognized (FooEnum'UnrecognizedValue 5)"] @=? map show [Enum1, Enum2, Enum2a, toEnum 5] - ["Enum1", "Enum2", "Enum2", "FooEnum'Unrecognized (FooEnum'UnrecognizedValue 6)"] + ["Enum1", "Enum2", "Enum2", "6"] @=? map showEnum [Enum1, Enum2, Enum2a, toEnum 6] [Just Enum1, Just Enum2, Just Enum2, Nothing, Nothing] @=? map readEnum ["Enum1", "Enum2", "Enum2a", "4", "5"] From 62787e4c3302088b85b7a41098c6a599e9dad71f Mon Sep 17 00:00:00 2001 From: Paul Kinsky Date: Thu, 26 Oct 2017 16:47:21 -0700 Subject: [PATCH 04/15] formatting --- .../src/Data/ProtoLens/Compiler/Generate.hs | 57 +++++++++---------- 1 file changed, 28 insertions(+), 29 deletions(-) diff --git a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs index 443caeb2..57baaf90 100644 --- a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs +++ b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs @@ -303,34 +303,34 @@ generateEnumDecls Proto3 info = [match "readEnum" ["k"] $ "Text.Read.readMaybe" @@ "k"] ] - -- instance Bounded Foo where - -- minBound = Foo1 - -- maxBound = FooN - , instDecl [] ("Prelude.Bounded" `ihApp` [dataType]) - [[ match "minBound" [] $ con $ unQual minBoundName - , match "maxBound" [] $ con $ unQual maxBoundName - ]] - - -- 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]) + -- instance Bounded Foo where + -- minBound = Foo1 + -- maxBound = FooN + , instDecl [] ("Prelude.Bounded" `ihApp` [dataType]) + [[ match "minBound" [] $ con $ unQual minBoundName + , match "maxBound" [] $ con $ unQual maxBoundName + ]] + + -- 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__")] @@ -524,7 +524,6 @@ generateEnumDecls Proto2 info = , enumAliasOf = Just originalName } <- enumValues info ] - where dataType = tyCon $ unQual dataName EnumInfo { enumName = dataName, enumDescriptor = ed } = info From 9454bddede14d125c93e158003a5dd17cd8a6bb0 Mon Sep 17 00:00:00 2001 From: Paul Kinsky Date: Thu, 26 Oct 2017 17:00:53 -0700 Subject: [PATCH 05/15] comments! --- .../src/Data/ProtoLens/Compiler/Generate.hs | 26 ++++++++++++++----- 1 file changed, 20 insertions(+), 6 deletions(-) diff --git a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs index 57baaf90..b4774882 100644 --- a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs +++ b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs @@ -259,22 +259,34 @@ generateEnumExports syntaxType e = [exportAll n, exportWith n aliases] generateEnumDecls :: SyntaxType -> EnumInfo Name -> [Decl] generateEnumDecls Proto3 info = + -- data FooEnum = Enum1 + -- | Enum2 + -- | FooEnum'Unrecognized !FooEnum'UnrecognizedValue + -- deriving (Prelude.Show, Prelude.Eq, Prelude.Ord, Prelude.Read) [ dataDecl dataName ( (flip conDecl [] <$> constructorNames) ++ [conDecl unrecognizedName [unrecognizedValueType]] ) $ deriving' ["Prelude.Show", "Prelude.Eq", "Prelude.Ord, Prelude.Read"] + -- 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, Prelude.Read"] - -- instance MessageEnum Foo where - -- maybeToEnum k = Just $ toEnum k - -- showEnum (Foo 0) = "Value0" -- the proto name - -- showEnum (Foo k) = show k - -- readEnum "Value0" = Just (Foo 0) - -- readEnum _ = Nothing + -- instance Data.ProtoLens.MessageEnum FooEnum where + -- maybeToEnum 0 = Prelude.Just Enum1 + -- maybeToEnum 3 = Prelude.Just Enum2 + -- maybeToEnum k + -- = Prelude.Just + -- (FooEnum'Unrecognized + -- (FooEnum'UnrecognizedValue (Prelude.fromIntegral k))) + -- showEnum (FooEnum'Unrecognized (FooEnum'UnrecognizedValue k)) + -- = Prelude.show k + -- showEnum k = Prelude.show k + -- readEnum "Enum2a" = Prelude.Just Enum2a -- alias + -- readEnum k = Text.Read.readMaybe k , instDecl [] ("Data.ProtoLens.MessageEnum" `ihApp` [dataType]) [ [ match "maybeToEnum" [pLitInt k] $ "Prelude.Just" @@ con (unQual c) | (c, k) <- constructorNumbers @@ -361,6 +373,8 @@ generateEnumDecls Proto3 info = , instDecl [] ("Data.ProtoLens.FieldDefault" `ihApp` [dataType]) [[match "fieldDefault" [] defaultCon]] ] ++ + -- pattern Enum2a :: FooEnum + -- pattern Enum2a = Enum2 concat [ [ patSynSig aliasName dataType , patSyn (pVar aliasName) (pVar originalName) From 339bec45cd6155d6bae47c1c1f1e00be6a535c56 Mon Sep 17 00:00:00 2001 From: Paul Kinsky Date: Mon, 30 Oct 2017 14:46:25 -0700 Subject: [PATCH 06/15] refactoring based on comments, test broken --- .../src/Data/ProtoLens/Compiler/Generate.hs | 7 +++--- proto-lens-tests/tests/proto3.proto | 14 +++++------ proto-lens-tests/tests/proto3_test.hs | 24 +++++++++---------- 3 files changed, 23 insertions(+), 22 deletions(-) diff --git a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs index b4774882..b3a33ea1 100644 --- a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs +++ b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs @@ -259,9 +259,10 @@ generateEnumExports syntaxType e = [exportAll n, exportWith n aliases] generateEnumDecls :: SyntaxType -> EnumInfo Name -> [Decl] generateEnumDecls Proto3 info = - -- data FooEnum = Enum1 - -- | Enum2 - -- | FooEnum'Unrecognized !FooEnum'UnrecognizedValue + -- data FooEnum + -- = Enum1 + -- | Enum2 + -- | FooEnum'Unrecognized !FooEnum'UnrecognizedValue -- deriving (Prelude.Show, Prelude.Eq, Prelude.Ord, Prelude.Read) [ dataDecl dataName ( (flip conDecl [] <$> constructorNames) diff --git a/proto-lens-tests/tests/proto3.proto b/proto-lens-tests/tests/proto3.proto index f8be50c6..0e7b8a0d 100644 --- a/proto-lens-tests/tests/proto3.proto +++ b/proto-lens-tests/tests/proto3.proto @@ -16,18 +16,18 @@ message Foo { } Sub sub = 5; + + enum FooEnum { + option allow_alias = true; + Enum1 = 0; + Enum2 = 3; + Enum2a = 3; + } FooEnum enum = 6; repeated int32 f = 7; } -enum FooEnum { - option allow_alias = true; - Enum1 = 0; - Enum2 = 3; - Enum2a = 3; -} - message Strings { bytes bytes = 1; string string = 2; diff --git a/proto-lens-tests/tests/proto3_test.hs b/proto-lens-tests/tests/proto3_test.hs index 67b6b4b7..8aabbe18 100644 --- a/proto-lens-tests/tests/proto3_test.hs +++ b/proto-lens-tests/tests/proto3_test.hs @@ -13,7 +13,7 @@ import qualified Data.ByteString.Builder as Builder import Data.Monoid ((<>)) import Proto.Proto3 ( Foo - , FooEnum(..) + , Foo'FooEnum(..) , Foo'Sub(..) , Strings ) @@ -96,25 +96,25 @@ main = testMain [ testCase "int" $ (def :: Foo) @=? (def & a .~ 0) , testCase "bytes" $ (def :: Strings) @=? (def & bytes .~ "") , testCase "string" $ (def :: Strings) @=? (def & string .~ "") - , testCase "enum" $ (def :: Foo) @=? (def & enum .~ Enum1) + , testCase "enum" $ (def :: Foo) @=? (def & enum .~ Foo'Enum1) ] -- Enums are all pattern aliases , testGroup "enum" - [ testCase "aliases are exported" $ Enum2 @=? Enum2a + [ testCase "aliases are exported" $ Foo'Enum2 @=? Foo'Enum2a , testCase "enum values" $ do - map toEnum [0, 3, 3] @=? [Enum1, Enum2, Enum2a] - ["Enum1", "Enum2", "Enum2", "FooEnum'Unrecognized (FooEnum'UnrecognizedValue 5)"] - @=? map show [Enum1, Enum2, Enum2a, toEnum 5] - ["Enum1", "Enum2", "Enum2", "6"] - @=? map showEnum [Enum1, Enum2, Enum2a, toEnum 6] - [Just Enum1, Just Enum2, Just Enum2, Nothing, Nothing] - @=? map readEnum ["Enum1", "Enum2", "Enum2a", "4", "5"] + map toEnum [0, 3, 3] @=? [Foo'Enum1, Foo'Enum2, Foo'Enum2a] + ["Foo'Enum1", "Foo'Enum2", "Foo'Enum2", "Foo'FooEnum'Unrecognized (Foo'FooEnum'UnrecognizedValue 5)"] + @=? map show [Foo'Enum1, Foo'Enum2, Foo'Enum2a, toEnum 5] + ["Foo'Enum1", "Foo'Enum2", "Foo'Enum2", "6"] + @=? map showEnum [Foo'Enum1, Foo'Enum2, Foo'Enum2a, toEnum 6] + [Just Foo'Enum1, Just Foo'Enum2, Just Foo'Enum2, Nothing, Nothing] + @=? map readEnum ["Foo'Enum1", "Foo'Enum2", "Foo'Enum2a", "4", "5"] , testCase "enum patterns" $ do assertBool "enum value" $ case toEnum 3 of - Enum2 -> True + Foo'Enum2 -> True _ -> False assertBool "enum alias" $ case toEnum 3 of - Enum2a -> True + Foo'Enum2a -> True _ -> False ] From bc7bdb41b6313744c187f19ce32ec5f5fd6d9acd Mon Sep 17 00:00:00 2001 From: Paul Kinsky Date: Tue, 31 Oct 2017 12:28:58 -0700 Subject: [PATCH 07/15] fix tests --- .../Data/ProtoLens/Compiler/Combinators.hs | 5 ----- .../Data/ProtoLens/Compiler/Definitions.hs | 21 ++++++++++++++----- .../src/Data/ProtoLens/Compiler/Generate.hs | 15 ++++++------- 3 files changed, 24 insertions(+), 17 deletions(-) diff --git a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Combinators.hs b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Combinators.hs index 3e97a991..66923631 100644 --- a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Combinators.hs +++ b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Combinators.hs @@ -358,8 +358,3 @@ string s = Syntax.String () s (show s) modifyModuleName :: (String -> String) -> ModuleName -> ModuleName modifyModuleName f (Syntax.ModuleName _ unpacked) = Syntax.ModuleName () $ f unpacked - - -modifyIdent :: (String -> String) -> Name -> Name -modifyIdent f (Syntax.Ident l s) = Syntax.Ident l $ f s -modifyIdent _ x = x diff --git a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Definitions.hs b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Definitions.hs index 204e723f..dbcaa3e6 100644 --- a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Definitions.hs +++ b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Definitions.hs @@ -156,6 +156,8 @@ promoteSymbol (Symbol s) = tyPromotedString s -- | All the information needed to define or use a proto enum type. data EnumInfo n = EnumInfo { enumName :: n + , enumUnrecognizedName :: n + , enumUnrecognizedValueName :: n , enumDescriptor :: EnumDescriptorProto , enumValues :: [EnumValueInfo n] } deriving Functor @@ -163,6 +165,7 @@ data EnumInfo n = EnumInfo -- | Information about a single value case of a proto enum. data EnumValueInfo n = EnumValueInfo { enumValueName :: n + , enumValueNameString :: String -- because the EnumValueDescriptorProto name doesn't have the hs prefix , enumValueDescriptor :: EnumValueDescriptorProto , enumAliasOf :: Maybe Name -- ^ If 'Nothing', we turn value into a normal constructor of the enum. @@ -361,12 +364,17 @@ enumDef :: Text -> String -> EnumDescriptorProto -> (Text, Definition Name) enumDef protoPrefix hsPrefix d = let mkText n = protoPrefix <> n - mkHsName n = fromString $ hsPrefix ++ unpack n + mkHsName :: Text -> Name + mkHsName = fromString . mkHsNameString + mkHsNameString :: Text -> String + mkHsNameString n = hsPrefix ++ unpack n in (mkText (d ^. name) , Enum EnumInfo { enumName = mkHsName (d ^. name) + , enumUnrecognizedName = mkHsName (d ^. name <> "'Unrecognized") + , enumUnrecognizedValueName = mkHsName (d ^. name <> "'UnrecognizedValue") , enumDescriptor = d - , enumValues = collectEnumValues mkHsName $ d ^. value + , enumValues = collectEnumValues mkHsNameString $ d ^. value }) -- | Generate the definitions for each enum value. In particular, decide @@ -375,7 +383,7 @@ enumDef protoPrefix hsPrefix d = let -- -- Like Java, we treat the first case of each numeric value as the "real" -- constructor, and subsequent cases as synonyms. -collectEnumValues :: (Text -> Name) -> [EnumValueDescriptorProto] +collectEnumValues :: (Text -> String) -> [EnumValueDescriptorProto] -> [EnumValueInfo Name] collectEnumValues mkHsName = snd . mapAccumL helper Map.empty where @@ -385,8 +393,11 @@ collectEnumValues mkHsName = snd . mapAccumL helper Map.empty | Just n' <- Map.lookup k seenNames = (seenNames, mkValue (Just n')) | otherwise = (Map.insert k n seenNames, mkValue Nothing) where - mkValue = EnumValueInfo n v - n = mkHsName (v ^. name) + mkValue = EnumValueInfo n n' v + n :: Name + n = fromString $ mkHsName (v ^. name) + n' :: String + n' = mkHsName (v ^. name) k = v ^. number -- Haskell types must start with an uppercase letter, so we capitalize message diff --git a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs index b3a33ea1..52bac267 100644 --- a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs +++ b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs @@ -266,7 +266,7 @@ generateEnumDecls Proto3 info = -- deriving (Prelude.Show, Prelude.Eq, Prelude.Ord, Prelude.Read) [ dataDecl dataName ( (flip conDecl [] <$> constructorNames) - ++ [conDecl unrecognizedName [unrecognizedValueType]] + ++ [conDecl unrecognizedName [tyCon $ unQual unrecognizedValueName]] ) $ deriving' ["Prelude.Show", "Prelude.Eq", "Prelude.Ord, Prelude.Read"] @@ -311,7 +311,8 @@ generateEnumDecls Proto3 info = $ "Prelude.Just" @@ con (unQual n) | v <- filter (not . null . enumAliasOf) $ enumValues info , let n = enumValueName v - , let pn = T.unpack $ enumValueDescriptor v ^. name + , let pn = enumValueNameString v + -- problem: descriptor != name, only name has Foo' prefix, not descriptor ] ++ [match "readEnum" ["k"] $ "Text.Read.readMaybe" @@ "k"] ] @@ -387,7 +388,11 @@ generateEnumDecls Proto3 info = ] where - EnumInfo { enumName = dataName, enumDescriptor = ed } = info + EnumInfo { enumName = dataName + , enumUnrecognizedName = unrecognizedName + , enumUnrecognizedValueName = unrecognizedValueName + , enumDescriptor = ed + } = info errorMessage = "toEnum: unknown value for enum " ++ unpack (ed ^. name) ++ ": " @@ -398,11 +403,7 @@ generateEnumDecls Proto3 info = dataType = tyCon $ unQual dataName - unrecognizedValueName, unrecognizedName :: Name - unrecognizedValueName = modifyIdent (++ "'UnrecognizedValue") dataName - unrecognizedName = modifyIdent (++ "'Unrecognized") dataName - unrecognizedValueType = tyCon $ unQual unrecognizedValueName constructors :: [(Name, EnumValueDescriptorProto)] constructors = List.sortBy (comparing ((^. number) . snd)) From 3dd6f6e2bb00f34b8a9bccbcf125ccd037bccedf Mon Sep 17 00:00:00 2001 From: Paul Kinsky Date: Tue, 31 Oct 2017 14:36:23 -0700 Subject: [PATCH 08/15] fix tests --- .../src/Data/ProtoLens/Compiler/Combinators.hs | 3 +++ .../src/Data/ProtoLens/Compiler/Definitions.hs | 17 +++++------------ .../src/Data/ProtoLens/Compiler/Generate.hs | 17 +++++++++++------ proto-lens-tests/src/Data/ProtoLens/TestUtil.hs | 1 + proto-lens-tests/tests/proto3_test.hs | 12 ++++++++---- 5 files changed, 28 insertions(+), 22 deletions(-) diff --git a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Combinators.hs b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Combinators.hs index 66923631..3fe73fe3 100644 --- a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Combinators.hs +++ b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Combinators.hs @@ -166,6 +166,9 @@ ihApp = foldl (Syntax.IHApp ()) tyParen :: Type -> Type tyParen = Syntax.TyParen () +paren :: Exp -> Exp +paren = Syntax.Paren () + type Match = Syntax.Match () -- | A simple clause of a function binding. diff --git a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Definitions.hs b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Definitions.hs index dbcaa3e6..2db51bef 100644 --- a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Definitions.hs +++ b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Definitions.hs @@ -165,7 +165,6 @@ data EnumInfo n = EnumInfo -- | Information about a single value case of a proto enum. data EnumValueInfo n = EnumValueInfo { enumValueName :: n - , enumValueNameString :: String -- because the EnumValueDescriptorProto name doesn't have the hs prefix , enumValueDescriptor :: EnumValueDescriptorProto , enumAliasOf :: Maybe Name -- ^ If 'Nothing', we turn value into a normal constructor of the enum. @@ -364,17 +363,14 @@ enumDef :: Text -> String -> EnumDescriptorProto -> (Text, Definition Name) enumDef protoPrefix hsPrefix d = let mkText n = protoPrefix <> n - mkHsName :: Text -> Name - mkHsName = fromString . mkHsNameString - mkHsNameString :: Text -> String - mkHsNameString n = hsPrefix ++ unpack n + mkHsName n = fromString $ hsPrefix ++ unpack n in (mkText (d ^. name) , Enum EnumInfo { enumName = mkHsName (d ^. name) , enumUnrecognizedName = mkHsName (d ^. name <> "'Unrecognized") , enumUnrecognizedValueName = mkHsName (d ^. name <> "'UnrecognizedValue") , enumDescriptor = d - , enumValues = collectEnumValues mkHsNameString $ d ^. value + , enumValues = collectEnumValues mkHsName $ d ^. value }) -- | Generate the definitions for each enum value. In particular, decide @@ -383,7 +379,7 @@ enumDef protoPrefix hsPrefix d = let -- -- Like Java, we treat the first case of each numeric value as the "real" -- constructor, and subsequent cases as synonyms. -collectEnumValues :: (Text -> String) -> [EnumValueDescriptorProto] +collectEnumValues :: (Text -> Name) -> [EnumValueDescriptorProto] -> [EnumValueInfo Name] collectEnumValues mkHsName = snd . mapAccumL helper Map.empty where @@ -393,11 +389,8 @@ collectEnumValues mkHsName = snd . mapAccumL helper Map.empty | Just n' <- Map.lookup k seenNames = (seenNames, mkValue (Just n')) | otherwise = (Map.insert k n seenNames, mkValue Nothing) where - mkValue = EnumValueInfo n n' v - n :: Name - n = fromString $ mkHsName (v ^. name) - n' :: String - n' = mkHsName (v ^. name) + mkValue = EnumValueInfo n v + n = mkHsName (v ^. name) k = v ^. number -- Haskell types must start with an uppercase letter, so we capitalize message diff --git a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs index 52bac267..6170d1bc 100644 --- a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs +++ b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs @@ -301,20 +301,25 @@ generateEnumDecls Proto3 info = ) ) ] - , [match "showEnum" [pApp (unQual unrecognizedName) + , [ match "showEnum" [pApp (unQual n) []] + $ stringExp pn + | v <- filter (null . enumAliasOf) $ enumValues info + , let n = enumValueName v + , let pn = T.unpack $ enumValueDescriptor v ^. name + ] ++ + [match "showEnum" [pApp (unQual unrecognizedName) [pApp (unQual unrecognizedValueName) [pVar "k"]] ] $ "Prelude.show" @@ "k" - ] ++ - [match "showEnum" ["k"] $ "Prelude.show" @@ "k"] + ] , [ match "readEnum" [stringPat pn] $ "Prelude.Just" @@ con (unQual n) - | v <- filter (not . null . enumAliasOf) $ enumValues info + | v <- enumValues info , let n = enumValueName v - , let pn = enumValueNameString v + , let pn = T.unpack $ enumValueDescriptor v ^. name -- problem: descriptor != name, only name has Foo' prefix, not descriptor ] ++ - [match "readEnum" ["k"] $ "Text.Read.readMaybe" @@ "k"] + [match "readEnum" [pVar "k"] $ ("Prelude.>>=" @@ paren ("Text.Read.readMaybe" @@ "k")) @@ ("Data.ProtoLens.maybeToEnum")] ] -- instance Bounded Foo where diff --git a/proto-lens-tests/src/Data/ProtoLens/TestUtil.hs b/proto-lens-tests/src/Data/ProtoLens/TestUtil.hs index 757bce99..3bd9cd12 100644 --- a/proto-lens-tests/src/Data/ProtoLens/TestUtil.hs +++ b/proto-lens-tests/src/Data/ProtoLens/TestUtil.hs @@ -68,6 +68,7 @@ import Text.PrettyPrint testMain :: [Test] -> IO () testMain = defaultMain +-- todo use this for enum msg on Foo serializeTo :: (Show a, Eq a, Message a) => String -> a -> Doc -> Builder.Builder -> Test serializeTo name x text bs = testCase name $ do diff --git a/proto-lens-tests/tests/proto3_test.hs b/proto-lens-tests/tests/proto3_test.hs index 8aabbe18..7fb2f8ec 100644 --- a/proto-lens-tests/tests/proto3_test.hs +++ b/proto-lens-tests/tests/proto3_test.hs @@ -98,17 +98,21 @@ main = testMain , testCase "string" $ (def :: Strings) @=? (def & string .~ "") , testCase "enum" $ (def :: Foo) @=? (def & enum .~ Foo'Enum1) ] - -- Enums are all pattern aliases + -- Enums are sum types, except for aliases , testGroup "enum" [ testCase "aliases are exported" $ Foo'Enum2 @=? Foo'Enum2a + , serializeTo "serializeTo enum" + (def & enum .~ Foo'Enum2 :: Foo) + "enum: Enum2" + "0\ETX" , testCase "enum values" $ do map toEnum [0, 3, 3] @=? [Foo'Enum1, Foo'Enum2, Foo'Enum2a] ["Foo'Enum1", "Foo'Enum2", "Foo'Enum2", "Foo'FooEnum'Unrecognized (Foo'FooEnum'UnrecognizedValue 5)"] @=? map show [Foo'Enum1, Foo'Enum2, Foo'Enum2a, toEnum 5] - ["Foo'Enum1", "Foo'Enum2", "Foo'Enum2", "6"] + ["Enum1", "Enum2", "Enum2", "6"] @=? map showEnum [Foo'Enum1, Foo'Enum2, Foo'Enum2a, toEnum 6] - [Just Foo'Enum1, Just Foo'Enum2, Just Foo'Enum2, Nothing, Nothing] - @=? map readEnum ["Foo'Enum1", "Foo'Enum2", "Foo'Enum2a", "4", "5"] + [Just Foo'Enum1, Just Foo'Enum2, Just Foo'Enum2, maybeToEnum 4, maybeToEnum 5] + @=? map readEnum ["Enum1", "Enum2", "Enum2a", "4", "5"] , testCase "enum patterns" $ do assertBool "enum value" $ case toEnum 3 of Foo'Enum2 -> True From 009d8a2bc00e2b6cd8a63202086452f154f81f76 Mon Sep 17 00:00:00 2001 From: Paul Kinsky Date: Tue, 31 Oct 2017 14:57:26 -0700 Subject: [PATCH 09/15] cleanup --- proto-lens-protoc/src/Data/ProtoLens/Compiler/Combinators.hs | 1 + proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs | 5 +++-- proto-lens-tests/tests/proto3.proto | 1 - 3 files changed, 4 insertions(+), 3 deletions(-) diff --git a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Combinators.hs b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Combinators.hs index 3fe73fe3..4c6cb1f4 100644 --- a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Combinators.hs +++ b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Combinators.hs @@ -361,3 +361,4 @@ string s = Syntax.String () s (show s) modifyModuleName :: (String -> String) -> ModuleName -> ModuleName modifyModuleName f (Syntax.ModuleName _ unpacked) = Syntax.ModuleName () $ f unpacked + diff --git a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs index 6170d1bc..df38a5e4 100644 --- a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs +++ b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs @@ -287,7 +287,9 @@ generateEnumDecls Proto3 info = -- = Prelude.show k -- showEnum k = Prelude.show k -- readEnum "Enum2a" = Prelude.Just Enum2a -- alias - -- readEnum k = Text.Read.readMaybe k + -- readEnum "Enum2" = Prelude.Just Enum2 + -- readEnum "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 @@ -317,7 +319,6 @@ generateEnumDecls Proto3 info = | v <- enumValues info , let n = enumValueName v , let pn = T.unpack $ enumValueDescriptor v ^. name - -- problem: descriptor != name, only name has Foo' prefix, not descriptor ] ++ [match "readEnum" [pVar "k"] $ ("Prelude.>>=" @@ paren ("Text.Read.readMaybe" @@ "k")) @@ ("Data.ProtoLens.maybeToEnum")] ] diff --git a/proto-lens-tests/tests/proto3.proto b/proto-lens-tests/tests/proto3.proto index 0e7b8a0d..1e1c77a7 100644 --- a/proto-lens-tests/tests/proto3.proto +++ b/proto-lens-tests/tests/proto3.proto @@ -16,7 +16,6 @@ message Foo { } Sub sub = 5; - enum FooEnum { option allow_alias = true; Enum1 = 0; From 145a390bb64aa497e7ed98905dc2ab693ebd855e Mon Sep 17 00:00:00 2001 From: Paul Kinsky Date: Tue, 31 Oct 2017 15:15:11 -0700 Subject: [PATCH 10/15] cleanup --- proto-lens-protoc/src/Data/ProtoLens/Compiler/Combinators.hs | 3 --- proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs | 2 +- 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Combinators.hs b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Combinators.hs index 4c6cb1f4..4055465d 100644 --- a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Combinators.hs +++ b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Combinators.hs @@ -166,9 +166,6 @@ ihApp = foldl (Syntax.IHApp ()) tyParen :: Type -> Type tyParen = Syntax.TyParen () -paren :: Exp -> Exp -paren = Syntax.Paren () - type Match = Syntax.Match () -- | A simple clause of a function binding. diff --git a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs index df38a5e4..ec9a5a5f 100644 --- a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs +++ b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs @@ -320,7 +320,7 @@ generateEnumDecls Proto3 info = , let n = enumValueName v , let pn = T.unpack $ enumValueDescriptor v ^. name ] ++ - [match "readEnum" [pVar "k"] $ ("Prelude.>>=" @@ paren ("Text.Read.readMaybe" @@ "k")) @@ ("Data.ProtoLens.maybeToEnum")] + [match "readEnum" [pVar "k"] $ "Prelude.>>=" @@ ("Text.Read.readMaybe" @@ "k") @@ "Data.ProtoLens.maybeToEnum"] ] -- instance Bounded Foo where From 1c1a18e5a2665e198413d2ecd26876539b8e1a58 Mon Sep 17 00:00:00 2001 From: Paul Kinsky Date: Tue, 31 Oct 2017 15:16:28 -0700 Subject: [PATCH 11/15] cleanup --- proto-lens-tests/src/Data/ProtoLens/TestUtil.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/proto-lens-tests/src/Data/ProtoLens/TestUtil.hs b/proto-lens-tests/src/Data/ProtoLens/TestUtil.hs index 3bd9cd12..757bce99 100644 --- a/proto-lens-tests/src/Data/ProtoLens/TestUtil.hs +++ b/proto-lens-tests/src/Data/ProtoLens/TestUtil.hs @@ -68,7 +68,6 @@ import Text.PrettyPrint testMain :: [Test] -> IO () testMain = defaultMain --- todo use this for enum msg on Foo serializeTo :: (Show a, Eq a, Message a) => String -> a -> Doc -> Builder.Builder -> Test serializeTo name x text bs = testCase name $ do From 1e0f0596100dba8ad6d05ad3c3aad6b880bdcea2 Mon Sep 17 00:00:00 2001 From: Paul Kinsky Date: Tue, 31 Oct 2017 15:53:34 -0700 Subject: [PATCH 12/15] export unrecognized value type w/o constructors --- proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs index ec9a5a5f..8e88da17 100644 --- a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs +++ b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs @@ -250,12 +250,14 @@ generateMessageDecls syntaxType env protoName info = allFields = allMessageFields syntaxType env info generateEnumExports :: SyntaxType -> EnumInfo Name -> [ExportSpec] -generateEnumExports syntaxType e = [exportAll n, exportWith n aliases] +generateEnumExports syntaxType e = [exportAll n, exportWith n aliases] ++ proto3NewType where n = unQual $ enumName e aliases = [enumValueName v | v <- enumValues e, needsManualExport v] - needsManualExport v = syntaxType == Proto3 - || isJust (enumAliasOf v) + needsManualExport v = isJust (enumAliasOf v) + proto3NewType = if syntaxType == Proto3 + then [exportVar . unQual $ enumUnrecognizedValueName e] + else [] generateEnumDecls :: SyntaxType -> EnumInfo Name -> [Decl] generateEnumDecls Proto3 info = From 68d0c768b23257002ce5ebb144af6fc94b984719 Mon Sep 17 00:00:00 2001 From: Paul Kinsky Date: Tue, 31 Oct 2017 16:00:20 -0700 Subject: [PATCH 13/15] nits --- proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs | 7 ++++--- proto-lens-tests/tests/proto3_test.hs | 3 ++- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs index 8e88da17..18b68bed 100644 --- a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs +++ b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs @@ -270,13 +270,13 @@ generateEnumDecls Proto3 info = ( (flip conDecl [] <$> constructorNames) ++ [conDecl unrecognizedName [tyCon $ unQual unrecognizedValueName]] ) - $ deriving' ["Prelude.Show", "Prelude.Eq", "Prelude.Ord, Prelude.Read"] + $ 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, Prelude.Read"] + $ deriving' ["Prelude.Eq", "Prelude.Ord", "Prelude.Show"] -- instance Data.ProtoLens.MessageEnum FooEnum where -- maybeToEnum 0 = Prelude.Just Enum1 @@ -287,7 +287,8 @@ generateEnumDecls Proto3 info = -- (FooEnum'UnrecognizedValue (Prelude.fromIntegral k))) -- showEnum (FooEnum'Unrecognized (FooEnum'UnrecognizedValue k)) -- = Prelude.show k - -- showEnum k = Prelude.show k + -- showEnum Foo'Enum2 = "Enum2" + -- showEnum Foo'Enum1 = "Enum1" -- readEnum "Enum2a" = Prelude.Just Enum2a -- alias -- readEnum "Enum2" = Prelude.Just Enum2 -- readEnum "Enum1" = Prelude.Just Enum1 diff --git a/proto-lens-tests/tests/proto3_test.hs b/proto-lens-tests/tests/proto3_test.hs index 7fb2f8ec..34106105 100644 --- a/proto-lens-tests/tests/proto3_test.hs +++ b/proto-lens-tests/tests/proto3_test.hs @@ -104,9 +104,10 @@ main = testMain , serializeTo "serializeTo enum" (def & enum .~ Foo'Enum2 :: Foo) "enum: Enum2" - "0\ETX" + $ tagged 6 $ VarInt 3 , testCase "enum values" $ do map toEnum [0, 3, 3] @=? [Foo'Enum1, Foo'Enum2, Foo'Enum2a] + fromEnum <$> (maybeToEnum 4 :: Maybe Foo'FooEnum) @=? Just 4 ["Foo'Enum1", "Foo'Enum2", "Foo'Enum2", "Foo'FooEnum'Unrecognized (Foo'FooEnum'UnrecognizedValue 5)"] @=? map show [Foo'Enum1, Foo'Enum2, Foo'Enum2a, toEnum 5] ["Enum1", "Enum2", "Enum2", "6"] From 251e93dbb949dc1144d8e1cf04a66c73973b9efe Mon Sep 17 00:00:00 2001 From: Paul Kinsky Date: Tue, 31 Oct 2017 16:09:01 -0700 Subject: [PATCH 14/15] nit --- proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs index 18b68bed..9d85749b 100644 --- a/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs +++ b/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs @@ -323,7 +323,9 @@ generateEnumDecls Proto3 info = , let n = enumValueName v , let pn = T.unpack $ enumValueDescriptor v ^. name ] ++ - [match "readEnum" [pVar "k"] $ "Prelude.>>=" @@ ("Text.Read.readMaybe" @@ "k") @@ "Data.ProtoLens.maybeToEnum"] + [match "readEnum" [pVar "k"] $ "Prelude.>>=" + @@ ("Text.Read.readMaybe" @@ "k") + @@ "Data.ProtoLens.maybeToEnum"] ] -- instance Bounded Foo where From f1fe93dbe35fd838cba5112712433122d74b1fa9 Mon Sep 17 00:00:00 2001 From: Paul Kinsky Date: Tue, 31 Oct 2017 18:04:16 -0700 Subject: [PATCH 15/15] test --- proto-lens-tests/tests/proto3_test.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/proto-lens-tests/tests/proto3_test.hs b/proto-lens-tests/tests/proto3_test.hs index 34106105..4dfc8ea0 100644 --- a/proto-lens-tests/tests/proto3_test.hs +++ b/proto-lens-tests/tests/proto3_test.hs @@ -105,6 +105,10 @@ main = testMain (def & enum .~ Foo'Enum2 :: Foo) "enum: Enum2" $ tagged 6 $ VarInt 3 + , serializeTo "serializeTo unrecognized" + (def & enum .~ toEnum 9 :: Foo) + "enum: 9" + $ tagged 6 $ VarInt 9 , testCase "enum values" $ do map toEnum [0, 3, 3] @=? [Foo'Enum1, Foo'Enum2, Foo'Enum2a] fromEnum <$> (maybeToEnum 4 :: Maybe Foo'FooEnum) @=? Just 4