Sumtype enums #151
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
|
|
@@ -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", "Text.Read" | ||
| ] | ||
| ++ map importSimple imports | ||
| env = Map.union (unqualifyEnv definitions) importedEnv | ||
|
|
@@ -259,80 +259,193 @@ 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 [tyCon $ unQual unrecognizedValueName]] | ||
| ) | ||
| $ 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 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 | ||
|
There was a problem hiding this comment. I think this comment needs to be updated since you're not calling |
||
| -- readEnum "Enum2a" = Prelude.Just Enum2a -- alias | ||
| -- 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 | ||
| ] | ||
| ++ | ||
| [match "maybeToEnum" ["k"] | ||
| $ "Prelude.Just" @@ | ||
| (con (unQual unrecognizedName) | ||
| @@ (con (unQual unrecognizedValueName) | ||
| @@ ("Prelude.fromIntegral" @@ "k") | ||
| ) | ||
| ) | ||
| ] | ||
| , [ 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 "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.>>=" @@ paren ("Text.Read.readMaybe" @@ "k")) @@ ("Data.ProtoLens.maybeToEnum")] | ||
|
There was a problem hiding this comment. Break this line which has gotten pretty long. |
||
| ] | ||
|
|
||
| -- 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 "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" | ||
| ] | ||
|
|
||
| -- instance Data.Default.Class.Default Foo where | ||
| -- def = FirstEnumValue | ||
| , instDecl [] ("Data.Default.Class.Default" `ihApp` [dataType]) | ||
| [[match "def" [] defaultCon]] | ||
| -- instance Data.ProtoLens.FieldDefault Foo where | ||
| -- fieldDefault = FirstEnumValue | ||
| , instDecl [] ("Data.ProtoLens.FieldDefault" `ihApp` [dataType]) | ||
| [[match "fieldDefault" [] defaultCon]] | ||
| ] ++ | ||
| -- pattern Enum2a :: FooEnum | ||
| -- pattern Enum2a = Enum2 | ||
| concat | ||
| [ [ patSynSig aliasName dataType | ||
| , patSyn (pVar aliasName) (pVar originalName) | ||
| ] | ||
| | EnumValueInfo | ||
| { enumValueName = aliasName | ||
| , enumAliasOf = Just originalName | ||
| } <- enumValues info | ||
| ] | ||
|
|
||
| where | ||
| EnumInfo { enumName = dataName | ||
| , enumUnrecognizedName = unrecognizedName | ||
| , enumUnrecognizedValueName = unrecognizedValueName | ||
| , 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 | ||
|
|
||
|
|
||
|
|
||
| constructors :: [(Name, EnumValueDescriptorProto)] | ||
|
There was a problem hiding this comment. 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 = | ||
|
There was a problem hiding this comment. I think There was a problem hiding this comment. Sounds good. Is not erroring on Do you also want me to redefine There was a problem hiding this comment. I think this would break things, eg for it seems like we want |
||
| 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] | ||
|
|
||
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Can we remove the
Readinstance, to make sure it's not being used accidentally?(Also because we'd like
toEnum/maybeToEnumto be the only way to construct these values)Up to you.