From 7424454acef153176a14c3f95e925d5edd6b2e87 Mon Sep 17 00:00:00 2001
From: David Lazar <lazar6@illinois.edu>
Date: Fri, 29 Mar 2013 10:22:11 -0700
Subject: Haddock reader: improved error reporting.

---
 src/Text/Pandoc/Readers/Haddock.hs      | 6 ++++--
 src/Text/Pandoc/Readers/Haddock/Lex.x   | 3 ++-
 src/Text/Pandoc/Readers/Haddock/Parse.y | 6 +++---
 3 files changed, 9 insertions(+), 6 deletions(-)

(limited to 'src/Text')

diff --git a/src/Text/Pandoc/Readers/Haddock.hs b/src/Text/Pandoc/Readers/Haddock.hs
index 49154b0ca..081ec7b5e 100644
--- a/src/Text/Pandoc/Readers/Haddock.hs
+++ b/src/Text/Pandoc/Readers/Haddock.hs
@@ -24,8 +24,10 @@ readHaddock :: ReaderOptions -- ^ Reader options
 readHaddock _ s = Pandoc (Meta [] [] []) blocks
   where
     blocks = case parseParas (tokenise s (0,0)) of
-        Nothing -> []
-        Just x -> mergeLists (toList x)
+        Left [] -> error "parse failure"
+        Left (tok:_) -> error $ "parse failure " ++ pos (tokenPos tok)
+          where pos (l, c) = "(line " ++ show l ++ ", column " ++ show c ++ ")"
+        Right x -> mergeLists (toList x)
 
 -- similar to 'docAppend' in Haddock.Doc
 mergeLists :: [Block] -> [Block]
diff --git a/src/Text/Pandoc/Readers/Haddock/Lex.x b/src/Text/Pandoc/Readers/Haddock/Lex.x
index 902ac84c0..9d686c885 100644
--- a/src/Text/Pandoc/Readers/Haddock/Lex.x
+++ b/src/Text/Pandoc/Readers/Haddock/Lex.x
@@ -19,7 +19,8 @@
 module Text.Pandoc.Readers.Haddock.Lex (
     Token(..),
     LToken,
-    tokenise
+    tokenise,
+    tokenPos
  ) where
 
 import Data.Char
diff --git a/src/Text/Pandoc/Readers/Haddock/Parse.y b/src/Text/Pandoc/Readers/Haddock/Parse.y
index 26d7c287d..c45e09113 100644
--- a/src/Text/Pandoc/Readers/Haddock/Parse.y
+++ b/src/Text/Pandoc/Readers/Haddock/Parse.y
@@ -46,7 +46,7 @@ import Data.Sequence (viewr, ViewR(..))
     PARA    { (TokPara,_) }
     STRING  { (TokString $$,_) }
 
-%monad { Maybe }
+%monad { Either [LToken] }
 
 %name parseParas doc
 %name parseString seq
@@ -126,8 +126,8 @@ strings :: { String }
     | STRING strings    { $1 ++ $2 }
 
 {
-happyError :: [LToken] -> Maybe a
-happyError toks = Nothing
+happyError :: [LToken] -> Either [LToken] a
+happyError toks = Left toks
 
 para' :: Inlines -> Blocks
 para' (Many ils) =
-- 
cgit v1.2.3


From d2704c2af19ef1950a2c80909b1a513769acbe1b Mon Sep 17 00:00:00 2001
From: David Lazar <lazar6@illinois.edu>
Date: Fri, 29 Mar 2013 10:35:06 -0700
Subject: Haddock reader: add the "haskell" attribute to code blocks so they
 are highlighted. We reasonably assume that code blocks in Haddock markup wont
 be used for anything but Haskell code.

---
 src/Text/Pandoc/Readers/Haddock/Parse.y | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

(limited to 'src/Text')

diff --git a/src/Text/Pandoc/Readers/Haddock/Parse.y b/src/Text/Pandoc/Readers/Haddock/Parse.y
index c45e09113..e34f9d95e 100644
--- a/src/Text/Pandoc/Readers/Haddock/Parse.y
+++ b/src/Text/Pandoc/Readers/Haddock/Parse.y
@@ -76,7 +76,7 @@ defpara :: { (Inlines, [Blocks]) }
 
 para :: { Blocks }
     : seq               { para' $1 }
-    | codepara          { codeBlock $1 }
+    | codepara          { codeBlockWith ([], ["haskell"], []) $1 }
     | property          { $1 }
     | examples          { $1 }
 
@@ -118,8 +118,8 @@ elem1 :: { Inlines }
     | URL               { makeHyperlink $1 }
     | PIC               { image $1 $1 mempty }
     | ANAME             { mempty } -- TODO
-    | IDENT             { code $1 }
-    | DQUO strings DQUO { code $2 }
+    | IDENT             { codeWith ([], ["haskell"], []) $1 }
+    | DQUO strings DQUO { codeWith ([], ["haskell"], []) $2 }
 
 strings :: { String }
     : STRING            { $1 }
@@ -162,7 +162,7 @@ makeProperty s = case strip s of
 -- | Create an 'Example', stripping superfluous characters as appropriate
 makeExample :: String -> String -> [String] -> Blocks
 makeExample prompt expression result =
-    para $ codeWith ([], ["expr"], []) (strip expression ++ "\n")
+    para $ codeWith ([], ["haskell", "expr"], []) (strip expression ++ "\n")
         <> codeWith ([], ["result"], []) (unlines result')
   where
     -- 1. drop trailing whitespace from the prompt, remember the prefix
-- 
cgit v1.2.3


From 86636677881ab7eace0fd9b2993cfdb01adb7b18 Mon Sep 17 00:00:00 2001
From: David Lazar <lazar6@illinois.edu>
Date: Fri, 29 Mar 2013 11:43:49 -0700
Subject: Haddock reader: make clearer which production the comment refers to.

---
 src/Text/Pandoc/Readers/Haddock/Lex.x | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

(limited to 'src/Text')

diff --git a/src/Text/Pandoc/Readers/Haddock/Lex.x b/src/Text/Pandoc/Readers/Haddock/Lex.x
index 9d686c885..a84204e83 100644
--- a/src/Text/Pandoc/Readers/Haddock/Lex.x
+++ b/src/Text/Pandoc/Readers/Haddock/Lex.x
@@ -55,14 +55,15 @@ $ident    = [$alphanum \'\_\.\!\#\$\%\&\*\+\/\<\=\>\?\@\\\\\^\|\-\~\:]
 <line> {
   $ws* \>               { begin birdtrack }
   $ws* \>\>\>           { strtoken TokExamplePrompt `andBegin` exampleexpr }
-  $ws* \n               { token TokPara `andBegin` para }
 
-  -- Here, we really want to be able to say
+  $ws* \n               { token TokPara `andBegin` para }
+  -- ^ Here, we really want to be able to say
   -- $ws* (\n | <eof>)  { token TokPara `andBegin` para}
   -- because otherwise a trailing line of whitespace will result in
   -- a spurious TokString at the end of a docstring.  We don't have <eof>,
   -- though (NOW I realise what it was for :-).  To get around this, we always
   -- append \n to the end of a docstring.
+
   ()                    { begin string }
 }
 
-- 
cgit v1.2.3