diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,202 @@ + + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright [yyyy] [name of copyright owner] + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,127 @@ +# avro-parser-haskell + +[![Actions Status](https://github.com/kutyel/avro-parser-haskell/workflows/Haskell%20CI/badge.svg)](https://github.com/kutyel/avro-parser-haskell/actions) +[![Hackage](https://img.shields.io/hackage/v/language-avro.svg?logo=haskell)](https://hackage.haskell.org/package/language-avro) +[![ormolu](https://img.shields.io/badge/styled%20with-ormolu-blueviolet)](https://github.com/tweag/ormolu) + +Language definition and parser for AVRO (`.avdl`) files. + +## Example + +```haskell +#! /usr/bin/env runhaskell + +module Main where + +import Language.Avro.Parser (readWithImports) + +main :: IO () +main = readWithImports "test" "PeopleService.avdl" +-- λ> +-- Right +-- (Protocol { +-- ns = Just (Namespace ["example","seed","server","protocol","avro"]), +-- pname = "PeopleService", imports = [IdlImport "People.avdl"], +-- types = [ +-- Record { +-- name = "Person", +-- aliases = [], +-- doc = Nothing, +-- order = Nothing, +-- fields = [ +-- Field { +-- fldName = "name", +-- fldAliases = [], +-- fldDoc = Nothing, +-- fldOrder = Nothing, +-- fldType = String, +-- fldDefault = Nothing +-- }, +-- Field { +-- fldName = "age", +-- fldAliases = [], +-- fldDoc = Nothing, +-- fldOrder = Nothing, +-- fldType = Int, +-- fldDefault = Nothing +-- } +-- ] +-- }, +-- Record { +-- name = "NotFoundError", +-- aliases = [], +-- doc = Nothing, +-- order = Nothing, +-- fields = [ +-- Field { +-- fldName = "message", +-- fldAliases = [], +-- fldDoc = Nothing, +-- fldOrder = Nothing, +-- fldType = String, +-- fldDefault = Nothing +-- } +-- ] +-- }, +-- Record { +-- name = "DuplicatedPersonError", +-- aliases = [], +-- doc = Nothing, +-- order = Nothing, +-- fields = [ +-- Field { +-- fldName = "message", +-- fldAliases = [], +-- fldDoc = Nothing, +-- fldOrder = Nothing, +-- fldType = String, +-- fldDefault = Nothing +-- } +-- ] +-- }, +-- Record { +-- name = "PeopleRequest", +-- aliases = [], +-- doc = Nothing, +-- order = Nothing, +-- fields = [ +-- Field { +-- fldName = "name", +-- fldAliases = [], +-- fldDoc = Nothing, +-- fldOrder = Nothing, +-- fldType = String, +-- fldDefault = Nothing +-- } +-- ] +-- }, +-- Record { +-- name = "PeopleResponse", +-- aliases = [], +-- doc = Nothing, +-- order = Nothing, +-- fields = [ +-- Field { +-- fldName = "result", +-- fldAliases = [], +-- fldDoc = Nothing, +-- fldOrder = Nothing, +-- fldType = Union {options = [NamedType "Person",NamedType "NotFoundError",NamedType "DuplicatedPersonError"]}, +-- fldDefault = Nothing +-- } +-- ] +-- } +-- ], +-- messages = [ +-- Method { +-- mname = "getPerson", +-- args = [Argument {atype = NamedType "example.seed.server.protocol.avro.PeopleRequest", aname = "request"}], +-- result = NamedType "example.seed.server.protocol.avro.PeopleResponse", +-- throws = Null, +-- oneway = False +-- } +-- ] +-- }) +``` + +⚠️ Warning: `readWithImports` only works right now if the import type is `"idl"`! diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/language-avro.cabal b/language-avro.cabal new file mode 100644 --- /dev/null +++ b/language-avro.cabal @@ -0,0 +1,45 @@ +name: language-avro +version: 0.1.0.0 +synopsis: Language definition and parser for AVRO files. +description: Parser for the AVRO language specification, see README.md for more details. +homepage: https://github.com/kutyel/avro-parser-haskell#readme +license: Apache-2.0 +license-file: LICENSE +author: Flavio Corpa +maintainer: flavio.corpa@47deg.com +copyright: Copyright © 2019-2020 +category: Network +build-type: Simple +cabal-version: >=1.10 +extra-source-files: README.md + +library + exposed-modules: Language.Avro.Types, + Language.Avro.Parser + build-depends: base >=4.12 && <5 + , avro + , filepath + , megaparsec + , text + , vector + hs-source-dirs: src + default-language: Haskell2010 + +test-suite avro-parser-haskell-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + default-language: Haskell2010 + hs-source-dirs: + test + ghc-options: + -threaded + -rtsopts + -with-rtsopts=-N + build-depends: + base >=4.12 && <5 + , avro + , language-avro + , megaparsec + , text + , hspec + , vector diff --git a/src/Language/Avro/Parser.hs b/src/Language/Avro/Parser.hs new file mode 100644 --- /dev/null +++ b/src/Language/Avro/Parser.hs @@ -0,0 +1,237 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | Parser for AVRO (@.avdl@) files, as defined in . +module Language.Avro.Parser ( + -- * Main parsers + parseProtocol + , readWithImports + -- * Intermediate parsers + , parseAliases + , parseAnnotation + , parseImport + , parseMethod + , parseNamespace + , parseOrder + , parseSchema + ) where + +import Data.Avro +import Data.Avro.Schema +import Data.Either (partitionEithers) +import Data.List (foldl') +import qualified Data.Text as T +import qualified Data.Text.IO as T +import Data.Vector (Vector, fromList) +import Language.Avro.Types +import Text.Megaparsec +import Text.Megaparsec.Char +import qualified Text.Megaparsec.Char.Lexer as L +import System.FilePath + +spaces :: MonadParsec Char T.Text m => m () +spaces = L.space space1 (L.skipLineComment "//") (L.skipBlockComment "/*" "*/") + +lexeme :: MonadParsec Char T.Text m => m a -> m a +lexeme = L.lexeme spaces + +symbol :: MonadParsec Char T.Text m => T.Text -> m T.Text +symbol = L.symbol spaces + +reserved :: MonadParsec Char T.Text m => T.Text -> m T.Text +reserved = lexeme . chunk + +number :: (MonadParsec Char T.Text m, Integral a) => m a +number = L.signed spaces (lexeme L.decimal) <|> lexeme L.octal <|> lexeme L.hexadecimal + +floating :: (MonadParsec Char T.Text m, RealFloat a) => m a +floating = L.signed spaces (lexeme L.float) + +strlit :: MonadParsec Char T.Text m => m T.Text +strlit = T.pack <$> (char '"' >> manyTill L.charLiteral (char '"')) + +braces :: MonadParsec Char T.Text m => m a -> m a +braces = between (symbol "{") (symbol "}") + +brackets :: MonadParsec Char T.Text m => m a -> m a +brackets = between (symbol "[") (symbol "]") + +parens :: MonadParsec Char T.Text m => m a -> m a +parens = between (symbol "(") (symbol ")") + +diamonds :: MonadParsec Char T.Text m => m a -> m a +diamonds = between (symbol "<") (symbol ">") + +backticks :: MonadParsec Char T.Text m => m T.Text +backticks = T.pack <$> (char '`' >> manyTill L.charLiteral (char '`')) + +ident :: MonadParsec Char T.Text m => m T.Text +ident = T.pack <$> ((:) <$> letterChar <*> many (alphaNumChar <|> char '_' <|> char '-')) + +identifier :: MonadParsec Char T.Text m => m T.Text +identifier = lexeme (ident <|> backticks) + +toNamedType :: [T.Text] -> TypeName +toNamedType [] = error "named types cannot be empty" +toNamedType xs = TN {baseName, namespace} + where + baseName = last xs + namespace = filter (/= "") $ init xs + +multiNamedTypes :: [T.Text] -> [TypeName] +multiNamedTypes = fmap $ toNamedType . T.splitOn "." + +-- | Parses annotations into the 'Annotation' structure. +parseAnnotation :: MonadParsec Char T.Text m => m Annotation +parseAnnotation = Annotation <$ symbol "@" <*> identifier <*> parens strlit + +-- | Parses a single import into the 'ImportType' structure. +parseNamespace :: MonadParsec Char T.Text m => m Namespace +parseNamespace = toNs <$ (symbol "@" *> reserved "namespace") <*> parens strlit + where + toNs :: T.Text -> Namespace + toNs = Namespace . T.splitOn "." + +-- | Parses aliases, which are just Lists of 'TypeName'. +parseAliases :: MonadParsec Char T.Text m => m Aliases +parseAliases = multiNamedTypes <$> parseFieldAlias + +-- | Parses a single import into the 'ImportType' structure. +parseImport :: MonadParsec Char T.Text m => m ImportType +parseImport = + reserved "import" + *> ( impHelper IdlImport "idl" + <|> impHelper ProtocolImport "protocol" + <|> impHelper SchemaImport "schema" + ) + where + impHelper :: MonadParsec Char T.Text m => (T.Text -> a) -> T.Text -> m a + impHelper ct t = ct <$> (reserved t *> strlit <* symbol ";") + +-- | Parses a single protocol into the 'Protocol' structure. +parseProtocol :: MonadParsec Char T.Text m => m Protocol +parseProtocol = + buildProtocol <$ spaces <*> optional parseNamespace <* reserved "protocol" + <*> identifier + <*> braces (many serviceThing) + where + buildProtocol :: Maybe Namespace -> T.Text -> [ProtocolThing] -> Protocol + buildProtocol ns name things = + Protocol + ns + name + [i | ProtocolThingImport i <- things] + [t | ProtocolThingType t <- things] + [m | ProtocolThingMethod m <- things] + +data ProtocolThing + = ProtocolThingImport ImportType + | ProtocolThingType Schema + | ProtocolThingMethod Method + +serviceThing :: MonadParsec Char T.Text m => m ProtocolThing +serviceThing = + try (ProtocolThingImport <$> parseImport) + <|> try (ProtocolThingMethod <$> parseMethod) + <|> ProtocolThingType <$> parseSchema + +parseVector :: MonadParsec Char T.Text m => m a -> m (Vector a) +parseVector t = fromList <$> braces (lexeme $ sepBy1 t $ symbol ",") + +parseTypeName :: MonadParsec Char T.Text m => m TypeName +parseTypeName = toNamedType . pure <$> identifier + +-- | Parses order annotations into the 'Order' structure. +parseOrder :: MonadParsec Char T.Text m => m Order +parseOrder = + symbol "@" *> reserved "order" + *> parens + ( Ascending <$ string "\"ascending\"" + <|> Descending <$ string "\"descending\"" + <|> Ignore <$ string "\"ignore\"" + ) + +parseFieldAlias :: MonadParsec Char T.Text m => m [T.Text] +parseFieldAlias = + symbol "@" *> reserved "aliases" + *> parens (brackets $ lexeme $ sepBy1 strlit $ symbol ",") + +parseField :: MonadParsec Char T.Text m => m Field +parseField = + (\o t a n -> Field n a Nothing o t Nothing) -- FIXME: docs and default values are not supported yet. + <$> optional parseOrder + <*> parseSchema + <*> option [] parseFieldAlias + <*> identifier + <* symbol ";" + +-- | Parses arguments of methods into the 'Argument' structure. +parseArgument :: MonadParsec Char T.Text m => m Argument +parseArgument = Argument <$> parseSchema <*> identifier + +-- | Parses a single method/message into the 'Method' structure. +parseMethod :: MonadParsec Char T.Text m => m Method +parseMethod = + (\r n a t o -> Method n a r t o) + <$> parseSchema + <*> identifier + <*> parens (option [] (lexeme $ sepBy1 parseArgument $ symbol ",")) + <*> option Null (reserved "throws" *> parseSchema) + <*> option False (True <$ reserved "oneway") + <* symbol ";" + +-- | Parses a single type respecting @Data.Avro.Schema@'s 'Schema'. +parseSchema :: MonadParsec Char T.Text m => m Schema +parseSchema = + Null <$ (reserved "null" <|> reserved "void") + <|> Boolean <$ reserved "boolean" + <|> Int <$ reserved "int" + <|> Long <$ reserved "long" + <|> Float <$ reserved "float" + <|> Double <$ reserved "double" + <|> Bytes <$ reserved "bytes" + <|> String <$ reserved "string" + <|> Array <$ reserved "array" <*> diamonds parseSchema + <|> Map <$ reserved "map" <*> diamonds parseSchema + <|> Union <$ reserved "union" <*> parseVector parseSchema + <|> try + ( flip Fixed + <$> option [] parseAliases <* reserved "fixed" + <*> parseTypeName + <*> parens number + ) + <|> try + ( flip Enum + <$> option [] parseAliases <* reserved "enum" + <*> parseTypeName + <*> pure Nothing -- docs are ignored for now... + <*> parseVector identifier + ) + <|> try + ( flip Record + <$> option [] parseAliases <* (reserved "record" <|> reserved "error") + <*> parseTypeName + <*> pure Nothing -- docs are ignored for now... + <*> optional parseOrder -- FIXME: order for records is not supported yet. + <*> option [] (braces . many $ parseField) + ) + <|> NamedType . toNamedType <$> lexeme (sepBy1 identifier $ char '.') + +parseFile :: Parsec e T.Text a -> String -> IO (Either (ParseErrorBundle T.Text e) a) +parseFile p file = runParser p file <$> T.readFile file + +-- | Reads and parses a whole file and its imports, recursively. +readWithImports :: FilePath -- ^ base directory + -> FilePath -- ^ initial file + -> IO (Either (ParseErrorBundle T.Text Char) Protocol) +readWithImports baseDir initialFile = do + initial <- parseFile parseProtocol (baseDir initialFile) + case initial of + Left e -> pure $ Left e + Right p -> do + let imps = [i | IdlImport i <- imports p] + (lefts, rights) <- partitionEithers <$> traverse (readWithImports baseDir . T.unpack) imps + pure $ case lefts of + e:_ -> Left e + _ -> Right $ foldl' (<>) p rights diff --git a/src/Language/Avro/Types.hs b/src/Language/Avro/Types.hs new file mode 100644 --- /dev/null +++ b/src/Language/Avro/Types.hs @@ -0,0 +1,69 @@ +-- | Language definition for AVRO (@.avdl@) files, +-- as defined in . +module Language.Avro.Types ( + module Language.Avro.Types, Schema (..) +) where + +import Data.Avro.Schema +import qualified Data.Text as T + +-- | Whole definition of protocol. +data Protocol + = Protocol + { ns :: Maybe Namespace, + pname :: T.Text, + imports :: [ImportType], + types :: [Schema], + messages :: [Method] + } + deriving (Eq, Show) + +instance Semigroup Protocol where + p1 <> p2 = + Protocol + (ns p1) + (pname p1) + (imports p1 <> imports p2) + (types p1 <> types p2) + (messages p1 <> messages p2) + +-- | Newtype for the namespace of methods and protocols. +newtype Namespace + = Namespace [T.Text] + deriving (Eq, Show) + +type Aliases = [TypeName] + +-- | Type for special annotations. +data Annotation + = Annotation + { ann :: T.Text, + abody :: T.Text + } + deriving (Eq, Show) + +-- | Type for the possible import types in 'Protocol'. +data ImportType + = IdlImport T.Text + | ProtocolImport T.Text + | SchemaImport T.Text + deriving (Eq, Show) + +-- | Helper type for the arguments of 'Method'. +data Argument + = Argument + { atype :: Schema, + aname :: T.Text + } + deriving (Eq, Show) + +-- | Type for methods/messages that belong to a protocol. +data Method + = Method + { mname :: T.Text, + args :: [Argument], + result :: Schema, + throws :: Schema, + oneway :: Bool + } + deriving (Eq, Show) diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,211 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main + ( main, + ) +where + +import Data.Avro.Schema +import Data.Text as T hiding (tail) +import Data.Vector (fromList) +import Language.Avro.Parser +import Language.Avro.Types +import Test.Hspec +import Text.Megaparsec (parse) + +enumTest :: T.Text +enumTest = + T.unlines + [ "@aliases([\"org.foo.KindOf\"])", + "enum Kind {", + "FOO,", + "BAR, // the bar enum value", + "BAZ", + "}" + ] + +simpleProtocol :: [T.Text] +simpleProtocol = + [ "@namespace(\"example.seed.server.protocol.avro\")", + "protocol PeopleService {", + "import idl \"People.avdl\";", + "example.seed.server.protocol.avro.PeopleResponse getPerson(example.seed.server.protocol.avro.PeopleRequest request);", + "}" + ] + +simpleRecord :: T.Text +simpleRecord = + T.unlines + [ "@aliases([\"org.foo.Person\"])", + "record Person {", + "string name;", + "int age;", + "}" + ] + +complexRecord :: T.Text +complexRecord = + T.unlines + [ "record TestRecord {", + "@order(\"ignore\")", + "string name;", + "@order(\"descending\")", + "Kind kind;", + "MD5 hash;", + "union { MD5, null} @aliases([\"hash\"]) nullableHash;", + "array arrayOfLongs;", + "}" + ] + +main :: IO () +main = hspec $ do + describe "Parse annotations" $ do + it "should parse namespaces" $ do + parse parseNamespace "" "@namespace(\"mynamespace\")" + `shouldBe` (Right $ Namespace ["mynamespace"]) + parse parseNamespace "" "@namespace(\"org.apache.avro.test\")" + `shouldBe` (Right $ Namespace ["org", "apache", "avro", "test"]) + it "should parse ordering" $ do + parse parseOrder "" "@order(\"ascending\")" `shouldBe` Right Ascending + parse parseOrder "" "@order(\"descending\")" `shouldBe` Right Descending + parse parseOrder "" "@order(\"ignore\")" `shouldBe` Right Ignore + it "should parse aliases" $ do + parse parseAliases "" "@aliases([\"org.foo.KindOf\"])" + `shouldBe` Right [TN "KindOf" ["org", "foo"]] + parse parseAliases "" "@aliases([\"org.old.OldRecord\", \"org.ancient.AncientRecord\"])" + `shouldBe` Right [TN "OldRecord" ["org", "old"], TN "AncientRecord" ["org", "ancient"]] + it "should parse other annotations" $ do + parse parseAnnotation "" "@java-class(\"java.util.ArrayList\")" + `shouldBe` (Right $ Annotation "java-class" "java.util.ArrayList") + parse parseAnnotation "" "@java-key-class(\"java.io.File\")" + `shouldBe` (Right $ Annotation "java-key-class" "java.io.File") + describe "Parse imports" $ do + it "should parse idl" $ + parse parseImport "" "import idl \"foo.avdl\";" + `shouldBe` (Right $ IdlImport "foo.avdl") + it "should parse protocol" $ + parse parseImport "" "import protocol \"foo.avpr\";" + `shouldBe` (Right $ ProtocolImport "foo.avpr") + it "should parse schema" $ + parse parseImport "" "import schema \"foo.avsc\";" + `shouldBe` (Right $ SchemaImport "foo.avsc") + describe "Parse Data.Avro.Schema" $ do + it "should parse null" $ + parse parseSchema "" "null" `shouldBe` Right Null + it "should parse boolean" $ + parse parseSchema "" "boolean" `shouldBe` Right Boolean + it "should parse int" $ + parse parseSchema "" "int" `shouldBe` Right Int + it "should parse long" $ + parse parseSchema "" "long" `shouldBe` Right Long + it "should parse float" $ + parse parseSchema "" "float" `shouldBe` Right Float + it "should parse double" $ + parse parseSchema "" "double" `shouldBe` Right Double + it "should parse bytes" $ + parse parseSchema "" "bytes" `shouldBe` Right Bytes + it "should parse string" $ + parse parseSchema "" "string" `shouldBe` Right String + it "should parse array" $ do + parse parseSchema "" "array" `shouldBe` (Right $ Array Int) + parse parseSchema "" "array>" + `shouldBe` (Right $ Array $ Array String) + it "should parse map" $ do + parse parseSchema "" "map" `shouldBe` (Right $ Map Int) + parse parseSchema "" "map>" + `shouldBe` (Right $ Map $ Map String) + it "should parse unions" $ + parse parseSchema "" "union { string, int, null }" + `shouldBe` (Right $ Union $ fromList [String, Int, Null]) + it "should parse fixeds" $ do + parse parseSchema "" "fixed MD5(16)" + `shouldBe` (Right $ Fixed (TN "MD5" []) [] 16) + parse parseSchema "" "@aliases([\"org.foo.MD5\"])\nfixed MD5(16)" + `shouldBe` (Right $ Fixed (TN "MD5" []) ["org.foo.MD5"] 16) + it "should parse enums" $ do + parse parseSchema "" enumTest + `shouldBe` (Right $ Enum (TN "Kind" []) [TN "KindOf" ["org", "foo"]] Nothing (fromList ["FOO", "BAR", "BAZ"])) + parse parseSchema "" "enum Suit { SPADES, DIAMONDS, CLUBS, HEARTS }" + `shouldBe` (Right $ Enum (TN "Suit" []) [] Nothing (fromList ["SPADES", "DIAMONDS", "CLUBS", "HEARTS"])) + it "should parse named types" $ + parse parseSchema "" "example.seed.server.protocol.avro.PeopleResponse" + `shouldBe` ( Right $ NamedType $ TN + { baseName = "PeopleResponse", + namespace = ["example", "seed", "server", "protocol", "avro"] + } + ) + it "should parse simple records" $ + parse parseSchema "" simpleRecord + `shouldBe` ( Right $ + Record + (TN "Person" []) + [TN "Person" ["org", "foo"]] + Nothing -- docs are ignored for now... + Nothing -- order is ignored for now... + [ Field "name" [] Nothing Nothing String Nothing, + Field "age" [] Nothing Nothing Int Nothing + ] + ) + it "should parse complex records" $ + parse parseSchema "" complexRecord + `shouldBe` ( Right $ + Record + (TN "TestRecord" []) + [] + Nothing -- docs are ignored for now... + Nothing -- order is ignored for now... + [ Field "name" [] Nothing (Just Ignore) String Nothing, + Field "kind" [] Nothing (Just Descending) (NamedType "Kind") Nothing, + Field "hash" [] Nothing Nothing (NamedType "MD5") Nothing, + Field "nullableHash" ["hash"] Nothing Nothing (Union $ fromList [NamedType "MD5", Null]) Nothing, + Field "arrayOfLongs" [] Nothing Nothing (Array Long) Nothing + ] + ) + describe "Parse protocols" $ do + let getPerson = + Method + "getPerson" + [Argument (NamedType "example.seed.server.protocol.avro.PeopleRequest") "request"] + (NamedType "example.seed.server.protocol.avro.PeopleResponse") + Null + False + it "should parse with imports" $ + parse parseProtocol "" (T.unlines . tail $ simpleProtocol) + `shouldBe` ( Right $ + Protocol + Nothing + "PeopleService" + [IdlImport "People.avdl"] + [] + [getPerson] + ) + it "should parse with namespace" $ + parse parseProtocol "" (T.unlines simpleProtocol) + `shouldBe` ( Right $ + Protocol + (Just (Namespace ["example", "seed", "server", "protocol", "avro"])) + "PeopleService" + [IdlImport "People.avdl"] + [] + [getPerson] + ) + describe "Parse services" $ do + it "should parse simple messages" $ + parse parseMethod "" "string hello(string greeting);" + `shouldBe` (Right $ Method "hello" [Argument String "greeting"] String Null False) + it "should parse more simple messages" $ + parse parseMethod "" "bytes echoBytes(bytes data);" + `shouldBe` (Right $ Method "echoBytes" [Argument Bytes "data"] Bytes Null False) + it "should parse custom type messages" $ + let custom = NamedType "TestRecord" in + parse parseMethod "" "TestRecord echo(TestRecord `record`);" + `shouldBe` (Right $ Method "echo" [Argument custom "record"] custom Null False) + it "should parse multiple argument messages" $ + parse parseMethod "" "int add(int arg1, int arg2);" + `shouldBe` (Right $ Method "add" [Argument Int "arg1", Argument Int "arg2"] Int Null False) + it "should parse escaped and throwing messages" $ + parse parseMethod "" "void `error`() throws TestError;" + `shouldBe` (Right $ Method "error" [] Null (NamedType $ TN "TestError" []) False) + it "should parse oneway messages" $ + parse parseMethod "" "void ping() oneway;" + `shouldBe` (Right $ Method "ping" [] Null Null True)