Highlighting: highlighting now returns an Either rather than Maybe.

This allows us to display error information returned by the
skylighting library.

Display a warning if the highlighting library throws an error.

5 files changed, 44 insertions, 25 deletions

diff --git a/src/Text/Pandoc/Highlighting.hs b/src/Text/Pandoc/Highlighting.hs
index 80e6581b7..a4732cd02 100644
--- a/src/Text/Pandoc/Highlighting.hs
+++ b/src/Text/Pandoc/Highlighting.hs
@@ -79,7 +79,7 @@ languagesByExtension ext =
 highlight :: (FormatOptions -> [SourceLine] -> a) -- ^ Formatter
           -> Attr   -- ^ Attributes of the CodeBlock
           -> String -- ^ Raw contents of the CodeBlock
-          -> Maybe a -- ^ Maybe the formatted result
+          -> Either String a
 highlight formatter (_, classes, keyvals) rawCode =
   let firstNum = fromMaybe 1 (safeRead (fromMaybe "1" $ lookup "startFrom" keyvals))
       fmtOpts = defaultFormatOpts{
@@ -92,18 +92,17 @@ highlight formatter (_, classes, keyvals) rawCode =
       rawCode' = T.pack rawCode
   in  case msum (map (\l -> lookupSyntax l defaultSyntaxMap) classes') of
             Nothing
-              | numberLines fmtOpts -> Just
+              | numberLines fmtOpts -> Right
                               $ formatter fmtOpts{ codeClasses = [],
                                                    containerClasses = classes' }
-                              $ map (\ln -> [(NormalTok, ln)]) $ T.lines rawCode'
-              | otherwise  -> Nothing
+                              $ map (\ln -> [(NormalTok, ln)])
+                              $ T.lines rawCode'
+              | otherwise  -> Left ""
             Just syntax  ->
-              case tokenize tokenizeOpts syntax rawCode' of
-                   Right slines -> Just $
-                         formatter fmtOpts{ codeClasses =
-                                               [T.toLower (sShortname syntax)],
-                                            containerClasses = classes' } slines
-                   Left _ -> Nothing
+              (formatter fmtOpts{ codeClasses =
+                                   [T.toLower (sShortname syntax)],
+                                  containerClasses = classes' }) <$>
+                tokenize tokenizeOpts syntax rawCode'
 
 -- Functions for correlating latex listings package's language names
 -- with skylighting language names:
diff --git a/src/Text/Pandoc/Logging.hs b/src/Text/Pandoc/Logging.hs
index 3d2cc2287..052f5d364 100644
--- a/src/Text/Pandoc/Logging.hs
+++ b/src/Text/Pandoc/Logging.hs
@@ -80,6 +80,7 @@ data LogMessage =
   | Fetching String
   | NoTitleElement String
   | NoLangSpecified
+  | CouldNotHighlight String
   deriving (Show, Eq, Data, Ord, Typeable, Generic)
 
 instance ToJSON LogMessage where
@@ -164,6 +165,8 @@ instance ToJSON LogMessage where
       NoTitleElement fallback ->
            ["fallback" .= Text.pack fallback]
       NoLangSpecified -> []
+      CouldNotHighlight msg ->
+           ["message" .= Text.pack msg]
 
 showPos :: SourcePos -> String
 showPos pos = sn ++ "line " ++
@@ -233,6 +236,8 @@ showLogMessage msg =
        NoLangSpecified ->
          "No value for 'lang' was specified in the metadata.\n" ++
          "It is recommended that lang be specified for this format."
+       CouldNotHighlight msg ->
+         "Could not highlight code block:\n" ++ msg
 
 messageVerbosity:: LogMessage -> Verbosity
 messageVerbosity msg =
@@ -259,3 +264,4 @@ messageVerbosity msg =
        Fetching{}                   -> INFO
        NoTitleElement{}             -> WARNING
        NoLangSpecified              -> INFO
+       CouldNotHighlight{}          -> WARNING
diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
index c182d42a3..04daf3b4b 100644
--- a/src/Text/Pandoc/Writers/Docx.hs
+++ b/src/Text/Pandoc/Writers/Docx.hs
@@ -1156,9 +1156,13 @@ inlineToOpenXML' opts (Code attrs str) = do
                                  [ rCustomStyle (show toktype) ]
                                , mknode "w:t" [("xml:space","preserve")] (T.unpack tok) ]
   withTextProp (rCustomStyle "VerbatimChar")
-    $ case writerHighlightStyle opts >> highlight formatOpenXML attrs str of
-           Just h  -> return h
-           Nothing -> unhighlighted
+    $ if isNothing (writerHighlightStyle opts)
+          then unhighlighted
+          else case highlight formatOpenXML attrs str of
+                    Right h  -> return h
+                    Left msg -> do
+                      unless (null msg) $ report $ CouldNotHighlight msg
+                      unhighlighted
 inlineToOpenXML' opts (Note bs) = do
   notes <- gets stFootnotes
   notenum <- (lift . lift) getUniqueId
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index fdf62dd56..10b782de7 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -644,11 +644,14 @@ blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do
       hlCode   = if isJust (writerHighlightStyle opts)
                     then highlight formatHtmlBlock
                             (id',classes',keyvals) adjCode
-                    else Nothing
+                    else Left ""
   case hlCode of
-         Nothing -> return $ addAttrs opts (id',classes,keyvals)
+         Left msg -> do
+           unless (null msg) $
+             report $ CouldNotHighlight msg
+           return $ addAttrs opts (id',classes,keyvals)
                            $ H.pre $ H.code $ toHtml adjCode
-         Just  h -> modify (\st -> st{ stHighlighting = True }) >>
+         Right h -> modify (\st -> st{ stHighlighting = True }) >>
                     return (addAttrs opts (id',[],keyvals) h)
 blockToHtml opts (BlockQuote blocks) = do
   -- in S5, treat list in blockquote specially
@@ -872,17 +875,19 @@ inlineToHtml opts inline = do
     (Emph lst)       -> inlineListToHtml opts lst >>= return . H.em
     (Strong lst)     -> inlineListToHtml opts lst >>= return . H.strong
     (Code attr str)  -> case hlCode of
-                             Nothing -> return
-                                        $ addAttrs opts attr
-                                        $ H.code $ strToHtml str
-                             Just  h -> do
+                             Left msg -> do
+                               unless (null msg) $
+                                 report $ CouldNotHighlight msg
+                               return $ addAttrs opts attr
+                                      $ H.code $ strToHtml str
+                             Right h -> do
                                modify $ \st -> st{ stHighlighting = True }
                                return $ addAttrs opts (id',[],keyvals) h
                         where (id',_,keyvals) = attr
                               hlCode = if isJust (writerHighlightStyle opts)
                                           then highlight formatHtmlInline
                                                    attr str
-                                          else Nothing
+                                          else Left ""
     (Strikeout lst)  -> inlineListToHtml opts lst >>=
                         return . H.del
     (SmallCaps lst)   -> inlineListToHtml opts lst >>=
diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs
index 578c7017f..7e1970d01 100644
--- a/src/Text/Pandoc/Writers/LaTeX.hs
+++ b/src/Text/Pandoc/Writers/LaTeX.hs
@@ -540,8 +540,11 @@ blockToLaTeX (CodeBlock (identifier,classes,keyvalAttr) str) = do
                  "\\end{lstlisting}") $$ cr
   let highlightedCodeBlock =
         case highlight formatLaTeXBlock ("",classes,keyvalAttr) str of
-               Nothing -> rawCodeBlock
-               Just  h -> modify (\st -> st{ stHighlighting = True }) >>
+               Left msg -> do
+                 unless (null msg) $
+                   report $ CouldNotHighlight msg
+                 rawCodeBlock
+               Right h -> modify (\st -> st{ stHighlighting = True }) >>
                           return (flush $ linkAnchor $$ text (T.unpack h))
   case () of
      _ | isEnabled Ext_literate_haskell opts && "haskell" `elem` classes &&
@@ -958,8 +961,10 @@ inlineToLaTeX (Code (_,classes,_) str) = do
            return $ text $ "\\lstinline" ++ listingsopt ++ [chr] ++ str ++ [chr]
          highlightCode = do
            case highlight formatLaTeXInline ("",classes,[]) str of
-                  Nothing -> rawCode
-                  Just  h -> modify (\st -> st{ stHighlighting = True }) >>
+                  Left msg -> do
+                    unless (null msg) $ report $ CouldNotHighlight msg
+                    rawCode
+                  Right h -> modify (\st -> st{ stHighlighting = True }) >>
                              return (text (T.unpack h))
          rawCode = liftM (text . (\s -> "\\texttt{" ++ escapeSpaces s ++ "}"))
                           $ stringToLaTeX CodeString str