language-avro 0.1.3.1 → 0.1.4.0

raw patch · 5 files changed

+144/−104 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• README.md +4/−7
• language-avro.cabal +3/−3
• src/Language/Avro/Parser.hs +24/−22
• src/Language/Avro/Types.hs +27/−27
• test/Spec.hs +86/−45

@@ -1,9 +1,10 @@ # 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)+[![Actions Status](https://github.com/higherkindness/avro-parser-haskell/workflows/Haskell%20CI/badge.svg)](https://github.com/higherkindness/avro-parser-haskell/actions) [![Hackage](https://img.shields.io/hackage/v/language-avro.svg?logo=haskell)](https://hackage.haskell.org/package/language-avro) [![Stackage Nightly](http://stackage.org/package/language-avro/badge/nightly)](http://stackage.org/nightly/package/language-avro) [![Stackage LTS](http://stackage.org/package/language-avro/badge/lts)](http://stackage.org/lts/package/language-avro)+![Hackage-Deps](https://img.shields.io/hackage-deps/v/language-avro?style=flat) [![ormolu](https://img.shields.io/badge/styled%20with-ormolu-blueviolet)](https://github.com/tweag/ormolu)  Language definition and parser for AVRO (`.avdl`) files.@@ -12,21 +13,17 @@  ```haskell #!/usr/bin/env stack--- stack --resolver lts-15.0 script --package language-avro,megaparsec,pretty-simple+-- stack --resolver lts-18.19 script --package language-avro,pretty-simple  module Main where  import Language.Avro.Parser (readWithImports)-import Text.Megaparsec.Error (ShowErrorComponent (..), errorBundlePretty) import Text.Pretty.Simple (pPrint) -instance ShowErrorComponent Char where-  showErrorComponent = show- main :: IO () main =   readWithImports "test" "PeopleService.avdl"-    >>= either (putStrLn . errorBundlePretty) pPrint+    >>= either putStrLn pPrint -- λ> -- Protocol --   { ns = Just

@@ -1,5 +1,5 @@ name:               language-avro-version:            0.1.3.1+version:            0.1.4.0 synopsis:           Language definition and parser for AVRO files. description:   Parser for the AVRO language specification, see README.md for more details.@@ -8,8 +8,8 @@ license:            Apache-2.0 license-file:       LICENSE author:             Flavio Corpa-maintainer:         flavio.corpa@47deg.com-copyright:          Copyright © 2019-2020 <http://47deg.com 47 Degrees>+maintainer:         flaviocorpa@gmail.com+copyright:          Copyright © 2019-2022 <http://47deg.com 47 Degrees> category:           Network build-type:         Simple cabal-version:      >=1.10

