Implement v2 parser

.github/workflows/ci.yml

@@ -59,8 +59,16 @@ jobs:
           restore-keys: |
                ${{ runner.os }}-cabal-cache-${{ env.CURR_MONTH }}-${{ matrix.ghc_version }}-
       -
-        name: Build + Test
-        run: cabal test
+        name: Build
+        run: cabal build
+      -
+        name: Install dotslash
+        run: >
+          curl -fsSL https://github.com/facebook/dotslash/releases/latest/download/dotslash-ubuntu-22.04.$(uname -m).tar.gz
+          | tar xzf - -C /usr/local/bin/
+      -
+        name: Test
+        run: cabal exec cabal test
 
   lint:
     runs-on: ubuntu-latest

.gitignore

@@ -1,2 +1,3 @@
 .DS_Store
 dist-newstyle/
+cabal.project.local*

CHANGELOG.md

@@ -1,5 +1,6 @@
 ## Unreleased
 
+* Implement KDL v2 parser
 * Implement `KDL.render`, which is format-preserving
 * Improve rendering parse errors
 * Include filepath in error messages when `decodeFileWith` fails

kdl-hs.cabal

@@ -15,6 +15,8 @@ build-type: Simple
 extra-source-files:
   README.md
   CHANGELOG.md
+  test/KDL/__snapshots__/DecoderSpec.snap.md
+  test/KDL/__snapshots__/ParserSpec.snap.md
 
 source-repository head
   type: git
@@ -34,14 +36,9 @@ library
     KDL.Decoder.Monad
     KDL.Decoder.Schema
     KDL.Parser
+    KDL.Parser.Internal
     KDL.Render
     KDL.Types
-  other-modules:
-    KDL.Parser.Hustle
-    KDL.Parser.Hustle.Formatter
-    KDL.Parser.Hustle.Internal
-    KDL.Parser.Hustle.Parser
-    KDL.Parser.Hustle.Types
   build-depends:
       base < 5
     , containers
@@ -53,10 +50,25 @@ library
   default-language: GHC2021
   ghc-options: -Wall -Wcompat
 
+executable kdl-hs-test-decoder
+  main-is: test/kdl-hs-test-decoder.hs
+  build-depends:
+      base < 5
+    , aeson
+    , bytestring
+    , containers
+    , kdl-hs
+    , scientific
+    , text
+  default-language: GHC2021
+  ghc-options: -Wall -Wcompat
+
 test-suite kdl-tests
   type: exitcode-stdio-1.0
   ghc-options: -F -pgmF=skeletest-preprocessor
-  build-tool-depends: skeletest:skeletest-preprocessor
+  build-tool-depends:
+    , skeletest:skeletest-preprocessor
+    , kdl-hs:kdl-hs-test-decoder
   hs-source-dirs: test
   main-is: Main.hs
   other-modules:
@@ -65,12 +77,17 @@ test-suite kdl-tests
     KDL.Decoder.ArrowSpec
     KDL.Decoder.MonadSpec
     KDL.ParserSpec
+    KDL.TestUtils.AST
     KDL.TestUtils.Error
   build-depends:
       base
     , containers
+    , directory
     , filepath
     , kdl-hs
+    , pretty-show
+    , process
+    , scientific
     , skeletest
     , temporary
     , text

scripts/kdl-test

@@ -0,0 +1,54 @@
+#!/usr/bin/env dotslash
+{
+  "name": "kdl-test-0.2.0",
+  "platforms": {
+    "linux-x86_64": {
+      "size": 583741,
+      "hash": "sha256",
+      "digest": "1627ea50594c7c322ed5c7fb0d0063b2ac20a7a9460acc9363fa1777c92364c3",
+      "format": "tar.gz",
+      "path": "kdl-test",
+      "providers": [
+        {
+          "url": "https://github.com/brandonchinn178/kdl-test/releases/download/v0.2.0/kdl-test-0.2.0-linux-x86_64.tar.gz"
+        }
+      ]
+    },
+    "linux-aarch64": {
+      "size": 568646,
+      "hash": "sha256",
+      "digest": "f3ecbdb2225b6abc0d69a451be76eca4d095d835ee2e7830a880b4bfa051e6ee",
+      "format": "tar.gz",
+      "path": "kdl-test",
+      "providers": [
+        {
+          "url": "https://github.com/brandonchinn178/kdl-test/releases/download/v0.2.0/kdl-test-0.2.0-linux-arm64.tar.gz"
+        }
+      ]
+    },
+    "macos-x86_64": {
+      "size": 555773,
+      "hash": "sha256",
+      "digest": "2d66b5409889992554dbd9bf04c2817552b2c0416a2793204e2e4eea06bc4da4",
+      "format": "tar.gz",
+      "path": "kdl-test",
+      "providers": [
+        {
+          "url": "https://github.com/brandonchinn178/kdl-test/releases/download/v0.2.0/kdl-test-0.2.0-darwin-x86_64.tar.gz"
+        }
+      ]
+    },
+    "macos-aarch64": {
+      "size": 529715,
+      "hash": "sha256",
+      "digest": "abfcade1d1ce02810dc155b95ef0720e9c679d62cf50c7ab5400741909978eb2",
+      "format": "tar.gz",
+      "path": "kdl-test",
+      "providers": [
+        {
+          "url": "https://github.com/brandonchinn178/kdl-test/releases/download/v0.2.0/kdl-test-0.2.0-darwin-arm64.tar.gz"
+        }
+      ]
+    }
+  }
+}

