Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Sumtype enums #151

Merged
merged 15 commits into from
Nov 1, 2017
4 changes: 2 additions & 2 deletions proto-lens-protoc/package.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -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:
Expand Down
4 changes: 4 additions & 0 deletions proto-lens-protoc/src/Data/ProtoLens/Compiler/Combinators.hs
Original file line number Diff line number Diff line change
Expand Up @@ -359,3 +359,7 @@ modifyModuleName :: (String -> String) -> ModuleName -> ModuleName
modifyModuleName f (Syntax.ModuleName _ unpacked) =
Syntax.ModuleName () $ f unpacked


modifyIdent :: (String -> String) -> Name -> Name
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Code structure nit: we try to define names inside the Definitions module and use them in Generate. In this case, adding new fields to EnumInfo with the Names for the unrecognized types:
https://github.com/google/proto-lens/blob/master/proto-lens-protoc/src/Data/ProtoLens/Compiler/Definitions.hs#L157

modifyIdent f (Syntax.Ident l s) = Syntax.Ident l $ f s
modifyIdent _ x = x
215 changes: 160 additions & 55 deletions proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -259,80 +259,185 @@ 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"))
]
]
-- data FooEnum = Enum1
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Formatting nit in this comment:

-- data FooEnum
--     = Enum1
--     | Enum2
--     | FooEnum'Unrecognized ...

-- | 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"]

-- 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
-- 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"]
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Can we remove the Read instance, to make sure it's not being used accidentally?

(Also because we'd like toEnum/maybeToEnum to be the only way to construct these values)

Up to you.


-- 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
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think this comment needs to be updated since you're not calling Prelude.show anymore.

-- readEnum "Enum2a" = Prelude.Just Enum2a -- alias
-- readEnum k = Text.Read.readMaybe k
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I suspect this doesn't do what you think it does, for two reasons:

  • If the value is known, we should use the constructor instead of FooEnum'Unrecognized
  • If the value is not known, I think this reads a value of type FooEnum rather than of type int.

You probably want instead something like readMaybe k >>= maybeToEnum

Also please add tests for the above cases.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

readMaybe k >>= maybeToEnum assumes that the textual representation of these enum's are Ints. I was trying to reproduce the pre-existing logic in which strings like "Enum2a", "Enum2", etc are converted into instances of the sum type. Should this function instead take strings holding ints mapping to different enum values, eg readEnum "1" -> Just Foo'Enum1?

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Oh, I see, I think I misread your code earlier.

Taking another look, we actually can't use the Show and Read instances for FooEnum to implement showEnum/readEnum. Because for nested enums like

message Bar {
  enum Foo { A = 1; }
}

we want showEnum Bar'A = "A" and readEnum "A" = Bar'A, not showEnum Bar'A = "Bar'A" and readEnum "Bar'A" = Bar'A. It could probably be described better in the docs, but readEnum/showEnum are specifically for the proto text format representation of the enum:
https://github.com/google/proto-lens/blob/master/proto-lens/src/Data/ProtoLens/Message.hs#L231

I think we should just take the string representations (not the ints like I suggested earlier), as in the code for proto2:
https://github.com/google/proto-lens/blob/master/proto-lens-protoc/src/Data/ProtoLens/Compiler/Generate.hs#L374

readEnum "Enum2" = Enum2
readEnum "Enum2a" = Enum2a
etc.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

That sounds good, but that still leaves us with no ability to serialize/deserialize unrecognized enum's. I'm assuming readEnum . showEnum == id is a property we want to maintain. If so what should showEnum Foo'FooEnum Foo'Unrecognized... result in?

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Ah, good point, we do need something sensible for showEnum at least. How about this?

showEnum Enum2 = "Enum2"
showEnum (Foo'Unrecognized (Foo'UnrecognizedValue n)) = show n

readEnum "Enum2" = Enum2
readEnum "Enum2a" = Enum2
readEnum s = Foo'Unrecognized . UnrecognizedValue <$> readMaybe s

Since in proto text format, it's fine to refer to an enum by its numeric value rather than the case name.

