language-avro (empty) → 0.1.0.0
raw patch · 7 files changed
+893/−0 lines, 7 filesdep +avrodep +basedep +filepathsetup-changed
Dependencies added: avro, base, filepath, hspec, language-avro, megaparsec, text, vector
Files
- LICENSE +202/−0
- README.md +127/−0
- Setup.hs +2/−0
- language-avro.cabal +45/−0
- src/Language/Avro/Parser.hs +237/−0
- src/Language/Avro/Types.hs +69/−0
- test/Spec.hs +211/−0
+ LICENSE view
@@ -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.
+ README.md view
@@ -0,0 +1,127 @@+# avro-parser-haskell++[](https://github.com/kutyel/avro-parser-haskell/actions)+[](https://hackage.haskell.org/package/language-avro)+[](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"`!
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ language-avro.cabal view
@@ -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 <http://47deg.com 47 Degrees>+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
+ src/Language/Avro/Parser.hs view
@@ -0,0 +1,237 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Parser for AVRO (@.avdl@) files, as defined in <http://avro.apache.org/docs/1.8.2/spec.html>.+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
+ src/Language/Avro/Types.hs view
@@ -0,0 +1,69 @@+-- | Language definition for AVRO (@.avdl@) files,+-- as defined in <http://avro.apache.org/docs/1.8.2/spec.html>.+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)
+ test/Spec.hs view
@@ -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<long> 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<int>" `shouldBe` (Right $ Array Int)+ parse parseSchema "" "array<array<string>>"+ `shouldBe` (Right $ Array $ Array String)+ it "should parse map" $ do+ parse parseSchema "" "map<int>" `shouldBe` (Right $ Map Int)+ parse parseSchema "" "map<map<string>>"+ `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)