@@ -33,6 +33,7 @@ import Text.Megaparsec import Text.Megaparsec.Char import qualified Text.Megaparsec.Char.Lexer as L+import Text.Megaparsec.Error (errorBundlePretty)  spaces :: MonadParsec Char T.Text m => m () spaces = L.space space1 (L.skipLineComment "//") (L.skipBlockComment "/*" "*/")@@ -105,9 +106,9 @@ parseImport :: MonadParsec Char T.Text m => m ImportType parseImport =   reserved "import"-    *> ( impHelper IdlImport "idl"-           <|> impHelper ProtocolImport "protocol"-           <|> impHelper SchemaImport "schema"+    *> ( (impHelper IdlImport "idl" <?> "Import of type IDL")+           <|> (impHelper ProtocolImport "protocol" <?> "Import of type protocol")+           <|> (impHelper SchemaImport "schema" <?> "Import of type schema")        )   where     impHelper :: MonadParsec Char T.Text m => (T.Text -> a) -> T.Text -> m a@@ -149,7 +150,7 @@ -- | Parses order annotations into the 'Order' structure. parseOrder :: MonadParsec Char T.Text m => m Order parseOrder =-  symbol "@" *> reserved "order"+  symbol "@" *> (reserved "order" <?> "Order can be ascending/descending/ignore")     *> parens       ( Ascending <$ string "\"ascending\""           <|> Descending <$ string "\"descending\""@@ -164,11 +165,12 @@ parseField :: MonadParsec Char T.Text m => m Field parseField =   (\o t a n -> Field n a Nothing o t Nothing) -- FIXME: docs are not supported yet.-    <$> optional parseOrder-    <*> parseSchema-    <*> option [] parseFieldAlias-    <*> identifier-    <* (symbol ";" <|> symbol "=" <* manyTill anySingle (symbol ";")) -- FIXME: default values are not supported yet.+    <$> optional (parseOrder <?> "Order of the field in the schema")+    <*> (parseSchema <?> "Type of the field in the schema")+    <*> (option [] parseFieldAlias <?> "Aliases of the field in the schema")+    <*> (identifier <?> "Name of the field in the schema")+    -- FIXME: default values are not supported yet.+    <* ((symbol ";" <|> symbol "=" <* manyTill anySingle (symbol ";")) <?> "Semicolon or equals sign")  -- | Parses arguments of methods into the 'Argument' structure. parseArgument :: MonadParsec Char T.Text m => m Argument@@ -178,12 +180,12 @@ 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 ";"+    <$> (parseSchema <?> "Result type of the method")+    <*> (identifier <?> "Name of the method")+    <*> (parens (option [] (lexeme $ sepBy1 parseArgument $ symbol ",")) <?> "Arguments of the method")+    <*> (option Null (reserved "throws" *> parseSchema) <?> "If the method throws an exception")+    <*> (option False (True <$ reserved "oneway") <?> "If the method is `oneway` or not")+    <* (symbol ";" <?> "Should end with a semicolon")  -- | Parses the special type @decimal@ into it's corresponding 'Decimal' structure. parseDecimal :: MonadParsec Char T.Text m => m Decimal@@ -224,14 +226,14 @@       ( flip Enum           <$> option [] parseAliases <* reserved "enum"           <*> parseTypeName-          <*> pure Nothing -- docs are ignored for now...+          <*> pure Nothing -- FIXME: docs are ignored for now...           <*> parseVector identifier       )     <|> try       ( flip Record           <$> option [] parseAliases <* (reserved "record" <|> reserved "error")           <*> parseTypeName-          <*> pure Nothing -- docs are ignored for now...+          <*> pure Nothing -- FIXME: docs are ignored for now...           <*> option [] (braces . many $ parseField)       )     <|> NamedType . toNamedType <$> lexeme (sepBy1 identifier $ char '.')@@ -249,11 +251,11 @@   FilePath ->   -- | initial file   FilePath ->-  IO (Either (ParseErrorBundle T.Text Char) Protocol)+  IO (Either T.Text Protocol) readWithImports baseDir initialFile = do   initial <- parseFile parseProtocol (baseDir </> initialFile)   case initial of-    Left e -> pure $ Left e+    Left err -> pure $ Left $ T.pack (errorBundlePretty err)     Right p -> do       possibleImps <- traverse (oneOfTwo . T.unpack) [i | IdlImport i <- S.toList $ imports p]       (lefts, rights) <- partitionEithers <$> traverse (>>>= readWithImports baseDir) possibleImps@@ -261,7 +263,7 @@         e : _ -> Left e         _ -> Right $ S.foldl' (<>) p (S.fromList rights)   where-    oneOfTwo :: FilePath -> IO (Either (ParseErrorBundle T.Text Char) FilePath)+    oneOfTwo :: FilePath -> IO (Either T.Text FilePath)     oneOfTwo p = do       let dir = takeDirectory initialFile           path1 = baseDir </> p@@ -270,7 +272,7 @@       pure $ case options of         (True, False) -> Right p         (False, True) -> Right $ dir </> p-        (False, False) -> runParser (fail $ "Import not found: " ++ p) initialFile ""+        (False, False) -> Left $ T.pack ("Import not found: " ++ p)         (True, True)           | normalise dir == "." -> Right p-          | otherwise -> runParser (fail $ "Duplicate files found: " ++ p) initialFile ""+          | otherwise -> Left $ T.pack ("Duplicate files found: " ++ p)

@@ -7,20 +7,23 @@ where  import Data.Avro-import Data.Set+import Data.Set (Set) import qualified Data.Text as T+import Text.Megaparsec.Error (ShowErrorComponent (..))  -- | Whole definition of protocol.-data Protocol-  = Protocol-      { ns :: Maybe Namespace,-        pname :: T.Text,-        imports :: Set ImportType,-        types :: Set Schema,-        messages :: Set Method-      }+data Protocol = Protocol+  { ns :: Maybe Namespace,+    pname :: T.Text,+    imports :: Set ImportType,+    types :: Set Schema,+    messages :: Set Method+  }   deriving (Eq, Show, Ord) +instance ShowErrorComponent Char where+  showErrorComponent = show+ instance Semigroup Protocol where   p1 <> p2 =     Protocol@@ -38,11 +41,10 @@ type Aliases = [TypeName]  -- | Type for special annotations.-data Annotation-  = Annotation-      { ann :: T.Text,-        abody :: T.Text-      }+data Annotation = Annotation+  { ann :: T.Text,+    abody :: T.Text+  }   deriving (Eq, Show)  -- | Type for the possible import types in 'Protocol'.@@ -53,20 +55,18 @@   deriving (Eq, Show, Ord)  -- | Helper type for the arguments of 'Method'.-data Argument-  = Argument-      { atype :: Schema,-        aname :: T.Text-      }+data Argument = Argument+  { atype :: Schema,+    aname :: T.Text+  }   deriving (Eq, Show, Ord)  -- | Type for methods/messages that belong to a protocol.-data Method-  = Method-      { mname :: T.Text,-        args :: [Argument],-        result :: Schema,-        throws :: Schema,-        oneway :: Bool-      }+data Method = Method+  { mname :: T.Text,+    args :: [Argument],+    result :: Schema,+    throws :: Schema,+    oneway :: Bool+  }   deriving (Eq, Show, Ord)

@@ -1,10 +1,7 @@ {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} -module Main-  ( main,-  )-where+module Main (main) where  import Data.Avro import qualified Data.Text as T@@ -16,54 +13,66 @@ import Text.Megaparsec (parse) import Text.Megaparsec.Error -instance ShowErrorComponent Char where-  showErrorComponent = show- enumTest :: T.Text enumTest =-  T.unlines-    [ "@aliases([\"org.foo.KindOf\"])",-      "enum Kind {",-      "FOO,",-      "BAR, // the bar enum value",-      "BAZ",-      "}"-    ]+  "@aliases([\"org.foo.KindOf\"])\n\+  \enum Kind {\n\+  \  FOO,\n\+  \  BAR, // the bar enum value\n\+  \  BAZ\n\+  \}" -simpleProtocol :: [T.Text]+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);",-    "}"-  ]+  "@namespace(\"example.seed.server.protocol.avro\")\n\+  \protocol PeopleService {\n\+  \import idl \"People.avdl\";\n\+  \example.seed.server.protocol.avro.PeopleResponse getPerson(example.seed.server.protocol.avro.PeopleRequest request);\n\+  \}"  simpleRecord :: T.Text simpleRecord =-  T.unlines-    [ "@aliases([\"org.foo.Person\"])",-      "record Person {",-      "string name;",-      "int age;",-      "date birthday;",-      "}"-    ]+  "@aliases([\"org.foo.Person\"])\n\+  \record Person {\n\+  \  string name;\n\+  \  int age;\n\+  \  date birthday;\n\+  \}"  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;",-      "}"-    ]+  "record TestRecord {\n\+  \  @order(\"ignore\")\n\+  \  string name;\n\+  \  @order(\"descending\")\n\+  \  Kind kind;\n\+  \  MD5 hash;\n\+  \  union { MD5, null} @aliases([\"hash\"]) nullableHash;\n\+  \  array<long> arrayOfLongs;\n\+  \}" +avdlWithTypo :: T.Text+avdlWithTypo =+  "@namespace(\"integrationtest\") \n\+  \protocol WeatherService { \n\+  \  record GetForecastRequest { \n\+  \    // NOTE: missing semicolon\n\+  \    string city\n\+  \    int days_required;\n\+  \  }\n\+  \  enum Weather {\n\+  \    SUNNY,\n\+  \    CLOUDY,\n\+  \    RAINY\n\+  \  }\n\+  \  record GetForecastResponse {\n\+  \    string last_updated;\n\+  \    array<Weather> daily_forecasts;\n\+  \  }\n\+  \  void ping();\n\+  \  GetForecastResponse getForecast(GetForecastRequest req);\n\+  \}"+ main :: IO () main = hspec $ do   describe "Parse annotations" $ do@@ -183,17 +192,49 @@             (NamedType "example.seed.server.protocol.avro.PeopleResponse")             Null             False-    it "should parse with imports" $-      parse parseProtocol "" (T.unlines . tail $ simpleProtocol)-        `shouldParse` Protocol Nothing "PeopleService" [IdlImport "People.avdl"] [] [getPerson]     it "should parse with namespace" $-      parse parseProtocol "" (T.unlines simpleProtocol)+      parse parseProtocol "" simpleProtocol         `shouldParse` Protocol           (Just (Namespace ["example", "seed", "server", "protocol", "avro"]))           "PeopleService"           [IdlImport "People.avdl"]           []           [getPerson]+    it "should not parse protocols with typos" $+      parse parseProtocol "" avdlWithTypo+        `shouldFailWith` err+          86+          ( utok '{'+              <> etoks "array"+              <> etoks "boolean"+              <> etoks "bytes"+              <> etoks "date"+              <> etoks "decimal"+              <> etoks "double"+              <> etoks "enum"+              <> etoks "error"+              <> etoks "fixed"+              <> etoks "float"+              <> etoks "import"+              <> etoks "int"+              <> etoks "long"+              <> etoks "map"+              <> etoks "null"+              <> etoks "record"+              <> etoks "string"+              <> etoks "time_ms"+              <> etoks "timestamp_ms"+              <> etoks "union"+              <> etoks "uuid"+              <> etoks "void"+              <> etok '.'+              <> etok ';' -- This is the actual one missing 🤔+              <> etok '@'+              <> etok '`'+              <> etok '}'+              <> elabel "Result type of the method"+              <> elabel "letter"+          )   describe "Parse services" $ do     it "should parse simple messages" $       parse parseMethod "" "string hello(string greeting);"