From 6d4715d59d06825a07de2b04ece5b5bba0c58ffc Mon Sep 17 00:00:00 2001
From: Robert Hensing <robert@roberthensing.nl>
Date: Fri, 22 Dec 2023 00:37:48 +0100
Subject: [PATCH] Fix line and column numbers in YAML parser error message

---
 src/Data/Yaml/Frontmatter.hs | 19 ++++++++++++++++---
 test/Data/FrontmatterSpec.hs |  5 ++++-
 2 files changed, 20 insertions(+), 4 deletions(-)

diff --git a/src/Data/Yaml/Frontmatter.hs b/src/Data/Yaml/Frontmatter.hs
index c6fd2ad..854d047 100644
--- a/src/Data/Yaml/Frontmatter.hs
+++ b/src/Data/Yaml/Frontmatter.hs
@@ -3,7 +3,8 @@ module Data.Yaml.Frontmatter where
 
 import           Data.Attoparsec.ByteString
 import           Data.Frontmatter.Internal
-import           Data.Yaml                  (FromJSON, Value, decodeEither)
+import           Data.Yaml                  (FromJSON, Value, decodeEither', ParseException (InvalidYaml), YamlException (YamlParseException, yamlProblem, yamlProblemMark, yamlContext), YamlMark (yamlLine, yamlColumn))
+import           Data.Yaml.Aeson            (prettyPrintParseException)
 
 -- |
 -- Parses a YAML frontmatter or JSON frontmatter from a 'ByteString' as a
@@ -14,6 +15,18 @@ frontmatterYaml = frontmatterYaml' <?> "frontmatterYaml"
   where
     frontmatterYaml' = do
         f <- frontmatter
-        case decodeEither f of
-            Left e -> fail e
+        case decodeEither' f of
+            Left (InvalidYaml (Just (e0@YamlParseException { yamlProblem = msg, yamlContext = ctx, yamlProblemMark = pos }))) ->
+              let
+                fixedMark =
+                  -- Column and line are both incremented, so they count from 1, as is usual...
+                  pos {
+                    -- ... and an extra increment for the --- marker
+                    yamlLine = yamlLine pos + 2,
+                    yamlColumn = yamlColumn pos + 1
+                  }
+                e = InvalidYaml (Just e0 { yamlProblemMark = fixedMark })
+              in failYaml e
+            Left e -> failYaml e
             Right v -> return v
+    failYaml = fail . prettyPrintParseException
diff --git a/test/Data/FrontmatterSpec.hs b/test/Data/FrontmatterSpec.hs
index 9bb6064..91615a9 100644
--- a/test/Data/FrontmatterSpec.hs
+++ b/test/Data/FrontmatterSpec.hs
@@ -44,5 +44,8 @@ spec = do
 
         it "handles input with invalid frontmatters" $ do
             input <- ByteString.readFile "./invalid-yaml-frontmatter.md"
-            let Fail input' _ _ = parse frontmatterYaml input :: Result Value
+            let Fail input' _ctx msg = parse frontmatterYaml input :: Result Value
             input' `shouldBe` "etc etc\n"
+            -- ignoring _ctx. Does not appear useful.
+            -- A somewhat different message may be ok, but the line and column must be the same
+            msg `shouldBe` "Failed reading: YAML parse exception at line 2, column 11:\nmapping values are not allowed in this context"