Implement decimal parser 🔢

.github/workflows/haskell.yml

@@ -5,32 +5,19 @@ jobs:
     runs-on: ubuntu-latest
     strategy:
       matrix:
-        ghc: ["8.8.1"]
+        ghc: ["8.8.2"]
         cabal: ["3.0"]
     steps:
     - uses: actions/checkout@v1
     - uses: actions/setup-haskell@v1
       with:
         ghc-version: ${{ matrix.ghc }}
         cabal-version: ${{ matrix.cabal }}
-    # We cache the elements of the Cabal store separately,
-    # as the entirety of ~/.cabal can grow very large
-    # for projects with many dependencies.
-    - uses: actions/cache@v1
-      name: Cache ~/.cabal/packages
-      with:
-        path: ~/.cabal/packages
-        key: ${{ runner.os }}-${{ matrix.ghc }}-cabal-packages
     - uses: actions/cache@v1
       name: Cache ~/.cabal/store
       with:
         path: ~/.cabal/store
         key: ${{ runner.os }}-${{ matrix.ghc }}-cabal-store
-    - uses: actions/cache@v1
-      name: Cache dist-newstyle
-      with:
-        path: dist-newstyle
-        key: ${{ runner.os }}-${{ matrix.ghc }}-dist-newstyle
     - name: Install dependencies
       run: |
         cabal new-update

.gitignore

@@ -1,2 +1,3 @@
 .stack-work
 dist*
+*.yaml.lock

cabal.project

@@ -0,0 +1,6 @@
+packages: .
+
+source-repository-package
+    type: git
+    location: https://github.com/serras/avro.git
+    tag: c684139b773c296079a2941fb30ee43a52b66204

language-avro.cabal

@@ -1,5 +1,5 @@
 name:                language-avro
-version:             0.1.0.0
+version:             0.1.1.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

src/Language/Avro/Parser.hs

@@ -11,6 +11,7 @@ module Language.Avro.Parser
     -- * Intermediate parsers
     parseAliases,
     parseAnnotation,
+    parseDecimal,
     parseImport,
     parseMethod,
     parseNamespace,
@@ -183,17 +184,28 @@ parseMethod =
     <*> option False (True <$ reserved "oneway")
     <* symbol ";"
 
+-- | Parses the special type @decimal@ into it's corresponding 'Decimal' structure.
+parseDecimal :: MonadParsec Char T.Text m => m Decimal
+parseDecimal = toDec <$ reserved "decimal" <*> parens (lexeme $ sepBy1 number $ symbol ",")
+  where
+    toDec :: [Int] -> Decimal
+    toDec [precision] = Decimal (fromIntegral precision) 0
+    toDec [precision, scale] = Decimal (fromIntegral precision) (fromIntegral scale)
+    toDec _ = error "decimal types can only be specified using two numbers!"
+
 -- | 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"
+    <|> Int' <$ reserved "int"
+    <|> Long' <$ reserved "long"
+    <|> Long . Just . DecimalL <$> parseDecimal
     <|> Float <$ reserved "float"
     <|> Double <$ reserved "double"
-    <|> Bytes <$ reserved "bytes"
-    <|> String <$ reserved "string"
+    <|> Bytes' <$ reserved "bytes"
+    <|> String (Just UUID) <$ reserved "uuid"
+    <|> String' <$ reserved "string"
     <|> Array <$ reserved "array" <*> diamonds parseSchema
     <|> Map <$ reserved "map" <*> diamonds parseSchema
     <|> Union <$ reserved "union" <*> parseVector parseSchema
@@ -202,6 +214,7 @@ parseSchema =
           <$> option [] parseAliases <* reserved "fixed"
           <*> parseTypeName
           <*> parens number