src/KDL/Decoder/Internal/Error.hs

@@ -67,22 +67,22 @@ data BaseDecodeError
 renderDecodeError :: DecodeError -> Text
 renderDecodeError decodeError =
   Text.intercalate "\n"
-    . addPath decodeError.filepath
-    . map renderCtxErrors
+    . concatMap renderCtxErrors
     . groupCtxErrors
     $ decodeError.errors
  where
   -- Group errors with the same contexts together
   groupCtxErrors es = Map.toAscList $ Map.fromListWith (<>) [(ctx, [e]) | (ctx, e) <- es]
 
-  addPath = \case
-    Nothing -> id
-    Just fp -> let msg = "Failed to decode " <> Text.pack fp <> ":" in (msg :)
+  addPath =
+    case decodeError.filepath of
+      Nothing -> id
+      Just fp -> let msg = "Failed to decode " <> Text.pack fp <> ":" in (msg :)
 
   renderCtxErrors = \case
     -- Special case parse errors, which shouldn't have a context
-    (_, [DecodeError_ParseError msg]) -> msg
-    (ctx, errs) -> Text.intercalate "\n" $ ("At: " <> renderCtxItems ctx) : renderErrors errs
+    (_, [DecodeError_ParseError msg]) -> [msg]
+    (ctx, errs) -> addPath $ ("At: " <> renderCtxItems ctx) : renderErrors errs
 
   renderCtxItems items
     | null items = "<root>"

src/KDL/Parser.hs

@@ -1,91 +1,28 @@
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
 
+{-|
+Implement the v2 parser specified at: https://kdl.dev/spec/#name-full-grammar
+-}
 module KDL.Parser (
   parse,
   parseFile,
 ) where
 
-import Data.Map qualified as Map
+import Data.Bifunctor (first)
 import Data.Text (Text)
 import Data.Text qualified as Text
 import Data.Text.IO qualified as Text
-import KDL.Parser.Hustle qualified as Hustle
-import KDL.Types (
-  Ann (..),
-  Document,
-  Entry (..),
-  Identifier (..),
-  Node (..),
-  NodeList (..),
-  Value (..),
-  ValueData (..),
-  ValueFormat (..),
- )
+import KDL.Parser.Internal (p_document)
+import KDL.Types (Document)
+import Text.Megaparsec qualified as Megaparsec
 
--- TODO: Implement our own parser that implements the v2.0.0 spec + preserves formatting and comments
 parse :: Text -> Either Text Document
-parse input =
-  case Hustle.parse Hustle.document "" input of
-    Left e -> Left . Text.strip . Text.pack . Hustle.errorBundlePretty $ e
-    Right (Hustle.Document nodes) -> Right $ fromNodes nodes
- where
-  fromNodes nodes =
-    NodeList
-      { nodes = map fromNode nodes
-      , format = Nothing
-      }
+parse = parse' ""
 
-  fromAnn identifier =
-    Ann
-      { identifier = fromIdentifier identifier
-      , format = Nothing
-      }
-
-  fromNode Hustle.Node{..} =
-    Node
-      { ann = fromAnn <$> nodeAnn
-      , name = fromIdentifier nodeName
-      , entries = map fromArgEntry nodeArgs <> map fromPropEntry (Map.toList nodeProps)
-      , children = Just $ fromNodes nodeChildren
-      , format = Nothing
-      }
-
-  fromArgEntry v =
-    Entry
-      { name = Nothing
-      , value = fromValue v
-      , format = Nothing
-      }
-
-  fromPropEntry (name, v) =
-    Entry
-      { name = Just $ fromIdentifier name
-      , value = fromValue v
-      , format = Nothing
-      }
-
-  fromValue Hustle.Value{..} =
-    Value
-      { ann = fromAnn <$> valueAnn
-      , data_ =
-          case valueExp of
-            Hustle.StringValue s -> Text s
-            Hustle.IntegerValue x -> Number (fromInteger x)
-            Hustle.SciValue x -> Number x
-            Hustle.BooleanValue x -> Bool x
-            Hustle.NullValue -> Null
-      , format =
-          case valueExp of
-            Hustle.IntegerValue x -> Just ValueFormat{repr = Text.pack $ show x}
-            _ -> Nothing
-      }
-
-  fromIdentifier (Hustle.Identifier s) =
-    Identifier
-      { value = s
-      , format = Nothing
-      }
+parse' :: FilePath -> Text -> Either Text Document
+parse' fp input =
+  first (Text.strip . Text.pack . Megaparsec.errorBundlePretty) $
+    Megaparsec.parse p_document fp input
 
 parseFile :: FilePath -> IO (Either Text Document)
-parseFile = fmap parse . Text.readFile
+parseFile fp = parse' fp <$> Text.readFile fp