Implement v2 parser

Author: brandonchinn178

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

@@ -35,14 +35,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
@@ -89,6 +84,7 @@ test-suite kdl-tests
     , filepath
     , kdl-hs
     , process
+    , scientific
     , skeletest
     , temporary
     , text

src/KDL/Parser.hs

@@ -1,91 +1,23 @@
-{-# 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
-      }
-
-  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
-      }
+  first (Text.strip . Text.pack . Megaparsec.errorBundlePretty) $
+    Megaparsec.parse p_document "" input
 
 parseFile :: FilePath -> IO (Either Text Document)
 parseFile = fmap parse . Text.readFile