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.
This commit is contained in:
John MacFarlane
parent
efcb51bcb0
commit
db37b71d9a
5 changed files with 44 additions and 25 deletions
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 >>=
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue