From db37b71d9a12bbd9370d68a472a0553f07661aec Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Mon, 13 Mar 2017 11:38:19 +0100 Subject: 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. --- src/Text/Pandoc/Highlighting.hs | 19 +++++++++---------- src/Text/Pandoc/Logging.hs | 6 ++++++ src/Text/Pandoc/Writers/Docx.hs | 10 +++++++--- src/Text/Pandoc/Writers/HTML.hs | 21 +++++++++++++-------- src/Text/Pandoc/Writers/LaTeX.hs | 13 +++++++++---- 5 files changed, 44 insertions(+), 25 deletions(-) (limited to 'src/Text/Pandoc') 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 -- cgit v1.2.3