From fb1d1c69c33715c1c18120b496055912ecaac0ab Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Tue, 14 Nov 2023 00:06:59 +0100 Subject: [PATCH 01/55] add cabal build --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 76467e6..11f8a4f 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,3 @@ .stack-work/ *~ +dist-newstyle From f6dea68a225b16cfe75eda1400ab9eb749a800fc Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Wed, 15 Nov 2023 21:54:03 +0100 Subject: [PATCH 02/55] simplify enum reserved parser --- app/Main.hs | 5 +++- src/ProtoParser/Enum.hs | 64 +++++++++++++++++------------------------ test/Unit/Enum.hs | 18 ++++++------ 3 files changed, 39 insertions(+), 48 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index d6f7ccb..d37d932 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -5,6 +5,9 @@ import Text.Parsec (parse) main :: IO () main = do - case parse enumField "" "reserved 1, 2" of + -- case parse enumField "" "reserved \"FOO\",\"FOO\"" of + -- case parse enumField "" "reserved 1" of + case parse reservedNumbers "" "4294967294 to max" of + -- case parse enumField "" "reserved 4294967294 to max" of Left err -> print err Right res -> print res diff --git a/src/ProtoParser/Enum.hs b/src/ProtoParser/Enum.hs index 464b8fb..e9ffc4e 100644 --- a/src/ProtoParser/Enum.hs +++ b/src/ProtoParser/Enum.hs @@ -29,13 +29,13 @@ protoEnum = do else do whitespace _ <- char '}' - -- TODO: check enum values for correctness (numbers and names) + -- TODO: check enum values for correctness (numbers and names) -> in extra function traversing finished proto data return (Protobuf.Enum name (catMaybes values)) enumField :: Parser (Maybe EnumField) enumField = do skipMany space - isEnd <- option False (try (lookAhead (char '}')) >> return True) + isEnd <- option False (lookAhead (char '}') >> return True) if isEnd then return Nothing else do @@ -70,7 +70,7 @@ enumOption = do enumReserved :: Parser (Maybe EnumField) enumReserved = do whitespace - reservedValues <- (reservedNames `sepBy1` char ',') <|> (reservedNumbers `sepBy1` char ',') + reservedValues <- (try reservedNames <|> try reservedNumbers) `sepEndBy` char ',' isParsedCorrect <- option True (try (lookAhead enumNumber) >> return False) <|> (try (lookAhead protoName) >> return False) if not isParsedCorrect then fail "Expected either numbers or names, end of enum or separator" @@ -101,43 +101,31 @@ enumReserved = do reservedNames :: Parser EnumReservedValues reservedNames = do - isEnd <- option False ((try (lookAhead (char ';')) >> return True) <|> (try (lookAhead eof) >> return True)) - if isEnd - then return (Names []) - else do - _ <- many space - _ <- char '\"' - name <- protoName - _ <- char '\"' - return (Names [name]) + _ <- many space + _ <- char '\"' + name <- protoName + _ <- char '\"' + return (Names [name]) + +reservedNumbersSingle :: Parser EnumReservedValues +reservedNumbersSingle = do + _ <- many space + firstNumber <- enumNumber + _ <- many space + return (Numbers [firstNumber]) + +reservedNumbersRange :: Parser EnumReservedValues +reservedNumbersRange = do + let numValues = try enumNumber <|> try (string "min" >> return 0) <|> try (string "max" >> return 0xFFFFFFFF) + firstNumber <- numValues + _ <- many space + _ <- string "to" + _ <- many space + secondNumber <- numValues + return (Numbers [firstNumber .. secondNumber]) reservedNumbers :: Parser EnumReservedValues -reservedNumbers = do - -- TODO: min only works with 'to' ranges ! now it works with all of them - let numValue = try enumNumber <|> try (string "min" >> return 0) <|> try (string "max" >> return 0xFFFFFFFF) -- TODO: use bound - endLookAhead = option False ((try (lookAhead (char ';')) >> return True) <|> (try (lookAhead eof) >> return True)) - -- TODO: notFollowedBy - isEnd <- endLookAhead - if isEnd - then return (Numbers []) - else do - skipMany space - firstNumber <- numValue - skipMany space - isEnd' <- endLookAhead - if isEnd' - then return (Numbers [firstNumber]) - else do - isRange <- option False (try (lookAhead (string "to") >> return True) "'to' keyword or ','") - if isRange - then do - skipMany space - _ <- string "to" - skipMany space - secondNumber <- numValue - return (Numbers [firstNumber .. secondNumber]) - else do - return (Numbers [firstNumber]) +reservedNumbers = try reservedNumbersRange <|> try reservedNumbersSingle enumNumber :: Parser EnumNumber enumNumber = diff --git a/test/Unit/Enum.hs b/test/Unit/Enum.hs index 9dc07c7..fea3afd 100644 --- a/test/Unit/Enum.hs +++ b/test/Unit/Enum.hs @@ -16,9 +16,9 @@ allTests = ---------------------------------------------------------------- testReservedNumbers :: Test testReservedNumbers = TestCase $ do - assertEqual "reservedNumbers" (Numbers []) (fromRight (Numbers [42]) (parse reservedNumbers "" "")) - assertEqual "reservedNumbers" (Numbers [0]) (fromRight (Numbers []) (parse reservedNumbers "" "0")) - assertEqual "reservedNumbersRange" (Numbers [0, 1, 2]) (fromRight (Numbers []) (parse reservedNumbers "" "min to 2")) + assertEqual "empty" False (isRight (parse reservedNumbers "" "")) + assertEqual "single" (Numbers [0]) (fromRight (Numbers []) (parse reservedNumbers "" "0")) + assertEqual "range" (Numbers [0, 1, 2]) (fromRight (Numbers []) (parse reservedNumbers "" "min to 2")) ---------------------------------------------------------------- @@ -34,18 +34,18 @@ testEnumFieldParser = TestCase $ do -- reserved number -- assertEqual "empytReserved" False (isRight (parse enumField "" "reserved")) assertEqual "outOfRangeSingleReserved" False (isRight (parse enumField "" "reserved -1")) - assertEqual "mulitReserved" (Just (EnumReserved (Numbers [1, 2]))) (fromRight emptyDefault (parse enumField "" "reserved 1, 2")) - assertEqual "mulitReserved" (Just (EnumReserved (Numbers [1, 3, 5]))) (fromRight emptyDefault (parse enumField "" "reserved 1, 3, 5")) - assertEqual "mulitReserved" (Just (EnumReserved (Numbers [1, 2, 3]))) (fromRight emptyDefault (parse enumField "" "reserved 1 to 3")) - assertEqual "mulitReserved" (Just (EnumReserved (Numbers [0, 1, 2, 3]))) (fromRight emptyDefault (parse enumField "" "reserved min to 3")) - assertEqual "mulitReserved" (Just (EnumReserved (Numbers [4294967294, 0xFFFFFFFF]))) (fromRight emptyDefault (parse enumField "" "reserved 4294967294 to max")) + assertEqual "multiReserved" (Just (EnumReserved (Numbers [1, 2]))) (fromRight emptyDefault (parse enumField "" "reserved 1, 2")) + assertEqual "multiReserved" (Just (EnumReserved (Numbers [1, 3, 5]))) (fromRight emptyDefault (parse enumField "" "reserved 1, 3, 5")) + assertEqual "multiReserved" (Just (EnumReserved (Numbers [1, 2, 3]))) (fromRight emptyDefault (parse enumField "" "reserved 1 to 3")) + assertEqual "multiReserved" (Just (EnumReserved (Numbers [0, 1, 2, 3]))) (fromRight emptyDefault (parse enumField "" "reserved min to 3")) + assertEqual "multiReserved" (Just (EnumReserved (Numbers [4294967294, 0xFFFFFFFF]))) (fromRight emptyDefault (parse enumField "" "reserved 4294967294 to max")) assertEqual "singleReserved" (Just (EnumReserved (Numbers [0]))) (fromRight emptyDefault (parse enumField "" "reserved 0")) assertEqual "singleReserved" (Just (EnumReserved (Numbers [1]))) (fromRight emptyDefault (parse enumField "" "reserved 1")) assertEqual "reservedIncorrectNumberFormat" False (isRight (parse enumField "" "reserved 1 2")) -- reserved name -- assertEqual "emptyReservedName" False (isRight (parse enumField "" "reserved")) assertEqual "singleReservedName" (Just (EnumReserved (Names ["FOO"]))) (fromRight emptyDefault (parse enumField "" "reserved \"FOO\"")) - assertEqual "mulitReservedName" (Just (EnumReserved (Names ["FOO", "BAR"]))) (fromRight emptyDefault (parse enumField "" "reserved \"FOO\", \"BAR\"")) + assertEqual "multiReservedName" (Just (EnumReserved (Names ["FOO", "BAR"]))) (fromRight emptyDefault (parse enumField "" "reserved \"FOO\", \"BAR\"")) -- option -- assertEqual "empyt" False (isRight (parse enumField "" "option invalid_option = true")) assertEqual "invalidOption" (Just (EnumOption "allow_alias" True)) (fromRight emptyDefault (parse enumField "" "option allow_alias = true")) From e0fc585875c0cf465d26b92a957249486cf6a874 Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Sat, 18 Nov 2023 10:55:31 +0100 Subject: [PATCH 03/55] add comments and imports --- app/Main.hs | 5 +++-- protobuf-parser.cabal | 5 +++++ src/ProtoParser.hs | 26 ++++++++++++++++++++++++++ src/ProtoParser/Comment.hs | 27 +++++++++++++++++++++++++++ src/ProtoParser/Import.hs | 20 ++++++++++++++++++++ src/ProtoParser/Misc.hs | 20 +++++++++++++++++++- src/Protobuf.hs | 6 +++++- test/Spec.hs | 13 ++++++++++--- test/Unit/Comment.hs | 36 ++++++++++++++++++++++++++++++++++++ test/Unit/Enum.hs | 15 +++++++++++++-- test/Unit/Import.hs | 32 ++++++++++++++++++++++++++++++++ test/Unit/Misc.hs | 12 +----------- test/Unit/ProtoParser.hs | 16 ++++++++++++++++ 13 files changed, 213 insertions(+), 20 deletions(-) create mode 100644 src/ProtoParser/Comment.hs create mode 100644 src/ProtoParser/Import.hs create mode 100644 test/Unit/Comment.hs create mode 100644 test/Unit/Import.hs create mode 100644 test/Unit/ProtoParser.hs diff --git a/app/Main.hs b/app/Main.hs index d37d932..9e0b113 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,13 +1,14 @@ module Main (main) where import ProtoParser +import ProtoParser.Comment import Text.Parsec (parse) main :: IO () main = do -- case parse enumField "" "reserved \"FOO\",\"FOO\"" of -- case parse enumField "" "reserved 1" of - case parse reservedNumbers "" "4294967294 to max" of - -- case parse enumField "" "reserved 4294967294 to max" of + case parse parseMultiLineComment "" "/* comment */" of + -- case parse enumField "" "reserved 4294967294 to max" of Left err -> print err Right res -> print res diff --git a/protobuf-parser.cabal b/protobuf-parser.cabal index 3f6c255..cbe57b9 100644 --- a/protobuf-parser.cabal +++ b/protobuf-parser.cabal @@ -27,7 +27,9 @@ library exposed-modules: Protobuf ProtoParser + ProtoParser.Comment ProtoParser.Enum + ProtoParser.Import ProtoParser.Misc other-modules: Paths_protobuf_parser @@ -60,8 +62,11 @@ test-suite protobuf-parser-test type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: + Unit.Comment Unit.Enum + Unit.Import Unit.Misc + Unit.ProtoParser Paths_protobuf_parser autogen-modules: Paths_protobuf_parser diff --git a/src/ProtoParser.hs b/src/ProtoParser.hs index c4067d0..40b4e44 100644 --- a/src/ProtoParser.hs +++ b/src/ProtoParser.hs @@ -1,8 +1,34 @@ +-- TODO: export only the necessary functions module ProtoParser ( module ProtoParser.Enum, module ProtoParser.Misc, + module ProtoParser.Import, + parseProtobuf, ) where import ProtoParser.Enum +import ProtoParser.Import import ProtoParser.Misc +import ProtoParser.Comment +import Protobuf +import Text.Parsec +import Text.Parsec.String + +parseProtobuf :: String -> (Either ParseError Protobuf) +parseProtobuf = parse parseProtobuf' "" + +parseProtobuf' :: Parser Protobuf +parseProtobuf' = do + _x <- parseImport + -- TODO: how to add multiple parser outputs? + return + ( Protobuf + { package = "", + imports = [], + options = [], + enums = [], + messages = [], + services = [] + } + ) diff --git a/src/ProtoParser/Comment.hs b/src/ProtoParser/Comment.hs new file mode 100644 index 0000000..3a4c1e4 --- /dev/null +++ b/src/ProtoParser/Comment.hs @@ -0,0 +1,27 @@ +module ProtoParser.Comment + ( parseComment, + parseSingleLineComment, + parseMultiLineComment, + ) +where + +import ProtoParser.Misc (eol) +import Protobuf (Comment) +import Text.Parsec +import Text.Parsec.String + +parseComment :: Parser Comment +parseComment = do + -- TODO: correct way to try? + try parseSingleLineComment <|> try parseMultiLineComment + +-- TODO: these comments could be anywhere +parseSingleLineComment :: Parser Comment +parseSingleLineComment = do + between (string "//") eol (many anyChar) + +-- TODO: these comments could be anywhere (same as spaces) +parseMultiLineComment :: Parser Comment +parseMultiLineComment = try $ do + _ <- string "/*" + manyTill anyChar (try (string "*/")) diff --git a/src/ProtoParser/Import.hs b/src/ProtoParser/Import.hs new file mode 100644 index 0000000..c572084 --- /dev/null +++ b/src/ProtoParser/Import.hs @@ -0,0 +1,20 @@ +module ProtoParser.Import (parseImport) where + +import ProtoParser.Misc (spaces1) +import Protobuf (ImportPath) +import Text.Parsec +import Text.Parsec.String + +pathExtension :: String +pathExtension = ".proto" + +parseImport :: Parser ImportPath +parseImport = do + skipMany space + _ <- string "import" "Expected import keyword" + spaces1 + _ <- char '"' "Expected '\"' after import keyword" + path <- anyChar `manyTill` (string (pathExtension ++ "\"")) + spaces + _ <- char ';' "Expected ';' at end of import statement" + return (path ++ pathExtension) diff --git a/src/ProtoParser/Misc.hs b/src/ProtoParser/Misc.hs index a442761..f526239 100644 --- a/src/ProtoParser/Misc.hs +++ b/src/ProtoParser/Misc.hs @@ -1,4 +1,11 @@ -module ProtoParser.Misc (whitespace, protoName, protoNumber) where +module ProtoParser.Misc + ( whitespace, + protoName, + protoNumber, + spaces1, + eol, + ) +where import Control.Monad (void) import Protobuf @@ -10,6 +17,11 @@ whitespace = void (many (oneOf " \n\t")) "whitespace" ---------------------------------------------------------------- +spaces1 :: Parser () +spaces1 = skipMany1 space + +---------------------------------------------------------------- + protoName :: Parser String protoName = do first <- letter "Expected first letter to be ...?" @@ -31,3 +43,9 @@ protoNumber = if n >= 1 && n <= 536870911 -- Range from 1 to 536,870,911 then return n else fail "number out of range" + +---------------------------------------------------------------- + +-- TODO : test +eol :: Parser () +eol = void (char '\n') <|> eof diff --git a/src/Protobuf.hs b/src/Protobuf.hs index 756e14d..a07a316 100644 --- a/src/Protobuf.hs +++ b/src/Protobuf.hs @@ -18,6 +18,10 @@ type EnumName = String type RPCName = String +type ImportPath = String + +type Comment = String + data IntType = Int32 | Int64 @@ -80,7 +84,7 @@ data Option = Option Name Value data Protobuf = Protobuf { package :: String, - imports :: [String], + imports :: [ImportPath], options :: [Option], enums :: [Protobuf.Enum], messages :: [Message], diff --git a/test/Spec.hs b/test/Spec.hs index 8a5ab2e..215abb5 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,11 +1,18 @@ import Test.HUnit (Test (TestList), runTestTTAndExit) -import Unit.Enum as Unit (allTests) -import Unit.Misc as Misc (allTests) +import Unit.Enum as Unit +import Unit.Import as Import +import Unit.Misc as Misc +import Unit.ProtoParser as Protobuf +import Unit.Comment as Comment main :: IO () main = runTestTTAndExit ( TestList - ( Unit.allTests ++ Misc.allTests + ( Unit.allTests + ++ Misc.allTests + ++ Import.allTests + ++ Protobuf.allTests + ++ Comment.allTests ) ) diff --git a/test/Unit/Comment.hs b/test/Unit/Comment.hs new file mode 100644 index 0000000..b64cc9b --- /dev/null +++ b/test/Unit/Comment.hs @@ -0,0 +1,36 @@ +module Unit.Comment (allTests) where + +import Data.Either (fromRight, isRight) +import ProtoParser.Comment +import Test.HUnit +import Text.Parsec (parse) + +allTests :: [Test] +allTests = + [ TestLabel "testSingleLine" testSingleLineComment, + TestLabel "testMultiLine" testMultiLineComment, + TestLabel "both" testMultiLineComment + ] + +testSingleLineComment :: Test +testSingleLineComment = TestCase $ do + assertEqual "empty" False (isRight (parse parseSingleLineComment "" "")) + assertEqual "too few '/'" False (isRight (parse parseSingleLineComment "" "/ comment")) + assertEqual "Simple Comment" " comment" (fromRight "incorrect" (parse parseSingleLineComment "" "// comment")) + assertEqual "No Space" "comment" (fromRight "incorrect" (parse parseSingleLineComment "" "//comment")) + assertEqual "Trailing Space" "comment " (fromRight "incorrect" (parse parseSingleLineComment "" "//comment ")) + +---------------------------------------------------------------- +testMultiLineComment :: Test +testMultiLineComment = TestCase $ do + assertEqual "empty" False (isRight (parse parseMultiLineComment "" "")) + assertEqual "too few '/'" False (isRight (parse parseMultiLineComment "" "/* comment")) + assertEqual "Space between" " comment " (fromRight "incorrect" (parse parseMultiLineComment "" "/* comment */")) + assertEqual "No Space" "comment" (fromRight "incorrect" (parse parseMultiLineComment "" "/*comment*/")) + assertEqual "Multi Line Comment" " 1\n2 " (fromRight "incorrect" (parse parseMultiLineComment "" "/* 1\n2 */")) + +testBothComments :: Test +testBothComments = TestCase $ do + assertEqual "empty" False (isRight (parse parseComment "" "")) + assertEqual "Single Line" " comment" (fromRight "incorrect" (parse parseComment "" "// comment")) + assertEqual "Multi Line" " comment " (fromRight "incorrect" (parse parseComment "" "/* comment */")) diff --git a/test/Unit/Enum.hs b/test/Unit/Enum.hs index fea3afd..ce60efb 100644 --- a/test/Unit/Enum.hs +++ b/test/Unit/Enum.hs @@ -1,7 +1,7 @@ module Unit.Enum (allTests) where import Data.Either (fromRight, isRight) -import ProtoParser +import ProtoParser.Enum import Protobuf import Test.HUnit import Text.Parsec (parse) @@ -10,7 +10,8 @@ allTests :: [Test] allTests = [ TestLabel "enumFieldParser" testEnumFieldParser, TestLabel "enumParser" testEnumParser, - TestLabel "reservedNumbers" testReservedNumbers + TestLabel "reservedNumbers" testReservedNumbers, + TestLabel "fieldNumbers" testEnumFieldNumbers ] ---------------------------------------------------------------- @@ -84,3 +85,13 @@ testEnumParser = TestCase $ do -- (string_name) = "display_value" -- ]; -- } + +testEnumFieldNumbers :: Test +testEnumFieldNumbers = TestCase $ do + assertEqual "belowMin" False (isRight (parse enumNumber "" "-1")) + assertEqual "min" 0 (fromRight 1 (parse enumNumber "" "0")) + assertEqual "max" 0xFFFFFFFF (fromRight 0 (parse enumNumber "" "4294967295")) + +-- TODO: not correct number +-- assertEqual "aboveMax" (False) (isRight (parse enumNumber "" "4294967296")) +---------------------------------------------------------------- diff --git a/test/Unit/Import.hs b/test/Unit/Import.hs new file mode 100644 index 0000000..6115e76 --- /dev/null +++ b/test/Unit/Import.hs @@ -0,0 +1,32 @@ +module Unit.Import (allTests) where + +import Data.Either (fromRight, isRight) +import ProtoParser.Import +import Protobuf (ImportPath) +import Test.HUnit +import Text.Parsec (parse) + +allTests :: [Test] +allTests = + [ TestLabel "import" testImport + ] + +testDefault :: ImportPath +testDefault = "TestDefault" + +simplePath :: ImportPath +simplePath = "path.proto" + +complexPath :: ImportPath +complexPath = "google/protobuf/descriptor.proto" + +testImport :: Test +testImport = TestCase $ do + assertEqual "empty" False (isRight (parse parseImport "" "")) + assertEqual "missing path" False (isRight (parse parseImport "" "import")) + assertEqual "missing 'proto;'" False (isRight (parse parseImport "" "import \"path\"")) + assertEqual "missing 'proto'" False (isRight (parse parseImport "" "import \"path\";")) + assertEqual "missing ';'" False (isRight (parse parseImport "" "import \"path.proto\"")) + assertEqual "missing proto" simplePath (fromRight testDefault (parse parseImport "" ("import \"" ++ simplePath ++ "\";"))) + assertEqual "simple path" simplePath (fromRight testDefault (parse parseImport "" ("import \"" ++ simplePath ++ "\";"))) + assertEqual "complex path" complexPath (fromRight testDefault (parse parseImport "" ("import \"" ++ complexPath ++ "\";"))) diff --git a/test/Unit/Misc.hs b/test/Unit/Misc.hs index c075eea..9a1c1fd 100644 --- a/test/Unit/Misc.hs +++ b/test/Unit/Misc.hs @@ -1,14 +1,13 @@ module Unit.Misc (allTests) where import Data.Either (fromRight, isRight) -import ProtoParser +import ProtoParser.Misc import Test.HUnit import Text.Parsec (parse) allTests :: [Test] allTests = [ TestLabel "numberParser" testNumberParser, - TestLabel "enumNumberParser" testEnumNumberParser, TestLabel "protoName" testProtoName ] @@ -39,12 +38,3 @@ testProtoName = TestCase $ do assertEqual "UpperCamelCase" "TestTest" (fromRight "Default" (parse protoName "" "TestTest")) ---------------------------------------------------------------- -testEnumNumberParser :: Test -testEnumNumberParser = TestCase $ do - assertEqual "belowMin" False (isRight (parse enumNumber "" "-1")) - assertEqual "min" 0 (fromRight 1 (parse enumNumber "" "0")) - assertEqual "max" 0xFFFFFFFF (fromRight 0 (parse enumNumber "" "4294967295")) - --- TODO: not correct number --- assertEqual "aboveMax" (False) (isRight (parse enumNumber "" "4294967296")) ----------------------------------------------------------------- diff --git a/test/Unit/ProtoParser.hs b/test/Unit/ProtoParser.hs new file mode 100644 index 0000000..00f8000 --- /dev/null +++ b/test/Unit/ProtoParser.hs @@ -0,0 +1,16 @@ +module Unit.ProtoParser (allTests) where + +import Data.Either (fromRight, isRight) +import ProtoParser +import Protobuf +import Test.HUnit +import Text.Parsec (parse) + +allTests :: [Test] +allTests = + [ TestLabel "text" testText + ] + +testText :: Test +testText = TestCase $ do + assertEqual "empty" False (isRight (parseProtobuf "")) From 0be924a937051147ebd96a231536d474179ded16 Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Sat, 18 Nov 2023 12:38:07 +0100 Subject: [PATCH 04/55] add base structure for message and package --- app/Main.hs | 4 ++-- protobuf-parser.cabal | 4 ++++ src/ProtoParser.hs | 11 +++++++++-- src/ProtoParser/Import.hs | 2 +- src/ProtoParser/Message.hs | 10 ++++++++++ src/ProtoParser/Misc.hs | 4 ++++ src/ProtoParser/Package.hs | 13 +++++++++++++ src/Protobuf.hs | 2 ++ test/Spec.hs | 6 +++++- test/Unit/Message.hs | 16 ++++++++++++++++ test/Unit/Package.hs | 20 ++++++++++++++++++++ 11 files changed, 86 insertions(+), 6 deletions(-) create mode 100644 src/ProtoParser/Message.hs create mode 100644 src/ProtoParser/Package.hs create mode 100644 test/Unit/Message.hs create mode 100644 test/Unit/Package.hs diff --git a/app/Main.hs b/app/Main.hs index 9e0b113..1b28d97 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,14 +1,14 @@ module Main (main) where import ProtoParser -import ProtoParser.Comment +import ProtoParser.Package import Text.Parsec (parse) main :: IO () main = do -- case parse enumField "" "reserved \"FOO\",\"FOO\"" of -- case parse enumField "" "reserved 1" of - case parse parseMultiLineComment "" "/* comment */" of + case parse parsePackage "" "package foo;" of -- case parse enumField "" "reserved 4294967294 to max" of Left err -> print err Right res -> print res diff --git a/protobuf-parser.cabal b/protobuf-parser.cabal index cbe57b9..7cf6898 100644 --- a/protobuf-parser.cabal +++ b/protobuf-parser.cabal @@ -30,7 +30,9 @@ library ProtoParser.Comment ProtoParser.Enum ProtoParser.Import + ProtoParser.Message ProtoParser.Misc + ProtoParser.Package other-modules: Paths_protobuf_parser autogen-modules: @@ -65,7 +67,9 @@ test-suite protobuf-parser-test Unit.Comment Unit.Enum Unit.Import + Unit.Message Unit.Misc + Unit.Package Unit.ProtoParser Paths_protobuf_parser autogen-modules: diff --git a/src/ProtoParser.hs b/src/ProtoParser.hs index 40b4e44..f738ff1 100644 --- a/src/ProtoParser.hs +++ b/src/ProtoParser.hs @@ -3,21 +3,28 @@ module ProtoParser ( module ProtoParser.Enum, module ProtoParser.Misc, module ProtoParser.Import, + module ProtoParser.Comment, + module ProtoParser.Message, + module ProtoParser.Package, parseProtobuf, ) where +import ProtoParser.Comment import ProtoParser.Enum import ProtoParser.Import +import ProtoParser.Message import ProtoParser.Misc -import ProtoParser.Comment +import ProtoParser.Package import Protobuf import Text.Parsec import Text.Parsec.String -parseProtobuf :: String -> (Either ParseError Protobuf) +parseProtobuf :: String -> Either ParseError Protobuf parseProtobuf = parse parseProtobuf' "" +-- TODO : check for too many ';' + parseProtobuf' :: Parser Protobuf parseProtobuf' = do _x <- parseImport diff --git a/src/ProtoParser/Import.hs b/src/ProtoParser/Import.hs index c572084..630c3f8 100644 --- a/src/ProtoParser/Import.hs +++ b/src/ProtoParser/Import.hs @@ -14,7 +14,7 @@ parseImport = do _ <- string "import" "Expected import keyword" spaces1 _ <- char '"' "Expected '\"' after import keyword" - path <- anyChar `manyTill` (string (pathExtension ++ "\"")) + path <- anyChar `manyTill` string (pathExtension ++ "\"") spaces _ <- char ';' "Expected ';' at end of import statement" return (path ++ pathExtension) diff --git a/src/ProtoParser/Message.hs b/src/ProtoParser/Message.hs new file mode 100644 index 0000000..ba97c97 --- /dev/null +++ b/src/ProtoParser/Message.hs @@ -0,0 +1,10 @@ +module ProtoParser.Message (parseMessage) where + +import ProtoParser.Misc (spaces1) +import Protobuf (Message (..), MessageField) +import Text.Parsec +import Text.Parsec.String + +parseMessage :: Parser Message +parseMessage = do + return (Message " " []) diff --git a/src/ProtoParser/Misc.hs b/src/ProtoParser/Misc.hs index f526239..b923861 100644 --- a/src/ProtoParser/Misc.hs +++ b/src/ProtoParser/Misc.hs @@ -49,3 +49,7 @@ protoNumber = -- TODO : test eol :: Parser () eol = void (char '\n') <|> eof + +---------------------------------------------------------------- + +-- TODO: maps diff --git a/src/ProtoParser/Package.hs b/src/ProtoParser/Package.hs new file mode 100644 index 0000000..55b89ca --- /dev/null +++ b/src/ProtoParser/Package.hs @@ -0,0 +1,13 @@ +module ProtoParser.Package (parsePackage) where + +import ProtoParser.Misc (spaces1) +import Protobuf (Package) +import Text.Parsec +import Text.Parsec.String + +parsePackage :: Parser Package +parsePackage = do + skipMany space + _ <- string "package" "Expected package keyword" + spaces1 + anyChar `manyTill` char ';' "Expected package name followed by ';'" diff --git a/src/Protobuf.hs b/src/Protobuf.hs index a07a316..a2a4774 100644 --- a/src/Protobuf.hs +++ b/src/Protobuf.hs @@ -22,6 +22,8 @@ type ImportPath = String type Comment = String +type Package = String + data IntType = Int32 | Int64 diff --git a/test/Spec.hs b/test/Spec.hs index 215abb5..20762b7 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,9 +1,11 @@ import Test.HUnit (Test (TestList), runTestTTAndExit) +import Unit.Comment as Comment import Unit.Enum as Unit import Unit.Import as Import +import Unit.Message as Message import Unit.Misc as Misc +import Unit.Package as Package import Unit.ProtoParser as Protobuf -import Unit.Comment as Comment main :: IO () main = @@ -14,5 +16,7 @@ main = ++ Import.allTests ++ Protobuf.allTests ++ Comment.allTests + ++ Message.allTests + ++ Package.allTests ) ) diff --git a/test/Unit/Message.hs b/test/Unit/Message.hs new file mode 100644 index 0000000..c17084a --- /dev/null +++ b/test/Unit/Message.hs @@ -0,0 +1,16 @@ +module Unit.Message (allTests) where + +import Data.Either (fromRight, isRight) +import ProtoParser.Message +import Protobuf (Message (..), MessageField) +import Test.HUnit +import Text.Parsec (parse) + +allTests :: [Test] +allTests = + [ TestLabel "simple" testSimple + ] + +testSimple :: Test +testSimple = TestCase $ do + assertEqual "placeholder" True (isRight (parse parseMessage "" "")) diff --git a/test/Unit/Package.hs b/test/Unit/Package.hs new file mode 100644 index 0000000..7db8385 --- /dev/null +++ b/test/Unit/Package.hs @@ -0,0 +1,20 @@ +module Unit.Package (allTests) where + +import Data.Either (fromRight, isRight) +import ProtoParser.Package +import Protobuf (Package) +import Test.HUnit +import Text.Parsec (parse) + +allTests :: [Test] +allTests = + [ TestLabel "package" testPackage + ] + +testPackage :: Test +testPackage = TestCase $ do + assertEqual "empty" False (isRight (parse parsePackage "" "")) + assertEqual "missing package name" False (isRight (parse parsePackage "" "package")) + assertEqual "missing ';'" False (isRight (parse parsePackage "" "package foo.bar")) + assertEqual "Simple" "foo" (fromRight "incorrect" (parse parsePackage "" "package foo;")) + assertEqual "Complex" "foo.bar" (fromRight "incorrect" (parse parsePackage "" "package foo.bar;")) From 5ded598598a03c3e8f87673533b72c221b946ca6 Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Sat, 18 Nov 2023 19:42:40 +0100 Subject: [PATCH 05/55] parse empty message --- app/Main.hs | 2 +- src/ProtoParser/Message.hs | 29 ++++++++++++++++++++++++++--- src/Protobuf.hs | 2 +- test/Unit/Message.hs | 10 ++++++++-- 4 files changed, 36 insertions(+), 7 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 1b28d97..833a2d6 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -8,7 +8,7 @@ main :: IO () main = do -- case parse enumField "" "reserved \"FOO\",\"FOO\"" of -- case parse enumField "" "reserved 1" of - case parse parsePackage "" "package foo;" of + case parse parseMessage "" "message Foo {}" of -- case parse enumField "" "reserved 4294967294 to max" of Left err -> print err Right res -> print res diff --git a/src/ProtoParser/Message.hs b/src/ProtoParser/Message.hs index ba97c97..5e60fb6 100644 --- a/src/ProtoParser/Message.hs +++ b/src/ProtoParser/Message.hs @@ -1,10 +1,33 @@ module ProtoParser.Message (parseMessage) where -import ProtoParser.Misc (spaces1) -import Protobuf (Message (..), MessageField) +import Data.Maybe (catMaybes) +import ProtoParser.Misc +import Protobuf import Text.Parsec import Text.Parsec.String parseMessage :: Parser Message parseMessage = do - return (Message " " []) + parseMessage' + +parseMessage' :: Parser Message +parseMessage' = do + _ <- string "message" + spaces1 + name <- protoName + spaces + _ <- char '{' + spaces + -- TODO: multiple inputs + fields <- parseMessageField `sepEndBy1` char ';' + spaces + _ <- char '}' + return (Message name (catMaybes fields)) + +parseMessageField :: Parser (Maybe MessageField) +parseMessageField = do + return Nothing + +-- return (Just (MessageField t "" 0 False)) +-- t :: ProtoDataType +-- t = return MessageName "" diff --git a/src/Protobuf.hs b/src/Protobuf.hs index a2a4774..53a2e7b 100644 --- a/src/Protobuf.hs +++ b/src/Protobuf.hs @@ -54,7 +54,7 @@ data MapValue = MapName | ProtonScalarType data ProtoDataType = ProtoScalarType | MessageName | EnumName | Map MapKey MapValue deriving (Show, Eq) -data MessageField = ProtoField ProtoDataType Name FieldNumber Repeat +data MessageField = MessageField ProtoDataType Name FieldNumber Repeat deriving (Show, Eq) data Message = Message MessageName [MessageField] diff --git a/test/Unit/Message.hs b/test/Unit/Message.hs index c17084a..0340ec9 100644 --- a/test/Unit/Message.hs +++ b/test/Unit/Message.hs @@ -2,7 +2,7 @@ module Unit.Message (allTests) where import Data.Either (fromRight, isRight) import ProtoParser.Message -import Protobuf (Message (..), MessageField) +import Protobuf import Test.HUnit import Text.Parsec (parse) @@ -11,6 +11,12 @@ allTests = [ TestLabel "simple" testSimple ] +failMessage :: Message +failMessage = Message "FAIL" [] + testSimple :: Test testSimple = TestCase $ do - assertEqual "placeholder" True (isRight (parse parseMessage "" "")) + assertEqual "empty" False (isRight (parse parseMessage "" "")) + assertEqual "keyword only" False (isRight (parse parseMessage "" "message")) + assertEqual "missing name" False (isRight (parse parseMessage "" "message {}")) + assertEqual "emptyMessage" (Message "Foo" []) (fromRight failMessage (parse parseMessage "" "message Foo {}")) From 0b4a44fad44bba89c66ddcf5c0d1b1b3cd01f97b Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Mon, 20 Nov 2023 19:21:16 +0100 Subject: [PATCH 06/55] refactor enum parser --- app/Main.hs | 5 +- src/ProtoParser/Enum.hs | 126 +++++++++++++++++----------------------- test/Unit/Enum.hs | 40 ++++++------- 3 files changed, 73 insertions(+), 98 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 833a2d6..5d7928b 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -6,9 +6,6 @@ import Text.Parsec (parse) main :: IO () main = do - -- case parse enumField "" "reserved \"FOO\",\"FOO\"" of - -- case parse enumField "" "reserved 1" of - case parse parseMessage "" "message Foo {}" of - -- case parse enumField "" "reserved 4294967294 to max" of + case parse enumField "" "reserved 1 2" of Left err -> print err Right res -> print res diff --git a/src/ProtoParser/Enum.hs b/src/ProtoParser/Enum.hs index e9ffc4e..6a94a34 100644 --- a/src/ProtoParser/Enum.hs +++ b/src/ProtoParser/Enum.hs @@ -7,7 +7,6 @@ module ProtoParser.Enum ) where -import Data.Maybe (catMaybes) import Debug.Trace import ProtoParser.Misc import Protobuf @@ -16,105 +15,84 @@ import Text.Parsec.String protoEnum :: Parser Protobuf.Enum protoEnum = do - skipMany space + spaces _ <- string "enum" "Expected enum keyword" - skipMany space + spaces name <- protoName "Expected enum name" - whitespace + spaces _ <- char '{' ("Expected '{' after enum name" ++ name) - skipMany space - values <- enumField `sepEndBy1` char ';' - if null (catMaybes values) - then fail "Expected at least one enum value" - else do - whitespace - _ <- char '}' - -- TODO: check enum values for correctness (numbers and names) -> in extra function traversing finished proto data - return (Protobuf.Enum name (catMaybes values)) + spaces + values <- try enumField `sepEndBy1` (try (string ";") <|> try (string ";\n")) "Expected at least one enum value" + return (Protobuf.Enum name values) -enumField :: Parser (Maybe EnumField) +enumField :: Parser EnumField enumField = do - skipMany space - isEnd <- option False (lookAhead (char '}') >> return True) - if isEnd - then return Nothing - else do - name <- protoName - case name of - "option" -> do enumOption - "reserved" -> do enumReserved - _ -> do - skipMany space - _ <- char '=' - skipMany space - number <- enumNumber - skipMany space - return (Just (EnumValue name number)) + spaces + name <- protoName + case name of + "option" -> do enumOption + "reserved" -> do enumReserved + _ -> do + spaces -- TODO: 1 space required? + _ <- char '=' + spaces -- TODO: 1 space required? + number <- enumNumber + spaces + return (EnumValue name number) -- https://protobuf.dev/programming-guides/proto3/#enum -enumOption :: Parser (Maybe EnumField) +enumOption :: Parser EnumField enumOption = do - whitespace + spaces optionName <- protoName case optionName of "allow_alias" -> do - whitespace + spaces _ <- char '=' - whitespace - active <- try (string "true" >> return True) <|> (string "false" >> return False) "Expected true or false" - whitespace - return (Just (EnumOption "allow_alias" active)) + spaces + active <- parseBoolOption + spaces + return (EnumOption "allow_alias" active) _ -> fail "Unknown option" +parseBoolOption :: Parser Bool +parseBoolOption = + try (string "true" >> return True) + <|> (string "false" >> return False) + "Expected true or false" + -- https://protobuf.dev/programming-guides/proto3/#reserved -enumReserved :: Parser (Maybe EnumField) +enumReserved :: Parser EnumField enumReserved = do - whitespace - reservedValues <- (try reservedNames <|> try reservedNumbers) `sepEndBy` char ',' - isParsedCorrect <- option True (try (lookAhead enumNumber) >> return False) <|> (try (lookAhead protoName) >> return False) - if not isParsedCorrect - then fail "Expected either numbers or names, end of enum or separator" - else case reservedValues of - [] -> fail "Expected at least one reserved value (either number or name)" - _ -> do - let numbers = - [ case x of - Numbers l -> l - _ -> [] - | x <- reservedValues - ] - names = - [ case x of - Names n -> n - _ -> [] - | x <- reservedValues - ] - if not (all null names) && not (all null numbers) - then fail "Expected either numbers or names, not both" - else - if all null numbers - then - if all null names - then fail "Expected either numbers or names" - else return (Just (EnumReserved (Names (concat names)))) - else return (Just (EnumReserved (Numbers (concat numbers)))) + spaces + try parseReservedNames <|> try parseReservedNumbers + +parseReservedNames :: Parser EnumField +parseReservedNames = do + names <- try reservedNames `sepEndBy1` char ',' + return (EnumReserved (Names (concat names))) + +parseReservedNumbers :: Parser EnumField +parseReservedNumbers = do + numbers <- try reservedNumbers `sepEndBy1` char ',' + return (EnumReserved (Numbers (concat numbers))) -reservedNames :: Parser EnumReservedValues +reservedNames :: Parser [EnumName] reservedNames = do _ <- many space _ <- char '\"' name <- protoName _ <- char '\"' - return (Names [name]) + return [name] -reservedNumbersSingle :: Parser EnumReservedValues +reservedNumbersSingle :: Parser [EnumNumber] reservedNumbersSingle = do _ <- many space firstNumber <- enumNumber _ <- many space - return (Numbers [firstNumber]) + return [firstNumber] -reservedNumbersRange :: Parser EnumReservedValues +reservedNumbersRange :: Parser [EnumNumber] reservedNumbersRange = do let numValues = try enumNumber <|> try (string "min" >> return 0) <|> try (string "max" >> return 0xFFFFFFFF) firstNumber <- numValues @@ -122,9 +100,9 @@ reservedNumbersRange = do _ <- string "to" _ <- many space secondNumber <- numValues - return (Numbers [firstNumber .. secondNumber]) + return [firstNumber .. secondNumber] -reservedNumbers :: Parser EnumReservedValues +reservedNumbers :: Parser [EnumNumber] reservedNumbers = try reservedNumbersRange <|> try reservedNumbersSingle enumNumber :: Parser EnumNumber diff --git a/test/Unit/Enum.hs b/test/Unit/Enum.hs index ce60efb..c4da388 100644 --- a/test/Unit/Enum.hs +++ b/test/Unit/Enum.hs @@ -11,46 +11,46 @@ allTests = [ TestLabel "enumFieldParser" testEnumFieldParser, TestLabel "enumParser" testEnumParser, TestLabel "reservedNumbers" testReservedNumbers, - TestLabel "fieldNumbers" testEnumFieldNumbers + TestLabel "fieldNumbers" testEnumFieldNumbers ] ---------------------------------------------------------------- testReservedNumbers :: Test testReservedNumbers = TestCase $ do assertEqual "empty" False (isRight (parse reservedNumbers "" "")) - assertEqual "single" (Numbers [0]) (fromRight (Numbers []) (parse reservedNumbers "" "0")) - assertEqual "range" (Numbers [0, 1, 2]) (fromRight (Numbers []) (parse reservedNumbers "" "min to 2")) + assertEqual "single" [0] (fromRight [] (parse reservedNumbers "" "0")) + assertEqual "range" [0, 1, 2] (fromRight [] (parse reservedNumbers "" "min to 2")) ---------------------------------------------------------------- -emptyDefault :: Maybe EnumField -emptyDefault = Just (EnumValue "TestDefault" 0) +emptyDefault :: EnumField +emptyDefault = EnumValue "TestDefault" 0 testEnumFieldParser :: Test testEnumFieldParser = TestCase $ do assertEqual "empyt" False (isRight (parse enumField "" "")) - assertEqual "enumEntry" (Just (EnumValue "TEST" 0)) (fromRight emptyDefault (parse enumField "" "TEST = 0")) - assertEqual "enumEntry" (Just (EnumValue "MORE" 1)) (fromRight emptyDefault (parse enumField "" "MORE = 1")) - assertEqual "enumEntry" (Just (EnumValue "UNDER_SCORE" 42)) (fromRight emptyDefault (parse enumField "" "UNDER_SCORE = 42")) + assertEqual "enumEntry" (EnumValue "TEST" 0) (fromRight emptyDefault (parse enumField "" "TEST = 0")) + assertEqual "enumEntry" (EnumValue "MORE" 1) (fromRight emptyDefault (parse enumField "" "MORE = 1")) + assertEqual "enumEntry" (EnumValue "UNDER_SCORE" 42) (fromRight emptyDefault (parse enumField "" "UNDER_SCORE = 42")) -- reserved number -- assertEqual "empytReserved" False (isRight (parse enumField "" "reserved")) assertEqual "outOfRangeSingleReserved" False (isRight (parse enumField "" "reserved -1")) - assertEqual "multiReserved" (Just (EnumReserved (Numbers [1, 2]))) (fromRight emptyDefault (parse enumField "" "reserved 1, 2")) - assertEqual "multiReserved" (Just (EnumReserved (Numbers [1, 3, 5]))) (fromRight emptyDefault (parse enumField "" "reserved 1, 3, 5")) - assertEqual "multiReserved" (Just (EnumReserved (Numbers [1, 2, 3]))) (fromRight emptyDefault (parse enumField "" "reserved 1 to 3")) - assertEqual "multiReserved" (Just (EnumReserved (Numbers [0, 1, 2, 3]))) (fromRight emptyDefault (parse enumField "" "reserved min to 3")) - assertEqual "multiReserved" (Just (EnumReserved (Numbers [4294967294, 0xFFFFFFFF]))) (fromRight emptyDefault (parse enumField "" "reserved 4294967294 to max")) - assertEqual "singleReserved" (Just (EnumReserved (Numbers [0]))) (fromRight emptyDefault (parse enumField "" "reserved 0")) - assertEqual "singleReserved" (Just (EnumReserved (Numbers [1]))) (fromRight emptyDefault (parse enumField "" "reserved 1")) - assertEqual "reservedIncorrectNumberFormat" False (isRight (parse enumField "" "reserved 1 2")) + assertEqual "multiReserved" (EnumReserved (Numbers [1, 2])) (fromRight emptyDefault (parse enumField "" "reserved 1, 2")) + assertEqual "multiReserved" (EnumReserved (Numbers [1, 3, 5])) (fromRight emptyDefault (parse enumField "" "reserved 1, 3, 5")) + assertEqual "multiReserved" (EnumReserved (Numbers [1, 2, 3])) (fromRight emptyDefault (parse enumField "" "reserved 1 to 3")) + assertEqual "multiReserved" (EnumReserved (Numbers [0, 1, 2, 3])) (fromRight emptyDefault (parse enumField "" "reserved min to 3")) + assertEqual "multiReserved" (EnumReserved (Numbers [4294967294, 0xFFFFFFFF])) (fromRight emptyDefault (parse enumField "" "reserved 4294967294 to max")) + assertEqual "singleReserved" (EnumReserved (Numbers [0])) (fromRight emptyDefault (parse enumField "" "reserved 0")) + assertEqual "singleReserved" (EnumReserved (Numbers [1])) (fromRight emptyDefault (parse enumField "" "reserved 1")) + -- assertEqual "reservedIncorrectNumberFormat" False (isRight (parse enumField "" "reserved 1 2")) -- cant parse with enumField alone anymore -- reserved name -- assertEqual "emptyReservedName" False (isRight (parse enumField "" "reserved")) - assertEqual "singleReservedName" (Just (EnumReserved (Names ["FOO"]))) (fromRight emptyDefault (parse enumField "" "reserved \"FOO\"")) - assertEqual "multiReservedName" (Just (EnumReserved (Names ["FOO", "BAR"]))) (fromRight emptyDefault (parse enumField "" "reserved \"FOO\", \"BAR\"")) + assertEqual "singleReservedName" (EnumReserved (Names ["FOO"])) (fromRight emptyDefault (parse enumField "" "reserved \"FOO\"")) + assertEqual "multiReservedName" (EnumReserved (Names ["FOO", "BAR"])) (fromRight emptyDefault (parse enumField "" "reserved \"FOO\", \"BAR\"")) -- option -- assertEqual "empyt" False (isRight (parse enumField "" "option invalid_option = true")) - assertEqual "invalidOption" (Just (EnumOption "allow_alias" True)) (fromRight emptyDefault (parse enumField "" "option allow_alias = true")) - assertEqual "invalidOption" (Just (EnumOption "allow_alias" False)) (fromRight emptyDefault (parse enumField "" "option allow_alias = false")) + assertEqual "invalidOption" (EnumOption "allow_alias" True) (fromRight emptyDefault (parse enumField "" "option allow_alias = true")) + assertEqual "invalidOption" (EnumOption "allow_alias" False) (fromRight emptyDefault (parse enumField "" "option allow_alias = false")) ---------------------------------------------------------------- From c11bbb7b0ce3ac34403f38f3d059207b5ba4aad7 Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Wed, 22 Nov 2023 08:53:49 +0100 Subject: [PATCH 07/55] add splitted definition support Workaround for package definition --- app/Main.hs | 10 +++++-- src/ProtoParser.hs | 29 ++++++++++--------- src/ProtoParser/Comment.hs | 15 +++++++++- src/ProtoParser/Enum.hs | 6 ++++ src/ProtoParser/Import.hs | 9 ++++-- src/ProtoParser/Message.hs | 14 +++++++--- src/ProtoParser/Package.hs | 9 ++++-- src/Protobuf.hs | 19 ++++++++++++- test/Unit/ProtoParser.hs | 57 ++++++++++++++++++++++++++++++++++++-- 9 files changed, 138 insertions(+), 30 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 5d7928b..c856cfd 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,11 +1,15 @@ module Main (main) where import ProtoParser -import ProtoParser.Package -import Text.Parsec (parse) + +splitImportText1 :: String +splitImportText1 = + "import \"foo.proto\";\n\ + \message FooBar {}\n\ + \import \"bar.proto\";" main :: IO () main = do - case parse enumField "" "reserved 1 2" of + case parseProtobuf splitImportText1 of Left err -> print err Right res -> print res diff --git a/src/ProtoParser.hs b/src/ProtoParser.hs index f738ff1..193b525 100644 --- a/src/ProtoParser.hs +++ b/src/ProtoParser.hs @@ -10,6 +10,7 @@ module ProtoParser ) where +import Debug.Trace import ProtoParser.Comment import ProtoParser.Enum import ProtoParser.Import @@ -21,21 +22,19 @@ import Text.Parsec import Text.Parsec.String parseProtobuf :: String -> Either ParseError Protobuf -parseProtobuf = parse parseProtobuf' "" +parseProtobuf = parse protoValue "" -- TODO : check for too many ';' -parseProtobuf' :: Parser Protobuf -parseProtobuf' = do - _x <- parseImport - -- TODO: how to add multiple parser outputs? - return - ( Protobuf - { package = "", - imports = [], - options = [], - enums = [], - messages = [], - services = [] - } - ) +protoValue :: Parser Protobuf +protoValue = do + x <- + choice + [ try parsePackage', + try parseImport', + try parseComment', + try parseEnum', + try parseMessage' + ] + `sepBy1` lookAhead anyToken + return (merge' x) diff --git a/src/ProtoParser/Comment.hs b/src/ProtoParser/Comment.hs index 3a4c1e4..9f45e78 100644 --- a/src/ProtoParser/Comment.hs +++ b/src/ProtoParser/Comment.hs @@ -1,15 +1,28 @@ module ProtoParser.Comment ( parseComment, + parseComment', parseSingleLineComment, parseMultiLineComment, ) where +import Control.Monad (void) import ProtoParser.Misc (eol) -import Protobuf (Comment) +import Protobuf import Text.Parsec import Text.Parsec.String +parseComment' :: Parser Protobuf +parseComment' = do + _ <- parseComment + return (Protobuf {package = [], imports = [], options = [], enums = [], messages = [], services = []}) + +removeComment :: Parser () +removeComment = do + -- TODO: correct way to try? + void (try parseSingleLineComment <|> try parseMultiLineComment) + + parseComment :: Parser Comment parseComment = do -- TODO: correct way to try? diff --git a/src/ProtoParser/Enum.hs b/src/ProtoParser/Enum.hs index 6a94a34..995ad37 100644 --- a/src/ProtoParser/Enum.hs +++ b/src/ProtoParser/Enum.hs @@ -1,5 +1,6 @@ module ProtoParser.Enum ( protoEnum, + parseEnum', enumField, enumNumber, protoName, @@ -13,6 +14,11 @@ import Protobuf import Text.Parsec import Text.Parsec.String +parseEnum' :: Parser Protobuf +parseEnum' = do + x <- protoEnum + return (Protobuf {package = [], imports = [], options = [], enums = [x], messages = [], services = []}) + protoEnum :: Parser Protobuf.Enum protoEnum = do spaces diff --git a/src/ProtoParser/Import.hs b/src/ProtoParser/Import.hs index 630c3f8..23414d1 100644 --- a/src/ProtoParser/Import.hs +++ b/src/ProtoParser/Import.hs @@ -1,10 +1,15 @@ -module ProtoParser.Import (parseImport) where +module ProtoParser.Import (parseImport, parseImport') where import ProtoParser.Misc (spaces1) -import Protobuf (ImportPath) +import Protobuf import Text.Parsec import Text.Parsec.String +parseImport' :: Parser Protobuf +parseImport' = do + imp <- parseImport + return (Protobuf {package = [], imports = [imp], options = [], enums = [], messages = [], services = []}) + pathExtension :: String pathExtension = ".proto" diff --git a/src/ProtoParser/Message.hs b/src/ProtoParser/Message.hs index 5e60fb6..699e685 100644 --- a/src/ProtoParser/Message.hs +++ b/src/ProtoParser/Message.hs @@ -1,4 +1,4 @@ -module ProtoParser.Message (parseMessage) where +module ProtoParser.Message (parseMessage, parseMessage') where import Data.Maybe (catMaybes) import ProtoParser.Misc @@ -6,12 +6,18 @@ import Protobuf import Text.Parsec import Text.Parsec.String +parseMessage' :: Parser Protobuf +parseMessage' = do + x <- parseMessage + return (Protobuf {package = [], imports = [], options = [], enums = [], messages = [x], services = []}) + parseMessage :: Parser Message parseMessage = do - parseMessage' + parseMessage'' -parseMessage' :: Parser Message -parseMessage' = do +parseMessage'' :: Parser Message +parseMessage'' = do + spaces _ <- string "message" spaces1 name <- protoName diff --git a/src/ProtoParser/Package.hs b/src/ProtoParser/Package.hs index 55b89ca..f1de28e 100644 --- a/src/ProtoParser/Package.hs +++ b/src/ProtoParser/Package.hs @@ -1,10 +1,15 @@ -module ProtoParser.Package (parsePackage) where +module ProtoParser.Package (parsePackage, parsePackage') where import ProtoParser.Misc (spaces1) -import Protobuf (Package) +import Protobuf import Text.Parsec import Text.Parsec.String +parsePackage' :: Parser Protobuf +parsePackage' = do + package' <- parsePackage + return (Protobuf {package = [package'], imports = [], options = [], enums = [], messages = [], services = []}) + parsePackage :: Parser Package parsePackage = do skipMany space diff --git a/src/Protobuf.hs b/src/Protobuf.hs index 53a2e7b..b72b363 100644 --- a/src/Protobuf.hs +++ b/src/Protobuf.hs @@ -85,7 +85,8 @@ data Option = Option Name Value deriving (Show, Eq) data Protobuf = Protobuf - { package :: String, + -- { package :: Maybe String, + { package :: [String], imports :: [ImportPath], options :: [Option], enums :: [Protobuf.Enum], @@ -93,3 +94,19 @@ data Protobuf = Protobuf services :: [Service] } deriving (Show, Eq) + +------------------------------------------------------------ + +merge' :: [Protobuf] -> Protobuf +merge' = foldl1 Protobuf.merge + +merge :: Protobuf -> Protobuf -> Protobuf +merge a b = + Protobuf + { package = package a ++ package b, + imports = imports a ++ imports b, + options = options a ++ options b, + enums = enums a ++ enums b, + messages = messages a ++ messages b, + services = services a ++ services b + } diff --git a/test/Unit/ProtoParser.hs b/test/Unit/ProtoParser.hs index 00f8000..6545073 100644 --- a/test/Unit/ProtoParser.hs +++ b/test/Unit/ProtoParser.hs @@ -4,13 +4,66 @@ import Data.Either (fromRight, isRight) import ProtoParser import Protobuf import Test.HUnit -import Text.Parsec (parse) allTests :: [Test] allTests = - [ TestLabel "text" testText + [ TestLabel "text" testText, + TestLabel "splittedDefinitions" testSplittedDefinitions ] +defaultTestProto :: Protobuf +defaultTestProto = + ( Protobuf + { package = [], + imports = [], + options = [], + enums = [], + messages = [], + services = [] + } + ) + +splitImportText :: String +splitImportText = + "import \"foo.proto\";\n\ + \package foobar;\n\ + \import \"bar.proto\";" + +splitImportProto :: Protobuf +splitImportProto = + ( Protobuf + { package = ["foobar"], + imports = ["foo.proto", "bar.proto"], + options = [], + enums = [], + messages = [], + services = [] + } + ) + +splitImportText1 :: String +splitImportText1 = + "import \"foo.proto\";\n\ + \message B {}\n\ + \import \"bar.proto\";" + +splitImportProto1 :: Protobuf +splitImportProto1 = + ( Protobuf + { package = [], + imports = ["foo.proto", "bar.proto"], + options = [], + enums = [], + messages = [Message "B" []], + services = [] + } + ) + +testSplittedDefinitions :: Test +testSplittedDefinitions = TestCase $ do + assertEqual "import - package - import" splitImportProto (fromRight defaultTestProto (parseProtobuf splitImportText)) + assertEqual "import - message - import" splitImportProto1 (fromRight defaultTestProto (parseProtobuf splitImportText1)) + testText :: Test testText = TestCase $ do assertEqual "empty" False (isRight (parseProtobuf "")) From 24ac2999ed35f6d0a6ec04bb005a57da7e475925 Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Thu, 23 Nov 2023 18:42:59 +0100 Subject: [PATCH 08/55] maps --- app/Main.hs | 10 +++--- src/ProtoParser/Message.hs | 64 +++++++++++++++++++++++++++++++++++++- src/ProtoParser/Misc.hs | 4 --- src/Protobuf.hs | 2 +- test/Unit/Message.hs | 24 +++++++++++++- test/Unit/Misc.hs | 2 -- 6 files changed, 91 insertions(+), 15 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index c856cfd..c36abe4 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,15 +1,13 @@ module Main (main) where import ProtoParser +import Text.Parsec +import Text.Parsec.String -splitImportText1 :: String -splitImportText1 = - "import \"foo.proto\";\n\ - \message FooBar {}\n\ - \import \"bar.proto\";" +-- map map_field = N; main :: IO () main = do - case parseProtobuf splitImportText1 of + case parse parseMap "" "map name = 2" of Left err -> print err Right res -> print res diff --git a/src/ProtoParser/Message.hs b/src/ProtoParser/Message.hs index 699e685..c105cd2 100644 --- a/src/ProtoParser/Message.hs +++ b/src/ProtoParser/Message.hs @@ -1,4 +1,4 @@ -module ProtoParser.Message (parseMessage, parseMessage') where +module ProtoParser.Message (parseMessage, parseMessage', parseMap) where import Data.Maybe (catMaybes) import ProtoParser.Misc @@ -37,3 +37,65 @@ parseMessageField = do -- return (Just (MessageField t "" 0 False)) -- t :: ProtoDataType -- t = return MessageName "" + +---------------------------------------------------------------- +parseIntType :: Parser MapKey +parseIntType = + let int32 = string "int32" >> return (IntKey Int32) + int64 = string "int64" >> return (IntKey Int64) + uint32 = string "uint32" >> return (IntKey UInt32) + uint64 = string "uint64" >> return (IntKey UInt64) + sint32 = string "sint32" >> return (IntKey SInt32) + sint64 = string "sint64" >> return (IntKey SInt64) + fixed32 = string "fixed32" >> return (IntKey Fixed32) + fixed64 = string "fixed64" >> return (IntKey Fixed64) + sfixed32 = string "sfixed32" >> return (IntKey SFixed32) + sfixed64 = string "sfixed64" >> return (IntKey SFixed64) + in do + int32 + <|> int64 + <|> uint32 + <|> uint64 + <|> sint32 + <|> sint64 + <|> fixed32 + <|> fixed64 + <|> sfixed32 + <|> sfixed64 + +---------------------------------------------------------------- +parseStringType :: Parser MapKey +parseStringType = do + StringKey <$> protoName + +---------------------------------------------------------------- +-- TODO: maps +parseMap :: Parser MessageField +parseMap = do + spaces + _ <- string "map" + spaces + _ <- char '<' + spaces + key <- parseMapKey + spaces + _ <- char ',' + value <- parseMapValue + spaces + _ <- char '>' + spaces + name <- protoName -- TODO: missing + spaces + _ <- char '=' + spaces + fieldNumber <- protoNumber -- TODO: missing -> convert to MessageField + return (MessageField (Map key value) name fieldNumber False) + +parseMapKey :: Parser MapKey +parseMapKey = do + parseIntType <|> parseStringType -- order is important! + +parseMapValue :: Parser MapValue +parseMapValue = do + -- TODO: any type except other map + MapName <$> protoName diff --git a/src/ProtoParser/Misc.hs b/src/ProtoParser/Misc.hs index b923861..f526239 100644 --- a/src/ProtoParser/Misc.hs +++ b/src/ProtoParser/Misc.hs @@ -49,7 +49,3 @@ protoNumber = -- TODO : test eol :: Parser () eol = void (char '\n') <|> eof - ----------------------------------------------------------------- - --- TODO: maps diff --git a/src/Protobuf.hs b/src/Protobuf.hs index b72b363..b2a0b22 100644 --- a/src/Protobuf.hs +++ b/src/Protobuf.hs @@ -48,7 +48,7 @@ data ScalarType = IntType IntType | FloatType FloatType | String | Bytes | Bool data MapKey = StringKey String | IntKey IntType deriving (Show, Eq) -data MapValue = MapName | ProtonScalarType +data MapValue = MapName String | ScalarType deriving (Show, Eq) data ProtoDataType = ProtoScalarType | MessageName | EnumName | Map MapKey MapValue diff --git a/test/Unit/Message.hs b/test/Unit/Message.hs index 0340ec9..8b5242a 100644 --- a/test/Unit/Message.hs +++ b/test/Unit/Message.hs @@ -8,7 +8,8 @@ import Text.Parsec (parse) allTests :: [Test] allTests = - [ TestLabel "simple" testSimple + [ TestLabel "simple" testSimple, + TestLabel "map" testMap ] failMessage :: Message @@ -20,3 +21,24 @@ testSimple = TestCase $ do assertEqual "keyword only" False (isRight (parse parseMessage "" "message")) assertEqual "missing name" False (isRight (parse parseMessage "" "message {}")) assertEqual "emptyMessage" (Message "Foo" []) (fromRight failMessage (parse parseMessage "" "message Foo {}")) + +---------------------------------------------------------------- + +defaulTestMap :: MessageField +defaulTestMap = MessageField (Map (StringKey "") (MapName "")) "TEST" 0 False + +-- map map_field = N; +testMap :: Test +testMap = TestCase $ do + assertEqual "empty" False (isRight (parse parseMap "" "")) + assertEqual "keyword only" False (isRight (parse parseMap "" "map")) + assertEqual + "Simple" + ( MessageField (Map (StringKey "T") (MapName "V")) "name" 2 False + ) + (fromRight defaulTestMap (parse parseMap "" "map name = 2")) + assertEqual + "Simple" + ( MessageField (Map (IntKey Int32) (MapName "V")) "name" 2 False + ) + (fromRight defaulTestMap (parse parseMap "" "map name = 2")) diff --git a/test/Unit/Misc.hs b/test/Unit/Misc.hs index 9a1c1fd..393c5af 100644 --- a/test/Unit/Misc.hs +++ b/test/Unit/Misc.hs @@ -36,5 +36,3 @@ testProtoName = TestCase $ do assertEqual "not a name" False (isRight (parse protoName "" "-1")) assertEqual "Uppercase" "TEST" (fromRight "Default" (parse protoName "" "TEST")) assertEqual "UpperCamelCase" "TestTest" (fromRight "Default" (parse protoName "" "TestTest")) - ----------------------------------------------------------------- From 06a3362cd45abc0ab8224636bb7e57c460dd9f0e Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Fri, 24 Nov 2023 09:36:32 +0100 Subject: [PATCH 09/55] add service --- app/Main.hs | 15 +++++- protobuf-parser.cabal | 4 +- src/ProtoParser.hs | 2 + src/ProtoParser/Service.hs | 62 +++++++++++++++++++++++++ src/Protobuf.hs | 2 +- test/Spec.hs | 2 + test/Unit/Service.hs | 94 ++++++++++++++++++++++++++++++++++++++ 7 files changed, 177 insertions(+), 4 deletions(-) create mode 100644 src/ProtoParser/Service.hs create mode 100644 test/Unit/Service.hs diff --git a/app/Main.hs b/app/Main.hs index c36abe4..36cd514 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -4,10 +4,21 @@ import ProtoParser import Text.Parsec import Text.Parsec.String --- map map_field = N; +singleServiceText :: String +singleServiceText = + "service SearchService {\n\ + \ rpc Search(SearchRequest) returns (SearchResponse);\n\ + \}" + +multipleServiceText :: String +multipleServiceText = + "service Multiple {\n\ + \ rpc Search(Foo) returns (Bar);\n\ + \ rpc Search1(Bar) returns (Foo);\n\ + \}" main :: IO () main = do - case parse parseMap "" "map name = 2" of + case parse parseService "" multipleServiceText of Left err -> print err Right res -> print res diff --git a/protobuf-parser.cabal b/protobuf-parser.cabal index 7cf6898..b4399b8 100644 --- a/protobuf-parser.cabal +++ b/protobuf-parser.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.35.2. +-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack @@ -33,6 +33,7 @@ library ProtoParser.Message ProtoParser.Misc ProtoParser.Package + ProtoParser.Service other-modules: Paths_protobuf_parser autogen-modules: @@ -71,6 +72,7 @@ test-suite protobuf-parser-test Unit.Misc Unit.Package Unit.ProtoParser + Unit.Service Paths_protobuf_parser autogen-modules: Paths_protobuf_parser diff --git a/src/ProtoParser.hs b/src/ProtoParser.hs index 193b525..cbf25f8 100644 --- a/src/ProtoParser.hs +++ b/src/ProtoParser.hs @@ -6,6 +6,7 @@ module ProtoParser module ProtoParser.Comment, module ProtoParser.Message, module ProtoParser.Package, + module ProtoParser.Service, parseProtobuf, ) where @@ -17,6 +18,7 @@ import ProtoParser.Import import ProtoParser.Message import ProtoParser.Misc import ProtoParser.Package +import ProtoParser.Service import Protobuf import Text.Parsec import Text.Parsec.String diff --git a/src/ProtoParser/Service.hs b/src/ProtoParser/Service.hs new file mode 100644 index 0000000..f9ddc36 --- /dev/null +++ b/src/ProtoParser/Service.hs @@ -0,0 +1,62 @@ +module ProtoParser.Service (parseService, parseService') where + +import Data.Maybe (catMaybes) +import ProtoParser.Misc +import Protobuf +import Text.Parsec +import Text.Parsec.String + +parseService' :: Parser Protobuf +parseService' = do + x <- parseService + return (Protobuf {package = [], imports = [], options = [], enums = [], messages = [], services = [x]}) + +parseService :: Parser Service +parseService = do + parseService'' + +parseService'' :: Parser Service +parseService'' = do + spaces + _ <- string "service" + spaces1 + name <- protoName + spaces + _ <- char '{' + spaces + fields <- try parseServiceField `sepEndBy1` char ';' + spaces + _ <- char '}' + return (Service name (catMaybes fields)) + +parseServiceField :: Parser (Maybe RPC) +parseServiceField = do + spaces + _ <- string "rpc" + spaces1 + name <- protoName + spaces + _ <- char '(' + spaces + isRequestStream <- option False (string "stream" >> spaces1 >> return True) + request <- protoName + spaces + _ <- char ')' + spaces + _ <- string "returns" + spaces + _ <- char '(' + spaces + isReplyStream <- option False (string "stream" >> spaces1 >> return True) + reply <- protoName + spaces + _ <- char ')' + spaces + return + ( Just + ( RPC + name + (if isRequestStream then RequestTypeStream request else RequestType request) + (if isReplyStream then ReplyTypeStream reply else ReplyType reply) + ) + ) diff --git a/src/Protobuf.hs b/src/Protobuf.hs index b2a0b22..cd9b7e5 100644 --- a/src/Protobuf.hs +++ b/src/Protobuf.hs @@ -75,7 +75,7 @@ data Service = Service Name [RPC] data RequestType = RequestType MessageName | RequestTypeStream MessageName deriving (Show, Eq) -data ReplyType = ReplyType MessageName | ReturnTypeStream MessageName +data ReplyType = ReplyType MessageName | ReplyTypeStream MessageName deriving (Show, Eq) data RPC = RPC RPCName RequestType ReplyType diff --git a/test/Spec.hs b/test/Spec.hs index 20762b7..99054e2 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -6,6 +6,7 @@ import Unit.Message as Message import Unit.Misc as Misc import Unit.Package as Package import Unit.ProtoParser as Protobuf +import Unit.Service as Service main :: IO () main = @@ -18,5 +19,6 @@ main = ++ Comment.allTests ++ Message.allTests ++ Package.allTests + ++ Service.allTests ) ) diff --git a/test/Unit/Service.hs b/test/Unit/Service.hs new file mode 100644 index 0000000..2965ef6 --- /dev/null +++ b/test/Unit/Service.hs @@ -0,0 +1,94 @@ +module Unit.Service (allTests) where + +import Data.Either (fromRight, isRight) +import ProtoParser.Service +import Protobuf +import Test.HUnit +import Text.Parsec (parse) + +allTests :: [Test] +allTests = + [ TestLabel "simple" testSimple + ] + +failMessage :: Service +failMessage = Service "FAIL" [] + +simpleServiceText :: String +simpleServiceText = + "service SearchService {\n\ + \ rpc Search(SearchRequest) returns (SearchResponse);\n\ + \}" + +simpleService :: Service +simpleService = + Service + "SearchService" + [ RPC + "Search" + (RequestType "SearchRequest") + (ReplyType "SearchResponse") + ] + +multipleServiceText :: String +multipleServiceText = + "service Multiple {\n\ + \ rpc Search(Foo) returns (Bar);\n\ + \ rpc Search1(Bar) returns (Foo);\n\ + \}" + +multipleService :: Service +multipleService = + Service + "Multiple" + [ RPC + "Search" + (RequestType "Foo") + (ReplyType "Bar"), + RPC + "Search1" + (RequestType "Bar") + (ReplyType "Foo") + ] + +streamRequestServiceText :: String +streamRequestServiceText = + "service Multiple {\n\ + \ rpc Search(stream Foo) returns (Bar);\n\ + \}" + +streamRequestService :: Service +streamRequestService = + Service + "Multiple" + [ RPC + "Search" + (RequestTypeStream "Foo") + (ReplyType "Bar") + ] + +streamReplyServiceText :: String +streamReplyServiceText = + "service Multiple {\n\ + \ rpc Search(Foo) returns (stream Bar);\n\ + \}" + +streamReplyService :: Service +streamReplyService = + Service + "Multiple" + [ RPC + "Search" + (RequestType "Foo") + (ReplyTypeStream "Bar") + ] + +testSimple :: Test +testSimple = TestCase $ do + assertEqual "empty" False (isRight (parse parseService "" "")) + assertEqual "keyword only" False (isRight (parse parseService "" "message")) + assertEqual "missing name" False (isRight (parse parseService "" "message {}")) + assertEqual "emptyMessage" simpleService (fromRight failMessage (parse parseService "" simpleServiceText)) + assertEqual "multiple" multipleService (fromRight failMessage (parse parseService "" multipleServiceText)) + assertEqual "stream request" streamRequestService (fromRight failMessage (parse parseService "" streamRequestServiceText)) + assertEqual "stream reply" streamReplyService (fromRight failMessage (parse parseService "" streamReplyServiceText)) From acd21ac9d0a5c9d4af2e2acebeeceb3c1a083110 Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Fri, 24 Nov 2023 10:11:55 +0100 Subject: [PATCH 10/55] spot too many semicolons --- app/Main.hs | 19 ++++++------------- src/ProtoParser.hs | 15 +++++++++++---- src/Protobuf.hs | 13 +++++++++++++ test/Unit/ProtoParser.hs | 10 +++++++++- 4 files changed, 39 insertions(+), 18 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 36cd514..de93b32 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -4,21 +4,14 @@ import ProtoParser import Text.Parsec import Text.Parsec.String -singleServiceText :: String -singleServiceText = - "service SearchService {\n\ - \ rpc Search(SearchRequest) returns (SearchResponse);\n\ - \}" - -multipleServiceText :: String -multipleServiceText = - "service Multiple {\n\ - \ rpc Search(Foo) returns (Bar);\n\ - \ rpc Search1(Bar) returns (Foo);\n\ - \}" +erro :: String +erro = + "import \"foo.proto\";\n\ + \import \"bar.proto\";" main :: IO () main = do - case parse parseService "" multipleServiceText of + case parseProtobuf erro of + -- case parse parseProtobuf "" erro of Left err -> print err Right res -> print res diff --git a/src/ProtoParser.hs b/src/ProtoParser.hs index cbf25f8..2a15b78 100644 --- a/src/ProtoParser.hs +++ b/src/ProtoParser.hs @@ -26,10 +26,13 @@ import Text.Parsec.String parseProtobuf :: String -> Either ParseError Protobuf parseProtobuf = parse protoValue "" --- TODO : check for too many ';' - protoValue :: Parser Protobuf protoValue = do + x <- (protoValue' emptyProtobuf) + return x + +protoValue' :: Protobuf -> Parser Protobuf +protoValue' o = do x <- choice [ try parsePackage', @@ -38,5 +41,9 @@ protoValue = do try parseEnum', try parseMessage' ] - `sepBy1` lookAhead anyToken - return (merge' x) + isEnd <- try ((lookAhead anyToken) >> return False) <|> return True + if isEnd + then return (merge o x) + else do + y <- protoValue' (merge o x) + return y diff --git a/src/Protobuf.hs b/src/Protobuf.hs index cd9b7e5..e346fcd 100644 --- a/src/Protobuf.hs +++ b/src/Protobuf.hs @@ -95,6 +95,19 @@ data Protobuf = Protobuf } deriving (Show, Eq) +------------------------------------------------------------ +emptyProtobuf :: Protobuf +emptyProtobuf = + ( Protobuf + { package = [], + imports = [], + options = [], + enums = [], + messages = [], + services = [] + } + ) + ------------------------------------------------------------ merge' :: [Protobuf] -> Protobuf diff --git a/test/Unit/ProtoParser.hs b/test/Unit/ProtoParser.hs index 6545073..dc9943d 100644 --- a/test/Unit/ProtoParser.hs +++ b/test/Unit/ProtoParser.hs @@ -66,4 +66,12 @@ testSplittedDefinitions = TestCase $ do testText :: Test testText = TestCase $ do - assertEqual "empty" False (isRight (parseProtobuf "")) + assertEqual + "too many semicolons" + False + ( isRight + ( parseProtobuf + "import \"foo.proto\";;\n\ + \import \"bar.proto\";" + ) + ) From 1e58ac549a0059709d547fbf7ac77eb6ddeddbdb Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Fri, 24 Nov 2023 10:42:16 +0100 Subject: [PATCH 11/55] ensure only 1 package is defined per file --- app/Main.hs | 8 +++----- src/ProtoParser.hs | 15 +++++++-------- src/ProtoParser/Comment.hs | 7 +++---- src/ProtoParser/Enum.hs | 11 +++++++---- src/ProtoParser/Import.hs | 10 +++++++--- src/ProtoParser/Message.hs | 10 +++++++--- src/ProtoParser/Package.hs | 13 ++++++++++--- src/ProtoParser/Service.hs | 10 +++++++--- src/Protobuf.hs | 14 ++++++++++---- test/Unit/ProtoParser.hs | 13 ++++++++++--- 10 files changed, 71 insertions(+), 40 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index de93b32..d93a633 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,17 +1,15 @@ module Main (main) where import ProtoParser -import Text.Parsec -import Text.Parsec.String erro :: String erro = - "import \"foo.proto\";\n\ - \import \"bar.proto\";" + "package foo;\n\ + \message B {}\n\ + \package bar;" main :: IO () main = do case parseProtobuf erro of - -- case parse parseProtobuf "" erro of Left err -> print err Right res -> print res diff --git a/src/ProtoParser.hs b/src/ProtoParser.hs index 2a15b78..3aa8401 100644 --- a/src/ProtoParser.hs +++ b/src/ProtoParser.hs @@ -11,7 +11,6 @@ module ProtoParser ) where -import Debug.Trace import ProtoParser.Comment import ProtoParser.Enum import ProtoParser.Import @@ -35,15 +34,15 @@ protoValue' :: Protobuf -> Parser Protobuf protoValue' o = do x <- choice - [ try parsePackage', - try parseImport', - try parseComment', - try parseEnum', - try parseMessage' + [ try (parsePackage' o), + try (parseImport' o), + try (parseComment' o), + try (parseEnum' o), + try (parseMessage' o) ] isEnd <- try ((lookAhead anyToken) >> return False) <|> return True if isEnd - then return (merge o x) + then return x else do - y <- protoValue' (merge o x) + y <- protoValue' x return y diff --git a/src/ProtoParser/Comment.hs b/src/ProtoParser/Comment.hs index 9f45e78..15c17aa 100644 --- a/src/ProtoParser/Comment.hs +++ b/src/ProtoParser/Comment.hs @@ -12,17 +12,16 @@ import Protobuf import Text.Parsec import Text.Parsec.String -parseComment' :: Parser Protobuf -parseComment' = do +parseComment' :: Protobuf -> Parser Protobuf +parseComment' p = do _ <- parseComment - return (Protobuf {package = [], imports = [], options = [], enums = [], messages = [], services = []}) + return p removeComment :: Parser () removeComment = do -- TODO: correct way to try? void (try parseSingleLineComment <|> try parseMultiLineComment) - parseComment :: Parser Comment parseComment = do -- TODO: correct way to try? diff --git a/src/ProtoParser/Enum.hs b/src/ProtoParser/Enum.hs index 995ad37..c79c62f 100644 --- a/src/ProtoParser/Enum.hs +++ b/src/ProtoParser/Enum.hs @@ -8,16 +8,19 @@ module ProtoParser.Enum ) where -import Debug.Trace import ProtoParser.Misc import Protobuf import Text.Parsec import Text.Parsec.String -parseEnum' :: Parser Protobuf -parseEnum' = do +parseEnum' :: Protobuf -> Parser Protobuf +parseEnum' p = do x <- protoEnum - return (Protobuf {package = [], imports = [], options = [], enums = [x], messages = [], services = []}) + return + ( Protobuf.merge + p + (Protobuf {package = Nothing, imports = [], options = [], enums = [x], messages = [], services = []}) + ) protoEnum :: Parser Protobuf.Enum protoEnum = do diff --git a/src/ProtoParser/Import.hs b/src/ProtoParser/Import.hs index 23414d1..c481d52 100644 --- a/src/ProtoParser/Import.hs +++ b/src/ProtoParser/Import.hs @@ -5,10 +5,14 @@ import Protobuf import Text.Parsec import Text.Parsec.String -parseImport' :: Parser Protobuf -parseImport' = do +parseImport' :: Protobuf -> Parser Protobuf +parseImport' p = do imp <- parseImport - return (Protobuf {package = [], imports = [imp], options = [], enums = [], messages = [], services = []}) + return + ( Protobuf.merge + p + (Protobuf {package = Nothing, imports = [imp], options = [], enums = [], messages = [], services = []}) + ) pathExtension :: String pathExtension = ".proto" diff --git a/src/ProtoParser/Message.hs b/src/ProtoParser/Message.hs index c105cd2..822c848 100644 --- a/src/ProtoParser/Message.hs +++ b/src/ProtoParser/Message.hs @@ -6,10 +6,14 @@ import Protobuf import Text.Parsec import Text.Parsec.String -parseMessage' :: Parser Protobuf -parseMessage' = do +parseMessage' :: Protobuf -> Parser Protobuf +parseMessage' p = do x <- parseMessage - return (Protobuf {package = [], imports = [], options = [], enums = [], messages = [x], services = []}) + return + ( Protobuf.merge + p + (Protobuf {package = Nothing, imports = [], options = [], enums = [], messages = [x], services = []}) + ) parseMessage :: Parser Message parseMessage = do diff --git a/src/ProtoParser/Package.hs b/src/ProtoParser/Package.hs index f1de28e..402f6d5 100644 --- a/src/ProtoParser/Package.hs +++ b/src/ProtoParser/Package.hs @@ -5,10 +5,17 @@ import Protobuf import Text.Parsec import Text.Parsec.String -parsePackage' :: Parser Protobuf -parsePackage' = do +parsePackage' :: Protobuf -> Parser Protobuf +parsePackage' p = do package' <- parsePackage - return (Protobuf {package = [package'], imports = [], options = [], enums = [], messages = [], services = []}) + if package p /= Nothing + then unexpected ": There can only be one package definition per file" + else + return + ( Protobuf.merge + p + (Protobuf {package = (Just package'), imports = [], options = [], enums = [], messages = [], services = []}) + ) parsePackage :: Parser Package parsePackage = do diff --git a/src/ProtoParser/Service.hs b/src/ProtoParser/Service.hs index f9ddc36..65de885 100644 --- a/src/ProtoParser/Service.hs +++ b/src/ProtoParser/Service.hs @@ -6,10 +6,14 @@ import Protobuf import Text.Parsec import Text.Parsec.String -parseService' :: Parser Protobuf -parseService' = do +parseService' :: Protobuf -> Parser Protobuf +parseService' p = do x <- parseService - return (Protobuf {package = [], imports = [], options = [], enums = [], messages = [], services = [x]}) + return + ( Protobuf.merge + p + (Protobuf {package = Nothing, imports = [], options = [], enums = [], messages = [], services = [x]}) + ) parseService :: Parser Service parseService = do diff --git a/src/Protobuf.hs b/src/Protobuf.hs index e346fcd..fd9f42c 100644 --- a/src/Protobuf.hs +++ b/src/Protobuf.hs @@ -85,8 +85,7 @@ data Option = Option Name Value deriving (Show, Eq) data Protobuf = Protobuf - -- { package :: Maybe String, - { package :: [String], + { package :: Maybe String, imports :: [ImportPath], options :: [Option], enums :: [Protobuf.Enum], @@ -99,7 +98,7 @@ data Protobuf = Protobuf emptyProtobuf :: Protobuf emptyProtobuf = ( Protobuf - { package = [], + { package = Nothing, imports = [], options = [], enums = [], @@ -116,10 +115,17 @@ merge' = foldl1 Protobuf.merge merge :: Protobuf -> Protobuf -> Protobuf merge a b = Protobuf - { package = package a ++ package b, + { package = mergePackages (package a) (package b), imports = imports a ++ imports b, options = options a ++ options b, enums = enums a ++ enums b, messages = messages a ++ messages b, services = services a ++ services b } + where + mergePackages :: Maybe String -> Maybe String -> Maybe String + mergePackages Nothing y = y + mergePackages x Nothing = x + mergePackages (Just x) (Just y) + | not (null x) && not (null y) = error "Conflicting non-empty packages" + | otherwise = Just (x ++ y) diff --git a/test/Unit/ProtoParser.hs b/test/Unit/ProtoParser.hs index dc9943d..e79d6f7 100644 --- a/test/Unit/ProtoParser.hs +++ b/test/Unit/ProtoParser.hs @@ -14,7 +14,7 @@ allTests = defaultTestProto :: Protobuf defaultTestProto = ( Protobuf - { package = [], + { package = Nothing, imports = [], options = [], enums = [], @@ -32,7 +32,7 @@ splitImportText = splitImportProto :: Protobuf splitImportProto = ( Protobuf - { package = ["foobar"], + { package = (Just "foobar"), imports = ["foo.proto", "bar.proto"], options = [], enums = [], @@ -50,7 +50,7 @@ splitImportText1 = splitImportProto1 :: Protobuf splitImportProto1 = ( Protobuf - { package = [], + { package = Nothing, imports = ["foo.proto", "bar.proto"], options = [], enums = [], @@ -59,6 +59,12 @@ splitImportProto1 = } ) +multiplePackageText :: String +multiplePackageText = + "package foo;\n\ + \message B {}\n\ + \package bar;" + testSplittedDefinitions :: Test testSplittedDefinitions = TestCase $ do assertEqual "import - package - import" splitImportProto (fromRight defaultTestProto (parseProtobuf splitImportText)) @@ -75,3 +81,4 @@ testText = TestCase $ do \import \"bar.proto\";" ) ) + assertEqual "multiple package" False (isRight (parseProtobuf multiplePackageText)) From def1e90c827f4b853042ba10c33e6634e578a858 Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Fri, 24 Nov 2023 10:48:30 +0100 Subject: [PATCH 12/55] improve code --- src/ProtoParser.hs | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/src/ProtoParser.hs b/src/ProtoParser.hs index 3aa8401..9471a31 100644 --- a/src/ProtoParser.hs +++ b/src/ProtoParser.hs @@ -31,18 +31,18 @@ protoValue = do return x protoValue' :: Protobuf -> Parser Protobuf -protoValue' o = do - x <- +protoValue' old = do + new <- choice - [ try (parsePackage' o), - try (parseImport' o), - try (parseComment' o), - try (parseEnum' o), - try (parseMessage' o) + [ try (parsePackage' old), + try (parseImport' old), + try (parseComment' old), + try (parseEnum' old), + try (parseMessage' old) ] isEnd <- try ((lookAhead anyToken) >> return False) <|> return True if isEnd - then return x + then return new else do - y <- protoValue' x - return y + newNew <- protoValue' new + return newNew From 68de839a8e6c74d8958cf324052554703731242c Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Fri, 24 Nov 2023 11:45:55 +0100 Subject: [PATCH 13/55] fix spaces and comments --- app/Main.hs | 8 ++++--- protobuf-parser.cabal | 1 + src/ProtoParser/Comment.hs | 9 +++---- src/ProtoParser/Enum.hs | 23 +++++++++--------- src/ProtoParser/Import.hs | 6 ++--- src/ProtoParser/Message.hs | 25 ++++++++++---------- src/ProtoParser/Misc.hs | 12 +--------- src/ProtoParser/Package.hs | 4 ++-- src/ProtoParser/Service.hs | 27 ++++++++++----------- src/ProtoParser/Space.hs | 19 +++++++++++++++ test/Unit/Comment.hs | 1 + test/Unit/ProtoParser.hs | 48 +++++++++++++++++++++++++++++++++++++- 12 files changed, 123 insertions(+), 60 deletions(-) create mode 100644 src/ProtoParser/Space.hs diff --git a/app/Main.hs b/app/Main.hs index d93a633..e1e3b02 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -4,9 +4,11 @@ import ProtoParser erro :: String erro = - "package foo;\n\ - \message B {}\n\ - \package bar;" + "import \"foo.proto\";\n\ + \// comment\n\ + \package foobar;\n\ + \import \"bar.proto\";\ + \// comment\n" main :: IO () main = do diff --git a/protobuf-parser.cabal b/protobuf-parser.cabal index b4399b8..7c5059c 100644 --- a/protobuf-parser.cabal +++ b/protobuf-parser.cabal @@ -34,6 +34,7 @@ library ProtoParser.Misc ProtoParser.Package ProtoParser.Service + ProtoParser.Space other-modules: Paths_protobuf_parser autogen-modules: diff --git a/src/ProtoParser/Comment.hs b/src/ProtoParser/Comment.hs index 15c17aa..bfaaf8d 100644 --- a/src/ProtoParser/Comment.hs +++ b/src/ProtoParser/Comment.hs @@ -3,6 +3,7 @@ module ProtoParser.Comment parseComment', parseSingleLineComment, parseMultiLineComment, + removeComment, ) where @@ -13,6 +14,7 @@ import Text.Parsec import Text.Parsec.String parseComment' :: Protobuf -> Parser Protobuf +-- TODO: write try before do? parseComment' p = do _ <- parseComment return p @@ -27,13 +29,12 @@ parseComment = do -- TODO: correct way to try? try parseSingleLineComment <|> try parseMultiLineComment --- TODO: these comments could be anywhere parseSingleLineComment :: Parser Comment parseSingleLineComment = do - between (string "//") eol (many anyChar) + _ <- string "//" + manyTill anyChar (try eol) --- TODO: these comments could be anywhere (same as spaces) parseMultiLineComment :: Parser Comment -parseMultiLineComment = try $ do +parseMultiLineComment = do _ <- string "/*" manyTill anyChar (try (string "*/")) diff --git a/src/ProtoParser/Enum.hs b/src/ProtoParser/Enum.hs index c79c62f..b73a625 100644 --- a/src/ProtoParser/Enum.hs +++ b/src/ProtoParser/Enum.hs @@ -9,6 +9,7 @@ module ProtoParser.Enum where import ProtoParser.Misc +import ProtoParser.Space (spaces') import Protobuf import Text.Parsec import Text.Parsec.String @@ -24,13 +25,13 @@ parseEnum' p = do protoEnum :: Parser Protobuf.Enum protoEnum = do - spaces + spaces' _ <- string "enum" "Expected enum keyword" - spaces + spaces' name <- protoName "Expected enum name" - spaces + spaces' _ <- char '{' ("Expected '{' after enum name" ++ name) - spaces + spaces' values <- try enumField `sepEndBy1` (try (string ";") <|> try (string ";\n")) "Expected at least one enum value" return (Protobuf.Enum name values) @@ -42,11 +43,11 @@ enumField = do "option" -> do enumOption "reserved" -> do enumReserved _ -> do - spaces -- TODO: 1 space required? + spaces' _ <- char '=' - spaces -- TODO: 1 space required? + spaces' number <- enumNumber - spaces + spaces' return (EnumValue name number) -- https://protobuf.dev/programming-guides/proto3/#enum @@ -56,11 +57,11 @@ enumOption = do optionName <- protoName case optionName of "allow_alias" -> do - spaces + spaces' _ <- char '=' - spaces + spaces' active <- parseBoolOption - spaces + spaces' return (EnumOption "allow_alias" active) _ -> fail "Unknown option" @@ -73,7 +74,7 @@ parseBoolOption = -- https://protobuf.dev/programming-guides/proto3/#reserved enumReserved :: Parser EnumField enumReserved = do - spaces + spaces' try parseReservedNames <|> try parseReservedNumbers parseReservedNames :: Parser EnumField diff --git a/src/ProtoParser/Import.hs b/src/ProtoParser/Import.hs index c481d52..69a1cc6 100644 --- a/src/ProtoParser/Import.hs +++ b/src/ProtoParser/Import.hs @@ -1,6 +1,6 @@ module ProtoParser.Import (parseImport, parseImport') where -import ProtoParser.Misc (spaces1) +import ProtoParser.Space (spaces', spaces1) import Protobuf import Text.Parsec import Text.Parsec.String @@ -19,11 +19,11 @@ pathExtension = ".proto" parseImport :: Parser ImportPath parseImport = do - skipMany space + spaces' _ <- string "import" "Expected import keyword" spaces1 _ <- char '"' "Expected '\"' after import keyword" path <- anyChar `manyTill` string (pathExtension ++ "\"") - spaces + spaces' _ <- char ';' "Expected ';' at end of import statement" return (path ++ pathExtension) diff --git a/src/ProtoParser/Message.hs b/src/ProtoParser/Message.hs index 822c848..289895e 100644 --- a/src/ProtoParser/Message.hs +++ b/src/ProtoParser/Message.hs @@ -5,6 +5,7 @@ import ProtoParser.Misc import Protobuf import Text.Parsec import Text.Parsec.String +import ProtoParser.Space (spaces', spaces1) parseMessage' :: Protobuf -> Parser Protobuf parseMessage' p = do @@ -21,16 +22,16 @@ parseMessage = do parseMessage'' :: Parser Message parseMessage'' = do - spaces + spaces' _ <- string "message" spaces1 name <- protoName - spaces + spaces' _ <- char '{' - spaces + spaces' -- TODO: multiple inputs fields <- parseMessageField `sepEndBy1` char ';' - spaces + spaces' _ <- char '}' return (Message name (catMaybes fields)) @@ -76,22 +77,22 @@ parseStringType = do -- TODO: maps parseMap :: Parser MessageField parseMap = do - spaces + spaces' _ <- string "map" - spaces + spaces' _ <- char '<' - spaces + spaces' key <- parseMapKey - spaces + spaces' _ <- char ',' value <- parseMapValue - spaces + spaces' _ <- char '>' - spaces + spaces' name <- protoName -- TODO: missing - spaces + spaces' _ <- char '=' - spaces + spaces' fieldNumber <- protoNumber -- TODO: missing -> convert to MessageField return (MessageField (Map key value) name fieldNumber False) diff --git a/src/ProtoParser/Misc.hs b/src/ProtoParser/Misc.hs index f526239..60557ff 100644 --- a/src/ProtoParser/Misc.hs +++ b/src/ProtoParser/Misc.hs @@ -1,8 +1,6 @@ module ProtoParser.Misc - ( whitespace, - protoName, + ( protoName, protoNumber, - spaces1, eol, ) where @@ -12,14 +10,6 @@ import Protobuf import Text.Parsec import Text.Parsec.String -whitespace :: Parser () -whitespace = void (many (oneOf " \n\t")) "whitespace" - ----------------------------------------------------------------- - -spaces1 :: Parser () -spaces1 = skipMany1 space - ---------------------------------------------------------------- protoName :: Parser String diff --git a/src/ProtoParser/Package.hs b/src/ProtoParser/Package.hs index 402f6d5..5ba6bcb 100644 --- a/src/ProtoParser/Package.hs +++ b/src/ProtoParser/Package.hs @@ -1,6 +1,6 @@ module ProtoParser.Package (parsePackage, parsePackage') where -import ProtoParser.Misc (spaces1) +import ProtoParser.Space (spaces', spaces1) import Protobuf import Text.Parsec import Text.Parsec.String @@ -19,7 +19,7 @@ parsePackage' p = do parsePackage :: Parser Package parsePackage = do - skipMany space + spaces' _ <- string "package" "Expected package keyword" spaces1 anyChar `manyTill` char ';' "Expected package name followed by ';'" diff --git a/src/ProtoParser/Service.hs b/src/ProtoParser/Service.hs index 65de885..8004897 100644 --- a/src/ProtoParser/Service.hs +++ b/src/ProtoParser/Service.hs @@ -2,6 +2,7 @@ module ProtoParser.Service (parseService, parseService') where import Data.Maybe (catMaybes) import ProtoParser.Misc +import ProtoParser.Space (spaces', spaces1) import Protobuf import Text.Parsec import Text.Parsec.String @@ -21,41 +22,41 @@ parseService = do parseService'' :: Parser Service parseService'' = do - spaces + spaces' _ <- string "service" spaces1 name <- protoName - spaces + spaces' _ <- char '{' - spaces + spaces' fields <- try parseServiceField `sepEndBy1` char ';' - spaces + spaces' _ <- char '}' return (Service name (catMaybes fields)) parseServiceField :: Parser (Maybe RPC) parseServiceField = do - spaces + spaces' _ <- string "rpc" spaces1 name <- protoName - spaces + spaces' _ <- char '(' - spaces + spaces' isRequestStream <- option False (string "stream" >> spaces1 >> return True) request <- protoName - spaces + spaces' _ <- char ')' - spaces + spaces' _ <- string "returns" - spaces + spaces' _ <- char '(' - spaces + spaces' isReplyStream <- option False (string "stream" >> spaces1 >> return True) reply <- protoName - spaces + spaces' _ <- char ')' - spaces + spaces' return ( Just ( RPC diff --git a/src/ProtoParser/Space.hs b/src/ProtoParser/Space.hs new file mode 100644 index 0000000..e4f636c --- /dev/null +++ b/src/ProtoParser/Space.hs @@ -0,0 +1,19 @@ +module ProtoParser.Space + ( spaces', + spaces1, + ) +where + +import Control.Monad (void) +import ProtoParser.Comment (removeComment) +import Text.Parsec +import Text.Parsec.String + +space' :: Parser () +space' = (void space <|> removeComment) + +spaces' :: Parser () +spaces' = skipMany space' + +spaces1 :: Parser () +spaces1 = skipMany1 space' diff --git a/test/Unit/Comment.hs b/test/Unit/Comment.hs index b64cc9b..633406c 100644 --- a/test/Unit/Comment.hs +++ b/test/Unit/Comment.hs @@ -19,6 +19,7 @@ testSingleLineComment = TestCase $ do assertEqual "Simple Comment" " comment" (fromRight "incorrect" (parse parseSingleLineComment "" "// comment")) assertEqual "No Space" "comment" (fromRight "incorrect" (parse parseSingleLineComment "" "//comment")) assertEqual "Trailing Space" "comment " (fromRight "incorrect" (parse parseSingleLineComment "" "//comment ")) + assertEqual "New Line End" "comment " (fromRight "incorrect" (parse parseSingleLineComment "" "//comment \n")) ---------------------------------------------------------------- testMultiLineComment :: Test diff --git a/test/Unit/ProtoParser.hs b/test/Unit/ProtoParser.hs index e79d6f7..ac4905c 100644 --- a/test/Unit/ProtoParser.hs +++ b/test/Unit/ProtoParser.hs @@ -8,7 +8,8 @@ import Test.HUnit allTests :: [Test] allTests = [ TestLabel "text" testText, - TestLabel "splittedDefinitions" testSplittedDefinitions + TestLabel "splittedDefinitions" testSplittedDefinitions, + TestLabel "comments" testComments ] defaultTestProto :: Protobuf @@ -82,3 +83,48 @@ testText = TestCase $ do ) ) assertEqual "multiple package" False (isRight (parseProtobuf multiplePackageText)) + +textComment :: Protobuf +textComment = + ( Protobuf + { package = (Just "foobar"), + imports = ["foo.proto", "bar.proto"], + options = [], + enums = [], + messages = [], + services = [] + } + ) + +testComment1 :: String +testComment1 = + "import \"foo.proto\";\n\ + \// comment\n\ + \package foobar;\n\ + \import \"bar.proto\";" + +testComment2 :: String +testComment2 = + "import \"foo.proto\";\n\ + \/* comment */\n\ + \package foobar;\n\ + \import \"bar.proto\";" + +testComment3 :: String +testComment3 = + "import \"foo.proto\";\n\ + \package /* comment */ foobar;\n\ + \import \"bar.proto\";" + +testComment4 :: String +testComment4 = + "import \"foo.proto\";\n\ + \package /* comment \n\n */ foobar;\n\ + \import \"bar.proto\";" + +testComments :: Test +testComments = TestCase $ do + assertEqual "whole line 1" textComment (fromRight defaultTestProto (parseProtobuf testComment1)) + assertEqual "whole line 1" textComment (fromRight defaultTestProto (parseProtobuf testComment2)) + assertEqual "in-line" textComment (fromRight defaultTestProto (parseProtobuf testComment3)) + assertEqual "multi in-line" textComment (fromRight defaultTestProto (parseProtobuf testComment4)) From d0a130230ebedd39cf5062e282fba85a71f551f6 Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Fri, 24 Nov 2023 11:52:29 +0100 Subject: [PATCH 14/55] add additional ghc options --- package.yaml | 4 ++++ protobuf-parser.cabal | 6 +++--- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/package.yaml b/package.yaml index b54fa61..781b8a1 100644 --- a/package.yaml +++ b/package.yaml @@ -26,6 +26,10 @@ ghc-options: - -Wmissing-home-modules - -Wpartial-fields - -Wredundant-constraints + - -Werror -W -fwarn-unused-imports -fwarn-unused-binds -fwarn-orphans + - -fwarn-unused-matches -fwarn-unused-do-bind -fwarn-wrong-do-bind + - -fwarn-missing-signatures -fno-warn-partial-type-signatures + - -Wredundant-constraints -rtsopts library: source-dirs: src diff --git a/protobuf-parser.cabal b/protobuf-parser.cabal index 7c5059c..05ada9e 100644 --- a/protobuf-parser.cabal +++ b/protobuf-parser.cabal @@ -41,7 +41,7 @@ library Paths_protobuf_parser hs-source-dirs: src - ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Werror -W -fwarn-unused-imports -fwarn-unused-binds -fwarn-orphans -fwarn-unused-matches -fwarn-unused-do-bind -fwarn-wrong-do-bind -fwarn-missing-signatures -fno-warn-partial-type-signatures -Wredundant-constraints -rtsopts build-depends: base >=4.7 && <5 , parsec >=3.1.16 && <4 @@ -55,7 +55,7 @@ executable protobuf-parser-exe Paths_protobuf_parser hs-source-dirs: app - ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Werror -W -fwarn-unused-imports -fwarn-unused-binds -fwarn-orphans -fwarn-unused-matches -fwarn-unused-do-bind -fwarn-wrong-do-bind -fwarn-missing-signatures -fno-warn-partial-type-signatures -Wredundant-constraints -rtsopts -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.7 && <5 , parsec >=3.1.16 && <4 @@ -79,7 +79,7 @@ test-suite protobuf-parser-test Paths_protobuf_parser hs-source-dirs: test - ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Werror -W -fwarn-unused-imports -fwarn-unused-binds -fwarn-orphans -fwarn-unused-matches -fwarn-unused-do-bind -fwarn-wrong-do-bind -fwarn-missing-signatures -fno-warn-partial-type-signatures -Wredundant-constraints -rtsopts -threaded -rtsopts -with-rtsopts=-N build-depends: HUnit , base >=4.7 && <5 From 6a135c98cee20e963ef622b5e0e3f88df7ad2012 Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Fri, 24 Nov 2023 11:57:49 +0100 Subject: [PATCH 15/55] remove TODO comments --- src/ProtoParser.hs | 1 - src/ProtoParser/Comment.hs | 3 --- src/ProtoParser/Message.hs | 1 - src/ProtoParser/Misc.hs | 1 - 4 files changed, 6 deletions(-) diff --git a/src/ProtoParser.hs b/src/ProtoParser.hs index 9471a31..86c2fbf 100644 --- a/src/ProtoParser.hs +++ b/src/ProtoParser.hs @@ -1,4 +1,3 @@ --- TODO: export only the necessary functions module ProtoParser ( module ProtoParser.Enum, module ProtoParser.Misc, diff --git a/src/ProtoParser/Comment.hs b/src/ProtoParser/Comment.hs index bfaaf8d..8500a6f 100644 --- a/src/ProtoParser/Comment.hs +++ b/src/ProtoParser/Comment.hs @@ -14,19 +14,16 @@ import Text.Parsec import Text.Parsec.String parseComment' :: Protobuf -> Parser Protobuf --- TODO: write try before do? parseComment' p = do _ <- parseComment return p removeComment :: Parser () removeComment = do - -- TODO: correct way to try? void (try parseSingleLineComment <|> try parseMultiLineComment) parseComment :: Parser Comment parseComment = do - -- TODO: correct way to try? try parseSingleLineComment <|> try parseMultiLineComment parseSingleLineComment :: Parser Comment diff --git a/src/ProtoParser/Message.hs b/src/ProtoParser/Message.hs index 289895e..ea14059 100644 --- a/src/ProtoParser/Message.hs +++ b/src/ProtoParser/Message.hs @@ -74,7 +74,6 @@ parseStringType = do StringKey <$> protoName ---------------------------------------------------------------- --- TODO: maps parseMap :: Parser MessageField parseMap = do spaces' diff --git a/src/ProtoParser/Misc.hs b/src/ProtoParser/Misc.hs index 60557ff..c6eb8e3 100644 --- a/src/ProtoParser/Misc.hs +++ b/src/ProtoParser/Misc.hs @@ -36,6 +36,5 @@ protoNumber = ---------------------------------------------------------------- --- TODO : test eol :: Parser () eol = void (char '\n') <|> eof From 9ef448786e82e9fb1d6fbeef5752e690c9f5d2bb Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Fri, 24 Nov 2023 13:13:41 +0100 Subject: [PATCH 16/55] parse simple messages --- app/Main.hs | 15 ++++--- protobuf-parser.cabal | 5 ++- src/ProtoParser.hs | 6 ++- src/ProtoParser/Comment.hs | 2 +- src/ProtoParser/EndOfLine.hs | 8 ++++ src/ProtoParser/Enum.hs | 2 +- src/ProtoParser/Message.hs | 77 ++++++++++++---------------------- src/ProtoParser/Misc.hs | 40 ------------------ src/ProtoParser/Service.hs | 2 +- src/ProtoParser/Space.hs | 3 +- src/ProtoParser/Type.hs | 71 +++++++++++++++++++++++++++++++ src/Protobuf.hs | 6 +-- test/Spec.hs | 4 +- test/Unit/Comment.hs | 2 +- test/Unit/Message.hs | 16 +++++++ test/Unit/Package.hs | 1 - test/Unit/{Misc.hs => Type.hs} | 13 ++++-- 17 files changed, 159 insertions(+), 114 deletions(-) create mode 100644 src/ProtoParser/EndOfLine.hs delete mode 100644 src/ProtoParser/Misc.hs create mode 100644 src/ProtoParser/Type.hs rename test/Unit/{Misc.hs => Type.hs} (79%) diff --git a/app/Main.hs b/app/Main.hs index e1e3b02..5efbfab 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -3,12 +3,17 @@ module Main (main) where import ProtoParser erro :: String +-- erro = +-- "message Foo {\ +-- \int32 foo = 1;\ +-- \int32 bar = 2;\ +-- \}" + erro = - "import \"foo.proto\";\n\ - \// comment\n\ - \package foobar;\n\ - \import \"bar.proto\";\ - \// comment\n" + "message Foo {\ + \int32 bar = 2;\ + \}" + main :: IO () main = do diff --git a/protobuf-parser.cabal b/protobuf-parser.cabal index 05ada9e..51c9d2b 100644 --- a/protobuf-parser.cabal +++ b/protobuf-parser.cabal @@ -28,13 +28,14 @@ library Protobuf ProtoParser ProtoParser.Comment + ProtoParser.EndOfLine ProtoParser.Enum ProtoParser.Import ProtoParser.Message - ProtoParser.Misc ProtoParser.Package ProtoParser.Service ProtoParser.Space + ProtoParser.Type other-modules: Paths_protobuf_parser autogen-modules: @@ -70,10 +71,10 @@ test-suite protobuf-parser-test Unit.Enum Unit.Import Unit.Message - Unit.Misc Unit.Package Unit.ProtoParser Unit.Service + Unit.Type Paths_protobuf_parser autogen-modules: Paths_protobuf_parser diff --git a/src/ProtoParser.hs b/src/ProtoParser.hs index 86c2fbf..ff4cf9e 100644 --- a/src/ProtoParser.hs +++ b/src/ProtoParser.hs @@ -1,22 +1,24 @@ module ProtoParser ( module ProtoParser.Enum, - module ProtoParser.Misc, + module ProtoParser.Type, module ProtoParser.Import, module ProtoParser.Comment, module ProtoParser.Message, module ProtoParser.Package, module ProtoParser.Service, + module ProtoParser.EndOfLine, parseProtobuf, ) where import ProtoParser.Comment +import ProtoParser.EndOfLine import ProtoParser.Enum import ProtoParser.Import import ProtoParser.Message -import ProtoParser.Misc import ProtoParser.Package import ProtoParser.Service +import ProtoParser.Type import Protobuf import Text.Parsec import Text.Parsec.String diff --git a/src/ProtoParser/Comment.hs b/src/ProtoParser/Comment.hs index 8500a6f..d3fbc62 100644 --- a/src/ProtoParser/Comment.hs +++ b/src/ProtoParser/Comment.hs @@ -8,7 +8,7 @@ module ProtoParser.Comment where import Control.Monad (void) -import ProtoParser.Misc (eol) +import ProtoParser.EndOfLine (eol) import Protobuf import Text.Parsec import Text.Parsec.String diff --git a/src/ProtoParser/EndOfLine.hs b/src/ProtoParser/EndOfLine.hs new file mode 100644 index 0000000..5a08ec0 --- /dev/null +++ b/src/ProtoParser/EndOfLine.hs @@ -0,0 +1,8 @@ +module ProtoParser.EndOfLine (eol) where + +import Control.Monad (void) +import Text.Parsec +import Text.Parsec.String + +eol :: Parser () +eol = void (char '\n') <|> eof diff --git a/src/ProtoParser/Enum.hs b/src/ProtoParser/Enum.hs index b73a625..19129ec 100644 --- a/src/ProtoParser/Enum.hs +++ b/src/ProtoParser/Enum.hs @@ -8,7 +8,7 @@ module ProtoParser.Enum ) where -import ProtoParser.Misc +import ProtoParser.Type import ProtoParser.Space (spaces') import Protobuf import Text.Parsec diff --git a/src/ProtoParser/Message.hs b/src/ProtoParser/Message.hs index ea14059..a51ee6d 100644 --- a/src/ProtoParser/Message.hs +++ b/src/ProtoParser/Message.hs @@ -1,11 +1,11 @@ module ProtoParser.Message (parseMessage, parseMessage', parseMap) where import Data.Maybe (catMaybes) -import ProtoParser.Misc +import ProtoParser.Space (spaces', spaces1) +import ProtoParser.Type import Protobuf import Text.Parsec import Text.Parsec.String -import ProtoParser.Space (spaces', spaces1) parseMessage' :: Protobuf -> Parser Protobuf parseMessage' p = do @@ -29,49 +29,31 @@ parseMessage'' = do spaces' _ <- char '{' spaces' - -- TODO: multiple inputs - fields <- parseMessageField `sepEndBy1` char ';' + fields <- parseMessageField `sepEndBy` char ';' spaces' _ <- char '}' return (Message name (catMaybes fields)) parseMessageField :: Parser (Maybe MessageField) parseMessageField = do - return Nothing - --- return (Just (MessageField t "" 0 False)) --- t :: ProtoDataType --- t = return MessageName "" - ----------------------------------------------------------------- -parseIntType :: Parser MapKey -parseIntType = - let int32 = string "int32" >> return (IntKey Int32) - int64 = string "int64" >> return (IntKey Int64) - uint32 = string "uint32" >> return (IntKey UInt32) - uint64 = string "uint64" >> return (IntKey UInt64) - sint32 = string "sint32" >> return (IntKey SInt32) - sint64 = string "sint64" >> return (IntKey SInt64) - fixed32 = string "fixed32" >> return (IntKey Fixed32) - fixed64 = string "fixed64" >> return (IntKey Fixed64) - sfixed32 = string "sfixed32" >> return (IntKey SFixed32) - sfixed64 = string "sfixed64" >> return (IntKey SFixed64) - in do - int32 - <|> int64 - <|> uint32 - <|> uint64 - <|> sint32 - <|> sint64 - <|> fixed32 - <|> fixed64 - <|> sfixed32 - <|> sfixed64 + spaces' + -- _ <- try (string "repeated") -- TODO: optional + -- spaces' + t <- parseDataType + spaces' + name <- protoName + spaces' + _ <- char '=' + spaces' + fieldNumber <- protoNumber + spaces' + return (Just (MessageField t name fieldNumber False)) ----------------------------------------------------------------- -parseStringType :: Parser MapKey -parseStringType = do - StringKey <$> protoName +parseDataType :: Parser DataType +parseDataType = + do + Scalar <$> parseScalarType + <|> Compound <$> protoName ---------------------------------------------------------------- parseMap :: Parser MessageField @@ -81,25 +63,18 @@ parseMap = do spaces' _ <- char '<' spaces' - key <- parseMapKey + key <- + IntKey <$> parseIntType + <|> StringKey <$> protoName spaces' _ <- char ',' - value <- parseMapValue + value <- MapName <$> protoName spaces' _ <- char '>' spaces' - name <- protoName -- TODO: missing + name <- protoName spaces' _ <- char '=' spaces' - fieldNumber <- protoNumber -- TODO: missing -> convert to MessageField + fieldNumber <- protoNumber return (MessageField (Map key value) name fieldNumber False) - -parseMapKey :: Parser MapKey -parseMapKey = do - parseIntType <|> parseStringType -- order is important! - -parseMapValue :: Parser MapValue -parseMapValue = do - -- TODO: any type except other map - MapName <$> protoName diff --git a/src/ProtoParser/Misc.hs b/src/ProtoParser/Misc.hs deleted file mode 100644 index c6eb8e3..0000000 --- a/src/ProtoParser/Misc.hs +++ /dev/null @@ -1,40 +0,0 @@ -module ProtoParser.Misc - ( protoName, - protoNumber, - eol, - ) -where - -import Control.Monad (void) -import Protobuf -import Text.Parsec -import Text.Parsec.String - ----------------------------------------------------------------- - -protoName :: Parser String -protoName = do - first <- letter "Expected first letter to be ...?" - rest <- many (alphaNum <|> char '_' "Expected letter, number or '_'") - return (first : rest) - ----------------------------------------------------------------- - -protoNumber :: Parser FieldNumber -protoNumber = - -- https://protobuf.dev/programming-guides/proto3/#assigning - let val = (read <$> many1 digit) - in do - n <- val - -- 19,000 to 19,999 are reserved for the Protocol Buffers - if n >= 19000 && n <= 19999 - then fail "number reserved" - else - if n >= 1 && n <= 536870911 -- Range from 1 to 536,870,911 - then return n - else fail "number out of range" - ----------------------------------------------------------------- - -eol :: Parser () -eol = void (char '\n') <|> eof diff --git a/src/ProtoParser/Service.hs b/src/ProtoParser/Service.hs index 8004897..0ec5d17 100644 --- a/src/ProtoParser/Service.hs +++ b/src/ProtoParser/Service.hs @@ -1,7 +1,7 @@ module ProtoParser.Service (parseService, parseService') where import Data.Maybe (catMaybes) -import ProtoParser.Misc +import ProtoParser.Type import ProtoParser.Space (spaces', spaces1) import Protobuf import Text.Parsec diff --git a/src/ProtoParser/Space.hs b/src/ProtoParser/Space.hs index e4f636c..8240d8b 100644 --- a/src/ProtoParser/Space.hs +++ b/src/ProtoParser/Space.hs @@ -1,5 +1,6 @@ module ProtoParser.Space - ( spaces', + ( space', + spaces', spaces1, ) where diff --git a/src/ProtoParser/Type.hs b/src/ProtoParser/Type.hs new file mode 100644 index 0000000..1410c6a --- /dev/null +++ b/src/ProtoParser/Type.hs @@ -0,0 +1,71 @@ +module ProtoParser.Type + ( module ProtoParser.Type, + ) +where + +import Protobuf +import Text.Parsec +import Text.Parsec.String + +protoName :: Parser String +protoName = do + first <- letter "Expected first letter to be ...?" + rest <- many (alphaNum <|> char '_' "Expected letter, number or '_'") + return (first : rest) + +---------------------------------------------------------------- + +protoNumber :: Parser FieldNumber +protoNumber = + -- https://protobuf.dev/programming-guides/proto3/#assigning + let val = (read <$> many1 digit) + in do + n <- val + -- 19,000 to 19,999 are reserved for the Protocol Buffers + if n >= 19000 && n <= 19999 + then fail "number reserved" + else + if n >= 1 && n <= 536870911 -- Range from 1 to 536,870,911 + then return n + else fail "number out of range" + +---------------------------------------------------------------- + +parseIntType :: Parser IntType +parseIntType = + let int32 = string "int32" >> return (Int32) + int64 = string "int64" >> return (Int64) + uint32 = string "uint32" >> return (UInt32) + uint64 = string "uint64" >> return (UInt64) + sint32 = string "sint32" >> return (SInt32) + sint64 = string "sint64" >> return (SInt64) + fixed32 = string "fixed32" >> return (Fixed32) + fixed64 = string "fixed64" >> return (Fixed64) + sfixed32 = string "sfixed32" >> return (SFixed32) + sfixed64 = string "sfixed64" >> return (SFixed64) + in do + int32 + <|> int64 + <|> uint32 + <|> uint64 + <|> sint32 + <|> sint64 + <|> fixed32 + <|> fixed64 + <|> sfixed32 + <|> sfixed64 + +---------------------------------------------------------------- +parseStringType :: Parser MapKey +parseStringType = do + StringKey <$> protoName + +parseScalarType :: Parser ScalarType +parseScalarType = + do + intType <- parseIntType + return (IntType intType) + <|> (string "double" >> return (FloatType Double)) + <|> (string "float" >> return (FloatType Float)) + <|> (string "string" >> return StringType) + <|> (string "bytes" >> return BytesType) diff --git a/src/Protobuf.hs b/src/Protobuf.hs index fd9f42c..16182a1 100644 --- a/src/Protobuf.hs +++ b/src/Protobuf.hs @@ -42,7 +42,7 @@ data FloatType | Float deriving (Show, Eq) -data ScalarType = IntType IntType | FloatType FloatType | String | Bytes | Bool +data ScalarType = IntType IntType | FloatType FloatType | StringType | BytesType | BoolType deriving (Show, Eq) data MapKey = StringKey String | IntKey IntType @@ -51,10 +51,10 @@ data MapKey = StringKey String | IntKey IntType data MapValue = MapName String | ScalarType deriving (Show, Eq) -data ProtoDataType = ProtoScalarType | MessageName | EnumName | Map MapKey MapValue +data DataType = Scalar ScalarType | Compound Name | Map MapKey MapValue deriving (Show, Eq) -data MessageField = MessageField ProtoDataType Name FieldNumber Repeat +data MessageField = MessageField DataType Name FieldNumber Repeat deriving (Show, Eq) data Message = Message MessageName [MessageField] diff --git a/test/Spec.hs b/test/Spec.hs index 99054e2..94972e7 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -3,17 +3,17 @@ import Unit.Comment as Comment import Unit.Enum as Unit import Unit.Import as Import import Unit.Message as Message -import Unit.Misc as Misc import Unit.Package as Package import Unit.ProtoParser as Protobuf import Unit.Service as Service +import Unit.Type as Type main :: IO () main = runTestTTAndExit ( TestList ( Unit.allTests - ++ Misc.allTests + ++ Type.allTests ++ Import.allTests ++ Protobuf.allTests ++ Comment.allTests diff --git a/test/Unit/Comment.hs b/test/Unit/Comment.hs index 633406c..9df1e1d 100644 --- a/test/Unit/Comment.hs +++ b/test/Unit/Comment.hs @@ -9,7 +9,7 @@ allTests :: [Test] allTests = [ TestLabel "testSingleLine" testSingleLineComment, TestLabel "testMultiLine" testMultiLineComment, - TestLabel "both" testMultiLineComment + TestLabel "both" testBothComments ] testSingleLineComment :: Test diff --git a/test/Unit/Message.hs b/test/Unit/Message.hs index 8b5242a..37290d5 100644 --- a/test/Unit/Message.hs +++ b/test/Unit/Message.hs @@ -15,12 +15,28 @@ allTests = failMessage :: Message failMessage = Message "FAIL" [] +testMessage1 :: String +testMessage1 = + "message Foo {\ + \int32 foo = 1;\ + \double bar = 2;\ + \}" + +testMessage1Proto :: Message +testMessage1Proto = + Message + "Foo" + [ MessageField (Scalar (IntType Int32)) "foo" 1 False, + MessageField (Scalar (FloatType Double)) "bar" 2 False + ] + testSimple :: Test testSimple = TestCase $ do assertEqual "empty" False (isRight (parse parseMessage "" "")) assertEqual "keyword only" False (isRight (parse parseMessage "" "message")) assertEqual "missing name" False (isRight (parse parseMessage "" "message {}")) assertEqual "emptyMessage" (Message "Foo" []) (fromRight failMessage (parse parseMessage "" "message Foo {}")) + assertEqual "simple" testMessage1Proto (fromRight failMessage (parse parseMessage "" testMessage1)) ---------------------------------------------------------------- diff --git a/test/Unit/Package.hs b/test/Unit/Package.hs index 7db8385..aa8a6bb 100644 --- a/test/Unit/Package.hs +++ b/test/Unit/Package.hs @@ -2,7 +2,6 @@ module Unit.Package (allTests) where import Data.Either (fromRight, isRight) import ProtoParser.Package -import Protobuf (Package) import Test.HUnit import Text.Parsec (parse) diff --git a/test/Unit/Misc.hs b/test/Unit/Type.hs similarity index 79% rename from test/Unit/Misc.hs rename to test/Unit/Type.hs index 393c5af..d58823c 100644 --- a/test/Unit/Misc.hs +++ b/test/Unit/Type.hs @@ -1,14 +1,16 @@ -module Unit.Misc (allTests) where +module Unit.Type (allTests) where import Data.Either (fromRight, isRight) -import ProtoParser.Misc +import ProtoParser.Type +import Protobuf import Test.HUnit import Text.Parsec (parse) allTests :: [Test] allTests = [ TestLabel "numberParser" testNumberParser, - TestLabel "protoName" testProtoName + TestLabel "protoName" testProtoName, + TestLabel "scalarType" testSclarType ] testNumberParser :: Test @@ -36,3 +38,8 @@ testProtoName = TestCase $ do assertEqual "not a name" False (isRight (parse protoName "" "-1")) assertEqual "Uppercase" "TEST" (fromRight "Default" (parse protoName "" "TEST")) assertEqual "UpperCamelCase" "TestTest" (fromRight "Default" (parse protoName "" "TestTest")) + +testSclarType :: Test +testSclarType = TestCase $ do + assertEqual "int32" ((IntType Int32)) (fromRight (BoolType) (parse parseScalarType "" "int32")) + assertEqual "double" ((FloatType Double)) (fromRight (BoolType) (parse parseScalarType "" "double")) From 43f373ab92f5f47d7435b85a99490030947293ea Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Fri, 24 Nov 2023 13:28:27 +0100 Subject: [PATCH 17/55] auto format --- src/ProtoParser/Service.hs | 2 +- test/Unit/Message.hs | 1 - 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/src/ProtoParser/Service.hs b/src/ProtoParser/Service.hs index 0ec5d17..f8905ec 100644 --- a/src/ProtoParser/Service.hs +++ b/src/ProtoParser/Service.hs @@ -1,8 +1,8 @@ module ProtoParser.Service (parseService, parseService') where import Data.Maybe (catMaybes) -import ProtoParser.Type import ProtoParser.Space (spaces', spaces1) +import ProtoParser.Type import Protobuf import Text.Parsec import Text.Parsec.String diff --git a/test/Unit/Message.hs b/test/Unit/Message.hs index 37290d5..e2b9078 100644 --- a/test/Unit/Message.hs +++ b/test/Unit/Message.hs @@ -43,7 +43,6 @@ testSimple = TestCase $ do defaulTestMap :: MessageField defaulTestMap = MessageField (Map (StringKey "") (MapName "")) "TEST" 0 False --- map map_field = N; testMap :: Test testMap = TestCase $ do assertEqual "empty" False (isRight (parse parseMap "" "")) From e7b709cfd333a49eaa7e4f0a25991a437126624f Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Fri, 24 Nov 2023 14:35:29 +0100 Subject: [PATCH 18/55] extract reserved fields from enum --- app/Main.hs | 15 ++++++----- protobuf-parser.cabal | 1 + src/ProtoParser/Enum.hs | 51 +++++++++++------------------------ src/ProtoParser/Message.hs | 2 ++ src/ProtoParser/Reserved.hs | 53 +++++++++++++++++++++++++++++++++++++ src/Protobuf.hs | 11 ++++++-- test/Unit/Enum.hs | 30 ++++++++++----------- 7 files changed, 103 insertions(+), 60 deletions(-) create mode 100644 src/ProtoParser/Reserved.hs diff --git a/app/Main.hs b/app/Main.hs index 5efbfab..0992689 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,22 +1,23 @@ module Main (main) where import ProtoParser +import Text.Parsec (parse) -erro :: String +-- erro :: String -- erro = -- "message Foo {\ -- \int32 foo = 1;\ -- \int32 bar = 2;\ -- \}" -erro = - "message Foo {\ - \int32 bar = 2;\ - \}" - +-- erro = + -- "message Foo {\ + -- \int32 bar = 2;\ + -- \}" main :: IO () main = do - case parseProtobuf erro of + -- case parseProtobuf erro of {} + case parse enumField "" "reserved 1, 2" of Left err -> print err Right res -> print res diff --git a/protobuf-parser.cabal b/protobuf-parser.cabal index 51c9d2b..e601343 100644 --- a/protobuf-parser.cabal +++ b/protobuf-parser.cabal @@ -33,6 +33,7 @@ library ProtoParser.Import ProtoParser.Message ProtoParser.Package + ProtoParser.Reserved ProtoParser.Service ProtoParser.Space ProtoParser.Type diff --git a/src/ProtoParser/Enum.hs b/src/ProtoParser/Enum.hs index 19129ec..8f3dcfb 100644 --- a/src/ProtoParser/Enum.hs +++ b/src/ProtoParser/Enum.hs @@ -3,13 +3,15 @@ module ProtoParser.Enum parseEnum', enumField, enumNumber, + enumNumberRange, protoName, reservedNumbers, ) where -import ProtoParser.Type +import ProtoParser.Reserved import ProtoParser.Space (spaces') +import ProtoParser.Type import Protobuf import Text.Parsec import Text.Parsec.String @@ -71,7 +73,6 @@ parseBoolOption = <|> (string "false" >> return False) "Expected true or false" --- https://protobuf.dev/programming-guides/proto3/#reserved enumReserved :: Parser EnumField enumReserved = do spaces' @@ -79,48 +80,26 @@ enumReserved = do parseReservedNames :: Parser EnumField parseReservedNames = do - names <- try reservedNames `sepEndBy1` char ',' - return (EnumReserved (Names (concat names))) + names <- reservedNames + return (EnumReserved (ReservedEnumNames names)) parseReservedNumbers :: Parser EnumField parseReservedNumbers = do - numbers <- try reservedNumbers `sepEndBy1` char ',' - return (EnumReserved (Numbers (concat numbers))) - -reservedNames :: Parser [EnumName] -reservedNames = do - _ <- many space - _ <- char '\"' - name <- protoName - _ <- char '\"' - return [name] - -reservedNumbersSingle :: Parser [EnumNumber] -reservedNumbersSingle = do - _ <- many space - firstNumber <- enumNumber - _ <- many space - return [firstNumber] - -reservedNumbersRange :: Parser [EnumNumber] -reservedNumbersRange = do - let numValues = try enumNumber <|> try (string "min" >> return 0) <|> try (string "max" >> return 0xFFFFFFFF) - firstNumber <- numValues - _ <- many space - _ <- string "to" - _ <- many space - secondNumber <- numValues - return [firstNumber .. secondNumber] - -reservedNumbers :: Parser [EnumNumber] -reservedNumbers = try reservedNumbersRange <|> try reservedNumbersSingle + numbers <- try (reservedNumbers enumNumber enumNumberRange) `sepEndBy1` char ',' + return (EnumReserved (ReservedEnumNumbers (concat numbers))) enumNumber :: Parser EnumNumber enumNumber = -- https://protobuf.dev/programming-guides/proto3/#enum let val = (read <$> many1 digit) in do + -- TODO move min/max to here but in seperate parser because cant mix with standalone n <- val - if n >= (minBound :: FieldNumber) && n <= (maxBound :: FieldNumber) - then return (fromIntegral n) + if n >= (minBound :: EnumNumber) && n <= (maxBound :: EnumNumber) + then return n else fail "Number not in valid range" + +enumNumberRange :: Parser EnumNumber +enumNumberRange = do + n <- enumNumber <|> try (string "min" >> return 0) <|> try (string "max" >> return 0xFFFFFFFF) + return n diff --git a/src/ProtoParser/Message.hs b/src/ProtoParser/Message.hs index a51ee6d..db6b279 100644 --- a/src/ProtoParser/Message.hs +++ b/src/ProtoParser/Message.hs @@ -78,3 +78,5 @@ parseMap = do spaces' fieldNumber <- protoNumber return (MessageField (Map key value) name fieldNumber False) + +-- TODO: one of diff --git a/src/ProtoParser/Reserved.hs b/src/ProtoParser/Reserved.hs new file mode 100644 index 0000000..023f3ca --- /dev/null +++ b/src/ProtoParser/Reserved.hs @@ -0,0 +1,53 @@ +module ProtoParser.Reserved + ( module ProtoParser.Reserved, + ) +where + +import ProtoParser.Space (spaces') +import ProtoParser.Type +import Protobuf +import Text.Parsec +import Text.Parsec.String + +-- https://protobuf.dev/programming-guides/proto3/#reserved + +---------------------------------------------------------------- + +reservedNames :: Parser ReservedNames +reservedNames = do + names <- try reservedNames' `sepBy1` char ',' + return (ReservedNames (concat names)) + +reservedNames' :: Parser [Name] +reservedNames' = do + _ <- spaces' + _ <- char '\"' + name <- protoName + _ <- char '\"' + return [name] + +---------------------------------------------------------------- + +reservedNumbersSingle :: Parser a -> Parser [a] +reservedNumbersSingle p = do + _ <- spaces' + firstNumber <- p + _ <- spaces' + return [firstNumber] + +reservedNumbersRange :: (Integral a) => Parser a -> Parser [a] +reservedNumbersRange range = do + firstNumber <- range + _ <- spaces' + _ <- string "to" + _ <- spaces' + secondNumber <- range + return [firstNumber .. secondNumber] + +reservedNumbers :: (Integral a) => Parser a -> Parser a -> Parser [a] +reservedNumbers single range = do + numbers <- try (reservedNumbers' single range) `sepBy1` char ',' + return ((concat numbers)) + +reservedNumbers' :: (Integral a) => Parser a -> Parser a -> Parser [a] +reservedNumbers' single range = try (reservedNumbersRange range) <|> try (reservedNumbersSingle single) diff --git a/src/Protobuf.hs b/src/Protobuf.hs index 16182a1..257ba0d 100644 --- a/src/Protobuf.hs +++ b/src/Protobuf.hs @@ -54,13 +54,20 @@ data MapValue = MapName String | ScalarType data DataType = Scalar ScalarType | Compound Name | Map MapKey MapValue deriving (Show, Eq) -data MessageField = MessageField DataType Name FieldNumber Repeat +data MessageField = MessageField DataType Name FieldNumber Repeat | MessageReserved MessageReservedValues deriving (Show, Eq) data Message = Message MessageName [MessageField] deriving (Show, Eq) -data EnumReservedValues = Numbers [EnumNumber] | Names [Name] +data ReservedNames = ReservedNames [Name] + deriving (Show, Eq) + +data MessageReservedValues = ReservedMessageNumbers [FieldNumber] | ReservedMessageNames ReservedNames + deriving (Show, Eq) + +-- TODO: make reserved type generic +data EnumReservedValues = ReservedEnumNumbers [EnumNumber] | ReservedEnumNames ReservedNames deriving (Show, Eq) data EnumField = EnumValue Name EnumNumber | EnumOption Name Bool | EnumReserved EnumReservedValues diff --git a/test/Unit/Enum.hs b/test/Unit/Enum.hs index c4da388..b7795f6 100644 --- a/test/Unit/Enum.hs +++ b/test/Unit/Enum.hs @@ -10,16 +10,16 @@ allTests :: [Test] allTests = [ TestLabel "enumFieldParser" testEnumFieldParser, TestLabel "enumParser" testEnumParser, - TestLabel "reservedNumbers" testReservedNumbers, + TestLabel "reservedEnumNumbers" testReservedEnumNumbers, TestLabel "fieldNumbers" testEnumFieldNumbers ] ---------------------------------------------------------------- -testReservedNumbers :: Test -testReservedNumbers = TestCase $ do - assertEqual "empty" False (isRight (parse reservedNumbers "" "")) - assertEqual "single" [0] (fromRight [] (parse reservedNumbers "" "0")) - assertEqual "range" [0, 1, 2] (fromRight [] (parse reservedNumbers "" "min to 2")) +testReservedEnumNumbers :: Test +testReservedEnumNumbers = TestCase $ do + assertEqual "empty" False (isRight (parse (reservedNumbers enumNumber enumNumberRange) "" "")) + assertEqual "single" [0] (fromRight [] (parse (reservedNumbers enumNumber enumNumberRange) "" "0")) + assertEqual "range" [0, 1, 2] (fromRight [] (parse (reservedNumbers enumNumber enumNumberRange) "" "min to 2")) ---------------------------------------------------------------- @@ -35,18 +35,18 @@ testEnumFieldParser = TestCase $ do -- reserved number -- assertEqual "empytReserved" False (isRight (parse enumField "" "reserved")) assertEqual "outOfRangeSingleReserved" False (isRight (parse enumField "" "reserved -1")) - assertEqual "multiReserved" (EnumReserved (Numbers [1, 2])) (fromRight emptyDefault (parse enumField "" "reserved 1, 2")) - assertEqual "multiReserved" (EnumReserved (Numbers [1, 3, 5])) (fromRight emptyDefault (parse enumField "" "reserved 1, 3, 5")) - assertEqual "multiReserved" (EnumReserved (Numbers [1, 2, 3])) (fromRight emptyDefault (parse enumField "" "reserved 1 to 3")) - assertEqual "multiReserved" (EnumReserved (Numbers [0, 1, 2, 3])) (fromRight emptyDefault (parse enumField "" "reserved min to 3")) - assertEqual "multiReserved" (EnumReserved (Numbers [4294967294, 0xFFFFFFFF])) (fromRight emptyDefault (parse enumField "" "reserved 4294967294 to max")) - assertEqual "singleReserved" (EnumReserved (Numbers [0])) (fromRight emptyDefault (parse enumField "" "reserved 0")) - assertEqual "singleReserved" (EnumReserved (Numbers [1])) (fromRight emptyDefault (parse enumField "" "reserved 1")) + assertEqual "multiReserved" (EnumReserved (ReservedEnumNumbers [1, 2])) (fromRight emptyDefault (parse enumField "" "reserved 1, 2")) + assertEqual "multiReserved" (EnumReserved (ReservedEnumNumbers [1, 3, 5])) (fromRight emptyDefault (parse enumField "" "reserved 1, 3, 5")) + assertEqual "multiReserved" (EnumReserved (ReservedEnumNumbers [1, 2, 3])) (fromRight emptyDefault (parse enumField "" "reserved 1 to 3")) + assertEqual "multiReserved" (EnumReserved (ReservedEnumNumbers [0, 1, 2, 3])) (fromRight emptyDefault (parse enumField "" "reserved min to 3")) + assertEqual "multiReserved" (EnumReserved (ReservedEnumNumbers [4294967294, 0xFFFFFFFF])) (fromRight emptyDefault (parse enumField "" "reserved 4294967294 to max")) + assertEqual "singleReserved" (EnumReserved (ReservedEnumNumbers [0])) (fromRight emptyDefault (parse enumField "" "reserved 0")) + assertEqual "singleReserved" (EnumReserved (ReservedEnumNumbers [1])) (fromRight emptyDefault (parse enumField "" "reserved 1")) -- assertEqual "reservedIncorrectNumberFormat" False (isRight (parse enumField "" "reserved 1 2")) -- cant parse with enumField alone anymore -- reserved name -- assertEqual "emptyReservedName" False (isRight (parse enumField "" "reserved")) - assertEqual "singleReservedName" (EnumReserved (Names ["FOO"])) (fromRight emptyDefault (parse enumField "" "reserved \"FOO\"")) - assertEqual "multiReservedName" (EnumReserved (Names ["FOO", "BAR"])) (fromRight emptyDefault (parse enumField "" "reserved \"FOO\", \"BAR\"")) + assertEqual "singleReservedName" (EnumReserved (ReservedEnumNames (ReservedNames ["FOO"]))) (fromRight emptyDefault (parse enumField "" "reserved \"FOO\"")) + assertEqual "multiReservedName" (EnumReserved (ReservedEnumNames (ReservedNames ["FOO", "BAR"]))) (fromRight emptyDefault (parse enumField "" "reserved \"FOO\", \"BAR\"")) -- option -- assertEqual "empyt" False (isRight (parse enumField "" "option invalid_option = true")) assertEqual "invalidOption" (EnumOption "allow_alias" True) (fromRight emptyDefault (parse enumField "" "option allow_alias = true")) From 362777a8a777107066be340498f5a2f8e4187051 Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Fri, 24 Nov 2023 15:03:28 +0100 Subject: [PATCH 19/55] add reserved to message --- app/Main.hs | 22 +++++++---------- src/ProtoParser/Enum.hs | 2 +- src/ProtoParser/Message.hs | 49 +++++++++++++++++++++++++++++--------- src/ProtoParser/Type.hs | 4 ++-- test/Unit/Message.hs | 14 +++++++++++ 5 files changed, 64 insertions(+), 27 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 0992689..2669f9e 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,23 +1,19 @@ module Main (main) where import ProtoParser -import Text.Parsec (parse) --- erro :: String --- erro = --- "message Foo {\ --- \int32 foo = 1;\ --- \int32 bar = 2;\ --- \}" +-- import Text.Parsec (parse) --- erro = - -- "message Foo {\ - -- \int32 bar = 2;\ - -- \}" +erro :: String +erro = + "message Foo {\ + \int32 foo = 1;\ + \int32 bar = 2;\ + \reserved 1, 2;\ + \}" main :: IO () main = do - -- case parseProtobuf erro of {} - case parse enumField "" "reserved 1, 2" of + case parseProtobuf erro of Left err -> print err Right res -> print res diff --git a/src/ProtoParser/Enum.hs b/src/ProtoParser/Enum.hs index 8f3dcfb..16dc6b3 100644 --- a/src/ProtoParser/Enum.hs +++ b/src/ProtoParser/Enum.hs @@ -41,6 +41,7 @@ enumField :: Parser EnumField enumField = do spaces name <- protoName + -- TODO: exctact to extra parser functions case name of "option" -> do enumOption "reserved" -> do enumReserved @@ -93,7 +94,6 @@ enumNumber = -- https://protobuf.dev/programming-guides/proto3/#enum let val = (read <$> many1 digit) in do - -- TODO move min/max to here but in seperate parser because cant mix with standalone n <- val if n >= (minBound :: EnumNumber) && n <= (maxBound :: EnumNumber) then return n diff --git a/src/ProtoParser/Message.hs b/src/ProtoParser/Message.hs index db6b279..16ac788 100644 --- a/src/ProtoParser/Message.hs +++ b/src/ProtoParser/Message.hs @@ -1,6 +1,6 @@ module ProtoParser.Message (parseMessage, parseMessage', parseMap) where -import Data.Maybe (catMaybes) +import ProtoParser.Reserved import ProtoParser.Space (spaces', spaces1) import ProtoParser.Type import Protobuf @@ -10,6 +10,7 @@ import Text.Parsec.String parseMessage' :: Protobuf -> Parser Protobuf parseMessage' p = do x <- parseMessage + -- TODO: check for validity of message? return ( Protobuf.merge p @@ -32,22 +33,26 @@ parseMessage'' = do fields <- parseMessageField `sepEndBy` char ';' spaces' _ <- char '}' - return (Message name (catMaybes fields)) + return (Message name (fields)) -parseMessageField :: Parser (Maybe MessageField) +parseMessageField :: Parser MessageField parseMessageField = do spaces' -- _ <- try (string "repeated") -- TODO: optional -- spaces' + -- TODO: extra function parser for reserved to avoid this workaround t <- parseDataType - spaces' - name <- protoName - spaces' - _ <- char '=' - spaces' - fieldNumber <- protoNumber - spaces' - return (Just (MessageField t name fieldNumber False)) + case t of + (Compound "reserved") -> do messageReserved + _ -> do + spaces' + name <- protoName + spaces' + _ <- char '=' + spaces' + fieldNumber <- protoNumber + spaces' + return (MessageField t name fieldNumber False) parseDataType :: Parser DataType parseDataType = @@ -80,3 +85,25 @@ parseMap = do return (MessageField (Map key value) name fieldNumber False) -- TODO: one of + +---------------------------------------------------------------- + +messageReserved :: Parser MessageField +messageReserved = do + spaces' + try parseReservedNames <|> try parseReservedNumbers + +parseReservedNames :: Parser MessageField +parseReservedNames = do + names <- reservedNames + return (MessageReserved (ReservedMessageNames names)) + +parseReservedNumbers :: Parser MessageField +parseReservedNumbers = do + numbers <- try (reservedNumbers protoNumber fieldNumberRange) `sepEndBy1` char ',' + return (MessageReserved (ReservedMessageNumbers (concat numbers))) + +fieldNumberRange :: Parser FieldNumber +fieldNumberRange = do + n <- protoNumber <|> try (string "min" >> return 1) <|> try (string "max" >> return 0xFFFFFFFF) + return n diff --git a/src/ProtoParser/Type.hs b/src/ProtoParser/Type.hs index 1410c6a..0c4cf11 100644 --- a/src/ProtoParser/Type.hs +++ b/src/ProtoParser/Type.hs @@ -22,10 +22,10 @@ protoNumber = in do n <- val -- 19,000 to 19,999 are reserved for the Protocol Buffers - if n >= 19000 && n <= 19999 + if 19000 <= n && n <= 19999 then fail "number reserved" else - if n >= 1 && n <= 536870911 -- Range from 1 to 536,870,911 + if 1 <= n && n <= 536870911 -- Range from 1 to 536,870,911 then return n else fail "number out of range" diff --git a/test/Unit/Message.hs b/test/Unit/Message.hs index e2b9078..922c329 100644 --- a/test/Unit/Message.hs +++ b/test/Unit/Message.hs @@ -30,6 +30,19 @@ testMessage1Proto = MessageField (Scalar (FloatType Double)) "bar" 2 False ] +testMessageReserved :: String +testMessageReserved = + "message Foo {\ + \reserved 1, 2;\ + \}" + +testMessageReservedProto :: Message +testMessageReservedProto = + Message + "Foo" + [ MessageReserved (ReservedMessageNumbers [1, 2]) + ] + testSimple :: Test testSimple = TestCase $ do assertEqual "empty" False (isRight (parse parseMessage "" "")) @@ -37,6 +50,7 @@ testSimple = TestCase $ do assertEqual "missing name" False (isRight (parse parseMessage "" "message {}")) assertEqual "emptyMessage" (Message "Foo" []) (fromRight failMessage (parse parseMessage "" "message Foo {}")) assertEqual "simple" testMessage1Proto (fromRight failMessage (parse parseMessage "" testMessage1)) + assertEqual "reserved" testMessageReservedProto (fromRight failMessage (parse parseMessage "" testMessageReserved)) ---------------------------------------------------------------- From 0c70e898d2af36ba84aa02fbbfa936211b63b397 Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Fri, 24 Nov 2023 15:09:14 +0100 Subject: [PATCH 20/55] move map parser to Type --- src/ProtoParser/Message.hs | 24 +----------------------- src/ProtoParser/Type.hs | 28 ++++++++++++++++++++++++++++ test/Unit/Message.hs | 24 +----------------------- test/Unit/Type.hs | 23 ++++++++++++++++++++++- 4 files changed, 52 insertions(+), 47 deletions(-) diff --git a/src/ProtoParser/Message.hs b/src/ProtoParser/Message.hs index 16ac788..9f0227d 100644 --- a/src/ProtoParser/Message.hs +++ b/src/ProtoParser/Message.hs @@ -1,4 +1,4 @@ -module ProtoParser.Message (parseMessage, parseMessage', parseMap) where +module ProtoParser.Message (parseMessage, parseMessage') where import ProtoParser.Reserved import ProtoParser.Space (spaces', spaces1) @@ -61,28 +61,6 @@ parseDataType = <|> Compound <$> protoName ---------------------------------------------------------------- -parseMap :: Parser MessageField -parseMap = do - spaces' - _ <- string "map" - spaces' - _ <- char '<' - spaces' - key <- - IntKey <$> parseIntType - <|> StringKey <$> protoName - spaces' - _ <- char ',' - value <- MapName <$> protoName - spaces' - _ <- char '>' - spaces' - name <- protoName - spaces' - _ <- char '=' - spaces' - fieldNumber <- protoNumber - return (MessageField (Map key value) name fieldNumber False) -- TODO: one of diff --git a/src/ProtoParser/Type.hs b/src/ProtoParser/Type.hs index 0c4cf11..a48bbb5 100644 --- a/src/ProtoParser/Type.hs +++ b/src/ProtoParser/Type.hs @@ -3,6 +3,7 @@ module ProtoParser.Type ) where +import ProtoParser.Space (spaces') import Protobuf import Text.Parsec import Text.Parsec.String @@ -69,3 +70,30 @@ parseScalarType = <|> (string "float" >> return (FloatType Float)) <|> (string "string" >> return StringType) <|> (string "bytes" >> return BytesType) + +---------------------------------------------------------------- + +parseMap :: Parser MessageField +parseMap = do + spaces' + _ <- string "map" + spaces' + _ <- char '<' + spaces' + key <- + IntKey + <$> parseIntType + <|> StringKey + <$> protoName + spaces' + _ <- char ',' + value <- MapName <$> protoName + spaces' + _ <- char '>' + spaces' + name <- protoName + spaces' + _ <- char '=' + spaces' + fieldNumber <- protoNumber + return (MessageField (Map key value) name fieldNumber False) diff --git a/test/Unit/Message.hs b/test/Unit/Message.hs index 922c329..cb885f2 100644 --- a/test/Unit/Message.hs +++ b/test/Unit/Message.hs @@ -8,9 +8,7 @@ import Text.Parsec (parse) allTests :: [Test] allTests = - [ TestLabel "simple" testSimple, - TestLabel "map" testMap - ] + [TestLabel "simple" testSimple] failMessage :: Message failMessage = Message "FAIL" [] @@ -51,23 +49,3 @@ testSimple = TestCase $ do assertEqual "emptyMessage" (Message "Foo" []) (fromRight failMessage (parse parseMessage "" "message Foo {}")) assertEqual "simple" testMessage1Proto (fromRight failMessage (parse parseMessage "" testMessage1)) assertEqual "reserved" testMessageReservedProto (fromRight failMessage (parse parseMessage "" testMessageReserved)) - ----------------------------------------------------------------- - -defaulTestMap :: MessageField -defaulTestMap = MessageField (Map (StringKey "") (MapName "")) "TEST" 0 False - -testMap :: Test -testMap = TestCase $ do - assertEqual "empty" False (isRight (parse parseMap "" "")) - assertEqual "keyword only" False (isRight (parse parseMap "" "map")) - assertEqual - "Simple" - ( MessageField (Map (StringKey "T") (MapName "V")) "name" 2 False - ) - (fromRight defaulTestMap (parse parseMap "" "map name = 2")) - assertEqual - "Simple" - ( MessageField (Map (IntKey Int32) (MapName "V")) "name" 2 False - ) - (fromRight defaulTestMap (parse parseMap "" "map name = 2")) diff --git a/test/Unit/Type.hs b/test/Unit/Type.hs index d58823c..8874956 100644 --- a/test/Unit/Type.hs +++ b/test/Unit/Type.hs @@ -10,7 +10,8 @@ allTests :: [Test] allTests = [ TestLabel "numberParser" testNumberParser, TestLabel "protoName" testProtoName, - TestLabel "scalarType" testSclarType + TestLabel "scalarType" testSclarType, + TestLabel "map" testMap ] testNumberParser :: Test @@ -43,3 +44,23 @@ testSclarType :: Test testSclarType = TestCase $ do assertEqual "int32" ((IntType Int32)) (fromRight (BoolType) (parse parseScalarType "" "int32")) assertEqual "double" ((FloatType Double)) (fromRight (BoolType) (parse parseScalarType "" "double")) + +---------------------------------------------------------------- + +defaulTestMap :: MessageField +defaulTestMap = MessageField (Map (StringKey "") (MapName "")) "TEST" 0 False + +testMap :: Test +testMap = TestCase $ do + assertEqual "empty" False (isRight (parse parseMap "" "")) + assertEqual "keyword only" False (isRight (parse parseMap "" "map")) + assertEqual + "Simple" + ( MessageField (Map (StringKey "T") (MapName "V")) "name" 2 False + ) + (fromRight defaulTestMap (parse parseMap "" "map name = 2")) + assertEqual + "Simple" + ( MessageField (Map (IntKey Int32) (MapName "V")) "name" 2 False + ) + (fromRight defaulTestMap (parse parseMap "" "map name = 2")) From bff7424686f7e34f5dc31a3ccb7f2cbbf620b2a0 Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Fri, 24 Nov 2023 15:50:24 +0100 Subject: [PATCH 21/55] fix string type not parsed --- src/ProtoParser/Type.hs | 10 +++++----- test/Unit/Type.hs | 1 + 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/src/ProtoParser/Type.hs b/src/ProtoParser/Type.hs index a48bbb5..6610d75 100644 --- a/src/ProtoParser/Type.hs +++ b/src/ProtoParser/Type.hs @@ -64,12 +64,12 @@ parseStringType = do parseScalarType :: Parser ScalarType parseScalarType = do - intType <- parseIntType + intType <- try parseIntType return (IntType intType) - <|> (string "double" >> return (FloatType Double)) - <|> (string "float" >> return (FloatType Float)) - <|> (string "string" >> return StringType) - <|> (string "bytes" >> return BytesType) + <|> try (string "double" >> return (FloatType Double)) + <|> try (string "float" >> return (FloatType Float)) + <|> try (string "string" >> return StringType) + <|> try (string "bytes" >> return BytesType) ---------------------------------------------------------------- diff --git a/test/Unit/Type.hs b/test/Unit/Type.hs index 8874956..ac8b100 100644 --- a/test/Unit/Type.hs +++ b/test/Unit/Type.hs @@ -44,6 +44,7 @@ testSclarType :: Test testSclarType = TestCase $ do assertEqual "int32" ((IntType Int32)) (fromRight (BoolType) (parse parseScalarType "" "int32")) assertEqual "double" ((FloatType Double)) (fromRight (BoolType) (parse parseScalarType "" "double")) + assertEqual "string" ((StringType)) (fromRight (BoolType) (parse parseScalarType "" "string")) ---------------------------------------------------------------- From 7a1aad24f406812e38eade6adf688af070e93800 Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Fri, 24 Nov 2023 16:09:45 +0100 Subject: [PATCH 22/55] parse basic example proto file --- app/Main.hs | 21 +++++++++++---------- example.proto | 6 ++++++ src/ProtoParser.hs | 20 ++++++++++++++------ src/ProtoParser/Message.hs | 5 +++-- src/ProtoParser/Space.hs | 2 +- 5 files changed, 35 insertions(+), 19 deletions(-) create mode 100644 example.proto diff --git a/app/Main.hs b/app/Main.hs index 2669f9e..6ac38e6 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -4,16 +4,17 @@ import ProtoParser -- import Text.Parsec (parse) -erro :: String -erro = - "message Foo {\ - \int32 foo = 1;\ - \int32 bar = 2;\ - \reserved 1, 2;\ - \}" +-- erro :: String +-- erro = +-- "message Foo {\ +-- \int32 foo = 1;\ +-- \int32 bar = 2;\ +-- \reserved 1, 2;\ +-- \}" main :: IO () main = do - case parseProtobuf erro of - Left err -> print err - Right res -> print res + result <- parseProtoFile "example.proto" + case result of + Left err -> putStrLn $ "Parse error: " ++ show err + Right protobuf -> putStrLn $ "Successfully parsed: " ++ show protobuf diff --git a/example.proto b/example.proto new file mode 100644 index 0000000..914bc1d --- /dev/null +++ b/example.proto @@ -0,0 +1,6 @@ +import "foo.proto"; + +message SearchRequest { + int32 page_number = 2; + int32 results_per_page = 3; +} diff --git a/src/ProtoParser.hs b/src/ProtoParser.hs index ff4cf9e..50a6699 100644 --- a/src/ProtoParser.hs +++ b/src/ProtoParser.hs @@ -8,6 +8,7 @@ module ProtoParser module ProtoParser.Service, module ProtoParser.EndOfLine, parseProtobuf, + parseProtoFile, ) where @@ -20,16 +21,23 @@ import ProtoParser.Package import ProtoParser.Service import ProtoParser.Type import Protobuf +import System.IO import Text.Parsec import Text.Parsec.String parseProtobuf :: String -> Either ParseError Protobuf parseProtobuf = parse protoValue "" +parseProtoFile :: FilePath -> IO (Either ParseError Protobuf) +parseProtoFile filePath = do + handle <- openFile filePath ReadMode + contents <- hGetContents handle + -- hClose handle + return (parse protoValue filePath contents) + protoValue :: Parser Protobuf protoValue = do - x <- (protoValue' emptyProtobuf) - return x + protoValue' emptyProtobuf protoValue' :: Protobuf -> Parser Protobuf protoValue' old = do @@ -41,9 +49,9 @@ protoValue' old = do try (parseEnum' old), try (parseMessage' old) ] - isEnd <- try ((lookAhead anyToken) >> return False) <|> return True + isEnd <- try (lookAhead anyChar >> return False) <|> return True if isEnd - then return new + then do + return new else do - newNew <- protoValue' new - return newNew + protoValue' new diff --git a/src/ProtoParser/Message.hs b/src/ProtoParser/Message.hs index 9f0227d..5513d60 100644 --- a/src/ProtoParser/Message.hs +++ b/src/ProtoParser/Message.hs @@ -30,10 +30,11 @@ parseMessage'' = do spaces' _ <- char '{' spaces' - fields <- parseMessageField `sepEndBy` char ';' + fields <- try parseMessageField `sepEndBy` char ';' spaces' _ <- char '}' - return (Message name (fields)) + spaces' + return (Message name fields) parseMessageField :: Parser MessageField parseMessageField = do diff --git a/src/ProtoParser/Space.hs b/src/ProtoParser/Space.hs index 8240d8b..fcbe8d4 100644 --- a/src/ProtoParser/Space.hs +++ b/src/ProtoParser/Space.hs @@ -11,7 +11,7 @@ import Text.Parsec import Text.Parsec.String space' :: Parser () -space' = (void space <|> removeComment) +space' = void space <|> removeComment <|> void newline <|> void tab spaces' :: Parser () spaces' = skipMany space' From 04f00ead93f3c233e19d8a478c611daaa894adb2 Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Fri, 24 Nov 2023 16:38:51 +0100 Subject: [PATCH 23/55] format --- src/Protobuf.hs | 64 ++++++++++++++++++++++++++++++++++++------------- 1 file changed, 48 insertions(+), 16 deletions(-) diff --git a/src/Protobuf.hs b/src/Protobuf.hs index 257ba0d..9ff75a0 100644 --- a/src/Protobuf.hs +++ b/src/Protobuf.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE GADTs #-} module Protobuf (module Protobuf) where import Data.Word (Word32) @@ -42,53 +43,84 @@ data FloatType | Float deriving (Show, Eq) -data ScalarType = IntType IntType | FloatType FloatType | StringType | BytesType | BoolType +data ScalarType + = IntType IntType + | FloatType FloatType + | StringType + | BytesType + | BoolType deriving (Show, Eq) -data MapKey = StringKey String | IntKey IntType +data MapKey + = StringKey String + | IntKey IntType deriving (Show, Eq) -data MapValue = MapName String | ScalarType +data MapValue + = MapName String + | ScalarType deriving (Show, Eq) -data DataType = Scalar ScalarType | Compound Name | Map MapKey MapValue +data DataType + = Scalar ScalarType + | Compound Name + | Map MapKey MapValue deriving (Show, Eq) -data MessageField = MessageField DataType Name FieldNumber Repeat | MessageReserved MessageReservedValues +data MessageField + = MessageField DataType Name FieldNumber Repeat + | MessageReserved MessageReservedValues deriving (Show, Eq) -data Message = Message MessageName [MessageField] +data Message + = Message MessageName [MessageField] deriving (Show, Eq) -data ReservedNames = ReservedNames [Name] +data ReservedNames where + ReservedNames :: [Name] -> ReservedNames deriving (Show, Eq) -data MessageReservedValues = ReservedMessageNumbers [FieldNumber] | ReservedMessageNames ReservedNames +data MessageReservedValues + = ReservedMessageNumbers [FieldNumber] + | ReservedMessageNames ReservedNames deriving (Show, Eq) -- TODO: make reserved type generic -data EnumReservedValues = ReservedEnumNumbers [EnumNumber] | ReservedEnumNames ReservedNames +data EnumReservedValues + = ReservedEnumNumbers [EnumNumber] + | ReservedEnumNames ReservedNames deriving (Show, Eq) -data EnumField = EnumValue Name EnumNumber | EnumOption Name Bool | EnumReserved EnumReservedValues +data EnumField + = EnumValue Name EnumNumber + | EnumOption Name Bool + | EnumReserved EnumReservedValues deriving (Show, Eq) -data Enum = Enum EnumName [EnumField] +data Enum + = Enum EnumName [EnumField] deriving (Show, Eq) -data Service = Service Name [RPC] +data Service + = Service Name [RPC] deriving (Show, Eq) -data RequestType = RequestType MessageName | RequestTypeStream MessageName +data RequestType + = RequestType MessageName + | RequestTypeStream MessageName deriving (Show, Eq) -data ReplyType = ReplyType MessageName | ReplyTypeStream MessageName +data ReplyType + = ReplyType MessageName + | ReplyTypeStream MessageName deriving (Show, Eq) -data RPC = RPC RPCName RequestType ReplyType +data RPC + = RPC RPCName RequestType ReplyType deriving (Show, Eq) -data Option = Option Name Value +data Option + = Option Name Value deriving (Show, Eq) data Protobuf = Protobuf From 4c82d0a8a4beb1daac79920d99c53c6bc388d9bb Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Sat, 25 Nov 2023 14:43:09 +0100 Subject: [PATCH 24/55] enable file testing --- example.proto | 7 +++++ protobuf-parser.cabal | 1 + src/ProtoParser/Enum.hs | 10 +++---- src/ProtoParser/Message.hs | 11 +++---- src/ProtoParser/Package.hs | 5 ++-- src/ProtoParser/Reserved.hs | 2 +- src/ProtoParser/Type.hs | 26 ++++++++-------- test/Spec.hs | 2 ++ test/Unit/Files.hs | 60 +++++++++++++++++++++++++++++++++++++ test/Unit/ProtoParser.hs | 4 +-- test/Unit/Type.hs | 6 ++-- test/protofiles/1.proto | 6 ++++ test/protofiles/2.proto | 13 ++++++++ 13 files changed, 118 insertions(+), 35 deletions(-) create mode 100644 test/Unit/Files.hs create mode 100644 test/protofiles/1.proto create mode 100644 test/protofiles/2.proto diff --git a/example.proto b/example.proto index 914bc1d..614a683 100644 --- a/example.proto +++ b/example.proto @@ -1,6 +1,13 @@ import "foo.proto"; +import "bar.proto"; + +package bar; message SearchRequest { int32 page_number = 2; int32 results_per_page = 3; } + +message SearchResponse { + string name = 1; +} diff --git a/protobuf-parser.cabal b/protobuf-parser.cabal index e601343..bc7117c 100644 --- a/protobuf-parser.cabal +++ b/protobuf-parser.cabal @@ -70,6 +70,7 @@ test-suite protobuf-parser-test other-modules: Unit.Comment Unit.Enum + Unit.Files Unit.Import Unit.Message Unit.Package diff --git a/src/ProtoParser/Enum.hs b/src/ProtoParser/Enum.hs index 16dc6b3..6fc2a12 100644 --- a/src/ProtoParser/Enum.hs +++ b/src/ProtoParser/Enum.hs @@ -43,8 +43,8 @@ enumField = do name <- protoName -- TODO: exctact to extra parser functions case name of - "option" -> do enumOption - "reserved" -> do enumReserved + "option" -> enumOption + "reserved" -> enumReserved _ -> do spaces' _ <- char '=' @@ -81,8 +81,7 @@ enumReserved = do parseReservedNames :: Parser EnumField parseReservedNames = do - names <- reservedNames - return (EnumReserved (ReservedEnumNames names)) + EnumReserved . ReservedEnumNames <$> reservedNames parseReservedNumbers :: Parser EnumField parseReservedNumbers = do @@ -101,5 +100,4 @@ enumNumber = enumNumberRange :: Parser EnumNumber enumNumberRange = do - n <- enumNumber <|> try (string "min" >> return 0) <|> try (string "max" >> return 0xFFFFFFFF) - return n + enumNumber <|> try (string "min" >> return 0) <|> try (string "max" >> return 0xFFFFFFFF) diff --git a/src/ProtoParser/Message.hs b/src/ProtoParser/Message.hs index 5513d60..4571b3b 100644 --- a/src/ProtoParser/Message.hs +++ b/src/ProtoParser/Message.hs @@ -18,8 +18,7 @@ parseMessage' p = do ) parseMessage :: Parser Message -parseMessage = do - parseMessage'' +parseMessage = parseMessage'' parseMessage'' :: Parser Message parseMessage'' = do @@ -44,7 +43,7 @@ parseMessageField = do -- TODO: extra function parser for reserved to avoid this workaround t <- parseDataType case t of - (Compound "reserved") -> do messageReserved + (Compound "reserved") -> messageReserved _ -> do spaces' name <- protoName @@ -74,8 +73,7 @@ messageReserved = do parseReservedNames :: Parser MessageField parseReservedNames = do - names <- reservedNames - return (MessageReserved (ReservedMessageNames names)) + MessageReserved . ReservedMessageNames <$> reservedNames parseReservedNumbers :: Parser MessageField parseReservedNumbers = do @@ -84,5 +82,4 @@ parseReservedNumbers = do fieldNumberRange :: Parser FieldNumber fieldNumberRange = do - n <- protoNumber <|> try (string "min" >> return 1) <|> try (string "max" >> return 0xFFFFFFFF) - return n + protoNumber <|> try (string "min" >> return 1) <|> try (string "max" >> return 0xFFFFFFFF) diff --git a/src/ProtoParser/Package.hs b/src/ProtoParser/Package.hs index 5ba6bcb..061b440 100644 --- a/src/ProtoParser/Package.hs +++ b/src/ProtoParser/Package.hs @@ -1,5 +1,6 @@ module ProtoParser.Package (parsePackage, parsePackage') where +import qualified Data.Maybe import ProtoParser.Space (spaces', spaces1) import Protobuf import Text.Parsec @@ -8,13 +9,13 @@ import Text.Parsec.String parsePackage' :: Protobuf -> Parser Protobuf parsePackage' p = do package' <- parsePackage - if package p /= Nothing + if Data.Maybe.isJust (package p) then unexpected ": There can only be one package definition per file" else return ( Protobuf.merge p - (Protobuf {package = (Just package'), imports = [], options = [], enums = [], messages = [], services = []}) + (Protobuf {package = Just package', imports = [], options = [], enums = [], messages = [], services = []}) ) parsePackage :: Parser Package diff --git a/src/ProtoParser/Reserved.hs b/src/ProtoParser/Reserved.hs index 023f3ca..da33b8a 100644 --- a/src/ProtoParser/Reserved.hs +++ b/src/ProtoParser/Reserved.hs @@ -47,7 +47,7 @@ reservedNumbersRange range = do reservedNumbers :: (Integral a) => Parser a -> Parser a -> Parser [a] reservedNumbers single range = do numbers <- try (reservedNumbers' single range) `sepBy1` char ',' - return ((concat numbers)) + return (concat numbers) reservedNumbers' :: (Integral a) => Parser a -> Parser a -> Parser [a] reservedNumbers' single range = try (reservedNumbersRange range) <|> try (reservedNumbersSingle single) diff --git a/src/ProtoParser/Type.hs b/src/ProtoParser/Type.hs index 6610d75..4c4d123 100644 --- a/src/ProtoParser/Type.hs +++ b/src/ProtoParser/Type.hs @@ -34,18 +34,17 @@ protoNumber = parseIntType :: Parser IntType parseIntType = - let int32 = string "int32" >> return (Int32) - int64 = string "int64" >> return (Int64) - uint32 = string "uint32" >> return (UInt32) - uint64 = string "uint64" >> return (UInt64) - sint32 = string "sint32" >> return (SInt32) - sint64 = string "sint64" >> return (SInt64) - fixed32 = string "fixed32" >> return (Fixed32) - fixed64 = string "fixed64" >> return (Fixed64) - sfixed32 = string "sfixed32" >> return (SFixed32) - sfixed64 = string "sfixed64" >> return (SFixed64) - in do - int32 + let int32 = string "int32" >> return Int32 + int64 = string "int64" >> return Int64 + uint32 = string "uint32" >> return UInt32 + uint64 = string "uint64" >> return UInt64 + sint32 = string "sint32" >> return SInt32 + sint64 = string "sint64" >> return SInt64 + fixed32 = string "fixed32" >> return Fixed32 + fixed64 = string "fixed64" >> return Fixed64 + sfixed32 = string "sfixed32" >> return SFixed32 + sfixed64 = string "sfixed64" >> return SFixed64 + in int32 <|> int64 <|> uint32 <|> uint64 @@ -58,8 +57,7 @@ parseIntType = ---------------------------------------------------------------- parseStringType :: Parser MapKey -parseStringType = do - StringKey <$> protoName +parseStringType = StringKey <$> protoName parseScalarType :: Parser ScalarType parseScalarType = diff --git a/test/Spec.hs b/test/Spec.hs index 94972e7..75ae569 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,6 +1,7 @@ import Test.HUnit (Test (TestList), runTestTTAndExit) import Unit.Comment as Comment import Unit.Enum as Unit +import Unit.Files as Files import Unit.Import as Import import Unit.Message as Message import Unit.Package as Package @@ -20,5 +21,6 @@ main = ++ Message.allTests ++ Package.allTests ++ Service.allTests + ++ Files.allTests ) ) diff --git a/test/Unit/Files.hs b/test/Unit/Files.hs new file mode 100644 index 0000000..6da50ca --- /dev/null +++ b/test/Unit/Files.hs @@ -0,0 +1,60 @@ +module Unit.Files (allTests) where + +import Data.Either (fromRight) +import ProtoParser +import Protobuf +import Test.HUnit + +allTests :: [Test] +allTests = + [TestLabel "fileTest" testFiles] + +getResult :: FilePath -> IO Protobuf +getResult fileNameWithoutExtension = do + fromRight emptyProtobuf <$> parseProtoFile ("test/protofiles/" ++ fileNameWithoutExtension ++ ".proto") + +assertProtoFile :: FilePath -> Protobuf -> Assertion +assertProtoFile fileNameWithoutExtension expected = do + p <- getResult fileNameWithoutExtension + assertEqual fileNameWithoutExtension expected p + +testFiles :: Test +testFiles = TestCase $ do + assertProtoFile + "1" + ( Protobuf + { package = Nothing, + imports = ["foo.proto"], + options = [], + enums = [], + messages = + [ Message + "SearchRequest" + [ MessageField (Scalar (IntType Int32)) "page_number" 2 False, + MessageField (Scalar (FloatType Double)) "results_per_page" 3 False + ] + ], + services = [] + } + ) + assertProtoFile + "2" + ( Protobuf + { package = Just "foobar", + imports = ["foo.proto", "bar.proto"], + options = [], + enums = [], + messages = + [ Message + "SearchRequest" + [ MessageField (Scalar (IntType Int32)) "page_number" 2 False, + MessageField (Scalar (FloatType Double)) "results_per_page" 3 False + ], + Message + "SearchResponse" + [ MessageField (Scalar StringType) "name" 1 False + ] + ], + services = [] + } + ) diff --git a/test/Unit/ProtoParser.hs b/test/Unit/ProtoParser.hs index ac4905c..3213ca8 100644 --- a/test/Unit/ProtoParser.hs +++ b/test/Unit/ProtoParser.hs @@ -33,7 +33,7 @@ splitImportText = splitImportProto :: Protobuf splitImportProto = ( Protobuf - { package = (Just "foobar"), + { package = Just "foobar", imports = ["foo.proto", "bar.proto"], options = [], enums = [], @@ -87,7 +87,7 @@ testText = TestCase $ do textComment :: Protobuf textComment = ( Protobuf - { package = (Just "foobar"), + { package = Just "foobar", imports = ["foo.proto", "bar.proto"], options = [], enums = [], diff --git a/test/Unit/Type.hs b/test/Unit/Type.hs index ac8b100..ac85e87 100644 --- a/test/Unit/Type.hs +++ b/test/Unit/Type.hs @@ -42,9 +42,9 @@ testProtoName = TestCase $ do testSclarType :: Test testSclarType = TestCase $ do - assertEqual "int32" ((IntType Int32)) (fromRight (BoolType) (parse parseScalarType "" "int32")) - assertEqual "double" ((FloatType Double)) (fromRight (BoolType) (parse parseScalarType "" "double")) - assertEqual "string" ((StringType)) (fromRight (BoolType) (parse parseScalarType "" "string")) + assertEqual "int32" (IntType Int32) (fromRight BoolType (parse parseScalarType "" "int32")) + assertEqual "double" (FloatType Double) (fromRight BoolType (parse parseScalarType "" "double")) + assertEqual "string" StringType (fromRight BoolType (parse parseScalarType "" "string")) ---------------------------------------------------------------- diff --git a/test/protofiles/1.proto b/test/protofiles/1.proto new file mode 100644 index 0000000..7c93ca0 --- /dev/null +++ b/test/protofiles/1.proto @@ -0,0 +1,6 @@ +import "foo.proto"; + +message SearchRequest { + int32 page_number = 2; + double results_per_page = 3; +} diff --git a/test/protofiles/2.proto b/test/protofiles/2.proto new file mode 100644 index 0000000..2946d0b --- /dev/null +++ b/test/protofiles/2.proto @@ -0,0 +1,13 @@ +import "foo.proto"; +import "bar.proto"; + +package foobar; + +message SearchRequest { + int32 page_number = 2; + double results_per_page = 3; +} + +message SearchResponse { + string name = 1; +} From 65ec3ecd37d1cffb2eca67472a3d74e6b5f39679 Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Sat, 25 Nov 2023 15:38:34 +0100 Subject: [PATCH 25/55] add syntax parsing --- README.md | 2 ++ protobuf-parser.cabal | 2 ++ src/ProtoParser.hs | 2 ++ src/ProtoParser/Enum.hs | 2 +- src/ProtoParser/Import.hs | 2 +- src/ProtoParser/Message.hs | 2 +- src/ProtoParser/Package.hs | 2 +- src/ProtoParser/Service.hs | 2 +- src/ProtoParser/Syntax.hs | 35 +++++++++++++++++++++++++++++++++++ src/Protobuf.hs | 19 +++++++++++++++++-- test/Spec.hs | 2 ++ test/Unit/Files.hs | 6 ++++-- test/Unit/ProtoParser.hs | 12 ++++++++---- test/Unit/Syntax.hs | 21 +++++++++++++++++++++ 14 files changed, 98 insertions(+), 13 deletions(-) create mode 100644 src/ProtoParser/Syntax.hs create mode 100644 test/Unit/Syntax.hs diff --git a/README.md b/README.md index 73f5da8..27b8068 100644 --- a/README.md +++ b/README.md @@ -2,5 +2,7 @@ protobuf 3 + gRPC parser using parsec +Only syntax 3 is supported! + `stack run` `stack test` diff --git a/protobuf-parser.cabal b/protobuf-parser.cabal index bc7117c..ca7dc93 100644 --- a/protobuf-parser.cabal +++ b/protobuf-parser.cabal @@ -36,6 +36,7 @@ library ProtoParser.Reserved ProtoParser.Service ProtoParser.Space + ProtoParser.Syntax ProtoParser.Type other-modules: Paths_protobuf_parser @@ -76,6 +77,7 @@ test-suite protobuf-parser-test Unit.Package Unit.ProtoParser Unit.Service + Unit.Syntax Unit.Type Paths_protobuf_parser autogen-modules: diff --git a/src/ProtoParser.hs b/src/ProtoParser.hs index 50a6699..1163246 100644 --- a/src/ProtoParser.hs +++ b/src/ProtoParser.hs @@ -7,6 +7,7 @@ module ProtoParser module ProtoParser.Package, module ProtoParser.Service, module ProtoParser.EndOfLine, + module ProtoParser.Syntax, parseProtobuf, parseProtoFile, ) @@ -19,6 +20,7 @@ import ProtoParser.Import import ProtoParser.Message import ProtoParser.Package import ProtoParser.Service +import ProtoParser.Syntax import ProtoParser.Type import Protobuf import System.IO diff --git a/src/ProtoParser/Enum.hs b/src/ProtoParser/Enum.hs index 6fc2a12..5c17c6e 100644 --- a/src/ProtoParser/Enum.hs +++ b/src/ProtoParser/Enum.hs @@ -22,7 +22,7 @@ parseEnum' p = do return ( Protobuf.merge p - (Protobuf {package = Nothing, imports = [], options = [], enums = [x], messages = [], services = []}) + (Protobuf {syntax = Nothing, package = Nothing, imports = [], options = [], enums = [x], messages = [], services = []}) ) protoEnum :: Parser Protobuf.Enum diff --git a/src/ProtoParser/Import.hs b/src/ProtoParser/Import.hs index 69a1cc6..924f880 100644 --- a/src/ProtoParser/Import.hs +++ b/src/ProtoParser/Import.hs @@ -11,7 +11,7 @@ parseImport' p = do return ( Protobuf.merge p - (Protobuf {package = Nothing, imports = [imp], options = [], enums = [], messages = [], services = []}) + (Protobuf {syntax = Nothing, package = Nothing, imports = [imp], options = [], enums = [], messages = [], services = []}) ) pathExtension :: String diff --git a/src/ProtoParser/Message.hs b/src/ProtoParser/Message.hs index 4571b3b..96d20bb 100644 --- a/src/ProtoParser/Message.hs +++ b/src/ProtoParser/Message.hs @@ -14,7 +14,7 @@ parseMessage' p = do return ( Protobuf.merge p - (Protobuf {package = Nothing, imports = [], options = [], enums = [], messages = [x], services = []}) + (Protobuf {syntax = Nothing, package = Nothing, imports = [], options = [], enums = [], messages = [x], services = []}) ) parseMessage :: Parser Message diff --git a/src/ProtoParser/Package.hs b/src/ProtoParser/Package.hs index 061b440..0165dae 100644 --- a/src/ProtoParser/Package.hs +++ b/src/ProtoParser/Package.hs @@ -15,7 +15,7 @@ parsePackage' p = do return ( Protobuf.merge p - (Protobuf {package = Just package', imports = [], options = [], enums = [], messages = [], services = []}) + (Protobuf {syntax = Nothing, package = Just package', imports = [], options = [], enums = [], messages = [], services = []}) ) parsePackage :: Parser Package diff --git a/src/ProtoParser/Service.hs b/src/ProtoParser/Service.hs index f8905ec..884ca20 100644 --- a/src/ProtoParser/Service.hs +++ b/src/ProtoParser/Service.hs @@ -13,7 +13,7 @@ parseService' p = do return ( Protobuf.merge p - (Protobuf {package = Nothing, imports = [], options = [], enums = [], messages = [], services = [x]}) + (Protobuf {syntax = Nothing, package = Nothing, imports = [], options = [], enums = [], messages = [], services = [x]}) ) parseService :: Parser Service diff --git a/src/ProtoParser/Syntax.hs b/src/ProtoParser/Syntax.hs new file mode 100644 index 0000000..433ef75 --- /dev/null +++ b/src/ProtoParser/Syntax.hs @@ -0,0 +1,35 @@ +module ProtoParser.Syntax (parseSyntax, parseSyntax') where + +import qualified Data.Maybe +import ProtoParser.Space (spaces') +import Protobuf +import Text.Parsec +import Text.Parsec.String + +parseSyntax' :: Protobuf -> Parser Protobuf +parseSyntax' p = do + syn <- parseSyntax + if Data.Maybe.isJust (syntax p) + then unexpected ": There can only be one syntax definition per file" + else + return + ( Protobuf.merge + p + (Protobuf {syntax = Just syn, package = Nothing, imports = [], options = [], enums = [], messages = [], services = []}) + ) + +parseSyntax :: Parser Syntax +parseSyntax = do + spaces' + _ <- string "syntax" "Expected 'syntax' keyword" + spaces' + _ <- char '=' "Expected '=' after 'syntax' keyword" + spaces' + _ <- char '"' "Expected '\"' after 'syntax' keyword" + syn <- + try (string "proto2" >> return Proto2) + <|> try (string "proto3" >> return Proto3) + spaces' + _ <- char '"' "Expected '\"' after 'syntax' value" + _ <- char ';' "Expected ';' at end of syntax statement" + return syn diff --git a/src/Protobuf.hs b/src/Protobuf.hs index 9ff75a0..501cbed 100644 --- a/src/Protobuf.hs +++ b/src/Protobuf.hs @@ -1,4 +1,5 @@ {-# LANGUAGE GADTs #-} + module Protobuf (module Protobuf) where import Data.Word (Word32) @@ -123,8 +124,14 @@ data Option = Option Name Value deriving (Show, Eq) +data Syntax + = Proto2 + | Proto3 + deriving (Show, Eq) + data Protobuf = Protobuf - { package :: Maybe String, + { syntax :: Maybe Syntax, + package :: Maybe String, imports :: [ImportPath], options :: [Option], enums :: [Protobuf.Enum], @@ -139,6 +146,7 @@ emptyProtobuf = ( Protobuf { package = Nothing, imports = [], + syntax = Nothing, options = [], enums = [], messages = [], @@ -154,7 +162,8 @@ merge' = foldl1 Protobuf.merge merge :: Protobuf -> Protobuf -> Protobuf merge a b = Protobuf - { package = mergePackages (package a) (package b), + { syntax = mergeSyntax (syntax a) (syntax b), + package = mergePackages (package a) (package b), imports = imports a ++ imports b, options = options a ++ options b, enums = enums a ++ enums b, @@ -168,3 +177,9 @@ merge a b = mergePackages (Just x) (Just y) | not (null x) && not (null y) = error "Conflicting non-empty packages" | otherwise = Just (x ++ y) + mergeSyntax :: Maybe Syntax -> Maybe Syntax -> Maybe Syntax + mergeSyntax Nothing y = y + mergeSyntax x Nothing = x + mergeSyntax (Just x) (Just y) + | x == y = Just x + | otherwise = error "Conflicting syntax versions" diff --git a/test/Spec.hs b/test/Spec.hs index 75ae569..059eb86 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -7,6 +7,7 @@ import Unit.Message as Message import Unit.Package as Package import Unit.ProtoParser as Protobuf import Unit.Service as Service +import Unit.Syntax as Syntax import Unit.Type as Type main :: IO () @@ -22,5 +23,6 @@ main = ++ Package.allTests ++ Service.allTests ++ Files.allTests + ++ Syntax.allTests ) ) diff --git a/test/Unit/Files.hs b/test/Unit/Files.hs index 6da50ca..e2f0841 100644 --- a/test/Unit/Files.hs +++ b/test/Unit/Files.hs @@ -23,7 +23,8 @@ testFiles = TestCase $ do assertProtoFile "1" ( Protobuf - { package = Nothing, + { syntax = Nothing, + package = Nothing, imports = ["foo.proto"], options = [], enums = [], @@ -40,7 +41,8 @@ testFiles = TestCase $ do assertProtoFile "2" ( Protobuf - { package = Just "foobar", + { syntax = Nothing, + package = Just "foobar", imports = ["foo.proto", "bar.proto"], options = [], enums = [], diff --git a/test/Unit/ProtoParser.hs b/test/Unit/ProtoParser.hs index 3213ca8..044e15c 100644 --- a/test/Unit/ProtoParser.hs +++ b/test/Unit/ProtoParser.hs @@ -15,7 +15,8 @@ allTests = defaultTestProto :: Protobuf defaultTestProto = ( Protobuf - { package = Nothing, + { syntax = Nothing, + package = Nothing, imports = [], options = [], enums = [], @@ -33,7 +34,8 @@ splitImportText = splitImportProto :: Protobuf splitImportProto = ( Protobuf - { package = Just "foobar", + { syntax = Nothing, + package = Just "foobar", imports = ["foo.proto", "bar.proto"], options = [], enums = [], @@ -51,7 +53,8 @@ splitImportText1 = splitImportProto1 :: Protobuf splitImportProto1 = ( Protobuf - { package = Nothing, + { syntax = Nothing, + package = Nothing, imports = ["foo.proto", "bar.proto"], options = [], enums = [], @@ -87,7 +90,8 @@ testText = TestCase $ do textComment :: Protobuf textComment = ( Protobuf - { package = Just "foobar", + { syntax = Nothing, + package = Just "foobar", imports = ["foo.proto", "bar.proto"], options = [], enums = [], diff --git a/test/Unit/Syntax.hs b/test/Unit/Syntax.hs new file mode 100644 index 0000000..d8f074c --- /dev/null +++ b/test/Unit/Syntax.hs @@ -0,0 +1,21 @@ +module Unit.Syntax (allTests) where + +import Data.Either (fromRight, isRight) +import ProtoParser.Syntax +import Protobuf +import Test.HUnit +import Text.Parsec (parse) + +allTests :: [Test] +allTests = + [TestLabel "syntax" testSyntax] + +testSyntax :: Test +testSyntax = TestCase $ do + assertEqual "empty" False (isRight (parse parseSyntax "" "")) + assertEqual "missing package name" False (isRight (parse parseSyntax "" "syntax")) + assertEqual "missing ';'" False (isRight (parse parseSyntax "" "syntax \"proto3\"")) + assertEqual "invalid Proto Version" False (isRight (parse parseSyntax "" "syntax = \"proto1\";")) + assertEqual "Proto2" True (isRight (parse parseSyntax "" "syntax = \"proto2\";")) + assertEqual "Proto2" Proto2 (fromRight Proto3 (parse parseSyntax "" "syntax = \"proto2\";")) + assertEqual "Proto3" Proto3 (fromRight Proto2 (parse parseSyntax "" "syntax = \"proto3\";")) From 9129d21179e4d8a0d725868af0a2cafe15b380ac Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Sat, 25 Nov 2023 16:15:25 +0100 Subject: [PATCH 26/55] add chat proto test file --- test/protofiles/chat.proto | 39 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 39 insertions(+) create mode 100644 test/protofiles/chat.proto diff --git a/test/protofiles/chat.proto b/test/protofiles/chat.proto new file mode 100644 index 0000000..5c4c4ff --- /dev/null +++ b/test/protofiles/chat.proto @@ -0,0 +1,39 @@ +syntax = "proto3"; + +option java_package = "de.antonkesy.vs.chat"; +option java_outer_classname = "Chat"; + +package chat; + +service ChatService{ + rpc Chat (stream ChatRequest) returns (stream ChatResponse) {} +} + +message ChatRequest{ + ChatMessage message = 1; +} + +message ChatResponse{ + ChatMessage message = 1; +} + +message ChatMessage{ + oneof message{ + UserMessage userMessage = 1; + JoinMessage joinMessage = 2; + ExitMessage exitMessage = 3; + } +} + +message JoinMessage{ + string username = 1; +} + +message ExitMessage{ + string username = 1; +} + +message UserMessage{ + string username = 1; + string rawMessage = 2; +} From 087e1d0bcbd7d3297634b710dc35e61321e2f363 Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Sat, 25 Nov 2023 16:15:44 +0100 Subject: [PATCH 27/55] quick proto test main --- app/Main.hs | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 6ac38e6..fead49d 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,8 +1,7 @@ module Main (main) where -import ProtoParser - --- import Text.Parsec (parse) +import ProtoParser.Syntax +import Text.Parsec (parse) -- erro :: String -- erro = @@ -14,7 +13,13 @@ import ProtoParser main :: IO () main = do - result <- parseProtoFile "example.proto" - case result of + case parse parseSyntax "" "syntax = \"proto2\";" of Left err -> putStrLn $ "Parse error: " ++ show err Right protobuf -> putStrLn $ "Successfully parsed: " ++ show protobuf + +-- main :: IO () +-- main = do +-- result <- parseProtoFile "example.proto" +-- case result of +-- Left err -> putStrLn $ "Parse error: " ++ show err +-- Right protobuf -> putStrLn $ "Successfully parsed: " ++ show protobuf From 7ef166a5f72fd1536156ea47825f70aaa4d5fe0d Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Sat, 25 Nov 2023 16:41:14 +0100 Subject: [PATCH 28/55] add optional, reserved and repeated message fields --- app/Main.hs | 14 +++++-- src/ProtoParser/Message.hs | 82 +++++++++++++++++++++++++++----------- src/ProtoParser/Type.hs | 39 +++++++++++++----- src/Protobuf.hs | 4 +- test/Unit/Files.hs | 10 ++--- test/Unit/Message.hs | 46 ++++++++++++++++++++- test/Unit/Type.hs | 14 +++---- 7 files changed, 156 insertions(+), 53 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index fead49d..ca68ad6 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,6 +1,6 @@ module Main (main) where -import ProtoParser.Syntax +import ProtoParser.Message import Text.Parsec (parse) -- erro :: String @@ -11,11 +11,17 @@ import Text.Parsec (parse) -- \reserved 1, 2;\ -- \}" +testMessageReserved :: String +testMessageReserved = + "message Foo {\ + \reserved 1, 2;\ + \}" + main :: IO () main = do - case parse parseSyntax "" "syntax = \"proto2\";" of - Left err -> putStrLn $ "Parse error: " ++ show err - Right protobuf -> putStrLn $ "Successfully parsed: " ++ show protobuf + case parse parseMessage "" testMessageReserved of + Left err -> print err + Right protobuf -> print protobuf -- main :: IO () -- main = do diff --git a/src/ProtoParser/Message.hs b/src/ProtoParser/Message.hs index 96d20bb..a0a81f8 100644 --- a/src/ProtoParser/Message.hs +++ b/src/ProtoParser/Message.hs @@ -35,42 +35,76 @@ parseMessage'' = do spaces' return (Message name fields) -parseMessageField :: Parser MessageField -parseMessageField = do - spaces' - -- _ <- try (string "repeated") -- TODO: optional - -- spaces' - -- TODO: extra function parser for reserved to avoid this workaround - t <- parseDataType - case t of - (Compound "reserved") -> messageReserved - _ -> do - spaces' - name <- protoName - spaces' - _ <- char '=' - spaces' - fieldNumber <- protoNumber - spaces' - return (MessageField t name fieldNumber False) - parseDataType :: Parser DataType parseDataType = do Scalar <$> parseScalarType <|> Compound <$> protoName ----------------------------------------------------------------- +parseMessageField :: Parser MessageField +parseMessageField = + do + try implicitMessageField + <|> try optionalMessageField + <|> try repeatedMessageField + <|> try reservedMessageField --- TODO: one of +implicitMessageField :: Parser MessageField +implicitMessageField = do + spaces' + t <- parseDataType <|> parseMap + spaces' + name <- protoName + spaces' + _ <- char '=' + spaces' + fieldNumber <- protoNumber + spaces' + return (ImplicitMessageField t name fieldNumber) ----------------------------------------------------------------- +optionalMessageField :: Parser MessageField +optionalMessageField = do + spaces' + _ <- string "optional" + spaces' + t <- parseDataType <|> parseMap + spaces' + name <- protoName + spaces' + _ <- char '=' + spaces' + fieldNumber <- protoNumber + spaces' + return (OptionalMessageField t name fieldNumber) -messageReserved :: Parser MessageField -messageReserved = do +repeatedMessageField :: Parser MessageField +repeatedMessageField = do + spaces' + _ <- string "repeated" + spaces' + t <- parseDataType + spaces' + name <- protoName + spaces' + _ <- char '=' + spaces' + fieldNumber <- protoNumber + spaces' + return (RepeatedMessageField t name fieldNumber) + +reservedMessageField :: Parser MessageField +reservedMessageField = do + spaces' + _ <- string "reserved" spaces' try parseReservedNames <|> try parseReservedNumbers +---------------------------------------------------------------- + +-- TODO: one of + +---------------------------------------------------------------- + parseReservedNames :: Parser MessageField parseReservedNames = do MessageReserved . ReservedMessageNames <$> reservedNames diff --git a/src/ProtoParser/Type.hs b/src/ProtoParser/Type.hs index 4c4d123..3e85511 100644 --- a/src/ProtoParser/Type.hs +++ b/src/ProtoParser/Type.hs @@ -71,7 +71,33 @@ parseScalarType = ---------------------------------------------------------------- -parseMap :: Parser MessageField +-- parseMap :: Parser MessageField +-- parseMap = do +-- spaces' +-- _ <- string "map" +-- spaces' +-- _ <- char '<' +-- spaces' +-- key <- +-- IntKey +-- <$> parseIntType +-- <|> StringKey +-- <$> protoName +-- spaces' +-- _ <- char ',' +-- value <- MapName <$> protoName +-- spaces' +-- _ <- char '>' +-- spaces' +-- name <- protoName +-- spaces' +-- _ <- char '=' +-- spaces' +-- fieldNumber <- protoNumber +-- -- cannot be repeated +-- return (ImplicitMessageField (Map key value) name fieldNumber) + +parseMap :: Parser DataType parseMap = do spaces' _ <- string "map" @@ -81,17 +107,12 @@ parseMap = do key <- IntKey <$> parseIntType - <|> StringKey - <$> protoName + <|> StringKey + <$> protoName spaces' _ <- char ',' value <- MapName <$> protoName spaces' _ <- char '>' spaces' - name <- protoName - spaces' - _ <- char '=' - spaces' - fieldNumber <- protoNumber - return (MessageField (Map key value) name fieldNumber False) + return (Map key value) diff --git a/src/Protobuf.hs b/src/Protobuf.hs index 501cbed..b130d46 100644 --- a/src/Protobuf.hs +++ b/src/Protobuf.hs @@ -69,7 +69,9 @@ data DataType deriving (Show, Eq) data MessageField - = MessageField DataType Name FieldNumber Repeat + = ImplicitMessageField DataType Name FieldNumber + | OptionalMessageField DataType Name FieldNumber + | RepeatedMessageField DataType Name FieldNumber | MessageReserved MessageReservedValues deriving (Show, Eq) diff --git a/test/Unit/Files.hs b/test/Unit/Files.hs index e2f0841..31433e2 100644 --- a/test/Unit/Files.hs +++ b/test/Unit/Files.hs @@ -31,8 +31,8 @@ testFiles = TestCase $ do messages = [ Message "SearchRequest" - [ MessageField (Scalar (IntType Int32)) "page_number" 2 False, - MessageField (Scalar (FloatType Double)) "results_per_page" 3 False + [ ImplicitMessageField (Scalar (IntType Int32)) "page_number" 2, + ImplicitMessageField (Scalar (FloatType Double)) "results_per_page" 3 ] ], services = [] @@ -49,12 +49,12 @@ testFiles = TestCase $ do messages = [ Message "SearchRequest" - [ MessageField (Scalar (IntType Int32)) "page_number" 2 False, - MessageField (Scalar (FloatType Double)) "results_per_page" 3 False + [ ImplicitMessageField (Scalar (IntType Int32)) "page_number" 2, + ImplicitMessageField (Scalar (FloatType Double)) "results_per_page" 3 ], Message "SearchResponse" - [ MessageField (Scalar StringType) "name" 1 False + [ ImplicitMessageField (Scalar StringType) "name" 1 ] ], services = [] diff --git a/test/Unit/Message.hs b/test/Unit/Message.hs index cb885f2..c64a619 100644 --- a/test/Unit/Message.hs +++ b/test/Unit/Message.hs @@ -24,8 +24,8 @@ testMessage1Proto :: Message testMessage1Proto = Message "Foo" - [ MessageField (Scalar (IntType Int32)) "foo" 1 False, - MessageField (Scalar (FloatType Double)) "bar" 2 False + [ ImplicitMessageField (Scalar (IntType Int32)) "foo" 1, + ImplicitMessageField (Scalar (FloatType Double)) "bar" 2 ] testMessageReserved :: String @@ -41,6 +41,45 @@ testMessageReservedProto = [ MessageReserved (ReservedMessageNumbers [1, 2]) ] +testOptional :: String +testOptional = + "message Foo {\ + \optional int32 foo = 1;\ + \}" + +testOptionalProto :: Message +testOptionalProto = + Message + "Foo" + [ OptionalMessageField (Scalar (IntType Int32)) "foo" 1 + ] + +testRepeated :: String +testRepeated = + "message Foo {\ + \repeated int32 foo = 1;\ + \}" + +testRepeatedProto :: Message +testRepeatedProto = + Message + "Foo" + [ RepeatedMessageField (Scalar (IntType Int32)) "foo" 1 + ] + +testReservedNames :: String +testReservedNames = + "message Foo {\ + \reserved \"foo\", \"bar\";\ + \}" + +testReservedNamesProto :: Message +testReservedNamesProto = + Message + "Foo" + [ MessageReserved (ReservedMessageNames (ReservedNames ["foo", "bar"])) + ] + testSimple :: Test testSimple = TestCase $ do assertEqual "empty" False (isRight (parse parseMessage "" "")) @@ -49,3 +88,6 @@ testSimple = TestCase $ do assertEqual "emptyMessage" (Message "Foo" []) (fromRight failMessage (parse parseMessage "" "message Foo {}")) assertEqual "simple" testMessage1Proto (fromRight failMessage (parse parseMessage "" testMessage1)) assertEqual "reserved" testMessageReservedProto (fromRight failMessage (parse parseMessage "" testMessageReserved)) + assertEqual "optional" testOptionalProto (fromRight failMessage (parse parseMessage "" testOptional)) + assertEqual "repeated" testRepeatedProto (fromRight failMessage (parse parseMessage "" testRepeated)) + assertEqual "reserved names" testReservedNamesProto (fromRight failMessage (parse parseMessage "" testReservedNames)) diff --git a/test/Unit/Type.hs b/test/Unit/Type.hs index ac85e87..903c7de 100644 --- a/test/Unit/Type.hs +++ b/test/Unit/Type.hs @@ -48,8 +48,8 @@ testSclarType = TestCase $ do ---------------------------------------------------------------- -defaulTestMap :: MessageField -defaulTestMap = MessageField (Map (StringKey "") (MapName "")) "TEST" 0 False +defaulTestMap :: DataType +defaulTestMap = Map (StringKey "") (MapName "") testMap :: Test testMap = TestCase $ do @@ -57,11 +57,9 @@ testMap = TestCase $ do assertEqual "keyword only" False (isRight (parse parseMap "" "map")) assertEqual "Simple" - ( MessageField (Map (StringKey "T") (MapName "V")) "name" 2 False - ) - (fromRight defaulTestMap (parse parseMap "" "map name = 2")) + (Map (StringKey "T") (MapName "V")) + (fromRight defaulTestMap (parse parseMap "" "map")) assertEqual "Simple" - ( MessageField (Map (IntKey Int32) (MapName "V")) "name" 2 False - ) - (fromRight defaulTestMap (parse parseMap "" "map name = 2")) + (Map (IntKey Int32) (MapName "V")) + (fromRight defaulTestMap (parse parseMap "" "map")) From 6d21de24a5b6be85123180d4fca1214fdbc0a5f2 Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Sat, 25 Nov 2023 17:23:31 +0100 Subject: [PATCH 29/55] simplify message parsing --- app/Main.hs | 2 +- src/ProtoParser/Message.hs | 121 ++++++++++--------------------------- src/ProtoParser/Type.hs | 32 ++-------- 3 files changed, 39 insertions(+), 116 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index ca68ad6..1d3a0e1 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -14,7 +14,7 @@ import Text.Parsec (parse) testMessageReserved :: String testMessageReserved = "message Foo {\ - \reserved 1, 2;\ + \reserved \"foo\", \"bar\";\ \}" main :: IO () diff --git a/src/ProtoParser/Message.hs b/src/ProtoParser/Message.hs index a0a81f8..8196d56 100644 --- a/src/ProtoParser/Message.hs +++ b/src/ProtoParser/Message.hs @@ -21,98 +21,41 @@ parseMessage :: Parser Message parseMessage = parseMessage'' parseMessage'' :: Parser Message -parseMessage'' = do - spaces' - _ <- string "message" - spaces1 - name <- protoName - spaces' - _ <- char '{' - spaces' - fields <- try parseMessageField `sepEndBy` char ';' - spaces' - _ <- char '}' - spaces' - return (Message name fields) - -parseDataType :: Parser DataType -parseDataType = - do - Scalar <$> parseScalarType - <|> Compound <$> protoName +parseMessage'' = + Message + <$> (spaces' *> string "message" *> spaces1 *> name) + <*> (spaces' *> char '{' *> spaces' *> fields <* spaces' <* char '}' <* spaces') + where + name = protoName + fields = try parseMessageField `sepEndBy` char ';' parseMessageField :: Parser MessageField parseMessageField = - do - try implicitMessageField - <|> try optionalMessageField - <|> try repeatedMessageField - <|> try reservedMessageField - -implicitMessageField :: Parser MessageField -implicitMessageField = do - spaces' - t <- parseDataType <|> parseMap - spaces' - name <- protoName - spaces' - _ <- char '=' - spaces' - fieldNumber <- protoNumber - spaces' - return (ImplicitMessageField t name fieldNumber) - -optionalMessageField :: Parser MessageField -optionalMessageField = do - spaces' - _ <- string "optional" - spaces' - t <- parseDataType <|> parseMap - spaces' - name <- protoName - spaces' - _ <- char '=' - spaces' - fieldNumber <- protoNumber - spaces' - return (OptionalMessageField t name fieldNumber) - -repeatedMessageField :: Parser MessageField -repeatedMessageField = do - spaces' - _ <- string "repeated" - spaces' - t <- parseDataType - spaces' - name <- protoName - spaces' - _ <- char '=' - spaces' - fieldNumber <- protoNumber - spaces' - return (RepeatedMessageField t name fieldNumber) - -reservedMessageField :: Parser MessageField -reservedMessageField = do - spaces' - _ <- string "reserved" - spaces' - try parseReservedNames <|> try parseReservedNumbers - ----------------------------------------------------------------- - --- TODO: one of - ----------------------------------------------------------------- - -parseReservedNames :: Parser MessageField -parseReservedNames = do - MessageReserved . ReservedMessageNames <$> reservedNames - -parseReservedNumbers :: Parser MessageField -parseReservedNumbers = do - numbers <- try (reservedNumbers protoNumber fieldNumberRange) `sepEndBy1` char ',' - return (MessageReserved (ReservedMessageNumbers (concat numbers))) + spaces' *> (try implicitField <|> try optionalField <|> try repeatedField <|> try reservedField) + where + fieldName = spaces' *> protoName + fieldNumber = spaces' *> char '=' *> spaces' *> protoNumber + reservedValues = + try (ReservedMessageNames <$> reservedNames) + <|> try (ReservedMessageNumbers <$> reservedNumbers protoNumber fieldNumberRange) + implicitField = + ImplicitMessageField + <$> (try parseDataType <|> try parseMap) + <*> fieldName + <*> fieldNumber + optionalField = + OptionalMessageField + <$> (string "optional" *> spaces' *> (try parseDataType <|> try parseMap)) + <*> fieldName + <*> fieldNumber + repeatedField = + RepeatedMessageField + <$> (string "repeated" *> spaces' *> parseDataType) -- maps not allowed in repeated fields + <*> fieldName + <*> fieldNumber + reservedField = + MessageReserved + <$> (string "reserved" *> spaces' *> reservedValues) fieldNumberRange :: Parser FieldNumber fieldNumberRange = do diff --git a/src/ProtoParser/Type.hs b/src/ProtoParser/Type.hs index 3e85511..2ff57ef 100644 --- a/src/ProtoParser/Type.hs +++ b/src/ProtoParser/Type.hs @@ -71,32 +71,6 @@ parseScalarType = ---------------------------------------------------------------- --- parseMap :: Parser MessageField --- parseMap = do --- spaces' --- _ <- string "map" --- spaces' --- _ <- char '<' --- spaces' --- key <- --- IntKey --- <$> parseIntType --- <|> StringKey --- <$> protoName --- spaces' --- _ <- char ',' --- value <- MapName <$> protoName --- spaces' --- _ <- char '>' --- spaces' --- name <- protoName --- spaces' --- _ <- char '=' --- spaces' --- fieldNumber <- protoNumber --- -- cannot be repeated --- return (ImplicitMessageField (Map key value) name fieldNumber) - parseMap :: Parser DataType parseMap = do spaces' @@ -116,3 +90,9 @@ parseMap = do _ <- char '>' spaces' return (Map key value) + +parseDataType :: Parser DataType +parseDataType = + do + Scalar <$> parseScalarType + <|> Compound <$> protoName From 0d3b7c942e6d4b9aed1190d6bdced9accc3ca6cc Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Sat, 25 Nov 2023 18:32:17 +0100 Subject: [PATCH 30/55] fix issues until char.proto is parsable --- app/Main.hs | 32 +++++++++++++++----------------- protobuf-parser.cabal | 2 ++ src/ProtoParser.hs | 7 ++++++- src/ProtoParser/Message.hs | 7 ++++++- src/ProtoParser/Option.hs | 22 ++++++++++++++++++++++ src/ProtoParser/Service.hs | 6 +++++- src/Protobuf.hs | 1 + test/Spec.hs | 2 ++ test/Unit/Message.hs | 21 +++++++++++++++++++++ test/Unit/Option.hs | 20 ++++++++++++++++++++ test/Unit/Service.hs | 10 +++++----- 11 files changed, 105 insertions(+), 25 deletions(-) create mode 100644 src/ProtoParser/Option.hs create mode 100644 test/Unit/Option.hs diff --git a/app/Main.hs b/app/Main.hs index 1d3a0e1..8b3ab72 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,7 +1,8 @@ module Main (main) where -import ProtoParser.Message -import Text.Parsec (parse) +-- import ProtoParser.Option +import ProtoParser +-- import Text.Parsec (parse) -- erro :: String -- erro = @@ -11,21 +12,18 @@ import Text.Parsec (parse) -- \reserved 1, 2;\ -- \}" -testMessageReserved :: String -testMessageReserved = - "message Foo {\ - \reserved \"foo\", \"bar\";\ - \}" - -main :: IO () -main = do - case parse parseMessage "" testMessageReserved of - Left err -> print err - Right protobuf -> print protobuf +-- testMessageReserved :: String +-- testMessageReserved = "option java_package = \"de.test\";" -- main :: IO () -- main = do --- result <- parseProtoFile "example.proto" --- case result of --- Left err -> putStrLn $ "Parse error: " ++ show err --- Right protobuf -> putStrLn $ "Successfully parsed: " ++ show protobuf + -- case parse parseOption "" testMessageReserved of + -- Left err -> print err + -- Right protobuf -> print protobuf + +main :: IO () +main = do + result <- parseProtoFile "test/protofiles/chat.proto" + case result of + Left err -> putStrLn $ "Parse error: " ++ show err + Right protobuf -> putStrLn $ "Successfully parsed: " ++ show protobuf diff --git a/protobuf-parser.cabal b/protobuf-parser.cabal index ca7dc93..f83db99 100644 --- a/protobuf-parser.cabal +++ b/protobuf-parser.cabal @@ -32,6 +32,7 @@ library ProtoParser.Enum ProtoParser.Import ProtoParser.Message + ProtoParser.Option ProtoParser.Package ProtoParser.Reserved ProtoParser.Service @@ -74,6 +75,7 @@ test-suite protobuf-parser-test Unit.Files Unit.Import Unit.Message + Unit.Option Unit.Package Unit.ProtoParser Unit.Service diff --git a/src/ProtoParser.hs b/src/ProtoParser.hs index 1163246..73a8249 100644 --- a/src/ProtoParser.hs +++ b/src/ProtoParser.hs @@ -8,6 +8,7 @@ module ProtoParser module ProtoParser.Service, module ProtoParser.EndOfLine, module ProtoParser.Syntax, + module ProtoParser.Option, parseProtobuf, parseProtoFile, ) @@ -18,6 +19,7 @@ import ProtoParser.EndOfLine import ProtoParser.Enum import ProtoParser.Import import ProtoParser.Message +import ProtoParser.Option import ProtoParser.Package import ProtoParser.Service import ProtoParser.Syntax @@ -49,7 +51,10 @@ protoValue' old = do try (parseImport' old), try (parseComment' old), try (parseEnum' old), - try (parseMessage' old) + try (parseMessage' old), + try (parseOption' old), + try (parseSyntax' old), + try (parseService' old) ] isEnd <- try (lookAhead anyChar >> return False) <|> return True if isEnd diff --git a/src/ProtoParser/Message.hs b/src/ProtoParser/Message.hs index 8196d56..41d162b 100644 --- a/src/ProtoParser/Message.hs +++ b/src/ProtoParser/Message.hs @@ -31,10 +31,11 @@ parseMessage'' = parseMessageField :: Parser MessageField parseMessageField = - spaces' *> (try implicitField <|> try optionalField <|> try repeatedField <|> try reservedField) + spaces' *> (try implicitField <|> try optionalField <|> try repeatedField <|> try reservedField <|> try oneofField) where fieldName = spaces' *> protoName fieldNumber = spaces' *> char '=' *> spaces' *> protoNumber + fields = try parseMessageField `sepEndBy` char ';' reservedValues = try (ReservedMessageNames <$> reservedNames) <|> try (ReservedMessageNumbers <$> reservedNumbers protoNumber fieldNumberRange) @@ -56,6 +57,10 @@ parseMessageField = reservedField = MessageReserved <$> (string "reserved" *> spaces' *> reservedValues) + oneofField = + OneOfMessageField + <$> (string "oneof" *> spaces' *> protoName) + <*> (spaces' *> char '{' *> spaces' *> fields <* spaces' <* char '}' <* spaces') fieldNumberRange :: Parser FieldNumber fieldNumberRange = do diff --git a/src/ProtoParser/Option.hs b/src/ProtoParser/Option.hs new file mode 100644 index 0000000..ec4dcba --- /dev/null +++ b/src/ProtoParser/Option.hs @@ -0,0 +1,22 @@ +module ProtoParser.Option (parseOption, parseOption') where + +import ProtoParser.Space (spaces', spaces1) +import ProtoParser.Type (protoName) +import Protobuf +import Text.Parsec +import Text.Parsec.String + +parseOption' :: Protobuf -> Parser Protobuf +parseOption' p = do + opt <- parseOption + return + ( Protobuf.merge + p + (Protobuf {syntax = Nothing, package = Nothing, imports = [], options = [opt], enums = [], messages = [], services = []}) + ) + +parseOption :: Parser Option +parseOption = + Option + <$> (spaces' *> string "option" *> spaces1 *> protoName <* spaces1) + <*> (spaces' *> char '=' *> spaces' *> char '\"' *> (anyChar `manyTill` char '"') <* spaces' <* char ';') diff --git a/src/ProtoParser/Service.hs b/src/ProtoParser/Service.hs index 884ca20..d10b77e 100644 --- a/src/ProtoParser/Service.hs +++ b/src/ProtoParser/Service.hs @@ -29,7 +29,7 @@ parseService'' = do spaces' _ <- char '{' spaces' - fields <- try parseServiceField `sepEndBy1` char ';' + fields <- try parseServiceField `sepEndBy1` (lookAhead anyChar) spaces' _ <- char '}' return (Service name (catMaybes fields)) @@ -57,6 +57,10 @@ parseServiceField = do spaces' _ <- char ')' spaces' + _ <- char '{' + spaces' + _ <- char '}' + spaces' return ( Just ( RPC diff --git a/src/Protobuf.hs b/src/Protobuf.hs index b130d46..89426ca 100644 --- a/src/Protobuf.hs +++ b/src/Protobuf.hs @@ -73,6 +73,7 @@ data MessageField | OptionalMessageField DataType Name FieldNumber | RepeatedMessageField DataType Name FieldNumber | MessageReserved MessageReservedValues + | OneOfMessageField Name [MessageField] deriving (Show, Eq) data Message diff --git a/test/Spec.hs b/test/Spec.hs index 059eb86..0716bba 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -4,6 +4,7 @@ import Unit.Enum as Unit import Unit.Files as Files import Unit.Import as Import import Unit.Message as Message +import Unit.Option as Option import Unit.Package as Package import Unit.ProtoParser as Protobuf import Unit.Service as Service @@ -24,5 +25,6 @@ main = ++ Service.allTests ++ Files.allTests ++ Syntax.allTests + ++ Option.allTests ) ) diff --git a/test/Unit/Message.hs b/test/Unit/Message.hs index c64a619..ef0e8ba 100644 --- a/test/Unit/Message.hs +++ b/test/Unit/Message.hs @@ -80,6 +80,26 @@ testReservedNamesProto = [ MessageReserved (ReservedMessageNames (ReservedNames ["foo", "bar"])) ] +testOneOf :: String +testOneOf = + "message Foo {\ + \oneof foo {\ + \int32 bar = 1;\ + \double baz = 2;\ + \}\ + \}" + +testOneOfProto :: Message +testOneOfProto = + Message + "Foo" + [ OneOfMessageField + "foo" + [ ImplicitMessageField (Scalar (IntType Int32)) "bar" 1, + ImplicitMessageField (Scalar (FloatType Double)) "baz" 2 + ] + ] + testSimple :: Test testSimple = TestCase $ do assertEqual "empty" False (isRight (parse parseMessage "" "")) @@ -91,3 +111,4 @@ testSimple = TestCase $ do assertEqual "optional" testOptionalProto (fromRight failMessage (parse parseMessage "" testOptional)) assertEqual "repeated" testRepeatedProto (fromRight failMessage (parse parseMessage "" testRepeated)) assertEqual "reserved names" testReservedNamesProto (fromRight failMessage (parse parseMessage "" testReservedNames)) + assertEqual "oneof" testOneOfProto (fromRight failMessage (parse parseMessage "" testOneOf)) diff --git a/test/Unit/Option.hs b/test/Unit/Option.hs new file mode 100644 index 0000000..0cd48ec --- /dev/null +++ b/test/Unit/Option.hs @@ -0,0 +1,20 @@ +module Unit.Option (allTests) where + +import Data.Either (fromRight, isRight) +import ProtoParser.Option +import Protobuf +import Test.HUnit +import Text.Parsec (parse) + +allTests :: [Test] +allTests = + [ TestLabel "import" testImport + ] + +testOption :: Option +testOption = Option ("test") ("fail") + +testImport :: Test +testImport = TestCase $ do + assertEqual "empty" False (isRight (parse parseOption "" "")) + assertEqual "java_package" (Option "java_package" "de.test") (fromRight testOption (parse parseOption "" "option java_package = \"de.test\";")) diff --git a/test/Unit/Service.hs b/test/Unit/Service.hs index 2965ef6..e8599f6 100644 --- a/test/Unit/Service.hs +++ b/test/Unit/Service.hs @@ -17,7 +17,7 @@ failMessage = Service "FAIL" [] simpleServiceText :: String simpleServiceText = "service SearchService {\n\ - \ rpc Search(SearchRequest) returns (SearchResponse);\n\ + \ rpc Search(SearchRequest) returns (SearchResponse) {}\n\ \}" simpleService :: Service @@ -33,8 +33,8 @@ simpleService = multipleServiceText :: String multipleServiceText = "service Multiple {\n\ - \ rpc Search(Foo) returns (Bar);\n\ - \ rpc Search1(Bar) returns (Foo);\n\ + \ rpc Search(Foo) returns (Bar) {}\n\ + \ rpc Search1(Bar) returns (Foo) {}\n\ \}" multipleService :: Service @@ -54,7 +54,7 @@ multipleService = streamRequestServiceText :: String streamRequestServiceText = "service Multiple {\n\ - \ rpc Search(stream Foo) returns (Bar);\n\ + \ rpc Search(stream Foo) returns (Bar) {}\n\ \}" streamRequestService :: Service @@ -70,7 +70,7 @@ streamRequestService = streamReplyServiceText :: String streamReplyServiceText = "service Multiple {\n\ - \ rpc Search(Foo) returns (stream Bar);\n\ + \ rpc Search(Foo) returns (stream Bar) {}\n\ \}" streamReplyService :: Service From c8f4e5dc0bb77966850c85a371d45e4f4af5418a Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Sat, 25 Nov 2023 22:18:43 +0100 Subject: [PATCH 31/55] convert to <*> syntax --- app/Main.hs | 29 +++++---- src/ProtoParser.hs | 34 +++++----- src/ProtoParser/Comment.hs | 14 ++--- src/ProtoParser/Enum.hs | 120 ++++++++++++++++-------------------- src/ProtoParser/Import.hs | 15 +++-- src/ProtoParser/Message.hs | 53 +++++++++++++--- src/ProtoParser/Option.hs | 16 ++++- src/ProtoParser/Package.hs | 7 ++- src/ProtoParser/Reserved.hs | 55 +++++------------ src/ProtoParser/Service.hs | 94 +++++++++++++--------------- src/ProtoParser/Syntax.hs | 25 ++++---- src/ProtoParser/Type.hs | 104 ++++++++++++------------------- test/Unit/Enum.hs | 50 +++++++-------- 13 files changed, 296 insertions(+), 320 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 8b3ab72..6e756df 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,7 +1,8 @@ module Main (main) where --- import ProtoParser.Option +-- import ProtoParser.Enum import ProtoParser + -- import Text.Parsec (parse) -- erro :: String @@ -13,17 +14,23 @@ import ProtoParser -- \}" -- testMessageReserved :: String --- testMessageReserved = "option java_package = \"de.test\";" +-- testMessageReserved = "syntax = \"proto3\";" --- main :: IO () --- main = do - -- case parse parseOption "" testMessageReserved of - -- Left err -> print err - -- Right protobuf -> print protobuf +testMessageReserved :: String +testMessageReserved = + "import \"foo.proto\";\n\ + \package foobar;\n\ + \import \"bar.proto\";" main :: IO () main = do - result <- parseProtoFile "test/protofiles/chat.proto" - case result of - Left err -> putStrLn $ "Parse error: " ++ show err - Right protobuf -> putStrLn $ "Successfully parsed: " ++ show protobuf + case parseProtobuf testMessageReserved of + Left err -> print err + Right protobuf -> print protobuf + +-- main :: IO () +-- main = do +-- result <- parseProtoFile "test/protofiles/chat.proto" +-- case result of +-- Left err -> putStrLn $ "Parse error: " ++ show err +-- Right protobuf -> putStrLn $ "Successfully parsed: " ++ show protobuf diff --git a/src/ProtoParser.hs b/src/ProtoParser.hs index 73a8249..b78a215 100644 --- a/src/ProtoParser.hs +++ b/src/ProtoParser.hs @@ -44,21 +44,19 @@ protoValue = do protoValue' emptyProtobuf protoValue' :: Protobuf -> Parser Protobuf -protoValue' old = do - new <- - choice - [ try (parsePackage' old), - try (parseImport' old), - try (parseComment' old), - try (parseEnum' old), - try (parseMessage' old), - try (parseOption' old), - try (parseSyntax' old), - try (parseService' old) - ] - isEnd <- try (lookAhead anyChar >> return False) <|> return True - if isEnd - then do - return new - else do - protoValue' new +protoValue' old = + ( try (parsePackage' old) + <|> try (parseImport' old) + <|> try (parseComment' old) + <|> try (parseEnum' old) + <|> try (parseMessage' old) + <|> try (parseOption' old) + <|> try (parseSyntax' old) + <|> try (parseService' old) + ) + >>= \new -> + do + isEnd <- try (lookAhead anyChar >> return False) <|> return True + if isEnd + then return new + else protoValue' new diff --git a/src/ProtoParser/Comment.hs b/src/ProtoParser/Comment.hs index d3fbc62..f1f1deb 100644 --- a/src/ProtoParser/Comment.hs +++ b/src/ProtoParser/Comment.hs @@ -23,15 +23,13 @@ removeComment = do void (try parseSingleLineComment <|> try parseMultiLineComment) parseComment :: Parser Comment -parseComment = do - try parseSingleLineComment <|> try parseMultiLineComment +parseComment = + (try parseSingleLineComment <|> try parseMultiLineComment) parseSingleLineComment :: Parser Comment -parseSingleLineComment = do - _ <- string "//" - manyTill anyChar (try eol) +parseSingleLineComment = + (string "//") *> (manyTill anyChar (try eol)) parseMultiLineComment :: Parser Comment -parseMultiLineComment = do - _ <- string "/*" - manyTill anyChar (try (string "*/")) +parseMultiLineComment = + (string "/*") *> manyTill anyChar (try (string "*/")) diff --git a/src/ProtoParser/Enum.hs b/src/ProtoParser/Enum.hs index 5c17c6e..65b7a87 100644 --- a/src/ProtoParser/Enum.hs +++ b/src/ProtoParser/Enum.hs @@ -1,7 +1,7 @@ module ProtoParser.Enum - ( protoEnum, + ( parseEnum, parseEnum', - enumField, + parseEnumField, enumNumber, enumNumberRange, protoName, @@ -10,7 +10,7 @@ module ProtoParser.Enum where import ProtoParser.Reserved -import ProtoParser.Space (spaces') +import ProtoParser.Space (spaces', spaces1) import ProtoParser.Type import Protobuf import Text.Parsec @@ -18,55 +18,53 @@ import Text.Parsec.String parseEnum' :: Protobuf -> Parser Protobuf parseEnum' p = do - x <- protoEnum + x <- parseEnum return ( Protobuf.merge p (Protobuf {syntax = Nothing, package = Nothing, imports = [], options = [], enums = [x], messages = [], services = []}) ) -protoEnum :: Parser Protobuf.Enum -protoEnum = do - spaces' - _ <- string "enum" "Expected enum keyword" - spaces' - name <- protoName "Expected enum name" - spaces' - _ <- char '{' ("Expected '{' after enum name" ++ name) - spaces' - values <- try enumField `sepEndBy1` (try (string ";") <|> try (string ";\n")) "Expected at least one enum value" - return (Protobuf.Enum name values) +parseEnum :: Parser Protobuf.Enum +parseEnum = + Protobuf.Enum + <$> ( spaces' + *> string "enum" + *> spaces1 + *> name + ) + <*> ( spaces' + *> char '{' + *> spaces' + *> fields + <* spaces' + <* char '}' + <* spaces' + ) + where + name = protoName + fields = try parseEnumField `sepEndBy1` char ';' -enumField :: Parser EnumField -enumField = do - spaces - name <- protoName - -- TODO: exctact to extra parser functions - case name of - "option" -> enumOption - "reserved" -> enumReserved - _ -> do - spaces' - _ <- char '=' - spaces' - number <- enumNumber - spaces' - return (EnumValue name number) - --- https://protobuf.dev/programming-guides/proto3/#enum -enumOption :: Parser EnumField -enumOption = do - spaces - optionName <- protoName - case optionName of - "allow_alias" -> do - spaces' - _ <- char '=' - spaces' - active <- parseBoolOption - spaces' - return (EnumOption "allow_alias" active) - _ -> fail "Unknown option" +parseEnumField :: Parser EnumField +parseEnumField = + spaces' *> (try reservedField <|> try optionField <|> try valueField) + where + fieldName = spaces' *> protoName + fieldNumber = spaces' *> char '=' *> spaces' *> enumNumber + reservedValues = + try (ReservedEnumNames <$> reservedNames) + <|> try (ReservedEnumNumbers <$> reservedNumbers enumNumber enumNumberRange) + valueField = + EnumValue + <$> fieldName + <*> fieldNumber + optionField = + EnumOption + <$> (string "option" *> spaces1 *> protoName) + <*> (spaces1 *> char '=' *> spaces' *> parseBoolOption) + reservedField = + EnumReserved + <$> (string "reserved" *> spaces' *> reservedValues) parseBoolOption :: Parser Bool parseBoolOption = @@ -74,30 +72,16 @@ parseBoolOption = <|> (string "false" >> return False) "Expected true or false" -enumReserved :: Parser EnumField -enumReserved = do - spaces' - try parseReservedNames <|> try parseReservedNumbers - -parseReservedNames :: Parser EnumField -parseReservedNames = do - EnumReserved . ReservedEnumNames <$> reservedNames - -parseReservedNumbers :: Parser EnumField -parseReservedNumbers = do - numbers <- try (reservedNumbers enumNumber enumNumberRange) `sepEndBy1` char ',' - return (EnumReserved (ReservedEnumNumbers (concat numbers))) - enumNumber :: Parser EnumNumber enumNumber = - -- https://protobuf.dev/programming-guides/proto3/#enum - let val = (read <$> many1 digit) - in do - n <- val - if n >= (minBound :: EnumNumber) && n <= (maxBound :: EnumNumber) - then return n - else fail "Number not in valid range" + do + n <- (read <$> many1 digit) + if n >= (minBound :: EnumNumber) && n <= (maxBound :: EnumNumber) + then return n + else fail "Number not in valid range" enumNumberRange :: Parser EnumNumber -enumNumberRange = do - enumNumber <|> try (string "min" >> return 0) <|> try (string "max" >> return 0xFFFFFFFF) +enumNumberRange = + enumNumber + <|> try (string "min" >> return 0) + <|> try (string "max" >> return 0xFFFFFFFF) diff --git a/src/ProtoParser/Import.hs b/src/ProtoParser/Import.hs index 924f880..8b225ad 100644 --- a/src/ProtoParser/Import.hs +++ b/src/ProtoParser/Import.hs @@ -18,12 +18,11 @@ pathExtension :: String pathExtension = ".proto" parseImport :: Parser ImportPath -parseImport = do +parseImport = spaces' - _ <- string "import" "Expected import keyword" - spaces1 - _ <- char '"' "Expected '\"' after import keyword" - path <- anyChar `manyTill` string (pathExtension ++ "\"") - spaces' - _ <- char ';' "Expected ';' at end of import statement" - return (path ++ pathExtension) + *> (string "import" "Expected import keyword") + *> spaces1 + *> (char '"' "Expected '\"' after import keyword") + *> ((++ pathExtension) <$> (anyChar `manyTill` string (pathExtension ++ "\""))) + <* spaces' + <* char ';' diff --git a/src/ProtoParser/Message.hs b/src/ProtoParser/Message.hs index 41d162b..53ee9f1 100644 --- a/src/ProtoParser/Message.hs +++ b/src/ProtoParser/Message.hs @@ -23,15 +23,31 @@ parseMessage = parseMessage'' parseMessage'' :: Parser Message parseMessage'' = Message - <$> (spaces' *> string "message" *> spaces1 *> name) - <*> (spaces' *> char '{' *> spaces' *> fields <* spaces' <* char '}' <* spaces') + <$> ( spaces' + *> string "message" + *> spaces1 + *> protoName + ) + <*> ( spaces' + *> char '{' + *> spaces' + *> fields + <* spaces' + <* char '}' + <* spaces' + ) where - name = protoName fields = try parseMessageField `sepEndBy` char ';' parseMessageField :: Parser MessageField parseMessageField = - spaces' *> (try implicitField <|> try optionalField <|> try repeatedField <|> try reservedField <|> try oneofField) + spaces' + *> ( try implicitField + <|> try optionalField + <|> try repeatedField + <|> try reservedField + <|> try oneofField + ) where fieldName = spaces' *> protoName fieldNumber = spaces' *> char '=' *> spaces' *> protoNumber @@ -46,21 +62,40 @@ parseMessageField = <*> fieldNumber optionalField = OptionalMessageField - <$> (string "optional" *> spaces' *> (try parseDataType <|> try parseMap)) + <$> ( string "optional" + *> spaces' + *> (try parseDataType <|> try parseMap) + ) <*> fieldName <*> fieldNumber repeatedField = RepeatedMessageField - <$> (string "repeated" *> spaces' *> parseDataType) -- maps not allowed in repeated fields + <$> ( string "repeated" + *> spaces' + *> parseDataType -- maps not allowed in repeated fields + ) <*> fieldName <*> fieldNumber reservedField = MessageReserved - <$> (string "reserved" *> spaces' *> reservedValues) + <$> ( string "reserved" + *> spaces' + *> reservedValues + ) oneofField = OneOfMessageField - <$> (string "oneof" *> spaces' *> protoName) - <*> (spaces' *> char '{' *> spaces' *> fields <* spaces' <* char '}' <* spaces') + <$> ( string "oneof" + *> spaces' + *> protoName + ) + <*> ( spaces' + *> char '{' + *> spaces' + *> fields + <* spaces' + <* char '}' + <* spaces' + ) fieldNumberRange :: Parser FieldNumber fieldNumberRange = do diff --git a/src/ProtoParser/Option.hs b/src/ProtoParser/Option.hs index ec4dcba..09149d1 100644 --- a/src/ProtoParser/Option.hs +++ b/src/ProtoParser/Option.hs @@ -18,5 +18,17 @@ parseOption' p = do parseOption :: Parser Option parseOption = Option - <$> (spaces' *> string "option" *> spaces1 *> protoName <* spaces1) - <*> (spaces' *> char '=' *> spaces' *> char '\"' *> (anyChar `manyTill` char '"') <* spaces' <* char ';') + <$> ( spaces' + *> string "option" + *> spaces1 + *> protoName + <* spaces1 + ) + <*> ( spaces' + *> char '=' + *> spaces' + *> char '\"' + *> (anyChar `manyTill` char '"') + <* spaces' + <* char ';' + ) diff --git a/src/ProtoParser/Package.hs b/src/ProtoParser/Package.hs index 0165dae..65590e4 100644 --- a/src/ProtoParser/Package.hs +++ b/src/ProtoParser/Package.hs @@ -21,6 +21,7 @@ parsePackage' p = do parsePackage :: Parser Package parsePackage = do spaces' - _ <- string "package" "Expected package keyword" - spaces1 - anyChar `manyTill` char ';' "Expected package name followed by ';'" + *> string "package" + *> spaces1 + *> (anyChar `manyTill` char ';') + <* spaces' diff --git a/src/ProtoParser/Reserved.hs b/src/ProtoParser/Reserved.hs index da33b8a..8877e40 100644 --- a/src/ProtoParser/Reserved.hs +++ b/src/ProtoParser/Reserved.hs @@ -9,45 +9,22 @@ import Protobuf import Text.Parsec import Text.Parsec.String --- https://protobuf.dev/programming-guides/proto3/#reserved - ----------------------------------------------------------------- - reservedNames :: Parser ReservedNames -reservedNames = do - names <- try reservedNames' `sepBy1` char ',' - return (ReservedNames (concat names)) - -reservedNames' :: Parser [Name] -reservedNames' = do - _ <- spaces' - _ <- char '\"' - name <- protoName - _ <- char '\"' - return [name] - ----------------------------------------------------------------- - -reservedNumbersSingle :: Parser a -> Parser [a] -reservedNumbersSingle p = do - _ <- spaces' - firstNumber <- p - _ <- spaces' - return [firstNumber] - -reservedNumbersRange :: (Integral a) => Parser a -> Parser [a] -reservedNumbersRange range = do - firstNumber <- range - _ <- spaces' - _ <- string "to" - _ <- spaces' - secondNumber <- range - return [firstNumber .. secondNumber] +reservedNames = + ReservedNames + <$> try (spaces' *> char '\"' *> protoName <* char '\"') `sepBy1` char ',' reservedNumbers :: (Integral a) => Parser a -> Parser a -> Parser [a] -reservedNumbers single range = do - numbers <- try (reservedNumbers' single range) `sepBy1` char ',' - return (concat numbers) - -reservedNumbers' :: (Integral a) => Parser a -> Parser a -> Parser [a] -reservedNumbers' single range = try (reservedNumbersRange range) <|> try (reservedNumbersSingle single) +reservedNumbers single range = + concat <$> try (numbers `sepBy1` char ',') + where + numbers = + try + ( (\l r -> [l .. r]) + <$> range + <* spaces' + <* string "to" + <* spaces' + <*> range + ) + <|> ((: []) <$> try (spaces' *> single <* spaces')) diff --git a/src/ProtoParser/Service.hs b/src/ProtoParser/Service.hs index d10b77e..5b0934b 100644 --- a/src/ProtoParser/Service.hs +++ b/src/ProtoParser/Service.hs @@ -1,6 +1,5 @@ module ProtoParser.Service (parseService, parseService') where -import Data.Maybe (catMaybes) import ProtoParser.Space (spaces', spaces1) import ProtoParser.Type import Protobuf @@ -17,55 +16,48 @@ parseService' p = do ) parseService :: Parser Service -parseService = do - parseService'' - -parseService'' :: Parser Service -parseService'' = do - spaces' - _ <- string "service" - spaces1 - name <- protoName - spaces' - _ <- char '{' - spaces' - fields <- try parseServiceField `sepEndBy1` (lookAhead anyChar) - spaces' - _ <- char '}' - return (Service name (catMaybes fields)) +parseService = + Service + <$> ( spaces' + *> string "service" + *> spaces1 + *> protoName + ) + <*> ( spaces' + *> char '{' + *> spaces' + *> (try parseServiceField `sepEndBy1` (lookAhead anyChar)) + <* spaces' + <* char '}' + ) -parseServiceField :: Parser (Maybe RPC) -parseServiceField = do - spaces' - _ <- string "rpc" - spaces1 - name <- protoName - spaces' - _ <- char '(' - spaces' - isRequestStream <- option False (string "stream" >> spaces1 >> return True) - request <- protoName - spaces' - _ <- char ')' - spaces' - _ <- string "returns" - spaces' - _ <- char '(' - spaces' - isReplyStream <- option False (string "stream" >> spaces1 >> return True) - reply <- protoName - spaces' - _ <- char ')' - spaces' - _ <- char '{' - spaces' - _ <- char '}' - spaces' - return - ( Just - ( RPC - name - (if isRequestStream then RequestTypeStream request else RequestType request) - (if isReplyStream then ReplyTypeStream reply else ReplyType reply) +parseServiceField :: Parser RPC +parseServiceField = + RPC + <$> (spaces' *> string "rpc" *> spaces1 *> protoName) + <*> ( spaces' + *> char '(' + *> spaces' + *> (try requestStream <|> request) + <* spaces' + <* char ')' ) - ) + <*> ( spaces' + *> string "returns" + *> spaces' + *> char '(' + *> spaces' + *> (try replyStream <|> reply) + <* spaces' + <* char ')' + ) + <* spaces' + <* char '{' + <* spaces' + <* char '}' + <* spaces' + where + request = RequestType <$> protoName + requestStream = string "stream" *> spaces1 *> (RequestTypeStream <$> protoName) + reply = ReplyType <$> protoName + replyStream = string "stream" *> spaces1 *> (ReplyTypeStream <$> protoName) diff --git a/src/ProtoParser/Syntax.hs b/src/ProtoParser/Syntax.hs index 433ef75..d228f78 100644 --- a/src/ProtoParser/Syntax.hs +++ b/src/ProtoParser/Syntax.hs @@ -19,17 +19,16 @@ parseSyntax' p = do ) parseSyntax :: Parser Syntax -parseSyntax = do +parseSyntax = spaces' - _ <- string "syntax" "Expected 'syntax' keyword" - spaces' - _ <- char '=' "Expected '=' after 'syntax' keyword" - spaces' - _ <- char '"' "Expected '\"' after 'syntax' keyword" - syn <- - try (string "proto2" >> return Proto2) - <|> try (string "proto3" >> return Proto3) - spaces' - _ <- char '"' "Expected '\"' after 'syntax' value" - _ <- char ';' "Expected ';' at end of syntax statement" - return syn + *> string "syntax" + *> spaces' + *> char '=' + *> spaces' + *> char '"' + *> ( (try (string "proto2") >> return Proto2) + <|> (try (string "proto3") >> return Proto3) + ) + <* char '"' + <* spaces' + <* char ';' diff --git a/src/ProtoParser/Type.hs b/src/ProtoParser/Type.hs index 2ff57ef..a705fba 100644 --- a/src/ProtoParser/Type.hs +++ b/src/ProtoParser/Type.hs @@ -10,89 +10,63 @@ import Text.Parsec.String protoName :: Parser String protoName = do - first <- letter "Expected first letter to be ...?" - rest <- many (alphaNum <|> char '_' "Expected letter, number or '_'") - return (first : rest) - ----------------------------------------------------------------- + (:) + <$> letter + <*> many (alphaNum <|> char '_') protoNumber :: Parser FieldNumber -protoNumber = - -- https://protobuf.dev/programming-guides/proto3/#assigning - let val = (read <$> many1 digit) - in do - n <- val - -- 19,000 to 19,999 are reserved for the Protocol Buffers - if 19000 <= n && n <= 19999 - then fail "number reserved" - else - if 1 <= n && n <= 536870911 -- Range from 1 to 536,870,911 - then return n - else fail "number out of range" - ----------------------------------------------------------------- +protoNumber = do + n <- read <$> many1 digit + case () of + -- 19,000 to 19,999 are reserved for the Protocol Buffers + _ | n >= 19000 && n < 20000 -> fail "number reserved" + -- FieldNumber [1..536,870,911] + _ | n <= 0 || n > 536870911 -> fail "number out of range" + _ -> return n parseIntType :: Parser IntType parseIntType = - let int32 = string "int32" >> return Int32 - int64 = string "int64" >> return Int64 - uint32 = string "uint32" >> return UInt32 - uint64 = string "uint64" >> return UInt64 - sint32 = string "sint32" >> return SInt32 - sint64 = string "sint64" >> return SInt64 - fixed32 = string "fixed32" >> return Fixed32 - fixed64 = string "fixed64" >> return Fixed64 - sfixed32 = string "sfixed32" >> return SFixed32 - sfixed64 = string "sfixed64" >> return SFixed64 - in int32 - <|> int64 - <|> uint32 - <|> uint64 - <|> sint32 - <|> sint64 - <|> fixed32 - <|> fixed64 - <|> sfixed32 - <|> sfixed64 + (string "int32" >> return Int32) + <|> (string "int64" >> return Int64) + <|> (string "uint32" >> return UInt32) + <|> (string "uint64" >> return UInt64) + <|> (string "sint32" >> return SInt32) + <|> (string "sint64" >> return SInt64) + <|> (string "fixed32" >> return Fixed32) + <|> (string "fixed64" >> return Fixed64) + <|> (string "sfixed32" >> return SFixed32) + <|> (string "sfixed64" >> return SFixed64) ----------------------------------------------------------------- parseStringType :: Parser MapKey parseStringType = StringKey <$> protoName parseScalarType :: Parser ScalarType parseScalarType = - do - intType <- try parseIntType - return (IntType intType) + (IntType <$> try parseIntType) <|> try (string "double" >> return (FloatType Double)) <|> try (string "float" >> return (FloatType Float)) <|> try (string "string" >> return StringType) <|> try (string "bytes" >> return BytesType) ----------------------------------------------------------------- - parseMap :: Parser DataType -parseMap = do - spaces' - _ <- string "map" - spaces' - _ <- char '<' - spaces' - key <- - IntKey - <$> parseIntType - <|> StringKey - <$> protoName - spaces' - _ <- char ',' - value <- MapName <$> protoName - spaces' - _ <- char '>' - spaces' - return (Map key value) +parseMap = + Map + <$> ( string "map" + *> spaces' + *> char '<' + *> spaces' + *> (IntKey <$> parseIntType <|> StringKey <$> protoName) + ) + <*> ( spaces' + *> char ',' + *> spaces' + *> (MapName <$> protoName) + <* spaces' + <* char '>' + <* spaces' + ) parseDataType :: Parser DataType parseDataType = - do - Scalar <$> parseScalarType + Scalar <$> parseScalarType <|> Compound <$> protoName diff --git a/test/Unit/Enum.hs b/test/Unit/Enum.hs index b7795f6..801fca5 100644 --- a/test/Unit/Enum.hs +++ b/test/Unit/Enum.hs @@ -8,7 +8,7 @@ import Text.Parsec (parse) allTests :: [Test] allTests = - [ TestLabel "enumFieldParser" testEnumFieldParser, + [ TestLabel "parseEnumFieldParser" testEnumFieldParser, TestLabel "enumParser" testEnumParser, TestLabel "reservedEnumNumbers" testReservedEnumNumbers, TestLabel "fieldNumbers" testEnumFieldNumbers @@ -28,29 +28,29 @@ emptyDefault = EnumValue "TestDefault" 0 testEnumFieldParser :: Test testEnumFieldParser = TestCase $ do - assertEqual "empyt" False (isRight (parse enumField "" "")) - assertEqual "enumEntry" (EnumValue "TEST" 0) (fromRight emptyDefault (parse enumField "" "TEST = 0")) - assertEqual "enumEntry" (EnumValue "MORE" 1) (fromRight emptyDefault (parse enumField "" "MORE = 1")) - assertEqual "enumEntry" (EnumValue "UNDER_SCORE" 42) (fromRight emptyDefault (parse enumField "" "UNDER_SCORE = 42")) + assertEqual "empty" False (isRight (parse parseEnumField "" "")) + assertEqual "enumEntry" (EnumValue "TEST" 0) (fromRight emptyDefault (parse parseEnumField "" "TEST = 0")) + assertEqual "enumEntry" (EnumValue "MORE" 1) (fromRight emptyDefault (parse parseEnumField "" "MORE = 1")) + assertEqual "enumEntry" (EnumValue "UNDER_SCORE" 42) (fromRight emptyDefault (parse parseEnumField "" "UNDER_SCORE = 42")) -- reserved number -- - assertEqual "empytReserved" False (isRight (parse enumField "" "reserved")) - assertEqual "outOfRangeSingleReserved" False (isRight (parse enumField "" "reserved -1")) - assertEqual "multiReserved" (EnumReserved (ReservedEnumNumbers [1, 2])) (fromRight emptyDefault (parse enumField "" "reserved 1, 2")) - assertEqual "multiReserved" (EnumReserved (ReservedEnumNumbers [1, 3, 5])) (fromRight emptyDefault (parse enumField "" "reserved 1, 3, 5")) - assertEqual "multiReserved" (EnumReserved (ReservedEnumNumbers [1, 2, 3])) (fromRight emptyDefault (parse enumField "" "reserved 1 to 3")) - assertEqual "multiReserved" (EnumReserved (ReservedEnumNumbers [0, 1, 2, 3])) (fromRight emptyDefault (parse enumField "" "reserved min to 3")) - assertEqual "multiReserved" (EnumReserved (ReservedEnumNumbers [4294967294, 0xFFFFFFFF])) (fromRight emptyDefault (parse enumField "" "reserved 4294967294 to max")) - assertEqual "singleReserved" (EnumReserved (ReservedEnumNumbers [0])) (fromRight emptyDefault (parse enumField "" "reserved 0")) - assertEqual "singleReserved" (EnumReserved (ReservedEnumNumbers [1])) (fromRight emptyDefault (parse enumField "" "reserved 1")) - -- assertEqual "reservedIncorrectNumberFormat" False (isRight (parse enumField "" "reserved 1 2")) -- cant parse with enumField alone anymore + assertEqual "empytReserved" False (isRight (parse parseEnumField "" "reserved")) + assertEqual "outOfRangeSingleReserved" False (isRight (parse parseEnumField "" "reserved -1")) + assertEqual "multiReserved" (EnumReserved (ReservedEnumNumbers [1, 2])) (fromRight emptyDefault (parse parseEnumField "" "reserved 1, 2")) + assertEqual "multiReserved" (EnumReserved (ReservedEnumNumbers [1, 3, 5])) (fromRight emptyDefault (parse parseEnumField "" "reserved 1, 3, 5")) + assertEqual "multiReserved" (EnumReserved (ReservedEnumNumbers [1, 2, 3])) (fromRight emptyDefault (parse parseEnumField "" "reserved 1 to 3")) + assertEqual "multiReserved" (EnumReserved (ReservedEnumNumbers [0, 1, 2, 3])) (fromRight emptyDefault (parse parseEnumField "" "reserved min to 3")) + assertEqual "multiReserved" (EnumReserved (ReservedEnumNumbers [4294967294, 0xFFFFFFFF])) (fromRight emptyDefault (parse parseEnumField "" "reserved 4294967294 to max")) + assertEqual "singleReserved" (EnumReserved (ReservedEnumNumbers [0])) (fromRight emptyDefault (parse parseEnumField "" "reserved 0")) + assertEqual "singleReserved" (EnumReserved (ReservedEnumNumbers [1])) (fromRight emptyDefault (parse parseEnumField "" "reserved 1")) + -- assertEqual "reservedIncorrectNumberFormat" False (isRight (parse parseEnumField "" "reserved 1 2")) -- cant parse with enumField alone anymore -- reserved name -- - assertEqual "emptyReservedName" False (isRight (parse enumField "" "reserved")) - assertEqual "singleReservedName" (EnumReserved (ReservedEnumNames (ReservedNames ["FOO"]))) (fromRight emptyDefault (parse enumField "" "reserved \"FOO\"")) - assertEqual "multiReservedName" (EnumReserved (ReservedEnumNames (ReservedNames ["FOO", "BAR"]))) (fromRight emptyDefault (parse enumField "" "reserved \"FOO\", \"BAR\"")) + assertEqual "emptyReservedName" False (isRight (parse parseEnumField "" "reserved")) + assertEqual "singleReservedName" (EnumReserved (ReservedEnumNames (ReservedNames ["FOO"]))) (fromRight emptyDefault (parse parseEnumField "" "reserved \"FOO\"")) + assertEqual "multiReservedName" (EnumReserved (ReservedEnumNames (ReservedNames ["FOO", "BAR"]))) (fromRight emptyDefault (parse parseEnumField "" "reserved \"FOO\", \"BAR\"")) -- option -- - assertEqual "empyt" False (isRight (parse enumField "" "option invalid_option = true")) - assertEqual "invalidOption" (EnumOption "allow_alias" True) (fromRight emptyDefault (parse enumField "" "option allow_alias = true")) - assertEqual "invalidOption" (EnumOption "allow_alias" False) (fromRight emptyDefault (parse enumField "" "option allow_alias = false")) + assertEqual "empty" False (isRight (parse parseEnumField "" "")) + assertEqual "invalidOption" (EnumOption "allow_alias" True) (fromRight emptyDefault (parse parseEnumField "" "option allow_alias = true")) + assertEqual "invalidOption" (EnumOption "allow_alias" False) (fromRight emptyDefault (parse parseEnumField "" "option allow_alias = false")) ---------------------------------------------------------------- @@ -70,10 +70,10 @@ exampleEnumField = Protobuf.Enum "TestEnum" [EnumValue "UNKNOWN" 0, EnumValue "S testEnumParser :: Test testEnumParser = TestCase $ do - assertEqual "empyt" False (isRight (parse protoEnum "" "")) - assertEqual "atLeastOneEnumField" False (isRight (parse protoEnum "" "enum Test{}")) - assertEqual "singleEnum" (Protobuf.Enum "Test" [EnumValue "A" 0]) (fromRight empytDefault (parse protoEnum "" "enum Test { A = 0; }")) - assertEqual "multiple" exampleEnumField (fromRight empytDefault (parse protoEnum "" exampleEnum)) + assertEqual "empty" False (isRight (parse parseEnum "" "")) + assertEqual "atLeastOneEnumField" False (isRight (parse parseEnum "" "enum Test{}")) + assertEqual "singleEnum" (Protobuf.Enum "Test" [EnumValue "A" 0]) (fromRight empytDefault (parse parseEnum "" "enum Test { A = 0; }")) + assertEqual "multiple" exampleEnumField (fromRight empytDefault (parse parseEnum "" exampleEnum)) ---------------------------------------------------------------- From 485c9cc92f4aa621ab95af53242f16a5d8657106 Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Sun, 26 Nov 2023 00:20:06 +0100 Subject: [PATCH 32/55] dont export all submodules --- src/ProtoParser.hs | 14 +------------- 1 file changed, 1 insertion(+), 13 deletions(-) diff --git a/src/ProtoParser.hs b/src/ProtoParser.hs index b78a215..9bc4dd2 100644 --- a/src/ProtoParser.hs +++ b/src/ProtoParser.hs @@ -1,21 +1,10 @@ module ProtoParser - ( module ProtoParser.Enum, - module ProtoParser.Type, - module ProtoParser.Import, - module ProtoParser.Comment, - module ProtoParser.Message, - module ProtoParser.Package, - module ProtoParser.Service, - module ProtoParser.EndOfLine, - module ProtoParser.Syntax, - module ProtoParser.Option, - parseProtobuf, + ( parseProtobuf, parseProtoFile, ) where import ProtoParser.Comment -import ProtoParser.EndOfLine import ProtoParser.Enum import ProtoParser.Import import ProtoParser.Message @@ -23,7 +12,6 @@ import ProtoParser.Option import ProtoParser.Package import ProtoParser.Service import ProtoParser.Syntax -import ProtoParser.Type import Protobuf import System.IO import Text.Parsec From 0931a32ec8676f9e053d4721ecfaf5ad9bb2af20 Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Sun, 26 Nov 2023 00:53:55 +0100 Subject: [PATCH 33/55] parse multiple kind of options --- README.md | 2 ++ src/ProtoParser/Enum.hs | 10 ++-------- src/ProtoParser/Option.hs | 38 +++++++++++++++++++++++++++++++++++--- src/ProtoParser/Type.hs | 15 +++++++++++++++ src/Protobuf.hs | 19 ++++++++++++++----- test/Unit/Option.hs | 15 +++++++++++++-- 6 files changed, 81 insertions(+), 18 deletions(-) diff --git a/README.md b/README.md index 27b8068..832372e 100644 --- a/README.md +++ b/README.md @@ -4,5 +4,7 @@ protobuf 3 + gRPC parser using parsec Only syntax 3 is supported! +no checks for correctness of values -> only syntax + `stack run` `stack test` diff --git a/src/ProtoParser/Enum.hs b/src/ProtoParser/Enum.hs index 65b7a87..6911324 100644 --- a/src/ProtoParser/Enum.hs +++ b/src/ProtoParser/Enum.hs @@ -61,21 +61,15 @@ parseEnumField = optionField = EnumOption <$> (string "option" *> spaces1 *> protoName) - <*> (spaces1 *> char '=' *> spaces' *> parseBoolOption) + <*> (spaces1 *> char '=' *> spaces' *> parseBool) reservedField = EnumReserved <$> (string "reserved" *> spaces' *> reservedValues) -parseBoolOption :: Parser Bool -parseBoolOption = - try (string "true" >> return True) - <|> (string "false" >> return False) - "Expected true or false" - enumNumber :: Parser EnumNumber enumNumber = do - n <- (read <$> many1 digit) + n <- read <$> many1 digit if n >= (minBound :: EnumNumber) && n <= (maxBound :: EnumNumber) then return n else fail "Number not in valid range" diff --git a/src/ProtoParser/Option.hs b/src/ProtoParser/Option.hs index 09149d1..16642f9 100644 --- a/src/ProtoParser/Option.hs +++ b/src/ProtoParser/Option.hs @@ -1,7 +1,7 @@ module ProtoParser.Option (parseOption, parseOption') where import ProtoParser.Space (spaces', spaces1) -import ProtoParser.Type (protoName) +import ProtoParser.Type (parseBool, parseString, protoName) import Protobuf import Text.Parsec import Text.Parsec.String @@ -15,6 +15,9 @@ parseOption' p = do (Protobuf {syntax = Nothing, package = Nothing, imports = [], options = [opt], enums = [], messages = [], services = []}) ) +-- https://protobuf.dev/programming-guides/proto3/#options +-- TODO: value can be bool, string, protoname until ';' + parseOption :: Parser Option parseOption = Option @@ -27,8 +30,37 @@ parseOption = <*> ( spaces' *> char '=' *> spaces' - *> char '\"' - *> (anyChar `manyTill` char '"') + *> ( (StringValue <$> try parseString) + <|> (BoolValue <$> try parseBool) + <|> (CompoundValue <$> try protoName) + ) <* spaces' <* char ';' ) + +-- TODO: post options -> [deprecated = true], [packed = false] ...,,, +-- TODO: split by ',' and same possible values as protoOptions + +-- [(string_name) = ...]; <- valid +-- [retention = RETENTION_SOURCE]; +-- TODO: [retention = RETENTION_SOURCE, retention = RETENTION_SOURCE]; <- how to set this in data type? +-- parseFieldOption :: Parser FieldOption +-- parseFieldOption = +-- FieldOption +-- <$> ( spaces' +-- *> char '[' +-- *> spaces' +-- *> protoName +-- <* spaces' +-- ) +-- <*> ( spaces' +-- *> char '=' +-- *> spaces' +-- *> ( (StringValue <$> try parseString) +-- <|> (BoolValue <$> try parseBool) +-- <|> (CompoundValue <$> try protoName) +-- ) +-- <* spaces' +-- <* char ']' +-- <* char ';' +-- ) diff --git a/src/ProtoParser/Type.hs b/src/ProtoParser/Type.hs index a705fba..e153614 100644 --- a/src/ProtoParser/Type.hs +++ b/src/ProtoParser/Type.hs @@ -8,12 +8,14 @@ import Protobuf import Text.Parsec import Text.Parsec.String +-- TODO: rename parseName protoName :: Parser String protoName = do (:) <$> letter <*> many (alphaNum <|> char '_') +-- TODO: rename parseFieldNumber protoNumber :: Parser FieldNumber protoNumber = do n <- read <$> many1 digit @@ -70,3 +72,16 @@ parseDataType :: Parser DataType parseDataType = Scalar <$> parseScalarType <|> Compound <$> protoName + +parseBool :: Parser Bool +parseBool = + try (string "true" >> return True) + <|> (string "false" >> return False) + "Expected true or false" + +-- TODO: replace all +parseString :: Parser String +parseString = + char '\"' + *> manyTill anyChar (char '\"') + <* spaces' diff --git a/src/Protobuf.hs b/src/Protobuf.hs index 89426ca..acc236f 100644 --- a/src/Protobuf.hs +++ b/src/Protobuf.hs @@ -68,11 +68,20 @@ data DataType | Map MapKey MapValue deriving (Show, Eq) +data OptionValue + = StringValue String + | BoolValue Bool + | CompoundValue Name + deriving (Show, Eq) + +data FieldOption = FieldOption Name OptionValue + deriving (Show, Eq) + data MessageField - = ImplicitMessageField DataType Name FieldNumber - | OptionalMessageField DataType Name FieldNumber - | RepeatedMessageField DataType Name FieldNumber - | MessageReserved MessageReservedValues + = ImplicitMessageField DataType Name FieldNumber -- [FieldOption] + | OptionalMessageField DataType Name FieldNumber -- [FieldOption] + | RepeatedMessageField DataType Name FieldNumber -- [FieldOption] + | MessageReserved MessageReservedValues -- [FieldOption] | OneOfMessageField Name [MessageField] deriving (Show, Eq) @@ -124,7 +133,7 @@ data RPC deriving (Show, Eq) data Option - = Option Name Value + = Option Name OptionValue deriving (Show, Eq) data Syntax diff --git a/test/Unit/Option.hs b/test/Unit/Option.hs index 0cd48ec..7d6c41a 100644 --- a/test/Unit/Option.hs +++ b/test/Unit/Option.hs @@ -12,9 +12,20 @@ allTests = ] testOption :: Option -testOption = Option ("test") ("fail") +testOption = Option ("test") (StringValue ("fail")) testImport :: Test testImport = TestCase $ do assertEqual "empty" False (isRight (parse parseOption "" "")) - assertEqual "java_package" (Option "java_package" "de.test") (fromRight testOption (parse parseOption "" "option java_package = \"de.test\";")) + assertEqual + "java_package" + (Option "java_package" (StringValue "de.test")) + (fromRight testOption (parse parseOption "" "option java_package = \"de.test\";")) + assertEqual + "bool option" + (Option "cc_enable_arenas" (BoolValue True)) + (fromRight testOption (parse parseOption "" "option cc_enable_arenas = true;")) + assertEqual + "compund option" + (Option "optimize_for" (CompoundValue "SPEED")) + (fromRight testOption (parse parseOption "" "option optimize_for = SPEED;")) From b75e6b33e1e2a534db7ac61c52abdf2239f9662e Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Sun, 26 Nov 2023 11:45:57 +0100 Subject: [PATCH 34/55] remove if in protoParser --- src/ProtoParser.hs | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/src/ProtoParser.hs b/src/ProtoParser.hs index 9bc4dd2..324fa67 100644 --- a/src/ProtoParser.hs +++ b/src/ProtoParser.hs @@ -43,8 +43,5 @@ protoValue' old = <|> try (parseService' old) ) >>= \new -> - do - isEnd <- try (lookAhead anyChar >> return False) <|> return True - if isEnd - then return new - else protoValue' new + (notFollowedBy anyChar >> return new) + <|> protoValue' new From 0d4b0c7f17708287015b5b2d842706cdc96632d1 Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Sun, 26 Nov 2023 18:57:33 +0100 Subject: [PATCH 35/55] add field options --- README.md | 2 ++ app/Main.hs | 38 ++++++++++------------------ src/ProtoParser.hs | 2 ++ src/ProtoParser/Enum.hs | 2 ++ src/ProtoParser/Message.hs | 6 +++++ src/ProtoParser/Option.hs | 51 +++++++++++++++++--------------------- src/ProtoParser/Type.hs | 6 +++++ src/Protobuf.hs | 14 ++++++----- test/Unit/Enum.hs | 39 ++++++++++++++++++----------- test/Unit/Files.hs | 29 ++++++++++++++++++---- test/Unit/Message.hs | 30 +++++++++++++++++----- test/Unit/Option.hs | 22 +++++++++++++++- test/Unit/Type.hs | 10 +++++++- test/protofiles/enum.proto | 9 +++++++ 14 files changed, 173 insertions(+), 87 deletions(-) create mode 100644 test/protofiles/enum.proto diff --git a/README.md b/README.md index 832372e..98cf2ff 100644 --- a/README.md +++ b/README.md @@ -6,5 +6,7 @@ Only syntax 3 is supported! no checks for correctness of values -> only syntax +Applicative style <*>, *>, ... + `stack run` `stack test` diff --git a/app/Main.hs b/app/Main.hs index 6e756df..fb3d9fd 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,36 +1,24 @@ module Main (main) where --- import ProtoParser.Enum import ProtoParser - +-- import ProtoParser.Message -- import Text.Parsec (parse) --- erro :: String --- erro = +-- testMessageReserved :: String +-- testMessageReserved = -- "message Foo {\ --- \int32 foo = 1;\ --- \int32 bar = 2;\ --- \reserved 1, 2;\ +-- \int32 foo = 1 [default = true];\ -- \}" --- testMessageReserved :: String --- testMessageReserved = "syntax = \"proto3\";" - -testMessageReserved :: String -testMessageReserved = - "import \"foo.proto\";\n\ - \package foobar;\n\ - \import \"bar.proto\";" +-- main :: IO () +-- main = do +-- case parse parseMessage "" testMessageReserved of +-- Left err -> print err +-- Right protobuf -> print protobuf main :: IO () main = do - case parseProtobuf testMessageReserved of - Left err -> print err - Right protobuf -> print protobuf - --- main :: IO () --- main = do --- result <- parseProtoFile "test/protofiles/chat.proto" --- case result of --- Left err -> putStrLn $ "Parse error: " ++ show err --- Right protobuf -> putStrLn $ "Successfully parsed: " ++ show protobuf + result <- parseProtoFile "test/protofiles/enum.proto" + case result of + Left err -> putStrLn $ "Parse error: " ++ show err + Right protobuf -> putStrLn $ "Successfully parsed: " ++ show protobuf diff --git a/src/ProtoParser.hs b/src/ProtoParser.hs index 324fa67..81188bd 100644 --- a/src/ProtoParser.hs +++ b/src/ProtoParser.hs @@ -31,6 +31,8 @@ protoValue :: Parser Protobuf protoValue = do protoValue' emptyProtobuf +-- TODO: extend - https://protobuf.dev/programming-guides/proto3/#option-targets +-- TODO: rework according to https://protobuf.dev/reference/protobuf/proto3-spec/ protoValue' :: Protobuf -> Parser Protobuf protoValue' old = ( try (parsePackage' old) diff --git a/src/ProtoParser/Enum.hs b/src/ProtoParser/Enum.hs index 6911324..08fc64c 100644 --- a/src/ProtoParser/Enum.hs +++ b/src/ProtoParser/Enum.hs @@ -9,6 +9,7 @@ module ProtoParser.Enum ) where +import ProtoParser.Option import ProtoParser.Reserved import ProtoParser.Space (spaces', spaces1) import ProtoParser.Type @@ -58,6 +59,7 @@ parseEnumField = EnumValue <$> fieldName <*> fieldNumber + <*> (try parseFieldOption <|> return []) optionField = EnumOption <$> (string "option" *> spaces1 *> protoName) diff --git a/src/ProtoParser/Message.hs b/src/ProtoParser/Message.hs index 53ee9f1..7028b71 100644 --- a/src/ProtoParser/Message.hs +++ b/src/ProtoParser/Message.hs @@ -1,5 +1,6 @@ module ProtoParser.Message (parseMessage, parseMessage') where +import ProtoParser.Option import ProtoParser.Reserved import ProtoParser.Space (spaces', spaces1) import ProtoParser.Type @@ -52,6 +53,8 @@ parseMessageField = fieldName = spaces' *> protoName fieldNumber = spaces' *> char '=' *> spaces' *> protoNumber fields = try parseMessageField `sepEndBy` char ';' + fieldOptions = try parseFieldOption <|> return [] + reservedValues = try (ReservedMessageNames <$> reservedNames) <|> try (ReservedMessageNumbers <$> reservedNumbers protoNumber fieldNumberRange) @@ -60,6 +63,7 @@ parseMessageField = <$> (try parseDataType <|> try parseMap) <*> fieldName <*> fieldNumber + <*> fieldOptions optionalField = OptionalMessageField <$> ( string "optional" @@ -68,6 +72,7 @@ parseMessageField = ) <*> fieldName <*> fieldNumber + <*> fieldOptions repeatedField = RepeatedMessageField <$> ( string "repeated" @@ -76,6 +81,7 @@ parseMessageField = ) <*> fieldName <*> fieldNumber + <*> fieldOptions reservedField = MessageReserved <$> ( string "reserved" diff --git a/src/ProtoParser/Option.hs b/src/ProtoParser/Option.hs index 16642f9..73b406d 100644 --- a/src/ProtoParser/Option.hs +++ b/src/ProtoParser/Option.hs @@ -1,7 +1,7 @@ -module ProtoParser.Option (parseOption, parseOption') where +module ProtoParser.Option (parseOption, parseOption', parseFieldOption) where import ProtoParser.Space (spaces', spaces1) -import ProtoParser.Type (parseBool, parseString, protoName) +import ProtoParser.Type (parseBool, parseCustomName, parseString, protoName) import Protobuf import Text.Parsec import Text.Parsec.String @@ -38,29 +38,24 @@ parseOption = <* char ';' ) --- TODO: post options -> [deprecated = true], [packed = false] ...,,, --- TODO: split by ',' and same possible values as protoOptions - --- [(string_name) = ...]; <- valid --- [retention = RETENTION_SOURCE]; --- TODO: [retention = RETENTION_SOURCE, retention = RETENTION_SOURCE]; <- how to set this in data type? --- parseFieldOption :: Parser FieldOption --- parseFieldOption = --- FieldOption --- <$> ( spaces' --- *> char '[' --- *> spaces' --- *> protoName --- <* spaces' --- ) --- <*> ( spaces' --- *> char '=' --- *> spaces' --- *> ( (StringValue <$> try parseString) --- <|> (BoolValue <$> try parseBool) --- <|> (CompoundValue <$> try protoName) --- ) --- <* spaces' --- <* char ']' --- <* char ';' --- ) +parseFieldOption :: Parser [FieldOption] +parseFieldOption = + start + *> try ((try singleFieldOption `sepBy1` try (char ',')) <* end) + where + start = spaces' *> char '[' *> spaces' + end = spaces' <* char ']' + name = spaces' *> (try protoName <|> parseCustomName) <* spaces' + value = + spaces' + *> char '=' + *> spaces' + *> ( (StringValue <$> try parseString) + <|> (BoolValue <$> try parseBool) + <|> (CompoundValue <$> try protoName) + ) + <* spaces' + singleFieldOption = + FieldOption + <$> name + <*> value diff --git a/src/ProtoParser/Type.hs b/src/ProtoParser/Type.hs index e153614..16da1d9 100644 --- a/src/ProtoParser/Type.hs +++ b/src/ProtoParser/Type.hs @@ -85,3 +85,9 @@ parseString = char '\"' *> manyTill anyChar (char '\"') <* spaces' + +parseCustomName :: Parser String +parseCustomName = + char '(' + *> ((\x -> "(" ++ x ++ ")") <$> manyTill anyChar (char ')')) + <* spaces' diff --git a/src/Protobuf.hs b/src/Protobuf.hs index acc236f..87009e3 100644 --- a/src/Protobuf.hs +++ b/src/Protobuf.hs @@ -74,14 +74,16 @@ data OptionValue | CompoundValue Name deriving (Show, Eq) -data FieldOption = FieldOption Name OptionValue +data FieldOption + = FieldOption Name OptionValue + | MultipleFieldOption [FieldOption] deriving (Show, Eq) data MessageField - = ImplicitMessageField DataType Name FieldNumber -- [FieldOption] - | OptionalMessageField DataType Name FieldNumber -- [FieldOption] - | RepeatedMessageField DataType Name FieldNumber -- [FieldOption] - | MessageReserved MessageReservedValues -- [FieldOption] + = ImplicitMessageField DataType Name FieldNumber [FieldOption] + | OptionalMessageField DataType Name FieldNumber [FieldOption] + | RepeatedMessageField DataType Name FieldNumber [FieldOption] + | MessageReserved MessageReservedValues | OneOfMessageField Name [MessageField] deriving (Show, Eq) @@ -105,7 +107,7 @@ data EnumReservedValues deriving (Show, Eq) data EnumField - = EnumValue Name EnumNumber + = EnumValue Name EnumNumber [FieldOption] | EnumOption Name Bool | EnumReserved EnumReservedValues deriving (Show, Eq) diff --git a/test/Unit/Enum.hs b/test/Unit/Enum.hs index 801fca5..7534c5f 100644 --- a/test/Unit/Enum.hs +++ b/test/Unit/Enum.hs @@ -24,14 +24,14 @@ testReservedEnumNumbers = TestCase $ do ---------------------------------------------------------------- emptyDefault :: EnumField -emptyDefault = EnumValue "TestDefault" 0 +emptyDefault = EnumValue "TestDefault" 0 [] testEnumFieldParser :: Test testEnumFieldParser = TestCase $ do assertEqual "empty" False (isRight (parse parseEnumField "" "")) - assertEqual "enumEntry" (EnumValue "TEST" 0) (fromRight emptyDefault (parse parseEnumField "" "TEST = 0")) - assertEqual "enumEntry" (EnumValue "MORE" 1) (fromRight emptyDefault (parse parseEnumField "" "MORE = 1")) - assertEqual "enumEntry" (EnumValue "UNDER_SCORE" 42) (fromRight emptyDefault (parse parseEnumField "" "UNDER_SCORE = 42")) + assertEqual "enumEntry" (EnumValue "TEST" 0 []) (fromRight emptyDefault (parse parseEnumField "" "TEST = 0")) + assertEqual "enumEntry" (EnumValue "MORE" 1 []) (fromRight emptyDefault (parse parseEnumField "" "MORE = 1")) + assertEqual "enumEntry" (EnumValue "UNDER_SCORE" 42 []) (fromRight emptyDefault (parse parseEnumField "" "UNDER_SCORE = 42")) -- reserved number -- assertEqual "empytReserved" False (isRight (parse parseEnumField "" "reserved")) assertEqual "outOfRangeSingleReserved" False (isRight (parse parseEnumField "" "reserved -1")) @@ -66,26 +66,35 @@ exampleEnum = \}\n" exampleEnumField :: Protobuf.Enum -exampleEnumField = Protobuf.Enum "TestEnum" [EnumValue "UNKNOWN" 0, EnumValue "STARTED" 1, EnumValue "RUNNING" 1] +exampleEnumField = Protobuf.Enum "TestEnum" [EnumValue "UNKNOWN" 0 [], EnumValue "STARTED" 1 [], EnumValue "RUNNING" 1 []] + +enumFieldOption :: String +enumFieldOption = + "enum TestEnum {\n\ + \ UNKNOWN = 0;\n\ + \ STARTED = 1 [deprecated = true];\n\ + \ RUNNING = 1 [deprecated = false];\n\ + \}\n" + +enumFieldOptionProto :: Protobuf.Enum +enumFieldOptionProto = + Protobuf.Enum + "TestEnum" + [ EnumValue "UNKNOWN" 0 [], + EnumValue "STARTED" 1 [FieldOption "deprecated" (BoolValue True)], + EnumValue "RUNNING" 1 [FieldOption "deprecated" (BoolValue False)] + ] testEnumParser :: Test testEnumParser = TestCase $ do assertEqual "empty" False (isRight (parse parseEnum "" "")) assertEqual "atLeastOneEnumField" False (isRight (parse parseEnum "" "enum Test{}")) - assertEqual "singleEnum" (Protobuf.Enum "Test" [EnumValue "A" 0]) (fromRight empytDefault (parse parseEnum "" "enum Test { A = 0; }")) + assertEqual "singleEnum" (Protobuf.Enum "Test" [EnumValue "A" 0 []]) (fromRight empytDefault (parse parseEnum "" "enum Test { A = 0; }")) assertEqual "multiple" exampleEnumField (fromRight empytDefault (parse parseEnum "" exampleEnum)) + assertEqual "field option" enumFieldOptionProto (fromRight empytDefault (parse parseEnum "" enumFieldOption)) ---------------------------------------------------------------- --- TODO: test enum with options --- enum Data { --- DATA_UNSPECIFIED = 0; --- DATA_SEARCH = 1 [deprecated = true]; --- DATA_DISPLAY = 2 [ --- (string_name) = "display_value" --- ]; --- } - testEnumFieldNumbers :: Test testEnumFieldNumbers = TestCase $ do assertEqual "belowMin" False (isRight (parse enumNumber "" "-1")) diff --git a/test/Unit/Files.hs b/test/Unit/Files.hs index 31433e2..02ff5fd 100644 --- a/test/Unit/Files.hs +++ b/test/Unit/Files.hs @@ -31,8 +31,8 @@ testFiles = TestCase $ do messages = [ Message "SearchRequest" - [ ImplicitMessageField (Scalar (IntType Int32)) "page_number" 2, - ImplicitMessageField (Scalar (FloatType Double)) "results_per_page" 3 + [ ImplicitMessageField (Scalar (IntType Int32)) "page_number" 2 [], + ImplicitMessageField (Scalar (FloatType Double)) "results_per_page" 3 [] ] ], services = [] @@ -49,14 +49,33 @@ testFiles = TestCase $ do messages = [ Message "SearchRequest" - [ ImplicitMessageField (Scalar (IntType Int32)) "page_number" 2, - ImplicitMessageField (Scalar (FloatType Double)) "results_per_page" 3 + [ ImplicitMessageField (Scalar (IntType Int32)) "page_number" 2 [], + ImplicitMessageField (Scalar (FloatType Double)) "results_per_page" 3 [] ], Message "SearchResponse" - [ ImplicitMessageField (Scalar StringType) "name" 1 + [ ImplicitMessageField (Scalar StringType) "name" 1 [] ] ], services = [] } ) + assertProtoFile + "enum" + ( Protobuf + { syntax = Just Proto3, + package = Nothing, + imports = [], + options = [], + enums = + [ Protobuf.Enum + "Data" + [ EnumValue "DATA_UNSPECIFIED" 0 [], + EnumValue "DATA_SEARCH" 1 [FieldOption "deprecated" (BoolValue True)], + EnumValue "DATA_DISPLAY" 2 [FieldOption "(string_name)" (StringValue "display_value")] + ] + ], + messages = [], + services = [] + } + ) diff --git a/test/Unit/Message.hs b/test/Unit/Message.hs index ef0e8ba..b7be9e0 100644 --- a/test/Unit/Message.hs +++ b/test/Unit/Message.hs @@ -24,8 +24,8 @@ testMessage1Proto :: Message testMessage1Proto = Message "Foo" - [ ImplicitMessageField (Scalar (IntType Int32)) "foo" 1, - ImplicitMessageField (Scalar (FloatType Double)) "bar" 2 + [ ImplicitMessageField (Scalar (IntType Int32)) "foo" 1 [], + ImplicitMessageField (Scalar (FloatType Double)) "bar" 2 [] ] testMessageReserved :: String @@ -51,7 +51,7 @@ testOptionalProto :: Message testOptionalProto = Message "Foo" - [ OptionalMessageField (Scalar (IntType Int32)) "foo" 1 + [ OptionalMessageField (Scalar (IntType Int32)) "foo" 1 [] ] testRepeated :: String @@ -64,7 +64,7 @@ testRepeatedProto :: Message testRepeatedProto = Message "Foo" - [ RepeatedMessageField (Scalar (IntType Int32)) "foo" 1 + [ RepeatedMessageField (Scalar (IntType Int32)) "foo" 1 [] ] testReservedNames :: String @@ -95,11 +95,28 @@ testOneOfProto = "Foo" [ OneOfMessageField "foo" - [ ImplicitMessageField (Scalar (IntType Int32)) "bar" 1, - ImplicitMessageField (Scalar (FloatType Double)) "baz" 2 + [ ImplicitMessageField (Scalar (IntType Int32)) "bar" 1 [], + ImplicitMessageField (Scalar (FloatType Double)) "baz" 2 [] ] ] +testFieldOption :: String +testFieldOption = + "message Foo {\ + \int32 foo = 1 [default = true];\ + \}" + +testFieldOptionProto :: Message +testFieldOptionProto = + Message + "Foo" + [ ImplicitMessageField + (Scalar (IntType Int32)) + "foo" + 1 + [FieldOption "default" (BoolValue True)] + ] + testSimple :: Test testSimple = TestCase $ do assertEqual "empty" False (isRight (parse parseMessage "" "")) @@ -112,3 +129,4 @@ testSimple = TestCase $ do assertEqual "repeated" testRepeatedProto (fromRight failMessage (parse parseMessage "" testRepeated)) assertEqual "reserved names" testReservedNamesProto (fromRight failMessage (parse parseMessage "" testReservedNames)) assertEqual "oneof" testOneOfProto (fromRight failMessage (parse parseMessage "" testOneOf)) + assertEqual "field option" testFieldOptionProto (fromRight failMessage (parse parseMessage "" testFieldOption)) diff --git a/test/Unit/Option.hs b/test/Unit/Option.hs index 7d6c41a..a2aa7d0 100644 --- a/test/Unit/Option.hs +++ b/test/Unit/Option.hs @@ -8,7 +8,8 @@ import Text.Parsec (parse) allTests :: [Test] allTests = - [ TestLabel "import" testImport + [ TestLabel "import" testImport, + TestLabel "field option" testFieldOption ] testOption :: Option @@ -29,3 +30,22 @@ testImport = TestCase $ do "compund option" (Option "optimize_for" (CompoundValue "SPEED")) (fromRight testOption (parse parseOption "" "option optimize_for = SPEED;")) + +testDefaultFieldOption :: [FieldOption] +testDefaultFieldOption = [FieldOption ("test") (StringValue ("fail"))] + +testFieldOption :: Test +testFieldOption = TestCase $ do + assertEqual "empty" False (isRight (parse parseFieldOption "" "")) + assertEqual "missing content" False (isRight (parse parseFieldOption "" "[]")) + assertEqual + "single bool option" + ([FieldOption ("deprecated") (BoolValue True)]) + (fromRight testDefaultFieldOption (parse parseFieldOption "" "[deprecated = true]")) + assertEqual + "multi bool option" + ( [ (FieldOption ("deprecated") (BoolValue True)), + (FieldOption ("other") (BoolValue False)) + ] + ) + (fromRight testDefaultFieldOption (parse parseFieldOption "" "[deprecated = true, other = false]")) diff --git a/test/Unit/Type.hs b/test/Unit/Type.hs index 903c7de..292b56b 100644 --- a/test/Unit/Type.hs +++ b/test/Unit/Type.hs @@ -11,7 +11,8 @@ allTests = [ TestLabel "numberParser" testNumberParser, TestLabel "protoName" testProtoName, TestLabel "scalarType" testSclarType, - TestLabel "map" testMap + TestLabel "map" testMap, + TestLabel "custom name" testCustomName ] testNumberParser :: Test @@ -63,3 +64,10 @@ testMap = TestCase $ do "Simple" (Map (IntKey Int32) (MapName "V")) (fromRight defaulTestMap (parse parseMap "" "map")) + +testCustomName :: Test +testCustomName = TestCase $ do + assertEqual "empty" False (isRight (parse parseCustomName "" "")) + -- TODO: has to have at least 1 char + -- assertEqual "empty" False (isRight (parse parseCustomName "" "()")) + assertEqual "Simple" "(foo)" (fromRight "" (parse parseCustomName "" "(foo)")) diff --git a/test/protofiles/enum.proto b/test/protofiles/enum.proto new file mode 100644 index 0000000..c19c7c8 --- /dev/null +++ b/test/protofiles/enum.proto @@ -0,0 +1,9 @@ +syntax = "proto3"; + +enum Data { + DATA_UNSPECIFIED = 0; + DATA_SEARCH = 1 [deprecated = true]; + DATA_DISPLAY = 2 [ + (string_name) = "display_value" + ]; +} From 66f5705fe58d071c28da5066924d836861293c2e Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Sun, 26 Nov 2023 19:00:50 +0100 Subject: [PATCH 36/55] add todo for rework --- README.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/README.md b/README.md index 98cf2ff..f08b070 100644 --- a/README.md +++ b/README.md @@ -8,5 +8,8 @@ no checks for correctness of values -> only syntax Applicative style <*>, *>, ... +TODO: rework according to https://protobuf.dev/reference/protobuf/proto3-spec/ +TODO: add documentation + `stack run` `stack test` From b0f75c3badb0dad493d4a3d81bfbf6ba195ca2a0 Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Sun, 26 Nov 2023 20:48:09 +0100 Subject: [PATCH 37/55] add prettyprinter --- app/Main.hs | 15 ++++- package.yaml | 3 +- protobuf-parser.cabal | 3 + src/Protobuf.hs | 137 ++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 155 insertions(+), 3 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index fb3d9fd..c7427a9 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,6 +1,13 @@ module Main (main) where +import Prettyprinter + ( Pretty (pretty), + defaultLayoutOptions, + layoutPretty, + ) +import Prettyprinter.Render.String (renderString) import ProtoParser + -- import ProtoParser.Message -- import Text.Parsec (parse) @@ -18,7 +25,11 @@ import ProtoParser main :: IO () main = do - result <- parseProtoFile "test/protofiles/enum.proto" + result <- parseProtoFile "test/protofiles/chat.proto" case result of Left err -> putStrLn $ "Parse error: " ++ show err - Right protobuf -> putStrLn $ "Successfully parsed: " ++ show protobuf + Right protobuf -> + putStrLn $ + renderString $ + layoutPretty defaultLayoutOptions $ + pretty protobuf diff --git a/package.yaml b/package.yaml index 781b8a1..f13a580 100644 --- a/package.yaml +++ b/package.yaml @@ -14,7 +14,8 @@ description: Please see the README on GitHub at = 4.7 && < 5 - - parsec >=3.1.16 && <4 + - parsec >= 3.1.16 && < 4 + - prettyprinter >= 1.7.1 && < 2 ghc-options: - -Wall diff --git a/protobuf-parser.cabal b/protobuf-parser.cabal index f83db99..db0007d 100644 --- a/protobuf-parser.cabal +++ b/protobuf-parser.cabal @@ -49,6 +49,7 @@ library build-depends: base >=4.7 && <5 , parsec >=3.1.16 && <4 + , prettyprinter >=1.7.1 && <2 default-language: Haskell2010 executable protobuf-parser-exe @@ -63,6 +64,7 @@ executable protobuf-parser-exe build-depends: base >=4.7 && <5 , parsec >=3.1.16 && <4 + , prettyprinter >=1.7.1 && <2 , protobuf-parser default-language: Haskell2010 @@ -91,5 +93,6 @@ test-suite protobuf-parser-test HUnit , base >=4.7 && <5 , parsec >=3.1.16 && <4 + , prettyprinter >=1.7.1 && <2 , protobuf-parser default-language: Haskell2010 diff --git a/src/Protobuf.hs b/src/Protobuf.hs index 87009e3..1bb4984 100644 --- a/src/Protobuf.hs +++ b/src/Protobuf.hs @@ -3,6 +3,7 @@ module Protobuf (module Protobuf) where import Data.Word (Word32) +import Prettyprinter type FieldNumber = Int @@ -197,3 +198,139 @@ merge a b = mergeSyntax (Just x) (Just y) | x == y = Just x | otherwise = error "Conflicting syntax versions" + +------------------------------------------------------------ + +instance Pretty Protobuf where + pretty protobuf = + vsep + [ pretty "Protobuf", + pretty "{", + indent 2 (pretty "syntax =" <+> pretty (syntax protobuf) <> pretty ","), + indent 2 (pretty "package =" <+> pretty (package protobuf) <> pretty ","), + indent 2 (pretty "imports =" <+> pretty (imports protobuf) <> pretty ","), + indent 2 (pretty "options =" <+> pretty (options protobuf) <> pretty ","), + indent 2 (pretty "enums =" <+> pretty (enums protobuf) <> pretty ","), + indent 2 (pretty "messages =" <+> pretty (messages protobuf) <> pretty ","), + indent 2 (pretty "services =" <+> pretty (services protobuf)), + pretty "}" + ] + +instance Pretty FloatType where + pretty Double = pretty "double" + pretty Float = pretty "float" + +instance Pretty ScalarType where + pretty (IntType intType) = pretty intType + pretty (FloatType floatType) = pretty floatType + pretty StringType = pretty "string" + pretty BytesType = pretty "bytes" + pretty BoolType = pretty "bool" + +instance Pretty IntType where + pretty Int32 = pretty "int32" + pretty Int64 = pretty "int64" + pretty UInt32 = pretty "uint32" + pretty UInt64 = pretty "uint64" + pretty SInt32 = pretty "sint32" + pretty SInt64 = pretty "sint64" + pretty Fixed32 = pretty "fixed32" + pretty Fixed64 = pretty "fixed64" + pretty SFixed32 = pretty "sfixed32" + pretty SFixed64 = pretty "sfixed64" + +instance Pretty Message where + pretty (Message name fields) = + vsep [pretty "message" <+> pretty name <+> pretty "{", indent 2 (vsep (map pretty fields)), pretty "}"] + +instance Pretty FieldOption where + pretty (FieldOption name value) = pretty name <+> pretty "=" <+> pretty value + pretty (MultipleFieldOption opt) = + vsep [pretty "[", indent 2 (prettyList opt), pretty "]"] + +instance Pretty OptionValue where + pretty (StringValue s) = dquotes (pretty s) + pretty (BoolValue b) = pretty b + pretty (CompoundValue name) = pretty name + +instance Pretty MapKey where + pretty (StringKey s) = dquotes (pretty s) + pretty (IntKey intType) = pretty intType + +instance Pretty MapValue where + pretty (MapName name) = pretty name + pretty s = pretty s + +instance Pretty DataType where + pretty (Scalar st) = pretty st + pretty (Compound name) = pretty name + pretty (Map key value) = pretty "map" <+> pretty key <+> pretty "=>" <+> pretty value + +instance Pretty MessageField where + pretty (ImplicitMessageField dt name fieldNum opt) = + vsep + [ pretty dt, + pretty name <+> pretty "=" <+> pretty fieldNum <+> prettyList opt + ] + pretty (OptionalMessageField dt name fieldNum opt) = + vsep + [ pretty "optional" <+> pretty dt, + pretty name <+> pretty "=" <+> pretty fieldNum <+> prettyList opt + ] + pretty (RepeatedMessageField dt name fieldNum opt) = + vsep + [ pretty "repeated" <+> pretty dt, + pretty name <+> pretty "=" <+> pretty fieldNum <+> prettyList opt + ] + pretty (MessageReserved values) = pretty values + pretty (OneOfMessageField name fields) = + vsep + [ pretty "oneof" <+> pretty name <+> pretty "{", + indent 2 (vsep (map pretty fields)), + pretty "}" + ] + +instance Pretty MessageReservedValues where + pretty (ReservedMessageNumbers numbers) = + pretty "reserved" <+> hsep (map pretty numbers) + pretty (ReservedMessageNames (ReservedNames names)) = + pretty "reserved" <+> hsep (map pretty names) + +instance Pretty EnumReservedValues where + pretty (ReservedEnumNumbers numbers) = + pretty "reserved" <+> hsep (map pretty numbers) + pretty (ReservedEnumNames (ReservedNames names)) = + pretty "reserved" <+> hsep (map pretty names) + +instance Pretty EnumField where + pretty (EnumValue name number opt) = + vsep [pretty name <+> pretty "=" <+> pretty number <+> prettyList opt] + pretty (EnumOption name value) = pretty name <+> pretty "=" <+> pretty value + pretty (EnumReserved values) = pretty values + +instance Pretty Protobuf.Enum where + pretty (Enum name fields) = + vsep [pretty "enum" <+> pretty name <+> pretty "{", indent 2 (vsep (map pretty fields)), pretty "}"] + +instance Pretty Service where + pretty (Service name rpcs) = + vsep [pretty "service" <+> pretty name <+> pretty "{", indent 2 (vsep (map pretty rpcs)), pretty "}"] + +instance Pretty RequestType where + pretty (RequestType name) = pretty name + pretty (RequestTypeStream name) = pretty "stream" <+> pretty name + +instance Pretty ReplyType where + pretty (ReplyType name) = pretty name + pretty (ReplyTypeStream name) = pretty "stream" <+> pretty name + +instance Pretty RPC where + pretty (RPC name reqType replyType) = + vsep [pretty "rpc" <+> pretty name <+> pretty "(", pretty reqType, pretty ")" <+> pretty "returns" <+> pretty replyType] + +instance Pretty Option where + pretty (Option name value) = pretty name <+> pretty "=" <+> pretty value + +instance Pretty Syntax where + pretty Proto2 = pretty "syntax = \"proto2\"" + pretty Proto3 = pretty "syntax = \"proto3\"" From 4be6cfb8ef1d12e7648d13e3b27f6d2a9006280f Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Sun, 26 Nov 2023 21:46:50 +0100 Subject: [PATCH 38/55] remove redundant code --- src/ProtoParser/Comment.hs | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/src/ProtoParser/Comment.hs b/src/ProtoParser/Comment.hs index f1f1deb..8c95477 100644 --- a/src/ProtoParser/Comment.hs +++ b/src/ProtoParser/Comment.hs @@ -19,17 +19,16 @@ parseComment' p = do return p removeComment :: Parser () -removeComment = do - void (try parseSingleLineComment <|> try parseMultiLineComment) +removeComment = void (try parseSingleLineComment <|> try parseMultiLineComment) parseComment :: Parser Comment parseComment = - (try parseSingleLineComment <|> try parseMultiLineComment) + try parseSingleLineComment <|> try parseMultiLineComment parseSingleLineComment :: Parser Comment parseSingleLineComment = - (string "//") *> (manyTill anyChar (try eol)) + string "//" *> manyTill anyChar (try eol) parseMultiLineComment :: Parser Comment parseMultiLineComment = - (string "/*") *> manyTill anyChar (try (string "*/")) + string "/*" *> manyTill anyChar (try (string "*/")) From e5f35c6216463f6ae6acf0ecfbe17aa607b8ab20 Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Sun, 26 Nov 2023 23:12:05 +0100 Subject: [PATCH 39/55] move into Text module --- app/Main.hs | 4 +- package.yaml | 8 +-- protobuf-parser.cabal | 56 +++++++++---------- src/{ProtoParser.hs => Text/Protobuf.hs} | 22 ++++---- .../Protobuf/Parser}/Comment.hs | 6 +- .../Protobuf/Parser}/EndOfLine.hs | 2 +- .../Protobuf/Parser}/Enum.hs | 18 +++--- .../Protobuf/Parser}/Import.hs | 8 +-- .../Protobuf/Parser}/Message.hs | 14 ++--- .../Protobuf/Parser}/Option.hs | 10 ++-- .../Protobuf/Parser}/Package.hs | 9 +-- .../Protobuf/Parser}/Reserved.hs | 10 ++-- .../Protobuf/Parser}/Service.hs | 10 ++-- .../Protobuf/Parser}/Space.hs | 4 +- .../Protobuf/Parser}/Syntax.hs | 9 +-- .../Protobuf/Parser}/Type.hs | 14 +++-- src/{Protobuf.hs => Text/Protobuf/Types.hs} | 8 +-- test/{Unit => E2E}/Files.hs | 12 ++-- test/{ => E2E}/protofiles/1.proto | 0 test/{ => E2E}/protofiles/2.proto | 0 test/{ => E2E}/protofiles/chat.proto | 0 test/{ => E2E}/protofiles/enum.proto | 0 test/Spec.hs | 22 ++++---- .../Unit/{ProtoParser.hs => Text/Protobuf.hs} | 6 +- .../{ => Text/Protobuf/Parser}/Comment.hs | 4 +- test/Unit/{ => Text/Protobuf/Parser}/Enum.hs | 20 +++---- .../Unit/{ => Text/Protobuf/Parser}/Import.hs | 6 +- .../{ => Text/Protobuf/Parser}/Message.hs | 6 +- .../Unit/{ => Text/Protobuf/Parser}/Option.hs | 6 +- .../{ => Text/Protobuf/Parser}/Package.hs | 4 +- .../{ => Text/Protobuf/Parser}/Service.hs | 6 +- .../Unit/{ => Text/Protobuf/Parser}/Syntax.hs | 6 +- test/Unit/{ => Text/Protobuf/Parser}/Type.hs | 6 +- 33 files changed, 161 insertions(+), 155 deletions(-) rename src/{ProtoParser.hs => Text/Protobuf.hs} (74%) rename src/{ProtoParser => Text/Protobuf/Parser}/Comment.hs (87%) rename src/{ProtoParser => Text/Protobuf/Parser}/EndOfLine.hs (71%) rename src/{ProtoParser => Text/Protobuf/Parser}/Enum.hs (85%) rename src/{ProtoParser => Text/Protobuf/Parser}/Import.hs (77%) rename src/{ProtoParser => Text/Protobuf/Parser}/Message.hs (90%) rename src/{ProtoParser => Text/Protobuf/Parser}/Option.hs (83%) rename src/{ProtoParser => Text/Protobuf/Parser}/Package.hs (76%) rename src/{ProtoParser => Text/Protobuf/Parser}/Reserved.hs (76%) rename src/{ProtoParser => Text/Protobuf/Parser}/Service.hs (87%) rename src/{ProtoParser => Text/Protobuf/Parser}/Space.hs (78%) rename src/{ProtoParser => Text/Protobuf/Parser}/Syntax.hs (78%) rename src/{ProtoParser => Text/Protobuf/Parser}/Type.hs (91%) rename src/{Protobuf.hs => Text/Protobuf/Types.hs} (97%) rename test/{Unit => E2E}/Files.hs (88%) rename test/{ => E2E}/protofiles/1.proto (100%) rename test/{ => E2E}/protofiles/2.proto (100%) rename test/{ => E2E}/protofiles/chat.proto (100%) rename test/{ => E2E}/protofiles/enum.proto (100%) rename test/Unit/{ProtoParser.hs => Text/Protobuf.hs} (97%) rename test/Unit/{ => Text/Protobuf/Parser}/Comment.hs (95%) rename test/Unit/{ => Text/Protobuf/Parser}/Enum.hs (89%) rename test/Unit/{ => Text/Protobuf/Parser}/Import.hs (89%) rename test/Unit/{ => Text/Protobuf/Parser}/Message.hs (96%) rename test/Unit/{ => Text/Protobuf/Parser}/Option.hs (93%) rename test/Unit/{ => Text/Protobuf/Parser}/Package.hs (87%) rename test/Unit/{ => Text/Protobuf/Parser}/Service.hs (95%) rename test/Unit/{ => Text/Protobuf/Parser}/Syntax.hs (87%) rename test/Unit/{ => Text/Protobuf/Parser}/Type.hs (96%) diff --git a/app/Main.hs b/app/Main.hs index c7427a9..4ae0ced 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -6,7 +6,7 @@ import Prettyprinter layoutPretty, ) import Prettyprinter.Render.String (renderString) -import ProtoParser +import Text.Protobuf -- import ProtoParser.Message -- import Text.Parsec (parse) @@ -25,7 +25,7 @@ import ProtoParser main :: IO () main = do - result <- parseProtoFile "test/protofiles/chat.proto" + result <- parseProtoFile "test/E2E/protofiles/chat.proto" case result of Left err -> putStrLn $ "Parse error: " ++ show err Right protobuf -> diff --git a/package.yaml b/package.yaml index f13a580..9526218 100644 --- a/package.yaml +++ b/package.yaml @@ -27,10 +27,10 @@ ghc-options: - -Wmissing-home-modules - -Wpartial-fields - -Wredundant-constraints - - -Werror -W -fwarn-unused-imports -fwarn-unused-binds -fwarn-orphans - - -fwarn-unused-matches -fwarn-unused-do-bind -fwarn-wrong-do-bind - - -fwarn-missing-signatures -fno-warn-partial-type-signatures - - -Wredundant-constraints -rtsopts + # - -Werror -W -fwarn-unused-imports -fwarn-unused-binds -fwarn-orphans + # - -fwarn-unused-matches -fwarn-unused-do-bind -fwarn-wrong-do-bind + # - -fwarn-missing-signatures -fno-warn-partial-type-signatures + # - -Wredundant-constraints -rtsopts library: source-dirs: src diff --git a/protobuf-parser.cabal b/protobuf-parser.cabal index db0007d..dafcce9 100644 --- a/protobuf-parser.cabal +++ b/protobuf-parser.cabal @@ -25,27 +25,27 @@ source-repository head library exposed-modules: - Protobuf - ProtoParser - ProtoParser.Comment - ProtoParser.EndOfLine - ProtoParser.Enum - ProtoParser.Import - ProtoParser.Message - ProtoParser.Option - ProtoParser.Package - ProtoParser.Reserved - ProtoParser.Service - ProtoParser.Space - ProtoParser.Syntax - ProtoParser.Type + Text.Protobuf + Text.Protobuf.Parser.Comment + Text.Protobuf.Parser.EndOfLine + Text.Protobuf.Parser.Enum + Text.Protobuf.Parser.Import + Text.Protobuf.Parser.Message + Text.Protobuf.Parser.Option + Text.Protobuf.Parser.Package + Text.Protobuf.Parser.Reserved + Text.Protobuf.Parser.Service + Text.Protobuf.Parser.Space + Text.Protobuf.Parser.Syntax + Text.Protobuf.Parser.Type + Text.Protobuf.Types other-modules: Paths_protobuf_parser autogen-modules: Paths_protobuf_parser hs-source-dirs: src - ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Werror -W -fwarn-unused-imports -fwarn-unused-binds -fwarn-orphans -fwarn-unused-matches -fwarn-unused-do-bind -fwarn-wrong-do-bind -fwarn-missing-signatures -fno-warn-partial-type-signatures -Wredundant-constraints -rtsopts + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints build-depends: base >=4.7 && <5 , parsec >=3.1.16 && <4 @@ -60,7 +60,7 @@ executable protobuf-parser-exe Paths_protobuf_parser hs-source-dirs: app - ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Werror -W -fwarn-unused-imports -fwarn-unused-binds -fwarn-orphans -fwarn-unused-matches -fwarn-unused-do-bind -fwarn-wrong-do-bind -fwarn-missing-signatures -fno-warn-partial-type-signatures -Wredundant-constraints -rtsopts -threaded -rtsopts -with-rtsopts=-N + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.7 && <5 , parsec >=3.1.16 && <4 @@ -72,23 +72,23 @@ test-suite protobuf-parser-test type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: - Unit.Comment - Unit.Enum - Unit.Files - Unit.Import - Unit.Message - Unit.Option - Unit.Package - Unit.ProtoParser - Unit.Service - Unit.Syntax - Unit.Type + E2E.Files + Unit.Text.Protobuf + Unit.Text.Protobuf.Parser.Comment + Unit.Text.Protobuf.Parser.Enum + Unit.Text.Protobuf.Parser.Import + Unit.Text.Protobuf.Parser.Message + Unit.Text.Protobuf.Parser.Option + Unit.Text.Protobuf.Parser.Package + Unit.Text.Protobuf.Parser.Service + Unit.Text.Protobuf.Parser.Syntax + Unit.Text.Protobuf.Parser.Type Paths_protobuf_parser autogen-modules: Paths_protobuf_parser hs-source-dirs: test - ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Werror -W -fwarn-unused-imports -fwarn-unused-binds -fwarn-orphans -fwarn-unused-matches -fwarn-unused-do-bind -fwarn-wrong-do-bind -fwarn-missing-signatures -fno-warn-partial-type-signatures -Wredundant-constraints -rtsopts -threaded -rtsopts -with-rtsopts=-N + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-depends: HUnit , base >=4.7 && <5 diff --git a/src/ProtoParser.hs b/src/Text/Protobuf.hs similarity index 74% rename from src/ProtoParser.hs rename to src/Text/Protobuf.hs index 81188bd..5759e9f 100644 --- a/src/ProtoParser.hs +++ b/src/Text/Protobuf.hs @@ -1,21 +1,23 @@ -module ProtoParser +module Text.Protobuf ( parseProtobuf, parseProtoFile, ) where -import ProtoParser.Comment -import ProtoParser.Enum -import ProtoParser.Import -import ProtoParser.Message -import ProtoParser.Option -import ProtoParser.Package -import ProtoParser.Service -import ProtoParser.Syntax -import Protobuf +-- TODO: rename to Text.Protobuf.Parser + import System.IO import Text.Parsec import Text.Parsec.String +import Text.Protobuf.Parser.Comment +import Text.Protobuf.Parser.Enum +import Text.Protobuf.Parser.Import +import Text.Protobuf.Parser.Message +import Text.Protobuf.Parser.Option +import Text.Protobuf.Parser.Package +import Text.Protobuf.Parser.Service +import Text.Protobuf.Parser.Syntax +import Text.Protobuf.Types parseProtobuf :: String -> Either ParseError Protobuf parseProtobuf = parse protoValue "" diff --git a/src/ProtoParser/Comment.hs b/src/Text/Protobuf/Parser/Comment.hs similarity index 87% rename from src/ProtoParser/Comment.hs rename to src/Text/Protobuf/Parser/Comment.hs index 8c95477..7b751ae 100644 --- a/src/ProtoParser/Comment.hs +++ b/src/Text/Protobuf/Parser/Comment.hs @@ -1,4 +1,4 @@ -module ProtoParser.Comment +module Text.Protobuf.Parser.Comment ( parseComment, parseComment', parseSingleLineComment, @@ -8,10 +8,10 @@ module ProtoParser.Comment where import Control.Monad (void) -import ProtoParser.EndOfLine (eol) -import Protobuf import Text.Parsec import Text.Parsec.String +import Text.Protobuf.Parser.EndOfLine (eol) +import Text.Protobuf.Types parseComment' :: Protobuf -> Parser Protobuf parseComment' p = do diff --git a/src/ProtoParser/EndOfLine.hs b/src/Text/Protobuf/Parser/EndOfLine.hs similarity index 71% rename from src/ProtoParser/EndOfLine.hs rename to src/Text/Protobuf/Parser/EndOfLine.hs index 5a08ec0..4683f75 100644 --- a/src/ProtoParser/EndOfLine.hs +++ b/src/Text/Protobuf/Parser/EndOfLine.hs @@ -1,4 +1,4 @@ -module ProtoParser.EndOfLine (eol) where +module Text.Protobuf.Parser.EndOfLine (eol) where import Control.Monad (void) import Text.Parsec diff --git a/src/ProtoParser/Enum.hs b/src/Text/Protobuf/Parser/Enum.hs similarity index 85% rename from src/ProtoParser/Enum.hs rename to src/Text/Protobuf/Parser/Enum.hs index 08fc64c..097d127 100644 --- a/src/ProtoParser/Enum.hs +++ b/src/Text/Protobuf/Parser/Enum.hs @@ -1,4 +1,4 @@ -module ProtoParser.Enum +module Text.Protobuf.Parser.Enum ( parseEnum, parseEnum', parseEnumField, @@ -9,26 +9,26 @@ module ProtoParser.Enum ) where -import ProtoParser.Option -import ProtoParser.Reserved -import ProtoParser.Space (spaces', spaces1) -import ProtoParser.Type -import Protobuf import Text.Parsec import Text.Parsec.String +import Text.Protobuf.Parser.Option +import Text.Protobuf.Parser.Reserved +import Text.Protobuf.Parser.Space (spaces', spaces1) +import Text.Protobuf.Parser.Type +import Text.Protobuf.Types parseEnum' :: Protobuf -> Parser Protobuf parseEnum' p = do x <- parseEnum return - ( Protobuf.merge + ( Text.Protobuf.Types.merge p (Protobuf {syntax = Nothing, package = Nothing, imports = [], options = [], enums = [x], messages = [], services = []}) ) -parseEnum :: Parser Protobuf.Enum +parseEnum :: Parser Text.Protobuf.Types.Enum parseEnum = - Protobuf.Enum + Text.Protobuf.Types.Enum <$> ( spaces' *> string "enum" *> spaces1 diff --git a/src/ProtoParser/Import.hs b/src/Text/Protobuf/Parser/Import.hs similarity index 77% rename from src/ProtoParser/Import.hs rename to src/Text/Protobuf/Parser/Import.hs index 8b225ad..b1c7cfd 100644 --- a/src/ProtoParser/Import.hs +++ b/src/Text/Protobuf/Parser/Import.hs @@ -1,15 +1,15 @@ -module ProtoParser.Import (parseImport, parseImport') where +module Text.Protobuf.Parser.Import (parseImport, parseImport') where -import ProtoParser.Space (spaces', spaces1) -import Protobuf import Text.Parsec import Text.Parsec.String +import Text.Protobuf.Parser.Space (spaces', spaces1) +import Text.Protobuf.Types parseImport' :: Protobuf -> Parser Protobuf parseImport' p = do imp <- parseImport return - ( Protobuf.merge + ( Text.Protobuf.Types.merge p (Protobuf {syntax = Nothing, package = Nothing, imports = [imp], options = [], enums = [], messages = [], services = []}) ) diff --git a/src/ProtoParser/Message.hs b/src/Text/Protobuf/Parser/Message.hs similarity index 90% rename from src/ProtoParser/Message.hs rename to src/Text/Protobuf/Parser/Message.hs index 7028b71..939bd1e 100644 --- a/src/ProtoParser/Message.hs +++ b/src/Text/Protobuf/Parser/Message.hs @@ -1,19 +1,19 @@ -module ProtoParser.Message (parseMessage, parseMessage') where +module Text.Protobuf.Parser.Message (parseMessage, parseMessage') where -import ProtoParser.Option -import ProtoParser.Reserved -import ProtoParser.Space (spaces', spaces1) -import ProtoParser.Type -import Protobuf import Text.Parsec import Text.Parsec.String +import Text.Protobuf.Parser.Option +import Text.Protobuf.Parser.Reserved +import Text.Protobuf.Parser.Space (spaces', spaces1) +import Text.Protobuf.Parser.Type +import Text.Protobuf.Types parseMessage' :: Protobuf -> Parser Protobuf parseMessage' p = do x <- parseMessage -- TODO: check for validity of message? return - ( Protobuf.merge + ( Text.Protobuf.Types.merge p (Protobuf {syntax = Nothing, package = Nothing, imports = [], options = [], enums = [], messages = [x], services = []}) ) diff --git a/src/ProtoParser/Option.hs b/src/Text/Protobuf/Parser/Option.hs similarity index 83% rename from src/ProtoParser/Option.hs rename to src/Text/Protobuf/Parser/Option.hs index 73b406d..23a8e12 100644 --- a/src/ProtoParser/Option.hs +++ b/src/Text/Protobuf/Parser/Option.hs @@ -1,16 +1,16 @@ -module ProtoParser.Option (parseOption, parseOption', parseFieldOption) where +module Text.Protobuf.Parser.Option (parseOption, parseOption', parseFieldOption) where -import ProtoParser.Space (spaces', spaces1) -import ProtoParser.Type (parseBool, parseCustomName, parseString, protoName) -import Protobuf import Text.Parsec import Text.Parsec.String +import Text.Protobuf.Parser.Space (spaces', spaces1) +import Text.Protobuf.Parser.Type (parseBool, parseCustomName, parseString, protoName) +import Text.Protobuf.Types parseOption' :: Protobuf -> Parser Protobuf parseOption' p = do opt <- parseOption return - ( Protobuf.merge + ( Text.Protobuf.Types.merge p (Protobuf {syntax = Nothing, package = Nothing, imports = [], options = [opt], enums = [], messages = [], services = []}) ) diff --git a/src/ProtoParser/Package.hs b/src/Text/Protobuf/Parser/Package.hs similarity index 76% rename from src/ProtoParser/Package.hs rename to src/Text/Protobuf/Parser/Package.hs index 65590e4..d8fa5de 100644 --- a/src/ProtoParser/Package.hs +++ b/src/Text/Protobuf/Parser/Package.hs @@ -1,10 +1,10 @@ -module ProtoParser.Package (parsePackage, parsePackage') where +module Text.Protobuf.Parser.Package (parsePackage, parsePackage') where import qualified Data.Maybe -import ProtoParser.Space (spaces', spaces1) -import Protobuf import Text.Parsec import Text.Parsec.String +import Text.Protobuf.Parser.Space (spaces', spaces1) +import Text.Protobuf.Types parsePackage' :: Protobuf -> Parser Protobuf parsePackage' p = do @@ -13,7 +13,8 @@ parsePackage' p = do then unexpected ": There can only be one package definition per file" else return - ( Protobuf.merge + ( Text.Protobuf.Types.merge + p (Protobuf {syntax = Nothing, package = Just package', imports = [], options = [], enums = [], messages = [], services = []}) ) diff --git a/src/ProtoParser/Reserved.hs b/src/Text/Protobuf/Parser/Reserved.hs similarity index 76% rename from src/ProtoParser/Reserved.hs rename to src/Text/Protobuf/Parser/Reserved.hs index 8877e40..cad50b5 100644 --- a/src/ProtoParser/Reserved.hs +++ b/src/Text/Protobuf/Parser/Reserved.hs @@ -1,13 +1,13 @@ -module ProtoParser.Reserved - ( module ProtoParser.Reserved, +module Text.Protobuf.Parser.Reserved + ( module Text.Protobuf.Parser.Reserved, ) where -import ProtoParser.Space (spaces') -import ProtoParser.Type -import Protobuf import Text.Parsec import Text.Parsec.String +import Text.Protobuf.Parser.Space (spaces') +import Text.Protobuf.Types +import Text.Protobuf.Parser.Type reservedNames :: Parser ReservedNames reservedNames = diff --git a/src/ProtoParser/Service.hs b/src/Text/Protobuf/Parser/Service.hs similarity index 87% rename from src/ProtoParser/Service.hs rename to src/Text/Protobuf/Parser/Service.hs index 5b0934b..045cfca 100644 --- a/src/ProtoParser/Service.hs +++ b/src/Text/Protobuf/Parser/Service.hs @@ -1,16 +1,16 @@ -module ProtoParser.Service (parseService, parseService') where +module Text.Protobuf.Parser.Service (parseService, parseService') where -import ProtoParser.Space (spaces', spaces1) -import ProtoParser.Type -import Protobuf import Text.Parsec import Text.Parsec.String +import Text.Protobuf.Parser.Space (spaces', spaces1) +import Text.Protobuf.Parser.Type +import Text.Protobuf.Types parseService' :: Protobuf -> Parser Protobuf parseService' p = do x <- parseService return - ( Protobuf.merge + ( Text.Protobuf.Types.merge p (Protobuf {syntax = Nothing, package = Nothing, imports = [], options = [], enums = [], messages = [], services = [x]}) ) diff --git a/src/ProtoParser/Space.hs b/src/Text/Protobuf/Parser/Space.hs similarity index 78% rename from src/ProtoParser/Space.hs rename to src/Text/Protobuf/Parser/Space.hs index fcbe8d4..5671807 100644 --- a/src/ProtoParser/Space.hs +++ b/src/Text/Protobuf/Parser/Space.hs @@ -1,4 +1,4 @@ -module ProtoParser.Space +module Text.Protobuf.Parser.Space ( space', spaces', spaces1, @@ -6,9 +6,9 @@ module ProtoParser.Space where import Control.Monad (void) -import ProtoParser.Comment (removeComment) import Text.Parsec import Text.Parsec.String +import Text.Protobuf.Parser.Comment (removeComment) space' :: Parser () space' = void space <|> removeComment <|> void newline <|> void tab diff --git a/src/ProtoParser/Syntax.hs b/src/Text/Protobuf/Parser/Syntax.hs similarity index 78% rename from src/ProtoParser/Syntax.hs rename to src/Text/Protobuf/Parser/Syntax.hs index d228f78..1962bb5 100644 --- a/src/ProtoParser/Syntax.hs +++ b/src/Text/Protobuf/Parser/Syntax.hs @@ -1,10 +1,11 @@ -module ProtoParser.Syntax (parseSyntax, parseSyntax') where +module Text.Protobuf.Parser.Syntax (parseSyntax, parseSyntax') where import qualified Data.Maybe -import ProtoParser.Space (spaces') -import Protobuf import Text.Parsec import Text.Parsec.String +import Text.Protobuf.Parser.Space (spaces') +import Text.Protobuf.Parser.Type +import Text.Protobuf.Types parseSyntax' :: Protobuf -> Parser Protobuf parseSyntax' p = do @@ -13,7 +14,7 @@ parseSyntax' p = do then unexpected ": There can only be one syntax definition per file" else return - ( Protobuf.merge + ( Text.Protobuf.Types.merge p (Protobuf {syntax = Just syn, package = Nothing, imports = [], options = [], enums = [], messages = [], services = []}) ) diff --git a/src/ProtoParser/Type.hs b/src/Text/Protobuf/Parser/Type.hs similarity index 91% rename from src/ProtoParser/Type.hs rename to src/Text/Protobuf/Parser/Type.hs index 16da1d9..a8b0774 100644 --- a/src/ProtoParser/Type.hs +++ b/src/Text/Protobuf/Parser/Type.hs @@ -1,12 +1,12 @@ -module ProtoParser.Type - ( module ProtoParser.Type, +module Text.Protobuf.Parser.Type + ( module Text.Protobuf.Parser.Type, ) where -import ProtoParser.Space (spaces') -import Protobuf import Text.Parsec import Text.Parsec.String +import Text.Protobuf.Parser.Space (spaces') +import Text.Protobuf.Types -- TODO: rename parseName protoName :: Parser String @@ -70,8 +70,10 @@ parseMap = parseDataType :: Parser DataType parseDataType = - Scalar <$> parseScalarType - <|> Compound <$> protoName + Scalar + <$> parseScalarType + <|> Compound + <$> protoName parseBool :: Parser Bool parseBool = diff --git a/src/Protobuf.hs b/src/Text/Protobuf/Types.hs similarity index 97% rename from src/Protobuf.hs rename to src/Text/Protobuf/Types.hs index 1bb4984..b2a58f1 100644 --- a/src/Protobuf.hs +++ b/src/Text/Protobuf/Types.hs @@ -1,6 +1,6 @@ {-# LANGUAGE GADTs #-} -module Protobuf (module Protobuf) where +module Text.Protobuf.Types (module Text.Protobuf.Types) where import Data.Word (Word32) import Prettyprinter @@ -149,7 +149,7 @@ data Protobuf = Protobuf package :: Maybe String, imports :: [ImportPath], options :: [Option], - enums :: [Protobuf.Enum], + enums :: [Text.Protobuf.Types.Enum], messages :: [Message], services :: [Service] } @@ -172,7 +172,7 @@ emptyProtobuf = ------------------------------------------------------------ merge' :: [Protobuf] -> Protobuf -merge' = foldl1 Protobuf.merge +merge' = foldl1 Text.Protobuf.Types.merge merge :: Protobuf -> Protobuf -> Protobuf merge a b = @@ -308,7 +308,7 @@ instance Pretty EnumField where pretty (EnumOption name value) = pretty name <+> pretty "=" <+> pretty value pretty (EnumReserved values) = pretty values -instance Pretty Protobuf.Enum where +instance Pretty Text.Protobuf.Types.Enum where pretty (Enum name fields) = vsep [pretty "enum" <+> pretty name <+> pretty "{", indent 2 (vsep (map pretty fields)), pretty "}"] diff --git a/test/Unit/Files.hs b/test/E2E/Files.hs similarity index 88% rename from test/Unit/Files.hs rename to test/E2E/Files.hs index 02ff5fd..4b6493f 100644 --- a/test/Unit/Files.hs +++ b/test/E2E/Files.hs @@ -1,9 +1,9 @@ -module Unit.Files (allTests) where +module E2E.Files (allTests) where import Data.Either (fromRight) -import ProtoParser -import Protobuf import Test.HUnit +import Text.Protobuf +import Text.Protobuf.Types allTests :: [Test] allTests = @@ -11,7 +11,7 @@ allTests = getResult :: FilePath -> IO Protobuf getResult fileNameWithoutExtension = do - fromRight emptyProtobuf <$> parseProtoFile ("test/protofiles/" ++ fileNameWithoutExtension ++ ".proto") + fromRight emptyProtobuf <$> parseProtoFile ("test/E2E/protofiles/" ++ fileNameWithoutExtension ++ ".proto") assertProtoFile :: FilePath -> Protobuf -> Assertion assertProtoFile fileNameWithoutExtension expected = do @@ -63,12 +63,12 @@ testFiles = TestCase $ do assertProtoFile "enum" ( Protobuf - { syntax = Just Proto3, + { syntax = Just Proto3, package = Nothing, imports = [], options = [], enums = - [ Protobuf.Enum + [ Text.Protobuf.Types.Enum "Data" [ EnumValue "DATA_UNSPECIFIED" 0 [], EnumValue "DATA_SEARCH" 1 [FieldOption "deprecated" (BoolValue True)], diff --git a/test/protofiles/1.proto b/test/E2E/protofiles/1.proto similarity index 100% rename from test/protofiles/1.proto rename to test/E2E/protofiles/1.proto diff --git a/test/protofiles/2.proto b/test/E2E/protofiles/2.proto similarity index 100% rename from test/protofiles/2.proto rename to test/E2E/protofiles/2.proto diff --git a/test/protofiles/chat.proto b/test/E2E/protofiles/chat.proto similarity index 100% rename from test/protofiles/chat.proto rename to test/E2E/protofiles/chat.proto diff --git a/test/protofiles/enum.proto b/test/E2E/protofiles/enum.proto similarity index 100% rename from test/protofiles/enum.proto rename to test/E2E/protofiles/enum.proto diff --git a/test/Spec.hs b/test/Spec.hs index 0716bba..b1ad870 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,15 +1,15 @@ +import E2E.Files as Files import Test.HUnit (Test (TestList), runTestTTAndExit) -import Unit.Comment as Comment -import Unit.Enum as Unit -import Unit.Files as Files -import Unit.Import as Import -import Unit.Message as Message -import Unit.Option as Option -import Unit.Package as Package -import Unit.ProtoParser as Protobuf -import Unit.Service as Service -import Unit.Syntax as Syntax -import Unit.Type as Type +import Unit.Text.Protobuf as Protobuf +import Unit.Text.Protobuf.Parser.Comment as Comment +import Unit.Text.Protobuf.Parser.Enum as Unit +import Unit.Text.Protobuf.Parser.Import as Import +import Unit.Text.Protobuf.Parser.Message as Message +import Unit.Text.Protobuf.Parser.Option as Option +import Unit.Text.Protobuf.Parser.Package as Package +import Unit.Text.Protobuf.Parser.Service as Service +import Unit.Text.Protobuf.Parser.Syntax as Syntax +import Unit.Text.Protobuf.Parser.Type as Type main :: IO () main = diff --git a/test/Unit/ProtoParser.hs b/test/Unit/Text/Protobuf.hs similarity index 97% rename from test/Unit/ProtoParser.hs rename to test/Unit/Text/Protobuf.hs index 044e15c..bcbca16 100644 --- a/test/Unit/ProtoParser.hs +++ b/test/Unit/Text/Protobuf.hs @@ -1,9 +1,9 @@ -module Unit.ProtoParser (allTests) where +module Unit.Text.Protobuf (allTests) where import Data.Either (fromRight, isRight) -import ProtoParser -import Protobuf import Test.HUnit +import Text.Protobuf +import Text.Protobuf.Types allTests :: [Test] allTests = diff --git a/test/Unit/Comment.hs b/test/Unit/Text/Protobuf/Parser/Comment.hs similarity index 95% rename from test/Unit/Comment.hs rename to test/Unit/Text/Protobuf/Parser/Comment.hs index 9df1e1d..a54bd06 100644 --- a/test/Unit/Comment.hs +++ b/test/Unit/Text/Protobuf/Parser/Comment.hs @@ -1,9 +1,9 @@ -module Unit.Comment (allTests) where +module Unit.Text.Protobuf.Parser.Comment (allTests) where import Data.Either (fromRight, isRight) -import ProtoParser.Comment import Test.HUnit import Text.Parsec (parse) +import Text.Protobuf.Parser.Comment allTests :: [Test] allTests = diff --git a/test/Unit/Enum.hs b/test/Unit/Text/Protobuf/Parser/Enum.hs similarity index 89% rename from test/Unit/Enum.hs rename to test/Unit/Text/Protobuf/Parser/Enum.hs index 7534c5f..6397c46 100644 --- a/test/Unit/Enum.hs +++ b/test/Unit/Text/Protobuf/Parser/Enum.hs @@ -1,10 +1,10 @@ -module Unit.Enum (allTests) where +module Unit.Text.Protobuf.Parser.Enum (allTests) where import Data.Either (fromRight, isRight) -import ProtoParser.Enum -import Protobuf import Test.HUnit import Text.Parsec (parse) +import Text.Protobuf.Parser.Enum +import Text.Protobuf.Types allTests :: [Test] allTests = @@ -54,8 +54,8 @@ testEnumFieldParser = TestCase $ do ---------------------------------------------------------------- -empytDefault :: Protobuf.Enum -empytDefault = Protobuf.Enum "TestDefault" [] +empytDefault :: Text.Protobuf.Types.Enum +empytDefault = Text.Protobuf.Types.Enum "TestDefault" [] exampleEnum :: String exampleEnum = @@ -65,8 +65,8 @@ exampleEnum = \ RUNNING = 1;\n\ \}\n" -exampleEnumField :: Protobuf.Enum -exampleEnumField = Protobuf.Enum "TestEnum" [EnumValue "UNKNOWN" 0 [], EnumValue "STARTED" 1 [], EnumValue "RUNNING" 1 []] +exampleEnumField :: Text.Protobuf.Types.Enum +exampleEnumField = Text.Protobuf.Types.Enum "TestEnum" [EnumValue "UNKNOWN" 0 [], EnumValue "STARTED" 1 [], EnumValue "RUNNING" 1 []] enumFieldOption :: String enumFieldOption = @@ -76,9 +76,9 @@ enumFieldOption = \ RUNNING = 1 [deprecated = false];\n\ \}\n" -enumFieldOptionProto :: Protobuf.Enum +enumFieldOptionProto :: Text.Protobuf.Types.Enum enumFieldOptionProto = - Protobuf.Enum + Text.Protobuf.Types.Enum "TestEnum" [ EnumValue "UNKNOWN" 0 [], EnumValue "STARTED" 1 [FieldOption "deprecated" (BoolValue True)], @@ -89,7 +89,7 @@ testEnumParser :: Test testEnumParser = TestCase $ do assertEqual "empty" False (isRight (parse parseEnum "" "")) assertEqual "atLeastOneEnumField" False (isRight (parse parseEnum "" "enum Test{}")) - assertEqual "singleEnum" (Protobuf.Enum "Test" [EnumValue "A" 0 []]) (fromRight empytDefault (parse parseEnum "" "enum Test { A = 0; }")) + assertEqual "singleEnum" (Text.Protobuf.Types.Enum "Test" [EnumValue "A" 0 []]) (fromRight empytDefault (parse parseEnum "" "enum Test { A = 0; }")) assertEqual "multiple" exampleEnumField (fromRight empytDefault (parse parseEnum "" exampleEnum)) assertEqual "field option" enumFieldOptionProto (fromRight empytDefault (parse parseEnum "" enumFieldOption)) diff --git a/test/Unit/Import.hs b/test/Unit/Text/Protobuf/Parser/Import.hs similarity index 89% rename from test/Unit/Import.hs rename to test/Unit/Text/Protobuf/Parser/Import.hs index 6115e76..18cd8d4 100644 --- a/test/Unit/Import.hs +++ b/test/Unit/Text/Protobuf/Parser/Import.hs @@ -1,10 +1,10 @@ -module Unit.Import (allTests) where +module Unit.Text.Protobuf.Parser.Import (allTests) where import Data.Either (fromRight, isRight) -import ProtoParser.Import -import Protobuf (ImportPath) import Test.HUnit import Text.Parsec (parse) +import Text.Protobuf.Parser.Import +import Text.Protobuf.Types (ImportPath) allTests :: [Test] allTests = diff --git a/test/Unit/Message.hs b/test/Unit/Text/Protobuf/Parser/Message.hs similarity index 96% rename from test/Unit/Message.hs rename to test/Unit/Text/Protobuf/Parser/Message.hs index b7be9e0..3d92658 100644 --- a/test/Unit/Message.hs +++ b/test/Unit/Text/Protobuf/Parser/Message.hs @@ -1,10 +1,10 @@ -module Unit.Message (allTests) where +module Unit.Text.Protobuf.Parser.Message (allTests) where import Data.Either (fromRight, isRight) -import ProtoParser.Message -import Protobuf import Test.HUnit import Text.Parsec (parse) +import Text.Protobuf.Parser.Message +import Text.Protobuf.Types allTests :: [Test] allTests = diff --git a/test/Unit/Option.hs b/test/Unit/Text/Protobuf/Parser/Option.hs similarity index 93% rename from test/Unit/Option.hs rename to test/Unit/Text/Protobuf/Parser/Option.hs index a2aa7d0..1f13448 100644 --- a/test/Unit/Option.hs +++ b/test/Unit/Text/Protobuf/Parser/Option.hs @@ -1,10 +1,10 @@ -module Unit.Option (allTests) where +module Unit.Text.Protobuf.Parser.Option (allTests) where import Data.Either (fromRight, isRight) -import ProtoParser.Option -import Protobuf import Test.HUnit import Text.Parsec (parse) +import Text.Protobuf.Parser.Option +import Text.Protobuf.Types allTests :: [Test] allTests = diff --git a/test/Unit/Package.hs b/test/Unit/Text/Protobuf/Parser/Package.hs similarity index 87% rename from test/Unit/Package.hs rename to test/Unit/Text/Protobuf/Parser/Package.hs index aa8a6bb..3ca380c 100644 --- a/test/Unit/Package.hs +++ b/test/Unit/Text/Protobuf/Parser/Package.hs @@ -1,9 +1,9 @@ -module Unit.Package (allTests) where +module Unit.Text.Protobuf.Parser.Package (allTests) where import Data.Either (fromRight, isRight) -import ProtoParser.Package import Test.HUnit import Text.Parsec (parse) +import Text.Protobuf.Parser.Package allTests :: [Test] allTests = diff --git a/test/Unit/Service.hs b/test/Unit/Text/Protobuf/Parser/Service.hs similarity index 95% rename from test/Unit/Service.hs rename to test/Unit/Text/Protobuf/Parser/Service.hs index e8599f6..4aeadae 100644 --- a/test/Unit/Service.hs +++ b/test/Unit/Text/Protobuf/Parser/Service.hs @@ -1,10 +1,10 @@ -module Unit.Service (allTests) where +module Unit.Text.Protobuf.Parser.Service (allTests) where import Data.Either (fromRight, isRight) -import ProtoParser.Service -import Protobuf import Test.HUnit import Text.Parsec (parse) +import Text.Protobuf.Parser.Service +import Text.Protobuf.Types allTests :: [Test] allTests = diff --git a/test/Unit/Syntax.hs b/test/Unit/Text/Protobuf/Parser/Syntax.hs similarity index 87% rename from test/Unit/Syntax.hs rename to test/Unit/Text/Protobuf/Parser/Syntax.hs index d8f074c..1185d01 100644 --- a/test/Unit/Syntax.hs +++ b/test/Unit/Text/Protobuf/Parser/Syntax.hs @@ -1,10 +1,10 @@ -module Unit.Syntax (allTests) where +module Unit.Text.Protobuf.Parser.Syntax (allTests) where import Data.Either (fromRight, isRight) -import ProtoParser.Syntax -import Protobuf import Test.HUnit import Text.Parsec (parse) +import Text.Protobuf.Parser.Syntax +import Text.Protobuf.Types allTests :: [Test] allTests = diff --git a/test/Unit/Type.hs b/test/Unit/Text/Protobuf/Parser/Type.hs similarity index 96% rename from test/Unit/Type.hs rename to test/Unit/Text/Protobuf/Parser/Type.hs index 292b56b..40a59c3 100644 --- a/test/Unit/Type.hs +++ b/test/Unit/Text/Protobuf/Parser/Type.hs @@ -1,10 +1,10 @@ -module Unit.Type (allTests) where +module Unit.Text.Protobuf.Parser.Type (allTests) where import Data.Either (fromRight, isRight) -import ProtoParser.Type -import Protobuf import Test.HUnit import Text.Parsec (parse) +import Text.Protobuf.Parser.Type +import Text.Protobuf.Types allTests :: [Test] allTests = From 13beb46be7f0037aa08284b31693856f190a2cba Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Mon, 27 Nov 2023 11:40:14 +0100 Subject: [PATCH 40/55] move Parser file --- app/Main.hs | 2 +- protobuf-parser.cabal | 4 ++-- src/Text/{Protobuf.hs => Protobuf/Parser.hs} | 4 +--- test/E2E/Files.hs | 2 +- test/Spec.hs | 2 +- test/Unit/Text/{Protobuf.hs => Protobuf/Parser.hs} | 4 ++-- 6 files changed, 8 insertions(+), 10 deletions(-) rename src/Text/{Protobuf.hs => Protobuf/Parser.hs} (95%) rename test/Unit/Text/{Protobuf.hs => Protobuf/Parser.hs} (97%) diff --git a/app/Main.hs b/app/Main.hs index 4ae0ced..acd9ce1 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -6,7 +6,7 @@ import Prettyprinter layoutPretty, ) import Prettyprinter.Render.String (renderString) -import Text.Protobuf +import Text.Protobuf.Parser -- import ProtoParser.Message -- import Text.Parsec (parse) diff --git a/protobuf-parser.cabal b/protobuf-parser.cabal index dafcce9..979caf0 100644 --- a/protobuf-parser.cabal +++ b/protobuf-parser.cabal @@ -25,7 +25,7 @@ source-repository head library exposed-modules: - Text.Protobuf + Text.Protobuf.Parser Text.Protobuf.Parser.Comment Text.Protobuf.Parser.EndOfLine Text.Protobuf.Parser.Enum @@ -73,7 +73,7 @@ test-suite protobuf-parser-test main-is: Spec.hs other-modules: E2E.Files - Unit.Text.Protobuf + Unit.Text.Protobuf.Parser Unit.Text.Protobuf.Parser.Comment Unit.Text.Protobuf.Parser.Enum Unit.Text.Protobuf.Parser.Import diff --git a/src/Text/Protobuf.hs b/src/Text/Protobuf/Parser.hs similarity index 95% rename from src/Text/Protobuf.hs rename to src/Text/Protobuf/Parser.hs index 5759e9f..cef150b 100644 --- a/src/Text/Protobuf.hs +++ b/src/Text/Protobuf/Parser.hs @@ -1,11 +1,9 @@ -module Text.Protobuf +module Text.Protobuf.Parser ( parseProtobuf, parseProtoFile, ) where --- TODO: rename to Text.Protobuf.Parser - import System.IO import Text.Parsec import Text.Parsec.String diff --git a/test/E2E/Files.hs b/test/E2E/Files.hs index 4b6493f..96bc522 100644 --- a/test/E2E/Files.hs +++ b/test/E2E/Files.hs @@ -2,7 +2,7 @@ module E2E.Files (allTests) where import Data.Either (fromRight) import Test.HUnit -import Text.Protobuf +import Text.Protobuf.Parser import Text.Protobuf.Types allTests :: [Test] diff --git a/test/Spec.hs b/test/Spec.hs index b1ad870..2a23f65 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,6 +1,6 @@ import E2E.Files as Files import Test.HUnit (Test (TestList), runTestTTAndExit) -import Unit.Text.Protobuf as Protobuf +import Unit.Text.Protobuf.Parser as Protobuf import Unit.Text.Protobuf.Parser.Comment as Comment import Unit.Text.Protobuf.Parser.Enum as Unit import Unit.Text.Protobuf.Parser.Import as Import diff --git a/test/Unit/Text/Protobuf.hs b/test/Unit/Text/Protobuf/Parser.hs similarity index 97% rename from test/Unit/Text/Protobuf.hs rename to test/Unit/Text/Protobuf/Parser.hs index bcbca16..4bc1a5b 100644 --- a/test/Unit/Text/Protobuf.hs +++ b/test/Unit/Text/Protobuf/Parser.hs @@ -1,8 +1,8 @@ -module Unit.Text.Protobuf (allTests) where +module Unit.Text.Protobuf.Parser (allTests) where import Data.Either (fromRight, isRight) import Test.HUnit -import Text.Protobuf +import Text.Protobuf.Parser import Text.Protobuf.Types allTests :: [Test] From 5c5b88858127c16754cc769b98ccfe4410b89511 Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Mon, 27 Nov 2023 11:57:23 +0100 Subject: [PATCH 41/55] format pretty print --- src/Text/Protobuf/Types.hs | 128 +++++++++++++++++++++++++++++-------- 1 file changed, 101 insertions(+), 27 deletions(-) diff --git a/src/Text/Protobuf/Types.hs b/src/Text/Protobuf/Types.hs index b2a58f1..a58f8cd 100644 --- a/src/Text/Protobuf/Types.hs +++ b/src/Text/Protobuf/Types.hs @@ -241,12 +241,25 @@ instance Pretty IntType where instance Pretty Message where pretty (Message name fields) = - vsep [pretty "message" <+> pretty name <+> pretty "{", indent 2 (vsep (map pretty fields)), pretty "}"] + vsep + [ pretty "message" + <+> pretty name + <+> pretty "{", + indent 3 (vsep (map pretty fields)), + indent 2 (pretty "}") + ] instance Pretty FieldOption where - pretty (FieldOption name value) = pretty name <+> pretty "=" <+> pretty value + pretty (FieldOption name value) = + pretty name + <+> pretty "=" + <+> pretty value pretty (MultipleFieldOption opt) = - vsep [pretty "[", indent 2 (prettyList opt), pretty "]"] + vsep + [ pretty "[", + indent 2 (prettyList opt), + pretty "]" + ] instance Pretty OptionValue where pretty (StringValue s) = dquotes (pretty s) @@ -264,73 +277,134 @@ instance Pretty MapValue where instance Pretty DataType where pretty (Scalar st) = pretty st pretty (Compound name) = pretty name - pretty (Map key value) = pretty "map" <+> pretty key <+> pretty "=>" <+> pretty value + pretty (Map key value) = + pretty "map" + <+> pretty key + <+> pretty "=>" + <+> pretty value instance Pretty MessageField where pretty (ImplicitMessageField dt name fieldNum opt) = vsep [ pretty dt, - pretty name <+> pretty "=" <+> pretty fieldNum <+> prettyList opt + pretty name + <+> pretty "=" + <+> pretty fieldNum + <+> prettyList opt ] pretty (OptionalMessageField dt name fieldNum opt) = vsep - [ pretty "optional" <+> pretty dt, - pretty name <+> pretty "=" <+> pretty fieldNum <+> prettyList opt + [ pretty "optional" + <+> pretty dt, + pretty name + <+> pretty "=" + <+> pretty fieldNum + <+> prettyList opt ] pretty (RepeatedMessageField dt name fieldNum opt) = vsep - [ pretty "repeated" <+> pretty dt, - pretty name <+> pretty "=" <+> pretty fieldNum <+> prettyList opt + [ pretty "repeated" + <+> pretty dt, + pretty name + <+> pretty "=" + <+> pretty fieldNum + <+> prettyList opt ] pretty (MessageReserved values) = pretty values pretty (OneOfMessageField name fields) = vsep - [ pretty "oneof" <+> pretty name <+> pretty "{", + [ pretty "oneof" + <+> pretty name + <+> pretty "{", indent 2 (vsep (map pretty fields)), pretty "}" ] instance Pretty MessageReservedValues where pretty (ReservedMessageNumbers numbers) = - pretty "reserved" <+> hsep (map pretty numbers) + pretty "reserved" + <+> hsep (map pretty numbers) pretty (ReservedMessageNames (ReservedNames names)) = - pretty "reserved" <+> hsep (map pretty names) + pretty "reserved" + <+> hsep (map pretty names) instance Pretty EnumReservedValues where pretty (ReservedEnumNumbers numbers) = - pretty "reserved" <+> hsep (map pretty numbers) + pretty "reserved" + <+> hsep (map pretty numbers) pretty (ReservedEnumNames (ReservedNames names)) = - pretty "reserved" <+> hsep (map pretty names) + pretty "reserved" + <+> hsep (map pretty names) instance Pretty EnumField where pretty (EnumValue name number opt) = - vsep [pretty name <+> pretty "=" <+> pretty number <+> prettyList opt] - pretty (EnumOption name value) = pretty name <+> pretty "=" <+> pretty value - pretty (EnumReserved values) = pretty values + vsep + [ pretty name + <+> pretty "=" + <+> pretty number + <+> prettyList opt + ] + pretty (EnumOption name value) = + pretty name + <+> pretty "=" + <+> pretty value + pretty (EnumReserved values) = + pretty values instance Pretty Text.Protobuf.Types.Enum where pretty (Enum name fields) = - vsep [pretty "enum" <+> pretty name <+> pretty "{", indent 2 (vsep (map pretty fields)), pretty "}"] + vsep + [ pretty "enum" + <+> pretty name + <+> pretty "{", + indent 2 (vsep (map pretty fields)), + pretty "}" + ] instance Pretty Service where pretty (Service name rpcs) = - vsep [pretty "service" <+> pretty name <+> pretty "{", indent 2 (vsep (map pretty rpcs)), pretty "}"] + vsep + [ pretty "service" + <+> pretty name + <+> pretty "{", + indent 2 (vsep (map pretty rpcs)), + pretty "}" + ] instance Pretty RequestType where - pretty (RequestType name) = pretty name - pretty (RequestTypeStream name) = pretty "stream" <+> pretty name + pretty (RequestType name) = + pretty name + pretty (RequestTypeStream name) = + pretty "stream" + <+> pretty name instance Pretty ReplyType where - pretty (ReplyType name) = pretty name - pretty (ReplyTypeStream name) = pretty "stream" <+> pretty name + pretty (ReplyType name) = + pretty name + pretty (ReplyTypeStream name) = + pretty "stream" + <+> pretty name instance Pretty RPC where pretty (RPC name reqType replyType) = - vsep [pretty "rpc" <+> pretty name <+> pretty "(", pretty reqType, pretty ")" <+> pretty "returns" <+> pretty replyType] + vsep + [ pretty "rpc" + <+> pretty name + <+> pretty "(", + pretty reqType, + pretty ")" + <+> pretty "returns" + <+> pretty replyType + ] instance Pretty Option where - pretty (Option name value) = pretty name <+> pretty "=" <+> pretty value + pretty (Option name value) = + pretty name + <+> pretty "=" + <+> pretty value instance Pretty Syntax where - pretty Proto2 = pretty "syntax = \"proto2\"" - pretty Proto3 = pretty "syntax = \"proto3\"" + pretty Proto2 = + pretty "syntax = \"proto2\"" + pretty Proto3 = + pretty "syntax = \"proto3\"" From f17424e8221494d065d83e9660fffeb426ef6c04 Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Mon, 27 Nov 2023 12:22:42 +0100 Subject: [PATCH 42/55] clean-up --- src/Text/Protobuf/Parser/Syntax.hs | 1 - src/Text/Protobuf/Types.hs | 5 +---- 2 files changed, 1 insertion(+), 5 deletions(-) diff --git a/src/Text/Protobuf/Parser/Syntax.hs b/src/Text/Protobuf/Parser/Syntax.hs index 1962bb5..9b344ff 100644 --- a/src/Text/Protobuf/Parser/Syntax.hs +++ b/src/Text/Protobuf/Parser/Syntax.hs @@ -4,7 +4,6 @@ import qualified Data.Maybe import Text.Parsec import Text.Parsec.String import Text.Protobuf.Parser.Space (spaces') -import Text.Protobuf.Parser.Type import Text.Protobuf.Types parseSyntax' :: Protobuf -> Parser Protobuf diff --git a/src/Text/Protobuf/Types.hs b/src/Text/Protobuf/Types.hs index a58f8cd..f779219 100644 --- a/src/Text/Protobuf/Types.hs +++ b/src/Text/Protobuf/Types.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE GADTs #-} - module Text.Protobuf.Types (module Text.Protobuf.Types) where import Data.Word (Word32) @@ -92,8 +90,7 @@ data Message = Message MessageName [MessageField] deriving (Show, Eq) -data ReservedNames where - ReservedNames :: [Name] -> ReservedNames +data ReservedNames = ReservedNames [Name] deriving (Show, Eq) data MessageReservedValues From 35dcb44e76e9811564a1b2651d479d9a30cb1e6a Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Tue, 28 Nov 2023 14:17:21 +0100 Subject: [PATCH 43/55] remove example proto --- example.proto | 13 ------------- 1 file changed, 13 deletions(-) delete mode 100644 example.proto diff --git a/example.proto b/example.proto deleted file mode 100644 index 614a683..0000000 --- a/example.proto +++ /dev/null @@ -1,13 +0,0 @@ -import "foo.proto"; -import "bar.proto"; - -package bar; - -message SearchRequest { - int32 page_number = 2; - int32 results_per_page = 3; -} - -message SearchResponse { - string name = 1; -} From fdb219b00bb5ac3bf90c774ff9b6828a2ec4432c Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Tue, 28 Nov 2023 15:03:58 +0100 Subject: [PATCH 44/55] clean up --- src/Text/Protobuf/Parser/Message.hs | 1 - src/Text/Protobuf/Parser/Reserved.hs | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/src/Text/Protobuf/Parser/Message.hs b/src/Text/Protobuf/Parser/Message.hs index 939bd1e..e4711cf 100644 --- a/src/Text/Protobuf/Parser/Message.hs +++ b/src/Text/Protobuf/Parser/Message.hs @@ -11,7 +11,6 @@ import Text.Protobuf.Types parseMessage' :: Protobuf -> Parser Protobuf parseMessage' p = do x <- parseMessage - -- TODO: check for validity of message? return ( Text.Protobuf.Types.merge p diff --git a/src/Text/Protobuf/Parser/Reserved.hs b/src/Text/Protobuf/Parser/Reserved.hs index cad50b5..33ca5d2 100644 --- a/src/Text/Protobuf/Parser/Reserved.hs +++ b/src/Text/Protobuf/Parser/Reserved.hs @@ -6,8 +6,8 @@ where import Text.Parsec import Text.Parsec.String import Text.Protobuf.Parser.Space (spaces') -import Text.Protobuf.Types import Text.Protobuf.Parser.Type +import Text.Protobuf.Types reservedNames :: Parser ReservedNames reservedNames = From 45fc9ef53e01280ed2c2e41ab818167d00156aea Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Tue, 28 Nov 2023 19:09:48 +0100 Subject: [PATCH 45/55] use options for enum options --- src/Text/Protobuf/Parser/Enum.hs | 5 +---- src/Text/Protobuf/Types.hs | 8 +++----- test/Unit/Text/Protobuf/Parser/Enum.hs | 4 ++-- 3 files changed, 6 insertions(+), 11 deletions(-) diff --git a/src/Text/Protobuf/Parser/Enum.hs b/src/Text/Protobuf/Parser/Enum.hs index 097d127..e7fffc9 100644 --- a/src/Text/Protobuf/Parser/Enum.hs +++ b/src/Text/Protobuf/Parser/Enum.hs @@ -60,10 +60,7 @@ parseEnumField = <$> fieldName <*> fieldNumber <*> (try parseFieldOption <|> return []) - optionField = - EnumOption - <$> (string "option" *> spaces1 *> protoName) - <*> (spaces1 *> char '=' *> spaces' *> parseBool) + optionField = EnumOption <$> parseOption reservedField = EnumReserved <$> (string "reserved" *> spaces' *> reservedValues) diff --git a/src/Text/Protobuf/Types.hs b/src/Text/Protobuf/Types.hs index f779219..b8e7f8f 100644 --- a/src/Text/Protobuf/Types.hs +++ b/src/Text/Protobuf/Types.hs @@ -106,7 +106,7 @@ data EnumReservedValues data EnumField = EnumValue Name EnumNumber [FieldOption] - | EnumOption Name Bool + | EnumOption Option | EnumReserved EnumReservedValues deriving (Show, Eq) @@ -341,10 +341,8 @@ instance Pretty EnumField where <+> pretty number <+> prettyList opt ] - pretty (EnumOption name value) = - pretty name - <+> pretty "=" - <+> pretty value + pretty (EnumOption option) = + pretty option pretty (EnumReserved values) = pretty values diff --git a/test/Unit/Text/Protobuf/Parser/Enum.hs b/test/Unit/Text/Protobuf/Parser/Enum.hs index 6397c46..ff92c93 100644 --- a/test/Unit/Text/Protobuf/Parser/Enum.hs +++ b/test/Unit/Text/Protobuf/Parser/Enum.hs @@ -49,8 +49,8 @@ testEnumFieldParser = TestCase $ do assertEqual "multiReservedName" (EnumReserved (ReservedEnumNames (ReservedNames ["FOO", "BAR"]))) (fromRight emptyDefault (parse parseEnumField "" "reserved \"FOO\", \"BAR\"")) -- option -- assertEqual "empty" False (isRight (parse parseEnumField "" "")) - assertEqual "invalidOption" (EnumOption "allow_alias" True) (fromRight emptyDefault (parse parseEnumField "" "option allow_alias = true")) - assertEqual "invalidOption" (EnumOption "allow_alias" False) (fromRight emptyDefault (parse parseEnumField "" "option allow_alias = false")) + assertEqual "invalidOption" (EnumOption (Option "allow_alias" (BoolValue True))) (fromRight emptyDefault (parse parseEnumField "" "option allow_alias = true;")) + assertEqual "invalidOption" (EnumOption (Option "allow_alias" (BoolValue False))) (fromRight emptyDefault (parse parseEnumField "" "option allow_alias = false;")) ---------------------------------------------------------------- From e2eb7b9962c840956532defffcbb1754a7c7d5a7 Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Tue, 28 Nov 2023 19:22:39 +0100 Subject: [PATCH 46/55] add options in messages --- README.md | 11 +++++++---- src/Text/Protobuf/Parser/Message.hs | 3 +++ src/Text/Protobuf/Parser/Option.hs | 3 --- src/Text/Protobuf/Types.hs | 6 ++++++ 4 files changed, 16 insertions(+), 7 deletions(-) diff --git a/README.md b/README.md index f08b070..d30dd6c 100644 --- a/README.md +++ b/README.md @@ -1,15 +1,18 @@ # protobuf-parser -protobuf 3 + gRPC parser using parsec +simplified protobuf 3 + gRPC parser using parsec Only syntax 3 is supported! -no checks for correctness of values -> only syntax +no everytying is checked for correctness of values -> only syntax -Applicative style <*>, *>, ... +parsec Applicative style <_>, _>, ... -TODO: rework according to https://protobuf.dev/reference/protobuf/proto3-spec/ TODO: add documentation `stack run` `stack test` + +## Simplifications + +- Base Lexical Elements do not strictly follow [offical spec](https://protobuf.dev/reference/protobuf/proto3-spec/#lexical_elements) diff --git a/src/Text/Protobuf/Parser/Message.hs b/src/Text/Protobuf/Parser/Message.hs index e4711cf..6ed1d42 100644 --- a/src/Text/Protobuf/Parser/Message.hs +++ b/src/Text/Protobuf/Parser/Message.hs @@ -2,6 +2,7 @@ module Text.Protobuf.Parser.Message (parseMessage, parseMessage') where import Text.Parsec import Text.Parsec.String +import Text.Protobuf.Parser.Enum import Text.Protobuf.Parser.Option import Text.Protobuf.Parser.Reserved import Text.Protobuf.Parser.Space (spaces', spaces1) @@ -47,6 +48,8 @@ parseMessageField = <|> try repeatedField <|> try reservedField <|> try oneofField + <|> (OptionMessageField <$> try parseOption) + <|> (EnumMessageField <$> try parseEnum) ) where fieldName = spaces' *> protoName diff --git a/src/Text/Protobuf/Parser/Option.hs b/src/Text/Protobuf/Parser/Option.hs index 23a8e12..0dbaaaa 100644 --- a/src/Text/Protobuf/Parser/Option.hs +++ b/src/Text/Protobuf/Parser/Option.hs @@ -15,9 +15,6 @@ parseOption' p = do (Protobuf {syntax = Nothing, package = Nothing, imports = [], options = [opt], enums = [], messages = [], services = []}) ) --- https://protobuf.dev/programming-guides/proto3/#options --- TODO: value can be bool, string, protoname until ';' - parseOption :: Parser Option parseOption = Option diff --git a/src/Text/Protobuf/Types.hs b/src/Text/Protobuf/Types.hs index b8e7f8f..0df6143 100644 --- a/src/Text/Protobuf/Types.hs +++ b/src/Text/Protobuf/Types.hs @@ -84,6 +84,8 @@ data MessageField | RepeatedMessageField DataType Name FieldNumber [FieldOption] | MessageReserved MessageReservedValues | OneOfMessageField Name [MessageField] + | EnumMessageField Text.Protobuf.Types.Enum + | OptionMessageField Option deriving (Show, Eq) data Message @@ -316,6 +318,10 @@ instance Pretty MessageField where indent 2 (vsep (map pretty fields)), pretty "}" ] + pretty (OptionMessageField option) = + pretty option + pretty (EnumMessageField enum) = + pretty enum instance Pretty MessageReservedValues where pretty (ReservedMessageNumbers numbers) = From d38566334b0e7c85e599ad715cd72187d73327eb Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Tue, 28 Nov 2023 19:23:15 +0100 Subject: [PATCH 47/55] simplify sep --- src/Text/Protobuf/Parser/Service.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Text/Protobuf/Parser/Service.hs b/src/Text/Protobuf/Parser/Service.hs index 045cfca..39e8082 100644 --- a/src/Text/Protobuf/Parser/Service.hs +++ b/src/Text/Protobuf/Parser/Service.hs @@ -26,7 +26,7 @@ parseService = <*> ( spaces' *> char '{' *> spaces' - *> (try parseServiceField `sepEndBy1` (lookAhead anyChar)) + *> many1 (try parseServiceField) <* spaces' <* char '}' ) From 3c4201b6cd432abd48399d1775f93b0cfb688fe9 Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Tue, 28 Nov 2023 19:23:38 +0100 Subject: [PATCH 48/55] formatting and remove todo --- src/Text/Protobuf/Parser.hs | 2 -- src/Text/Protobuf/Parser/Type.hs | 4 ++-- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/src/Text/Protobuf/Parser.hs b/src/Text/Protobuf/Parser.hs index cef150b..b29db1c 100644 --- a/src/Text/Protobuf/Parser.hs +++ b/src/Text/Protobuf/Parser.hs @@ -31,8 +31,6 @@ protoValue :: Parser Protobuf protoValue = do protoValue' emptyProtobuf --- TODO: extend - https://protobuf.dev/programming-guides/proto3/#option-targets --- TODO: rework according to https://protobuf.dev/reference/protobuf/proto3-spec/ protoValue' :: Protobuf -> Parser Protobuf protoValue' old = ( try (parsePackage' old) diff --git a/src/Text/Protobuf/Parser/Type.hs b/src/Text/Protobuf/Parser/Type.hs index a8b0774..64ef756 100644 --- a/src/Text/Protobuf/Parser/Type.hs +++ b/src/Text/Protobuf/Parser/Type.hs @@ -72,8 +72,8 @@ parseDataType :: Parser DataType parseDataType = Scalar <$> parseScalarType - <|> Compound - <$> protoName + <|> Compound + <$> protoName parseBool :: Parser Bool parseBool = From f69f0e79f2774aaa1913deb7d686ab0062c81b06 Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Tue, 28 Nov 2023 20:17:05 +0100 Subject: [PATCH 49/55] create CLI --- app/Main.hs | 46 ++++++++++++++++++++++++++++++------------- package.yaml | 9 +++++---- protobuf-parser.cabal | 9 ++++++--- 3 files changed, 43 insertions(+), 21 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index acd9ce1..a0d8b79 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,5 +1,6 @@ module Main (main) where +import Options.Applicative import Prettyprinter ( Pretty (pretty), defaultLayoutOptions, @@ -7,28 +8,45 @@ import Prettyprinter ) import Prettyprinter.Render.String (renderString) import Text.Protobuf.Parser +import Text.Protobuf.Types --- import ProtoParser.Message --- import Text.Parsec (parse) +data Options = Options (Maybe FilePath) Bool [String] --- testMessageReserved :: String --- testMessageReserved = --- "message Foo {\ --- \int32 foo = 1 [default = true];\ --- \}" - --- main :: IO () --- main = do --- case parse parseMessage "" testMessageReserved of --- Left err -> print err --- Right protobuf -> print protobuf +parseOptions :: Parser Options +parseOptions = + Options + <$> optional + ( strOption + (long "file" <> short 'f' <> metavar "PATH" <> help "Specify file path to parse") + ) + <*> switch (long "pretty" <> short 'p' <> help "Enable pretty print") + <*> many (argument str (metavar "STRING...")) main :: IO () main = do - result <- parseProtoFile "test/E2E/protofiles/chat.proto" + opts <- execParser $ info (parseOptions <**> helper) fullDesc + processOptions opts + +processOptions :: Options -> IO () +processOptions (Options Nothing False []) = + putStrLn "Arguments: No file path provided or strings provided" +processOptions (Options (Just path) isPrettier []) = do + result <- parseProtoFile path case result of Left err -> putStrLn $ "Parse error: " ++ show err Right protobuf -> + protoPrint protobuf isPrettier +processOptions (Options _ isPrettier otherArgs) = + case parseProtobuf (unwords otherArgs) of + Left err -> putStrLn $ "Parse error: " ++ show err + Right protobuf -> + protoPrint protobuf isPrettier + +protoPrint :: Protobuf -> Bool -> IO () +protoPrint protobuf isPrettier = + if not isPrettier + then putStrLn $ show protobuf + else putStrLn $ renderString $ layoutPretty defaultLayoutOptions $ diff --git a/package.yaml b/package.yaml index 9526218..714a9a3 100644 --- a/package.yaml +++ b/package.yaml @@ -16,6 +16,7 @@ dependencies: - base >= 4.7 && < 5 - parsec >= 3.1.16 && < 4 - prettyprinter >= 1.7.1 && < 2 + - optparse-applicative >= 0.17.0 ghc-options: - -Wall @@ -27,10 +28,10 @@ ghc-options: - -Wmissing-home-modules - -Wpartial-fields - -Wredundant-constraints - # - -Werror -W -fwarn-unused-imports -fwarn-unused-binds -fwarn-orphans - # - -fwarn-unused-matches -fwarn-unused-do-bind -fwarn-wrong-do-bind - # - -fwarn-missing-signatures -fno-warn-partial-type-signatures - # - -Wredundant-constraints -rtsopts + - -Werror -W -fwarn-unused-imports -fwarn-unused-binds -fwarn-orphans + - -fwarn-unused-matches -fwarn-unused-do-bind -fwarn-wrong-do-bind + - -fwarn-missing-signatures -fno-warn-partial-type-signatures + - -Wredundant-constraints -rtsopts library: source-dirs: src diff --git a/protobuf-parser.cabal b/protobuf-parser.cabal index 979caf0..7a6d578 100644 --- a/protobuf-parser.cabal +++ b/protobuf-parser.cabal @@ -45,9 +45,10 @@ library Paths_protobuf_parser hs-source-dirs: src - ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Werror -W -fwarn-unused-imports -fwarn-unused-binds -fwarn-orphans -fwarn-unused-matches -fwarn-unused-do-bind -fwarn-wrong-do-bind -fwarn-missing-signatures -fno-warn-partial-type-signatures -Wredundant-constraints -rtsopts build-depends: base >=4.7 && <5 + , optparse-applicative >=0.17.0 , parsec >=3.1.16 && <4 , prettyprinter >=1.7.1 && <2 default-language: Haskell2010 @@ -60,9 +61,10 @@ executable protobuf-parser-exe Paths_protobuf_parser hs-source-dirs: app - ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Werror -W -fwarn-unused-imports -fwarn-unused-binds -fwarn-orphans -fwarn-unused-matches -fwarn-unused-do-bind -fwarn-wrong-do-bind -fwarn-missing-signatures -fno-warn-partial-type-signatures -Wredundant-constraints -rtsopts -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.7 && <5 + , optparse-applicative >=0.17.0 , parsec >=3.1.16 && <4 , prettyprinter >=1.7.1 && <2 , protobuf-parser @@ -88,10 +90,11 @@ test-suite protobuf-parser-test Paths_protobuf_parser hs-source-dirs: test - ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Werror -W -fwarn-unused-imports -fwarn-unused-binds -fwarn-orphans -fwarn-unused-matches -fwarn-unused-do-bind -fwarn-wrong-do-bind -fwarn-missing-signatures -fno-warn-partial-type-signatures -Wredundant-constraints -rtsopts -threaded -rtsopts -with-rtsopts=-N build-depends: HUnit , base >=4.7 && <5 + , optparse-applicative >=0.17.0 , parsec >=3.1.16 && <4 , prettyprinter >=1.7.1 && <2 , protobuf-parser From 6561ac3f1b467f4c4ad632344e95d77486e654fb Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Tue, 28 Nov 2023 20:17:13 +0100 Subject: [PATCH 50/55] add project info --- README.md | 64 ++++++++++++++++++++++++++++++++++++++++++++++++------- 1 file changed, 56 insertions(+), 8 deletions(-) diff --git a/README.md b/README.md index d30dd6c..3087cb7 100644 --- a/README.md +++ b/README.md @@ -1,18 +1,66 @@ # protobuf-parser -simplified protobuf 3 + gRPC parser using parsec +Simplified [Protocol Buffers]\[proto 3](https://protobuf.dev/programming-guides/proto3/) and [gRPC](https://grpc.io/docs/what-is-grpc/introduction/) parser using Haskell and [Parsec](https://hackage.haskell.org/package/parsec) -Only syntax 3 is supported! +## Usage -no everytying is checked for correctness of values -> only syntax +```bash +> stack run -- --help +Usage: protobuf-parser-exe [-f|--file PATH] [-p|--pretty] [STRING...] -parsec Applicative style <_>, _>, ... +Available options: + -f,--file PATH Specify file path to parse + -p,--pretty Enable pretty print + -h,--help Show this help text -TODO: add documentation +``` -`stack run` -`stack test` +```bash +stack run -- -p -f ./test/E2E/protofiles/chat.proto +stack run "import "foo.proto"; import "bar.proto"; package foobar;" +stack run -- -p "import "foo.proto"; import "bar.proto"; package foobar;" + +stack test +``` + +## Structure + +``` +. +├── app +│   └── Main.hs -> CLI Parsing +├── ... +├── src +│   └── Text +│   └── Protobuf +│   ├── Parser -> Partial Parser +│   │   ├── ... +│   │   └── *.hs +│   ├── Parser.hs -> Complete Protobuf Parser +│   └── Types.hs -> Protobuf Type representation +├── ... +└── test + ├── E2E + │   ├── ... + │   └── protofiles -> Example Protobuf files + │   └── *.proto + ├── ... + └── Unit + └── ... + +``` + +## Grammar + +TODO: past into parser segments ## Simplifications -- Base Lexical Elements do not strictly follow [offical spec](https://protobuf.dev/reference/protobuf/proto3-spec/#lexical_elements) +This projects acts as a parser combinator showcase project. +Therefore, not all features are complete or correct: + +- Only proto3 syntax is supported +- Not all values are check for correctness +- Base Lexical Elements do not strictly follow the [offical spec](https://protobuf.dev/reference/protobuf/proto3-spec/#lexical_elements) +- Protobuf 3 Ranges do not allow the keyword "min" +- Empty statements are missing From d5ada45f0955a3aa67ddde4bf5e3b4b148da1798 Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Tue, 28 Nov 2023 22:54:58 +0100 Subject: [PATCH 51/55] remove comment separator --- src/Text/Protobuf/Parser/Package.hs | 1 - src/Text/Protobuf/Types.hs | 6 ------ test/E2E/protofiles/chat.proto | 2 +- test/Unit/Text/Protobuf/Parser/Comment.hs | 1 - test/Unit/Text/Protobuf/Parser/Enum.hs | 8 -------- test/Unit/Text/Protobuf/Parser/Option.hs | 13 ++++++------- test/Unit/Text/Protobuf/Parser/Type.hs | 4 ---- 7 files changed, 7 insertions(+), 28 deletions(-) diff --git a/src/Text/Protobuf/Parser/Package.hs b/src/Text/Protobuf/Parser/Package.hs index d8fa5de..3d1c08f 100644 --- a/src/Text/Protobuf/Parser/Package.hs +++ b/src/Text/Protobuf/Parser/Package.hs @@ -14,7 +14,6 @@ parsePackage' p = do else return ( Text.Protobuf.Types.merge - p (Protobuf {syntax = Nothing, package = Just package', imports = [], options = [], enums = [], messages = [], services = []}) ) diff --git a/src/Text/Protobuf/Types.hs b/src/Text/Protobuf/Types.hs index 0df6143..83b5eda 100644 --- a/src/Text/Protobuf/Types.hs +++ b/src/Text/Protobuf/Types.hs @@ -100,7 +100,6 @@ data MessageReservedValues | ReservedMessageNames ReservedNames deriving (Show, Eq) --- TODO: make reserved type generic data EnumReservedValues = ReservedEnumNumbers [EnumNumber] | ReservedEnumNames ReservedNames @@ -154,7 +153,6 @@ data Protobuf = Protobuf } deriving (Show, Eq) ------------------------------------------------------------- emptyProtobuf :: Protobuf emptyProtobuf = ( Protobuf @@ -168,8 +166,6 @@ emptyProtobuf = } ) ------------------------------------------------------------- - merge' :: [Protobuf] -> Protobuf merge' = foldl1 Text.Protobuf.Types.merge @@ -198,8 +194,6 @@ merge a b = | x == y = Just x | otherwise = error "Conflicting syntax versions" ------------------------------------------------------------- - instance Pretty Protobuf where pretty protobuf = vsep diff --git a/test/E2E/protofiles/chat.proto b/test/E2E/protofiles/chat.proto index 5c4c4ff..ff86aef 100644 --- a/test/E2E/protofiles/chat.proto +++ b/test/E2E/protofiles/chat.proto @@ -1,6 +1,6 @@ syntax = "proto3"; -option java_package = "de.antonkesy.vs.chat"; +option java_package = "de.antonkesy.chat"; option java_outer_classname = "Chat"; package chat; diff --git a/test/Unit/Text/Protobuf/Parser/Comment.hs b/test/Unit/Text/Protobuf/Parser/Comment.hs index a54bd06..1dce86c 100644 --- a/test/Unit/Text/Protobuf/Parser/Comment.hs +++ b/test/Unit/Text/Protobuf/Parser/Comment.hs @@ -21,7 +21,6 @@ testSingleLineComment = TestCase $ do assertEqual "Trailing Space" "comment " (fromRight "incorrect" (parse parseSingleLineComment "" "//comment ")) assertEqual "New Line End" "comment " (fromRight "incorrect" (parse parseSingleLineComment "" "//comment \n")) ----------------------------------------------------------------- testMultiLineComment :: Test testMultiLineComment = TestCase $ do assertEqual "empty" False (isRight (parse parseMultiLineComment "" "")) diff --git a/test/Unit/Text/Protobuf/Parser/Enum.hs b/test/Unit/Text/Protobuf/Parser/Enum.hs index ff92c93..a44ca96 100644 --- a/test/Unit/Text/Protobuf/Parser/Enum.hs +++ b/test/Unit/Text/Protobuf/Parser/Enum.hs @@ -14,15 +14,12 @@ allTests = TestLabel "fieldNumbers" testEnumFieldNumbers ] ----------------------------------------------------------------- testReservedEnumNumbers :: Test testReservedEnumNumbers = TestCase $ do assertEqual "empty" False (isRight (parse (reservedNumbers enumNumber enumNumberRange) "" "")) assertEqual "single" [0] (fromRight [] (parse (reservedNumbers enumNumber enumNumberRange) "" "0")) assertEqual "range" [0, 1, 2] (fromRight [] (parse (reservedNumbers enumNumber enumNumberRange) "" "min to 2")) ----------------------------------------------------------------- - emptyDefault :: EnumField emptyDefault = EnumValue "TestDefault" 0 [] @@ -52,8 +49,6 @@ testEnumFieldParser = TestCase $ do assertEqual "invalidOption" (EnumOption (Option "allow_alias" (BoolValue True))) (fromRight emptyDefault (parse parseEnumField "" "option allow_alias = true;")) assertEqual "invalidOption" (EnumOption (Option "allow_alias" (BoolValue False))) (fromRight emptyDefault (parse parseEnumField "" "option allow_alias = false;")) ----------------------------------------------------------------- - empytDefault :: Text.Protobuf.Types.Enum empytDefault = Text.Protobuf.Types.Enum "TestDefault" [] @@ -93,8 +88,6 @@ testEnumParser = TestCase $ do assertEqual "multiple" exampleEnumField (fromRight empytDefault (parse parseEnum "" exampleEnum)) assertEqual "field option" enumFieldOptionProto (fromRight empytDefault (parse parseEnum "" enumFieldOption)) ----------------------------------------------------------------- - testEnumFieldNumbers :: Test testEnumFieldNumbers = TestCase $ do assertEqual "belowMin" False (isRight (parse enumNumber "" "-1")) @@ -103,4 +96,3 @@ testEnumFieldNumbers = TestCase $ do -- TODO: not correct number -- assertEqual "aboveMax" (False) (isRight (parse enumNumber "" "4294967296")) ----------------------------------------------------------------- diff --git a/test/Unit/Text/Protobuf/Parser/Option.hs b/test/Unit/Text/Protobuf/Parser/Option.hs index 1f13448..b14301a 100644 --- a/test/Unit/Text/Protobuf/Parser/Option.hs +++ b/test/Unit/Text/Protobuf/Parser/Option.hs @@ -13,7 +13,7 @@ allTests = ] testOption :: Option -testOption = Option ("test") (StringValue ("fail")) +testOption = Option "test" (StringValue "fail") testImport :: Test testImport = TestCase $ do @@ -32,7 +32,7 @@ testImport = TestCase $ do (fromRight testOption (parse parseOption "" "option optimize_for = SPEED;")) testDefaultFieldOption :: [FieldOption] -testDefaultFieldOption = [FieldOption ("test") (StringValue ("fail"))] +testDefaultFieldOption = [FieldOption "test" (StringValue "fail")] testFieldOption :: Test testFieldOption = TestCase $ do @@ -40,12 +40,11 @@ testFieldOption = TestCase $ do assertEqual "missing content" False (isRight (parse parseFieldOption "" "[]")) assertEqual "single bool option" - ([FieldOption ("deprecated") (BoolValue True)]) + [FieldOption "deprecated" (BoolValue True)] (fromRight testDefaultFieldOption (parse parseFieldOption "" "[deprecated = true]")) assertEqual "multi bool option" - ( [ (FieldOption ("deprecated") (BoolValue True)), - (FieldOption ("other") (BoolValue False)) - ] - ) + [ FieldOption "deprecated" (BoolValue True), + FieldOption "other" (BoolValue False) + ] (fromRight testDefaultFieldOption (parse parseFieldOption "" "[deprecated = true, other = false]")) diff --git a/test/Unit/Text/Protobuf/Parser/Type.hs b/test/Unit/Text/Protobuf/Parser/Type.hs index 40a59c3..14b3053 100644 --- a/test/Unit/Text/Protobuf/Parser/Type.hs +++ b/test/Unit/Text/Protobuf/Parser/Type.hs @@ -33,8 +33,6 @@ testNumberParser = TestCase $ do assertEqual "reservedEnd" False (isRight (parse protoNumber "" "19999")) assertEqual "aboveReserved" 20000 (fromRight 0 (parse protoNumber "" "20000")) ----------------------------------------------------------------- - testProtoName :: Test testProtoName = TestCase $ do assertEqual "not a name" False (isRight (parse protoName "" "-1")) @@ -47,8 +45,6 @@ testSclarType = TestCase $ do assertEqual "double" (FloatType Double) (fromRight BoolType (parse parseScalarType "" "double")) assertEqual "string" StringType (fromRight BoolType (parse parseScalarType "" "string")) ----------------------------------------------------------------- - defaulTestMap :: DataType defaulTestMap = Map (StringKey "") (MapName "") From b465f185522b4ce38a646c7e4b00148120ab3dec Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Tue, 28 Nov 2023 23:09:20 +0100 Subject: [PATCH 52/55] format code vertically --- app/Main.hs | 14 +- src/Text/Protobuf/Parser/Comment.hs | 6 +- src/Text/Protobuf/Parser/Enum.hs | 16 ++- src/Text/Protobuf/Parser/Import.hs | 15 +- src/Text/Protobuf/Parser/Message.hs | 23 +++- src/Text/Protobuf/Parser/Option.hs | 11 +- src/Text/Protobuf/Parser/Package.hs | 11 +- src/Text/Protobuf/Parser/Reserved.hs | 8 +- src/Text/Protobuf/Parser/Service.hs | 21 ++- src/Text/Protobuf/Parser/Space.hs | 6 +- src/Text/Protobuf/Parser/Syntax.hs | 23 +++- src/Text/Protobuf/Parser/Type.hs | 5 +- test/E2E/Files.hs | 46 +++++-- test/Unit/Text/Protobuf/Parser.hs | 35 ++++- test/Unit/Text/Protobuf/Parser/Comment.hs | 70 ++++++++-- test/Unit/Text/Protobuf/Parser/Enum.hs | 159 +++++++++++++++++----- test/Unit/Text/Protobuf/Parser/Import.hs | 40 ++++-- test/Unit/Text/Protobuf/Parser/Message.hs | 55 ++++++-- test/Unit/Text/Protobuf/Parser/Option.hs | 49 +++++-- test/Unit/Text/Protobuf/Parser/Package.hs | 25 +++- test/Unit/Text/Protobuf/Parser/Service.hs | 35 ++++- test/Unit/Text/Protobuf/Parser/Syntax.hs | 35 ++++- test/Unit/Text/Protobuf/Parser/Type.hs | 110 ++++++++++++--- 23 files changed, 662 insertions(+), 156 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index a0d8b79..21e52da 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -17,9 +17,17 @@ parseOptions = Options <$> optional ( strOption - (long "file" <> short 'f' <> metavar "PATH" <> help "Specify file path to parse") + ( long "file" + <> short 'f' + <> metavar "PATH" + <> help "Specify file path to parse" + ) + ) + <*> switch + ( long "pretty" + <> short 'p' + <> help "Enable pretty print" ) - <*> switch (long "pretty" <> short 'p' <> help "Enable pretty print") <*> many (argument str (metavar "STRING...")) main :: IO () @@ -45,7 +53,7 @@ processOptions (Options _ isPrettier otherArgs) = protoPrint :: Protobuf -> Bool -> IO () protoPrint protobuf isPrettier = if not isPrettier - then putStrLn $ show protobuf + then print protobuf else putStrLn $ renderString $ diff --git a/src/Text/Protobuf/Parser/Comment.hs b/src/Text/Protobuf/Parser/Comment.hs index 7b751ae..9013fee 100644 --- a/src/Text/Protobuf/Parser/Comment.hs +++ b/src/Text/Protobuf/Parser/Comment.hs @@ -19,7 +19,11 @@ parseComment' p = do return p removeComment :: Parser () -removeComment = void (try parseSingleLineComment <|> try parseMultiLineComment) +removeComment = + void + ( try parseSingleLineComment + <|> try parseMultiLineComment + ) parseComment :: Parser Comment parseComment = diff --git a/src/Text/Protobuf/Parser/Enum.hs b/src/Text/Protobuf/Parser/Enum.hs index e7fffc9..9ec5c06 100644 --- a/src/Text/Protobuf/Parser/Enum.hs +++ b/src/Text/Protobuf/Parser/Enum.hs @@ -23,7 +23,16 @@ parseEnum' p = do return ( Text.Protobuf.Types.merge p - (Protobuf {syntax = Nothing, package = Nothing, imports = [], options = [], enums = [x], messages = [], services = []}) + ( Protobuf + { syntax = Nothing, + package = Nothing, + imports = [], + options = [], + enums = [x], + messages = [], + services = [] + } + ) ) parseEnum :: Parser Text.Protobuf.Types.Enum @@ -54,7 +63,10 @@ parseEnumField = fieldNumber = spaces' *> char '=' *> spaces' *> enumNumber reservedValues = try (ReservedEnumNames <$> reservedNames) - <|> try (ReservedEnumNumbers <$> reservedNumbers enumNumber enumNumberRange) + <|> try + ( ReservedEnumNumbers + <$> reservedNumbers enumNumber enumNumberRange + ) valueField = EnumValue <$> fieldName diff --git a/src/Text/Protobuf/Parser/Import.hs b/src/Text/Protobuf/Parser/Import.hs index b1c7cfd..43a2144 100644 --- a/src/Text/Protobuf/Parser/Import.hs +++ b/src/Text/Protobuf/Parser/Import.hs @@ -11,7 +11,16 @@ parseImport' p = do return ( Text.Protobuf.Types.merge p - (Protobuf {syntax = Nothing, package = Nothing, imports = [imp], options = [], enums = [], messages = [], services = []}) + ( Protobuf + { syntax = Nothing, + package = Nothing, + imports = [imp], + options = [], + enums = [], + messages = [], + services = [] + } + ) ) pathExtension :: String @@ -23,6 +32,8 @@ parseImport = *> (string "import" "Expected import keyword") *> spaces1 *> (char '"' "Expected '\"' after import keyword") - *> ((++ pathExtension) <$> (anyChar `manyTill` string (pathExtension ++ "\""))) + *> ( (++ pathExtension) + <$> (anyChar `manyTill` string (pathExtension ++ "\"")) + ) <* spaces' <* char ';' diff --git a/src/Text/Protobuf/Parser/Message.hs b/src/Text/Protobuf/Parser/Message.hs index 6ed1d42..29634e0 100644 --- a/src/Text/Protobuf/Parser/Message.hs +++ b/src/Text/Protobuf/Parser/Message.hs @@ -15,7 +15,16 @@ parseMessage' p = do return ( Text.Protobuf.Types.merge p - (Protobuf {syntax = Nothing, package = Nothing, imports = [], options = [], enums = [], messages = [x], services = []}) + ( Protobuf + { syntax = Nothing, + package = Nothing, + imports = [], + options = [], + enums = [], + messages = [x], + services = [] + } + ) ) parseMessage :: Parser Message @@ -59,7 +68,10 @@ parseMessageField = reservedValues = try (ReservedMessageNames <$> reservedNames) - <|> try (ReservedMessageNumbers <$> reservedNumbers protoNumber fieldNumberRange) + <|> try + ( ReservedMessageNumbers + <$> reservedNumbers protoNumber fieldNumberRange + ) implicitField = ImplicitMessageField <$> (try parseDataType <|> try parseMap) @@ -106,5 +118,8 @@ parseMessageField = ) fieldNumberRange :: Parser FieldNumber -fieldNumberRange = do - protoNumber <|> try (string "min" >> return 1) <|> try (string "max" >> return 0xFFFFFFFF) +fieldNumberRange = + do + protoNumber + <|> try (string "min" >> return 1) + <|> try (string "max" >> return 0xFFFFFFFF) diff --git a/src/Text/Protobuf/Parser/Option.hs b/src/Text/Protobuf/Parser/Option.hs index 0dbaaaa..3fcba9d 100644 --- a/src/Text/Protobuf/Parser/Option.hs +++ b/src/Text/Protobuf/Parser/Option.hs @@ -12,7 +12,16 @@ parseOption' p = do return ( Text.Protobuf.Types.merge p - (Protobuf {syntax = Nothing, package = Nothing, imports = [], options = [opt], enums = [], messages = [], services = []}) + ( Protobuf + { syntax = Nothing, + package = Nothing, + imports = [], + options = [opt], + enums = [], + messages = [], + services = [] + } + ) ) parseOption :: Parser Option diff --git a/src/Text/Protobuf/Parser/Package.hs b/src/Text/Protobuf/Parser/Package.hs index 3d1c08f..570bb91 100644 --- a/src/Text/Protobuf/Parser/Package.hs +++ b/src/Text/Protobuf/Parser/Package.hs @@ -15,7 +15,16 @@ parsePackage' p = do return ( Text.Protobuf.Types.merge p - (Protobuf {syntax = Nothing, package = Just package', imports = [], options = [], enums = [], messages = [], services = []}) + ( Protobuf + { syntax = Nothing, + package = Just package', + imports = [], + options = [], + enums = [], + messages = [], + services = [] + } + ) ) parsePackage :: Parser Package diff --git a/src/Text/Protobuf/Parser/Reserved.hs b/src/Text/Protobuf/Parser/Reserved.hs index 33ca5d2..37cc99b 100644 --- a/src/Text/Protobuf/Parser/Reserved.hs +++ b/src/Text/Protobuf/Parser/Reserved.hs @@ -12,7 +12,13 @@ import Text.Protobuf.Types reservedNames :: Parser ReservedNames reservedNames = ReservedNames - <$> try (spaces' *> char '\"' *> protoName <* char '\"') `sepBy1` char ',' + <$> try + ( spaces' + *> char '\"' + *> protoName + <* char '\"' + ) + `sepBy1` char ',' reservedNumbers :: (Integral a) => Parser a -> Parser a -> Parser [a] reservedNumbers single range = diff --git a/src/Text/Protobuf/Parser/Service.hs b/src/Text/Protobuf/Parser/Service.hs index 39e8082..d76115a 100644 --- a/src/Text/Protobuf/Parser/Service.hs +++ b/src/Text/Protobuf/Parser/Service.hs @@ -12,7 +12,16 @@ parseService' p = do return ( Text.Protobuf.Types.merge p - (Protobuf {syntax = Nothing, package = Nothing, imports = [], options = [], enums = [], messages = [], services = [x]}) + ( Protobuf + { syntax = Nothing, + package = Nothing, + imports = [], + options = [], + enums = [], + messages = [], + services = [x] + } + ) ) parseService :: Parser Service @@ -58,6 +67,12 @@ parseServiceField = <* spaces' where request = RequestType <$> protoName - requestStream = string "stream" *> spaces1 *> (RequestTypeStream <$> protoName) + requestStream = + string "stream" + *> spaces1 + *> (RequestTypeStream <$> protoName) reply = ReplyType <$> protoName - replyStream = string "stream" *> spaces1 *> (ReplyTypeStream <$> protoName) + replyStream = + string "stream" + *> spaces1 + *> (ReplyTypeStream <$> protoName) diff --git a/src/Text/Protobuf/Parser/Space.hs b/src/Text/Protobuf/Parser/Space.hs index 5671807..1da583c 100644 --- a/src/Text/Protobuf/Parser/Space.hs +++ b/src/Text/Protobuf/Parser/Space.hs @@ -11,7 +11,11 @@ import Text.Parsec.String import Text.Protobuf.Parser.Comment (removeComment) space' :: Parser () -space' = void space <|> removeComment <|> void newline <|> void tab +space' = + void space + <|> removeComment + <|> void newline + <|> void tab spaces' :: Parser () spaces' = skipMany space' diff --git a/src/Text/Protobuf/Parser/Syntax.hs b/src/Text/Protobuf/Parser/Syntax.hs index 9b344ff..574d49d 100644 --- a/src/Text/Protobuf/Parser/Syntax.hs +++ b/src/Text/Protobuf/Parser/Syntax.hs @@ -11,12 +11,23 @@ parseSyntax' p = do syn <- parseSyntax if Data.Maybe.isJust (syntax p) then unexpected ": There can only be one syntax definition per file" - else - return - ( Text.Protobuf.Types.merge - p - (Protobuf {syntax = Just syn, package = Nothing, imports = [], options = [], enums = [], messages = [], services = []}) - ) + else case syn of + Proto2 -> fail "Proto2 is not supported" + Proto3 -> do + return + ( Text.Protobuf.Types.merge + p + ( Protobuf + { syntax = Just syn, + package = Nothing, + imports = [], + options = [], + enums = [], + messages = [], + services = [] + } + ) + ) parseSyntax :: Parser Syntax parseSyntax = diff --git a/src/Text/Protobuf/Parser/Type.hs b/src/Text/Protobuf/Parser/Type.hs index 64ef756..19620c8 100644 --- a/src/Text/Protobuf/Parser/Type.hs +++ b/src/Text/Protobuf/Parser/Type.hs @@ -57,7 +57,10 @@ parseMap = *> spaces' *> char '<' *> spaces' - *> (IntKey <$> parseIntType <|> StringKey <$> protoName) + *> ( IntKey + <$> parseIntType + <|> StringKey <$> protoName + ) ) <*> ( spaces' *> char ',' diff --git a/test/E2E/Files.hs b/test/E2E/Files.hs index 96bc522..98424f9 100644 --- a/test/E2E/Files.hs +++ b/test/E2E/Files.hs @@ -10,8 +10,10 @@ allTests = [TestLabel "fileTest" testFiles] getResult :: FilePath -> IO Protobuf -getResult fileNameWithoutExtension = do - fromRight emptyProtobuf <$> parseProtoFile ("test/E2E/protofiles/" ++ fileNameWithoutExtension ++ ".proto") +getResult fileNameWithoutExtension = + do + fromRight emptyProtobuf + <$> parseProtoFile ("test/E2E/protofiles/" ++ fileNameWithoutExtension ++ ".proto") assertProtoFile :: FilePath -> Protobuf -> Assertion assertProtoFile fileNameWithoutExtension expected = do @@ -31,8 +33,16 @@ testFiles = TestCase $ do messages = [ Message "SearchRequest" - [ ImplicitMessageField (Scalar (IntType Int32)) "page_number" 2 [], - ImplicitMessageField (Scalar (FloatType Double)) "results_per_page" 3 [] + [ ImplicitMessageField + (Scalar (IntType Int32)) + "page_number" + 2 + [], + ImplicitMessageField + (Scalar (FloatType Double)) + "results_per_page" + 3 + [] ] ], services = [] @@ -49,12 +59,24 @@ testFiles = TestCase $ do messages = [ Message "SearchRequest" - [ ImplicitMessageField (Scalar (IntType Int32)) "page_number" 2 [], - ImplicitMessageField (Scalar (FloatType Double)) "results_per_page" 3 [] + [ ImplicitMessageField + (Scalar (IntType Int32)) + "page_number" + 2 + [], + ImplicitMessageField + (Scalar (FloatType Double)) + "results_per_page" + 3 + [] ], Message "SearchResponse" - [ ImplicitMessageField (Scalar StringType) "name" 1 [] + [ ImplicitMessageField + (Scalar StringType) + "name" + 1 + [] ] ], services = [] @@ -71,8 +93,14 @@ testFiles = TestCase $ do [ Text.Protobuf.Types.Enum "Data" [ EnumValue "DATA_UNSPECIFIED" 0 [], - EnumValue "DATA_SEARCH" 1 [FieldOption "deprecated" (BoolValue True)], - EnumValue "DATA_DISPLAY" 2 [FieldOption "(string_name)" (StringValue "display_value")] + EnumValue + "DATA_SEARCH" + 1 + [FieldOption "deprecated" (BoolValue True)], + EnumValue + "DATA_DISPLAY" + 2 + [FieldOption "(string_name)" (StringValue "display_value")] ] ], messages = [], diff --git a/test/Unit/Text/Protobuf/Parser.hs b/test/Unit/Text/Protobuf/Parser.hs index 4bc1a5b..5a2fe61 100644 --- a/test/Unit/Text/Protobuf/Parser.hs +++ b/test/Unit/Text/Protobuf/Parser.hs @@ -71,8 +71,14 @@ multiplePackageText = testSplittedDefinitions :: Test testSplittedDefinitions = TestCase $ do - assertEqual "import - package - import" splitImportProto (fromRight defaultTestProto (parseProtobuf splitImportText)) - assertEqual "import - message - import" splitImportProto1 (fromRight defaultTestProto (parseProtobuf splitImportText1)) + assertEqual + "import - package - import" + splitImportProto + (fromRight defaultTestProto (parseProtobuf splitImportText)) + assertEqual + "import - message - import" + splitImportProto1 + (fromRight defaultTestProto (parseProtobuf splitImportText1)) testText :: Test testText = TestCase $ do @@ -85,7 +91,10 @@ testText = TestCase $ do \import \"bar.proto\";" ) ) - assertEqual "multiple package" False (isRight (parseProtobuf multiplePackageText)) + assertEqual + "multiple package" + False + (isRight (parseProtobuf multiplePackageText)) textComment :: Protobuf textComment = @@ -128,7 +137,19 @@ testComment4 = testComments :: Test testComments = TestCase $ do - assertEqual "whole line 1" textComment (fromRight defaultTestProto (parseProtobuf testComment1)) - assertEqual "whole line 1" textComment (fromRight defaultTestProto (parseProtobuf testComment2)) - assertEqual "in-line" textComment (fromRight defaultTestProto (parseProtobuf testComment3)) - assertEqual "multi in-line" textComment (fromRight defaultTestProto (parseProtobuf testComment4)) + assertEqual + "whole line 1" + textComment + (fromRight defaultTestProto (parseProtobuf testComment1)) + assertEqual + "whole line 1" + textComment + (fromRight defaultTestProto (parseProtobuf testComment2)) + assertEqual + "in-line" + textComment + (fromRight defaultTestProto (parseProtobuf testComment3)) + assertEqual + "multi in-line" + textComment + (fromRight defaultTestProto (parseProtobuf testComment4)) diff --git a/test/Unit/Text/Protobuf/Parser/Comment.hs b/test/Unit/Text/Protobuf/Parser/Comment.hs index 1dce86c..015d674 100644 --- a/test/Unit/Text/Protobuf/Parser/Comment.hs +++ b/test/Unit/Text/Protobuf/Parser/Comment.hs @@ -14,23 +14,65 @@ allTests = testSingleLineComment :: Test testSingleLineComment = TestCase $ do - assertEqual "empty" False (isRight (parse parseSingleLineComment "" "")) - assertEqual "too few '/'" False (isRight (parse parseSingleLineComment "" "/ comment")) - assertEqual "Simple Comment" " comment" (fromRight "incorrect" (parse parseSingleLineComment "" "// comment")) - assertEqual "No Space" "comment" (fromRight "incorrect" (parse parseSingleLineComment "" "//comment")) - assertEqual "Trailing Space" "comment " (fromRight "incorrect" (parse parseSingleLineComment "" "//comment ")) - assertEqual "New Line End" "comment " (fromRight "incorrect" (parse parseSingleLineComment "" "//comment \n")) + assertEqual + "empty" + False + (isRight (parse parseSingleLineComment "" "")) + assertEqual + "too few '/'" + False + (isRight (parse parseSingleLineComment "" "/ comment")) + assertEqual + "Simple Comment" + " comment" + (fromRight "incorrect" (parse parseSingleLineComment "" "// comment")) + assertEqual + "No Space" + "comment" + (fromRight "incorrect" (parse parseSingleLineComment "" "//comment")) + assertEqual + "Trailing Space" + "comment " + (fromRight "incorrect" (parse parseSingleLineComment "" "//comment ")) + assertEqual + "New Line End" + "comment " + (fromRight "incorrect" (parse parseSingleLineComment "" "//comment \n")) testMultiLineComment :: Test testMultiLineComment = TestCase $ do - assertEqual "empty" False (isRight (parse parseMultiLineComment "" "")) - assertEqual "too few '/'" False (isRight (parse parseMultiLineComment "" "/* comment")) - assertEqual "Space between" " comment " (fromRight "incorrect" (parse parseMultiLineComment "" "/* comment */")) - assertEqual "No Space" "comment" (fromRight "incorrect" (parse parseMultiLineComment "" "/*comment*/")) - assertEqual "Multi Line Comment" " 1\n2 " (fromRight "incorrect" (parse parseMultiLineComment "" "/* 1\n2 */")) + assertEqual + "empty" + False + (isRight (parse parseMultiLineComment "" "")) + assertEqual + "too few '/'" + False + (isRight (parse parseMultiLineComment "" "/* comment")) + assertEqual + "Space between" + " comment " + (fromRight "incorrect" (parse parseMultiLineComment "" "/* comment */")) + assertEqual + "No Space" + "comment" + (fromRight "incorrect" (parse parseMultiLineComment "" "/*comment*/")) + assertEqual + "Multi Line Comment" + " 1\n2 " + (fromRight "incorrect" (parse parseMultiLineComment "" "/* 1\n2 */")) testBothComments :: Test testBothComments = TestCase $ do - assertEqual "empty" False (isRight (parse parseComment "" "")) - assertEqual "Single Line" " comment" (fromRight "incorrect" (parse parseComment "" "// comment")) - assertEqual "Multi Line" " comment " (fromRight "incorrect" (parse parseComment "" "/* comment */")) + assertEqual + "empty" + False + (isRight (parse parseComment "" "")) + assertEqual + "Single Line" + " comment" + (fromRight "incorrect" (parse parseComment "" "// comment")) + assertEqual + "Multi Line" + " comment " + (fromRight "incorrect" (parse parseComment "" "/* comment */")) diff --git a/test/Unit/Text/Protobuf/Parser/Enum.hs b/test/Unit/Text/Protobuf/Parser/Enum.hs index a44ca96..81cf2ae 100644 --- a/test/Unit/Text/Protobuf/Parser/Enum.hs +++ b/test/Unit/Text/Protobuf/Parser/Enum.hs @@ -16,38 +16,103 @@ allTests = testReservedEnumNumbers :: Test testReservedEnumNumbers = TestCase $ do - assertEqual "empty" False (isRight (parse (reservedNumbers enumNumber enumNumberRange) "" "")) - assertEqual "single" [0] (fromRight [] (parse (reservedNumbers enumNumber enumNumberRange) "" "0")) - assertEqual "range" [0, 1, 2] (fromRight [] (parse (reservedNumbers enumNumber enumNumberRange) "" "min to 2")) + assertEqual + "empty" + False + (isRight (parse (reservedNumbers enumNumber enumNumberRange) "" "")) + assertEqual + "single" + [0] + (fromRight [] (parse (reservedNumbers enumNumber enumNumberRange) "" "0")) + assertEqual + "range" + [0, 1, 2] + (fromRight [] (parse (reservedNumbers enumNumber enumNumberRange) "" "min to 2")) emptyDefault :: EnumField emptyDefault = EnumValue "TestDefault" 0 [] testEnumFieldParser :: Test testEnumFieldParser = TestCase $ do - assertEqual "empty" False (isRight (parse parseEnumField "" "")) - assertEqual "enumEntry" (EnumValue "TEST" 0 []) (fromRight emptyDefault (parse parseEnumField "" "TEST = 0")) - assertEqual "enumEntry" (EnumValue "MORE" 1 []) (fromRight emptyDefault (parse parseEnumField "" "MORE = 1")) - assertEqual "enumEntry" (EnumValue "UNDER_SCORE" 42 []) (fromRight emptyDefault (parse parseEnumField "" "UNDER_SCORE = 42")) + assertEqual + "empty" + False + (isRight (parse parseEnumField "" "")) + assertEqual + "enumEntry" + (EnumValue "TEST" 0 []) + (fromRight emptyDefault (parse parseEnumField "" "TEST = 0")) + assertEqual + "enumEntry" + (EnumValue "MORE" 1 []) + (fromRight emptyDefault (parse parseEnumField "" "MORE = 1")) + assertEqual + "enumEntry" + (EnumValue "UNDER_SCORE" 42 []) + (fromRight emptyDefault (parse parseEnumField "" "UNDER_SCORE = 42")) -- reserved number -- - assertEqual "empytReserved" False (isRight (parse parseEnumField "" "reserved")) - assertEqual "outOfRangeSingleReserved" False (isRight (parse parseEnumField "" "reserved -1")) - assertEqual "multiReserved" (EnumReserved (ReservedEnumNumbers [1, 2])) (fromRight emptyDefault (parse parseEnumField "" "reserved 1, 2")) - assertEqual "multiReserved" (EnumReserved (ReservedEnumNumbers [1, 3, 5])) (fromRight emptyDefault (parse parseEnumField "" "reserved 1, 3, 5")) - assertEqual "multiReserved" (EnumReserved (ReservedEnumNumbers [1, 2, 3])) (fromRight emptyDefault (parse parseEnumField "" "reserved 1 to 3")) - assertEqual "multiReserved" (EnumReserved (ReservedEnumNumbers [0, 1, 2, 3])) (fromRight emptyDefault (parse parseEnumField "" "reserved min to 3")) - assertEqual "multiReserved" (EnumReserved (ReservedEnumNumbers [4294967294, 0xFFFFFFFF])) (fromRight emptyDefault (parse parseEnumField "" "reserved 4294967294 to max")) - assertEqual "singleReserved" (EnumReserved (ReservedEnumNumbers [0])) (fromRight emptyDefault (parse parseEnumField "" "reserved 0")) - assertEqual "singleReserved" (EnumReserved (ReservedEnumNumbers [1])) (fromRight emptyDefault (parse parseEnumField "" "reserved 1")) - -- assertEqual "reservedIncorrectNumberFormat" False (isRight (parse parseEnumField "" "reserved 1 2")) -- cant parse with enumField alone anymore + assertEqual + "empytReserved" + False + (isRight (parse parseEnumField "" "reserved")) + assertEqual + "outOfRangeSingleReserved" + False + (isRight (parse parseEnumField "" "reserved -1")) + assertEqual + "multiReserved" + (EnumReserved (ReservedEnumNumbers [1, 2])) + (fromRight emptyDefault (parse parseEnumField "" "reserved 1, 2")) + assertEqual + "multiReserved" + (EnumReserved (ReservedEnumNumbers [1, 3, 5])) + (fromRight emptyDefault (parse parseEnumField "" "reserved 1, 3, 5")) + assertEqual + "multiReserved" + (EnumReserved (ReservedEnumNumbers [1, 2, 3])) + (fromRight emptyDefault (parse parseEnumField "" "reserved 1 to 3")) + assertEqual + "multiReserved" + (EnumReserved (ReservedEnumNumbers [0, 1, 2, 3])) + (fromRight emptyDefault (parse parseEnumField "" "reserved min to 3")) + assertEqual + "multiReserved" + (EnumReserved (ReservedEnumNumbers [4294967294, 0xFFFFFFFF])) + (fromRight emptyDefault (parse parseEnumField "" "reserved 4294967294 to max")) + assertEqual + "singleReserved" + (EnumReserved (ReservedEnumNumbers [0])) + (fromRight emptyDefault (parse parseEnumField "" "reserved 0")) + assertEqual + "singleReserved" + (EnumReserved (ReservedEnumNumbers [1])) + (fromRight emptyDefault (parse parseEnumField "" "reserved 1")) -- reserved name -- - assertEqual "emptyReservedName" False (isRight (parse parseEnumField "" "reserved")) - assertEqual "singleReservedName" (EnumReserved (ReservedEnumNames (ReservedNames ["FOO"]))) (fromRight emptyDefault (parse parseEnumField "" "reserved \"FOO\"")) - assertEqual "multiReservedName" (EnumReserved (ReservedEnumNames (ReservedNames ["FOO", "BAR"]))) (fromRight emptyDefault (parse parseEnumField "" "reserved \"FOO\", \"BAR\"")) + assertEqual + "emptyReservedName" + False + (isRight (parse parseEnumField "" "reserved")) + assertEqual + "singleReservedName" + (EnumReserved (ReservedEnumNames (ReservedNames ["FOO"]))) + (fromRight emptyDefault (parse parseEnumField "" "reserved \"FOO\"")) + assertEqual + "multiReservedName" + (EnumReserved (ReservedEnumNames (ReservedNames ["FOO", "BAR"]))) + (fromRight emptyDefault (parse parseEnumField "" "reserved \"FOO\", \"BAR\"")) -- option -- - assertEqual "empty" False (isRight (parse parseEnumField "" "")) - assertEqual "invalidOption" (EnumOption (Option "allow_alias" (BoolValue True))) (fromRight emptyDefault (parse parseEnumField "" "option allow_alias = true;")) - assertEqual "invalidOption" (EnumOption (Option "allow_alias" (BoolValue False))) (fromRight emptyDefault (parse parseEnumField "" "option allow_alias = false;")) + assertEqual + "empty" + False + (isRight (parse parseEnumField "" "")) + assertEqual + "invalidOption" + (EnumOption (Option "allow_alias" (BoolValue True))) + (fromRight emptyDefault (parse parseEnumField "" "option allow_alias = true;")) + assertEqual + "invalidOption" + (EnumOption (Option "allow_alias" (BoolValue False))) + (fromRight emptyDefault (parse parseEnumField "" "option allow_alias = false;")) empytDefault :: Text.Protobuf.Types.Enum empytDefault = Text.Protobuf.Types.Enum "TestDefault" [] @@ -61,7 +126,13 @@ exampleEnum = \}\n" exampleEnumField :: Text.Protobuf.Types.Enum -exampleEnumField = Text.Protobuf.Types.Enum "TestEnum" [EnumValue "UNKNOWN" 0 [], EnumValue "STARTED" 1 [], EnumValue "RUNNING" 1 []] +exampleEnumField = + Text.Protobuf.Types.Enum + "TestEnum" + [ EnumValue "UNKNOWN" 0 [], + EnumValue "STARTED" 1 [], + EnumValue "RUNNING" 1 [] + ] enumFieldOption :: String enumFieldOption = @@ -82,17 +153,41 @@ enumFieldOptionProto = testEnumParser :: Test testEnumParser = TestCase $ do - assertEqual "empty" False (isRight (parse parseEnum "" "")) - assertEqual "atLeastOneEnumField" False (isRight (parse parseEnum "" "enum Test{}")) - assertEqual "singleEnum" (Text.Protobuf.Types.Enum "Test" [EnumValue "A" 0 []]) (fromRight empytDefault (parse parseEnum "" "enum Test { A = 0; }")) - assertEqual "multiple" exampleEnumField (fromRight empytDefault (parse parseEnum "" exampleEnum)) - assertEqual "field option" enumFieldOptionProto (fromRight empytDefault (parse parseEnum "" enumFieldOption)) + assertEqual + "empty" + False + (isRight (parse parseEnum "" "")) + assertEqual + "atLeastOneEnumField" + False + (isRight (parse parseEnum "" "enum Test{}")) + assertEqual + "singleEnum" + (Text.Protobuf.Types.Enum "Test" [EnumValue "A" 0 []]) + (fromRight empytDefault (parse parseEnum "" "enum Test { A = 0; }")) + assertEqual + "multiple" + exampleEnumField + (fromRight empytDefault (parse parseEnum "" exampleEnum)) + assertEqual + "field option" + enumFieldOptionProto + (fromRight empytDefault (parse parseEnum "" enumFieldOption)) testEnumFieldNumbers :: Test testEnumFieldNumbers = TestCase $ do - assertEqual "belowMin" False (isRight (parse enumNumber "" "-1")) - assertEqual "min" 0 (fromRight 1 (parse enumNumber "" "0")) - assertEqual "max" 0xFFFFFFFF (fromRight 0 (parse enumNumber "" "4294967295")) + assertEqual + "belowMin" + False + (isRight (parse enumNumber "" "-1")) + assertEqual + "min" + 0 + (fromRight 1 (parse enumNumber "" "0")) + assertEqual + "max" + 0xFFFFFFFF + (fromRight 0 (parse enumNumber "" "4294967295")) -- TODO: not correct number -- assertEqual "aboveMax" (False) (isRight (parse enumNumber "" "4294967296")) diff --git a/test/Unit/Text/Protobuf/Parser/Import.hs b/test/Unit/Text/Protobuf/Parser/Import.hs index 18cd8d4..49171e8 100644 --- a/test/Unit/Text/Protobuf/Parser/Import.hs +++ b/test/Unit/Text/Protobuf/Parser/Import.hs @@ -22,11 +22,35 @@ complexPath = "google/protobuf/descriptor.proto" testImport :: Test testImport = TestCase $ do - assertEqual "empty" False (isRight (parse parseImport "" "")) - assertEqual "missing path" False (isRight (parse parseImport "" "import")) - assertEqual "missing 'proto;'" False (isRight (parse parseImport "" "import \"path\"")) - assertEqual "missing 'proto'" False (isRight (parse parseImport "" "import \"path\";")) - assertEqual "missing ';'" False (isRight (parse parseImport "" "import \"path.proto\"")) - assertEqual "missing proto" simplePath (fromRight testDefault (parse parseImport "" ("import \"" ++ simplePath ++ "\";"))) - assertEqual "simple path" simplePath (fromRight testDefault (parse parseImport "" ("import \"" ++ simplePath ++ "\";"))) - assertEqual "complex path" complexPath (fromRight testDefault (parse parseImport "" ("import \"" ++ complexPath ++ "\";"))) + assertEqual + "empty" + False + (isRight (parse parseImport "" "")) + assertEqual + "missing path" + False + (isRight (parse parseImport "" "import")) + assertEqual + "missing 'proto;'" + False + (isRight (parse parseImport "" "import \"path\"")) + assertEqual + "missing 'proto'" + False + (isRight (parse parseImport "" "import \"path\";")) + assertEqual + "missing ';'" + False + (isRight (parse parseImport "" "import \"path.proto\"")) + assertEqual + "missing proto" + simplePath + (fromRight testDefault (parse parseImport "" ("import \"" ++ simplePath ++ "\";"))) + assertEqual + "simple path" + simplePath + (fromRight testDefault (parse parseImport "" ("import \"" ++ simplePath ++ "\";"))) + assertEqual + "complex path" + complexPath + (fromRight testDefault (parse parseImport "" ("import \"" ++ complexPath ++ "\";"))) diff --git a/test/Unit/Text/Protobuf/Parser/Message.hs b/test/Unit/Text/Protobuf/Parser/Message.hs index 3d92658..9286421 100644 --- a/test/Unit/Text/Protobuf/Parser/Message.hs +++ b/test/Unit/Text/Protobuf/Parser/Message.hs @@ -119,14 +119,47 @@ testFieldOptionProto = testSimple :: Test testSimple = TestCase $ do - assertEqual "empty" False (isRight (parse parseMessage "" "")) - assertEqual "keyword only" False (isRight (parse parseMessage "" "message")) - assertEqual "missing name" False (isRight (parse parseMessage "" "message {}")) - assertEqual "emptyMessage" (Message "Foo" []) (fromRight failMessage (parse parseMessage "" "message Foo {}")) - assertEqual "simple" testMessage1Proto (fromRight failMessage (parse parseMessage "" testMessage1)) - assertEqual "reserved" testMessageReservedProto (fromRight failMessage (parse parseMessage "" testMessageReserved)) - assertEqual "optional" testOptionalProto (fromRight failMessage (parse parseMessage "" testOptional)) - assertEqual "repeated" testRepeatedProto (fromRight failMessage (parse parseMessage "" testRepeated)) - assertEqual "reserved names" testReservedNamesProto (fromRight failMessage (parse parseMessage "" testReservedNames)) - assertEqual "oneof" testOneOfProto (fromRight failMessage (parse parseMessage "" testOneOf)) - assertEqual "field option" testFieldOptionProto (fromRight failMessage (parse parseMessage "" testFieldOption)) + assertEqual + "empty" + False + (isRight (parse parseMessage "" "")) + assertEqual + "keyword only" + False + (isRight (parse parseMessage "" "message")) + assertEqual + "missing name" + False + (isRight (parse parseMessage "" "message {}")) + assertEqual + "emptyMessage" + (Message "Foo" []) + (fromRight failMessage (parse parseMessage "" "message Foo {}")) + assertEqual + "simple" + testMessage1Proto + (fromRight failMessage (parse parseMessage "" testMessage1)) + assertEqual + "reserved" + testMessageReservedProto + (fromRight failMessage (parse parseMessage "" testMessageReserved)) + assertEqual + "optional" + testOptionalProto + (fromRight failMessage (parse parseMessage "" testOptional)) + assertEqual + "repeated" + testRepeatedProto + (fromRight failMessage (parse parseMessage "" testRepeated)) + assertEqual + "reserved names" + testReservedNamesProto + (fromRight failMessage (parse parseMessage "" testReservedNames)) + assertEqual + "oneof" + testOneOfProto + (fromRight failMessage (parse parseMessage "" testOneOf)) + assertEqual + "field option" + testFieldOptionProto + (fromRight failMessage (parse parseMessage "" testFieldOption)) diff --git a/test/Unit/Text/Protobuf/Parser/Option.hs b/test/Unit/Text/Protobuf/Parser/Option.hs index b14301a..39918ee 100644 --- a/test/Unit/Text/Protobuf/Parser/Option.hs +++ b/test/Unit/Text/Protobuf/Parser/Option.hs @@ -17,34 +17,67 @@ testOption = Option "test" (StringValue "fail") testImport :: Test testImport = TestCase $ do - assertEqual "empty" False (isRight (parse parseOption "" "")) + assertEqual + "empty" + False + ( isRight + ( parse parseOption "" "" + ) + ) assertEqual "java_package" (Option "java_package" (StringValue "de.test")) - (fromRight testOption (parse parseOption "" "option java_package = \"de.test\";")) + ( fromRight + testOption + ( parse parseOption "" "option java_package = \"de.test\";" + ) + ) assertEqual "bool option" (Option "cc_enable_arenas" (BoolValue True)) - (fromRight testOption (parse parseOption "" "option cc_enable_arenas = true;")) + ( fromRight + testOption + ( parse parseOption "" "option cc_enable_arenas = true;" + ) + ) assertEqual "compund option" (Option "optimize_for" (CompoundValue "SPEED")) - (fromRight testOption (parse parseOption "" "option optimize_for = SPEED;")) + ( fromRight + testOption + (parse parseOption "" "option optimize_for = SPEED;") + ) testDefaultFieldOption :: [FieldOption] testDefaultFieldOption = [FieldOption "test" (StringValue "fail")] testFieldOption :: Test testFieldOption = TestCase $ do - assertEqual "empty" False (isRight (parse parseFieldOption "" "")) - assertEqual "missing content" False (isRight (parse parseFieldOption "" "[]")) + assertEqual + "empty" + False + ( isRight + (parse parseFieldOption "" "") + ) + assertEqual + "missing content" + False + (isRight (parse parseFieldOption "" "[]")) assertEqual "single bool option" [FieldOption "deprecated" (BoolValue True)] - (fromRight testDefaultFieldOption (parse parseFieldOption "" "[deprecated = true]")) + ( fromRight + testDefaultFieldOption + ( parse parseFieldOption "" "[deprecated = true]" + ) + ) assertEqual "multi bool option" [ FieldOption "deprecated" (BoolValue True), FieldOption "other" (BoolValue False) ] - (fromRight testDefaultFieldOption (parse parseFieldOption "" "[deprecated = true, other = false]")) + ( fromRight + testDefaultFieldOption + ( parse parseFieldOption "" "[deprecated = true, other = false]" + ) + ) diff --git a/test/Unit/Text/Protobuf/Parser/Package.hs b/test/Unit/Text/Protobuf/Parser/Package.hs index 3ca380c..962fb5d 100644 --- a/test/Unit/Text/Protobuf/Parser/Package.hs +++ b/test/Unit/Text/Protobuf/Parser/Package.hs @@ -12,8 +12,23 @@ allTests = testPackage :: Test testPackage = TestCase $ do - assertEqual "empty" False (isRight (parse parsePackage "" "")) - assertEqual "missing package name" False (isRight (parse parsePackage "" "package")) - assertEqual "missing ';'" False (isRight (parse parsePackage "" "package foo.bar")) - assertEqual "Simple" "foo" (fromRight "incorrect" (parse parsePackage "" "package foo;")) - assertEqual "Complex" "foo.bar" (fromRight "incorrect" (parse parsePackage "" "package foo.bar;")) + assertEqual + "empty" + False + (isRight (parse parsePackage "" "")) + assertEqual + "missing package name" + False + (isRight (parse parsePackage "" "package")) + assertEqual + "missing ';'" + False + (isRight (parse parsePackage "" "package foo.bar")) + assertEqual + "Simple" + "foo" + (fromRight "incorrect" (parse parsePackage "" "package foo;")) + assertEqual + "Complex" + "foo.bar" + (fromRight "incorrect" (parse parsePackage "" "package foo.bar;")) diff --git a/test/Unit/Text/Protobuf/Parser/Service.hs b/test/Unit/Text/Protobuf/Parser/Service.hs index 4aeadae..88c2a66 100644 --- a/test/Unit/Text/Protobuf/Parser/Service.hs +++ b/test/Unit/Text/Protobuf/Parser/Service.hs @@ -85,10 +85,31 @@ streamReplyService = testSimple :: Test testSimple = TestCase $ do - assertEqual "empty" False (isRight (parse parseService "" "")) - assertEqual "keyword only" False (isRight (parse parseService "" "message")) - assertEqual "missing name" False (isRight (parse parseService "" "message {}")) - assertEqual "emptyMessage" simpleService (fromRight failMessage (parse parseService "" simpleServiceText)) - assertEqual "multiple" multipleService (fromRight failMessage (parse parseService "" multipleServiceText)) - assertEqual "stream request" streamRequestService (fromRight failMessage (parse parseService "" streamRequestServiceText)) - assertEqual "stream reply" streamReplyService (fromRight failMessage (parse parseService "" streamReplyServiceText)) + assertEqual + "empty" + False + (isRight (parse parseService "" "")) + assertEqual + "keyword only" + False + (isRight (parse parseService "" "message")) + assertEqual + "missing name" + False + (isRight (parse parseService "" "message {}")) + assertEqual + "emptyMessage" + simpleService + (fromRight failMessage (parse parseService "" simpleServiceText)) + assertEqual + "multiple" + multipleService + (fromRight failMessage (parse parseService "" multipleServiceText)) + assertEqual + "stream request" + streamRequestService + (fromRight failMessage (parse parseService "" streamRequestServiceText)) + assertEqual + "stream reply" + streamReplyService + (fromRight failMessage (parse parseService "" streamReplyServiceText)) diff --git a/test/Unit/Text/Protobuf/Parser/Syntax.hs b/test/Unit/Text/Protobuf/Parser/Syntax.hs index 1185d01..e52269d 100644 --- a/test/Unit/Text/Protobuf/Parser/Syntax.hs +++ b/test/Unit/Text/Protobuf/Parser/Syntax.hs @@ -12,10 +12,31 @@ allTests = testSyntax :: Test testSyntax = TestCase $ do - assertEqual "empty" False (isRight (parse parseSyntax "" "")) - assertEqual "missing package name" False (isRight (parse parseSyntax "" "syntax")) - assertEqual "missing ';'" False (isRight (parse parseSyntax "" "syntax \"proto3\"")) - assertEqual "invalid Proto Version" False (isRight (parse parseSyntax "" "syntax = \"proto1\";")) - assertEqual "Proto2" True (isRight (parse parseSyntax "" "syntax = \"proto2\";")) - assertEqual "Proto2" Proto2 (fromRight Proto3 (parse parseSyntax "" "syntax = \"proto2\";")) - assertEqual "Proto3" Proto3 (fromRight Proto2 (parse parseSyntax "" "syntax = \"proto3\";")) + assertEqual + "empty" + False + (isRight (parse parseSyntax "" "")) + assertEqual + "missing package name" + False + (isRight (parse parseSyntax "" "syntax")) + assertEqual + "missing ';'" + False + (isRight (parse parseSyntax "" "syntax \"proto3\"")) + assertEqual + "invalid Proto Version" + False + (isRight (parse parseSyntax "" "syntax = \"proto1\";")) + assertEqual + "Proto2" + True + (isRight (parse parseSyntax "" "syntax = \"proto2\";")) + assertEqual + "Proto2" + Proto2 + (fromRight Proto3 (parse parseSyntax "" "syntax = \"proto2\";")) + assertEqual + "Proto3" + Proto3 + (fromRight Proto2 (parse parseSyntax "" "syntax = \"proto3\";")) diff --git a/test/Unit/Text/Protobuf/Parser/Type.hs b/test/Unit/Text/Protobuf/Parser/Type.hs index 14b3053..bf0fd7e 100644 --- a/test/Unit/Text/Protobuf/Parser/Type.hs +++ b/test/Unit/Text/Protobuf/Parser/Type.hs @@ -17,41 +17,101 @@ allTests = testNumberParser :: Test testNumberParser = TestCase $ do - assertEqual "nan" False (isRight (parse protoNumber "" "a")) - assertEqual "negative" False (isRight (parse protoNumber "" "-42")) - assertEqual "acceptedValue42" 42 (fromRight 0 (parse protoNumber "" "42")) + assertEqual + "nan" + False + (isRight (parse protoNumber "" "a")) + assertEqual + "negative" + False + (isRight (parse protoNumber "" "-42")) + assertEqual + "acceptedValue42" + 42 + (fromRight 0 (parse protoNumber "" "42")) -- https://protobuf.dev/programming-guides/proto3/#assigning -- Range from 1 to 536,870,911 - assertEqual "min" 1 (fromRight 0 (parse protoNumber "" "1")) - assertEqual "belowMin" False (isRight (parse protoNumber "" "0")) - assertEqual "max" 536870911 (fromRight 0 (parse protoNumber "" "536870911")) - assertEqual "aboveMax" False (isRight (parse protoNumber "" "536870912")) + assertEqual + "min" + 1 + (fromRight 0 (parse protoNumber "" "1")) + assertEqual + "belowMin" + False + (isRight (parse protoNumber "" "0")) + assertEqual + "max" + 536870911 + (fromRight 0 (parse protoNumber "" "536870911")) + assertEqual + "aboveMax" + False + (isRight (parse protoNumber "" "536870912")) -- 19,000 to 19,999 are reserved for the Protocol Buffers - assertEqual "belowReserved" 18999 (fromRight 0 (parse protoNumber "" "18999")) - assertEqual "reservedStart" False (isRight (parse protoNumber "" "19000")) - assertEqual "inReserved" False (isRight (parse protoNumber "" "19123")) - assertEqual "reservedEnd" False (isRight (parse protoNumber "" "19999")) - assertEqual "aboveReserved" 20000 (fromRight 0 (parse protoNumber "" "20000")) + assertEqual + "belowReserved" + 18999 + (fromRight 0 (parse protoNumber "" "18999")) + assertEqual + "reservedStart" + False + (isRight (parse protoNumber "" "19000")) + assertEqual + "inReserved" + False + (isRight (parse protoNumber "" "19123")) + assertEqual + "reservedEnd" + False + (isRight (parse protoNumber "" "19999")) + assertEqual + "aboveReserved" + 20000 + (fromRight 0 (parse protoNumber "" "20000")) testProtoName :: Test testProtoName = TestCase $ do - assertEqual "not a name" False (isRight (parse protoName "" "-1")) - assertEqual "Uppercase" "TEST" (fromRight "Default" (parse protoName "" "TEST")) - assertEqual "UpperCamelCase" "TestTest" (fromRight "Default" (parse protoName "" "TestTest")) + assertEqual + "not a name" + False + (isRight (parse protoName "" "-1")) + assertEqual + "Uppercase" + "TEST" + (fromRight "Default" (parse protoName "" "TEST")) + assertEqual + "UpperCamelCase" + "TestTest" + (fromRight "Default" (parse protoName "" "TestTest")) testSclarType :: Test testSclarType = TestCase $ do - assertEqual "int32" (IntType Int32) (fromRight BoolType (parse parseScalarType "" "int32")) - assertEqual "double" (FloatType Double) (fromRight BoolType (parse parseScalarType "" "double")) - assertEqual "string" StringType (fromRight BoolType (parse parseScalarType "" "string")) + assertEqual + "int32" + (IntType Int32) + (fromRight BoolType (parse parseScalarType "" "int32")) + assertEqual + "double" + (FloatType Double) + (fromRight BoolType (parse parseScalarType "" "double")) + assertEqual + "string" + StringType + (fromRight BoolType (parse parseScalarType "" "string")) defaulTestMap :: DataType defaulTestMap = Map (StringKey "") (MapName "") testMap :: Test testMap = TestCase $ do - assertEqual "empty" False (isRight (parse parseMap "" "")) - assertEqual "keyword only" False (isRight (parse parseMap "" "map")) + assertEqual + "empty" + False + (isRight (parse parseMap "" "")) + assertEqual + "keyword only" + False + (isRight (parse parseMap "" "map")) assertEqual "Simple" (Map (StringKey "T") (MapName "V")) @@ -63,7 +123,13 @@ testMap = TestCase $ do testCustomName :: Test testCustomName = TestCase $ do - assertEqual "empty" False (isRight (parse parseCustomName "" "")) + assertEqual + "empty" + False + (isRight (parse parseCustomName "" "")) -- TODO: has to have at least 1 char -- assertEqual "empty" False (isRight (parse parseCustomName "" "()")) - assertEqual "Simple" "(foo)" (fromRight "" (parse parseCustomName "" "(foo)")) + assertEqual + "Simple" + "(foo)" + (fromRight "" (parse parseCustomName "" "(foo)")) From f4d7e54fdcb6ba9b4053ce7fafdb4467401a4be6 Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Tue, 28 Nov 2023 23:23:59 +0100 Subject: [PATCH 53/55] add grammar --- README.md | 88 ++++++++++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 80 insertions(+), 8 deletions(-) diff --git a/README.md b/README.md index 3087cb7..f47c818 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # protobuf-parser -Simplified [Protocol Buffers]\[proto 3](https://protobuf.dev/programming-guides/proto3/) and [gRPC](https://grpc.io/docs/what-is-grpc/introduction/) parser using Haskell and [Parsec](https://hackage.haskell.org/package/parsec) +Simplified [Protocol Buffers Version 3](https://protobuf.dev/programming-guides/proto3/) and [gRPC](https://grpc.io/docs/what-is-grpc/introduction/) parser using Haskell and [Parsec](https://hackage.haskell.org/package/parsec) ## Usage @@ -17,8 +17,8 @@ Available options: ```bash stack run -- -p -f ./test/E2E/protofiles/chat.proto -stack run "import "foo.proto"; import "bar.proto"; package foobar;" -stack run -- -p "import "foo.proto"; import "bar.proto"; package foobar;" +stack run -- -p "import \"foo.proto\"; import \"bar.proto\"; package foobar;" +stack run "import \"foo.proto\"; import \"bar.proto\"; package foobar;" stack test ``` @@ -50,10 +50,6 @@ stack test ``` -## Grammar - -TODO: past into parser segments - ## Simplifications This projects acts as a parser combinator showcase project. @@ -62,5 +58,81 @@ Therefore, not all features are complete or correct: - Only proto3 syntax is supported - Not all values are check for correctness - Base Lexical Elements do not strictly follow the [offical spec](https://protobuf.dev/reference/protobuf/proto3-spec/#lexical_elements) -- Protobuf 3 Ranges do not allow the keyword "min" +- Proto 3 Ranges do not allow the keyword "min" - Empty statements are missing +- Import weak and public are missing + +## Grammar + +The correct and complete Grammar can be found at the [offical Protocol Buffers Version 3 Language Specification](https://protobuf.dev/reference/protobuf/proto3-spec/) + +Following is basic syntax in Extended Backus-Naur Form (EBNF): + +``` +| alternation +() grouping +[] option (zero or one time) +{} repetition (any number of times) +``` + +``` +syntax = "syntax" "=" ("'" "proto3" "'" | '"' "proto3" '"') ";" + + +import = "import" [ "weak" | "public" ] strLit ";" + + +package = "package" fullIdent ";" + + +constant = fullIdent | ( [ "-" | "+" ] intLit ) | ( [ "-" | "+" ] floatLit ) | + strLit | boolLit | MessageValue + + +option = "option" optionName "=" constant ";" +optionName = ( ident | "(" ["."] fullIdent ")" ) + + +type = "double" | "float" | "int32" | "int64" | "uint32" | "uint64" + | "sint32" | "sint64" | "fixed32" | "fixed64" | "sfixed32" | "sfixed64" + | "bool" | "string" | "bytes" | messageType | enumType +fieldNumber = intLit; + +field = [ "repeated" ] type fieldName "=" fieldNumber [ "[" fieldOptions "]" ] ";" +fieldOptions = fieldOption { "," fieldOption } +fieldOption = optionName "=" constant + +oneof = "oneof" oneofName "{" { option | oneofField } "}" +oneofField = type fieldName "=" fieldNumber [ "[" fieldOptions "]" ] ";" + +mapField = "map" "<" keyType "," type ">" mapName "=" fieldNumber [ "[" fieldOptions "]" ] ";" +keyType = "int32" | "int64" | "uint32" | "uint64" | "sint32" | "sint64" | + "fixed32" | "fixed64" | "sfixed32" | "sfixed64" | "bool" | "string" + + +reserved = "reserved" ( ranges | strFieldNames ) ";" +ranges = range { "," range } +range = intLit [ "to" ( intLit | "max" ) ] +strFieldNames = strFieldName { "," strFieldName } +strFieldName = "'" fieldName "'" | '"' fieldName '"' + + +enum = "enum" enumName enumBody +enumBody = "{" { option | enumField | emptyStatement | reserved } "}" +enumField = ident "=" [ "-" ] intLit [ "[" enumValueOption { "," enumValueOption } "]" ]";" +enumValueOption = optionName "=" constant + + +message = "message" messageName messageBody +messageBody = "{" { field | enum | message | option | oneof | mapField | +reserved | emptyStatement } "}" + + +service = "service" serviceName "{" { option | rpc | emptyStatement } "}" +rpc = "rpc" rpcName "(" [ "stream" ] messageType ")" "returns" "(" [ "stream" ] +messageType ")" (( "{" {option | emptyStatement } "}" ) | ";") + + +proto = syntax { import | package | option | topLevelDef | emptyStatement } +topLevelDef = message | enum | service +``` From c0eea503d698b817451709a3ea01319a793bd139 Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Tue, 28 Nov 2023 23:25:01 +0100 Subject: [PATCH 54/55] replace pretty stdin example --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index f47c818..eac2fe9 100644 --- a/README.md +++ b/README.md @@ -17,7 +17,7 @@ Available options: ```bash stack run -- -p -f ./test/E2E/protofiles/chat.proto -stack run -- -p "import \"foo.proto\"; import \"bar.proto\"; package foobar;" +stack run -- -p "message SearchRequest { int32 page_number = 2; double results_per_page = 3; }" stack run "import \"foo.proto\"; import \"bar.proto\"; package foobar;" stack test From 16d532e5d5cace793e26b52b4b64de3bc84ff1e4 Mon Sep 17 00:00:00 2001 From: Anton Kesy Date: Tue, 28 Nov 2023 23:27:08 +0100 Subject: [PATCH 55/55] improve structure overview --- README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index eac2fe9..b48dfc8 100644 --- a/README.md +++ b/README.md @@ -26,14 +26,14 @@ stack test ## Structure ``` -. +protobuf-parser ├── app │   └── Main.hs -> CLI Parsing ├── ... ├── src │   └── Text │   └── Protobuf -│   ├── Parser -> Partial Parser +│   ├── Parser -> Parser Combinators │   │   ├── ... │   │   └── *.hs │   ├── Parser.hs -> Complete Protobuf Parser