aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJohn MacFarlane <fiddlosopher@gmail.com>2013-07-02 09:23:43 -0700
committerJohn MacFarlane <fiddlosopher@gmail.com>2013-07-02 09:23:43 -0700
commite973bbbbc8330ded96e2ed7aec678bd90f014ae5 (patch)
treecbd8c25ca94c8989a9e41fd2ca29f408546ab1d5
parentd39f527b07fa926df4a25d7d3ce2fa10bfeaf66f (diff)
downloadpandoc-e973bbbbc8330ded96e2ed7aec678bd90f014ae5.tar.gz
Markdown reader: Better error messages for yaml headers.
-rw-r--r--pandoc.cabal2
-rw-r--r--src/Text/Pandoc/Parsing.hs2
-rw-r--r--src/Text/Pandoc/Readers/Markdown.hs23
3 files changed, 21 insertions, 6 deletions
diff --git a/pandoc.cabal b/pandoc.cabal
index d0c994613..95bf3836b 100644
--- a/pandoc.cabal
+++ b/pandoc.cabal
@@ -259,7 +259,7 @@ Library
blaze-markup >= 0.5.1 && < 0.6,
attoparsec >= 0.10 && < 0.11,
stringable >= 0.1 && < 0.2,
- yaml >= 0.8 && < 0.9,
+ yaml >= 0.8.3 && < 0.9,
vector >= 0.10 && < 0.11,
hslua >= 0.3 && < 0.4
if flag(embed_data_files)
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