+          <*> pure Nothing
       )
     <|> try
       ( flip Enum

stack-nightly.yaml

@@ -0,0 +1,7 @@
+resolver: nightly-2020-02-14
+packages:
+- .
+extra-deps:
+- HasBigDecimal-0.1.1
+- git: https://github.com/serras/avro.git
+  commit: c684139b773c296079a2941fb30ee43a52b66204

stack.yaml

@@ -1,3 +1,7 @@
-resolver: lts-14.20
+resolver: lts-14.25
 packages:
 - .
+extra-deps:
+- HasBigDecimal-0.1.1
+- git: https://github.com/serras/avro.git
+  commit: c684139b773c296079a2941fb30ee43a52b66204

test/Spec.hs

@@ -95,33 +95,38 @@ main = hspec $ do
     it "should parse boolean" $
       parse parseSchema "" "boolean" `shouldBe` Right Boolean
     it "should parse int" $
-      parse parseSchema "" "int" `shouldBe` Right Int
+      parse parseSchema "" "int" `shouldBe` Right Int'
     it "should parse long" $
-      parse parseSchema "" "long" `shouldBe` Right 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 decimal" $ do
+      parse parseDecimal "" "decimal(4)" `shouldBe` (Right $ Decimal 4 0)
+      parse parseDecimal "" "decimal(15,2)" `shouldBe` (Right $ Decimal 15 2)
     it "should parse bytes" $
-      parse parseSchema "" "bytes" `shouldBe` Right Bytes
+      parse parseSchema "" "bytes" `shouldBe` Right Bytes'
     it "should parse string" $
-      parse parseSchema "" "string" `shouldBe` Right String
+      parse parseSchema "" "string" `shouldBe` Right String'
+    it "should parse uuid" $
+      parse parseSchema "" "uuid" `shouldBe` Right (String (Just UUID))
     it "should parse array" $ do
-      parse parseSchema "" "array<int>" `shouldBe` (Right $ Array Int)
+      parse parseSchema "" "array<int>" `shouldBe` (Right $ Array Int')
       parse parseSchema "" "array<array<string>>"
-        `shouldBe` (Right $ Array $ Array String)
+        `shouldBe` (Right $ Array $ Array String')
     it "should parse map" $ do
-      parse parseSchema "" "map<int>" `shouldBe` (Right $ Map Int)
+      parse parseSchema "" "map<int>" `shouldBe` (Right $ Map Int')
       parse parseSchema "" "map<map<string>>"
-        `shouldBe` (Right $ 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])
+        `shouldBe` (Right $ Union $ fromList [String', Int', Null])
     it "should parse fixeds" $ do
       parse parseSchema "" "fixed MD5(16)"
-        `shouldBe` (Right $ Fixed (TN "MD5" []) [] 16)
+        `shouldBe` (Right $ Fixed (TN "MD5" []) [] 16 Nothing)
       parse parseSchema "" "@aliases([\"org.foo.MD5\"])\nfixed MD5(16)"
-        `shouldBe` (Right $ Fixed (TN "MD5" []) ["org.foo.MD5"] 16)
+        `shouldBe` (Right $ Fixed (TN "MD5" []) ["org.foo.MD5"] 16 Nothing)
     it "should parse enums" $ do
       parse parseSchema "" enumTest
         `shouldBe` (Right $ Enum (TN "Kind" []) [TN "KindOf" ["org", "foo"]] Nothing (fromList ["FOO", "BAR", "BAZ"]))
@@ -143,8 +148,8 @@ main = hspec $ do
                          [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
+                         [ Field "name" [] Nothing Nothing String' Nothing,
+                           Field "age" [] Nothing Nothing Int' Nothing
                          ]
                    )
     it "should parse complex records" $
@@ -155,11 +160,11 @@ main = hspec $ do
                          []
                          Nothing -- docs are ignored for now...
                          Nothing -- order is ignored for now...
-                         [ Field "name" [] Nothing (Just Ignore) String Nothing,
+                         [ 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
+                           Field "arrayOfLongs" [] Nothing Nothing (Array Long') Nothing
                          ]
                    )
   describe "Parse protocols" $ do
@@ -193,17 +198,17 @@ main = hspec $ do
   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)
+        `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)
+        `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)
+        `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)