, 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 "maybeToEnum" [pLitInt k] $ "Prelude.Just" @@ con (unQual c)
| (c, k) <- constructorNumbers
]
, [ match "showEnum" [pApp (unQual dataName) ["k"]]
$ "Prelude.show" @@ "k"
++
[match "maybeToEnum" ["k"]
$ "Prelude.Just" @@
(con (unQual unrecognizedName)
@@ (con (unQual unrecognizedValueName)
@@ ("Prelude.fromIntegral" @@ "k")
)
)
]

, [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" ["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])
[[match "toEnum" ["k__"]
$ "Prelude.maybe" @@ errorMessageExpr @@ "Prelude.id"
@@ ("Data.ProtoLens.maybeToEnum" @@ "k__")]
, [ match "fromEnum" [pApp (unQual c) []] $ litInt k
| (c, k) <- constructorNumbers
]
++
[ match "readEnum" [pWildCard] "Prelude.Nothing"
[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"
, alias "enumFromTo" "Data.ProtoLens.Message.Enum.messageEnumFromTo"
, alias "enumFromThen" "Data.ProtoLens.Message.Enum.messageEnumFromThen"
, alias "enumFromThenTo"
"Data.ProtoLens.Message.Enum.messageEnumFromThenTo"
]

-- proto3 enums always default to zero.
-- 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]]
]
++
-- pattern Value0 :: Foo
-- pattern Value0 = Foo 0
[[match "fieldDefault" [] defaultCon]]
] ++
-- pattern Enum2a :: FooEnum
-- pattern Enum2a = Enum2
concat
[ [ patSynSig n dataType
, patSyn (pVar n)
$ pApp (unQual dataName) [pLitInt k]
[ [ patSynSig aliasName dataType
, patSyn (pVar aliasName) (pVar originalName)
]
| v <- enumValues info
, let n = enumValueName v
, let k = fromIntegral $ enumValueDescriptor v ^. number
| EnumValueInfo
{ enumValueName = aliasName
, enumAliasOf = Just originalName
} <- enumValues info
]

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

constructors :: [(Name, EnumValueDescriptorProto)]
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It's a shame this now duplicates logic from the proto2 code...not sure if there's a good way to re-combine the two. (They were split apart more in #137.)

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

constructorNumbers = map (second (fromIntegral . (^. number))) constructors

succPairs = zip constructorNames $ tail constructorNames
succDecl funName boundName thePairs =
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think succ should be equivalent to toEnum . incr . fromEnum. The implications are kind of subtle though compared to the proto2 semantics listed here: https://github.com/google/proto-lens/blob/master/proto-lens/src/Data/ProtoLens/Message/Enum.hs#L2
If we do make that change, we should note in Data.ProtoLens.Message.Enum that it only applies to proto2.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Sounds good. Is not erroring on succ maxEnum and instead returning SomeEnum'UnrecognizedValue... (fromEnum maxEnum + 1) the desired behavior here?

Do you also want me to redefine pred as toEnum . (-1) . fromEnum? Or should pred minEnum still result in an error?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think this would break things, eg for FooEnum as defined in proto3.proto:

  enum FooEnum {
    option allow_alias = true;
    Enum1 = 0;
    Enum2 = 3;
    Enum2a = 3;
  }

it seems like we want succ Enum1 == Enum2, not succ Enum1 == Foo'FooEnum'Unrecognized (Foo'FooEnum'UnrecognizedValue 2)

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
]
++
[match funName [pWildCard]
("Prelude.error" @@ stringExp (concat
[ prettyPrint dataName, ".", prettyPrint funName, ": bad argument: unrecognized value"
]))
]

generateEnumDecls Proto2 info =
[ dataDecl dataName
[conDecl n [] | n <- constructorNames]
Expand Down
13 changes: 7 additions & 6 deletions proto-lens-tests/tests/proto3.proto
Original file line number Diff line number Diff line change
Expand Up @@ -16,17 +16,18 @@ message Foo {
}
Sub sub = 5;

enum FooEnum {
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

What was the reason for changing this test? My preference is to add a new test case if we want to support the different situation. (Or, at minimum, add another test that does check naming of nested enums.)

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think that was due to a transient issue, I've reverted this change.

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;
Expand Down
20 changes: 10 additions & 10 deletions proto-lens-tests/tests/proto3_test.hs
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,7 @@ import qualified Data.ByteString.Builder as Builder
import Data.Monoid ((<>))
import Proto.Proto3
( Foo
, Foo'FooEnum(..)
, FooEnum(..)
, Foo'Sub(..)
, Strings
)
Expand Down Expand Up @@ -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", "FooEnum'Unrecognized (FooEnum'UnrecognizedValue 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

]
Expand Down