Parsing: Better error reporting in readWith.

- Specialize readWith to String input.
- On error have it print the line in which the error occurred,
  with a caret pointing to the column.
- This should help diagnose parsing problems in LaTeX especially.

2 files changed, 15 insertions, 5 deletions

diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs
index c5e77bec2..72ae828f0 100644
--- a/src/Text/Pandoc/Parsing.hs
+++ b/src/Text/Pandoc/Parsing.hs
@@ -764,13 +764,20 @@ gridTableFooter = blanklines
 ---
 
 -- | Parse a string with a given parser and state.
-readWith :: Parser [t] ParserState a      -- ^ parser
-         -> ParserState                    -- ^ initial state
-         -> [t]                            -- ^ input
+readWith :: Parser [Char] ParserState a       -- ^ parser
+         -> ParserState                       -- ^ initial state
+         -> [Char]                            -- ^ input
          -> a
 readWith parser state input =
     case runParser parser state "source" input of
-      Left err'    -> error $ "\nError:\n" ++ show err'
+      Left err'    ->
+        let errPos = errorPos err'
+            errLine = sourceLine errPos
+            errColumn = sourceColumn errPos
+            theline = (lines input ++ [""]) !! (errLine - 1)
+        in  error $ "\nError at " ++ show  err' ++ "\n" ++
+                theline ++ "\n" ++ replicate (errColumn - 1) ' ' ++
+                "^"
       Right result -> result
 
 -- | Parse a string with @parser@ (for testing).
diff --git a/src/Text/Pandoc/Readers/HTML.hs b/src/Text/Pandoc/Readers/HTML.hs
index 6dbba8c35..32ce46fba 100644
--- a/src/Text/Pandoc/Readers/HTML.hs
+++ b/src/Text/Pandoc/Readers/HTML.hs
@@ -59,7 +59,10 @@ readHtml :: ReaderOptions -- ^ Reader options
          -> String        -- ^ String to parse (assumes @'\n'@ line endings)
          -> Pandoc
 readHtml opts inp = Pandoc meta blocks
-  where blocks  = readWith parseBody def{ stateOptions = opts } rest
+  where blocks  = case runParser parseBody def{ stateOptions = opts }
+                    "source" rest of
+                      Left err'    -> error $ "\nError at " ++ show  err'
+                      Right result -> result
         tags    = canonicalizeTags $
                    parseTagsOptions parseOptions{ optTagPosition = True } inp
         hasHeader = any (~== TagOpen "head" []) tags