From e973bbbbc8330ded96e2ed7aec678bd90f014ae5 Mon Sep 17 00:00:00 2001
From: John MacFarlane <fiddlosopher@gmail.com>
Date: Tue, 2 Jul 2013 09:23:43 -0700
Subject: Markdown reader: Better error messages for yaml headers.

---
 src/Text/Pandoc/Parsing.hs          |  2 ++
 src/Text/Pandoc/Readers/Markdown.hs | 23 ++++++++++++++++++-----
 2 files changed, 20 insertions(+), 5 deletions(-)

(limited to 'src/Text')

diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs
index fce6f2248..0913d8c6c 100644
--- a/src/Text/Pandoc/Parsing.hs
+++ b/src/Text/Pandoc/Parsing.hs
@@ -141,6 +141,8 @@ module Text.Pandoc.Parsing ( (>>~),
                              setPosition,
                              sourceColumn,
                              sourceLine,
+                             setSourceColumn,
+                             setSourceLine,
                              newPos,
                              token
                              )
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index d333c0cd4..06e3cfd8b 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -40,6 +40,7 @@ import Text.Pandoc.Definition
 import qualified Data.Text as T
 import Data.Text (Text)
 import qualified Data.Yaml as Yaml
+import Data.Yaml (ParseException(..), YamlException(..), YamlMark(..))
 import qualified Data.HashMap.Strict as H
 import qualified Text.Pandoc.Builder as B
 import qualified Text.Pandoc.UTF8 as UTF8
@@ -233,20 +234,32 @@ yamlTitleBlock = try $ do
   rawYaml <- unlines <$> manyTill anyLine stopLine
   optional blanklines
   opts <- stateOptions <$> getState
-  case Yaml.decodeEither $ UTF8.fromString rawYaml of
+  case Yaml.decodeEither' $ UTF8.fromString rawYaml of
        Right (Yaml.Object hashmap) -> return $ return $
                 H.foldrWithKey (\k v f ->
                      if ignorable k
                         then f
                         else B.setMeta (T.unpack k) (yamlToMeta opts v) . f)
                   id hashmap
-       Left errStr -> do
-                   addWarning (Just pos) $ "Could not parse YAML header: " ++
-                     errStr
-                   return $ return id
        Right _ -> do
                    addWarning (Just pos) "YAML header is not an object"
                    return $ return id
+       Left err' -> do
+                case err' of
+                   InvalidYaml (Just YamlParseException{
+                               yamlProblem = problem
+                             , yamlContext = _ctxt
+                             , yamlProblemMark = Yaml.YamlMark {
+                                   yamlLine = yline
+                                 , yamlColumn = ycol
+                             }}) ->
+                        addWarning (Just $ setSourceLine
+                           (setSourceColumn pos (sourceColumn pos + ycol))
+                           (sourceLine pos + 1 + yline))
+                           $ "Could not parse YAML header: " ++ problem
+                   _ -> addWarning (Just pos)
+                           $ "Could not parse YAML header: " ++ show err'
+                return $ return id
 
 -- ignore fields ending with _
 ignorable :: Text -> Bool
-- 
cgit v1.2.3