aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r--src/Text/Pandoc/Highlighting.hs19
-rw-r--r--src/Text/Pandoc/Logging.hs6
-rw-r--r--src/Text/Pandoc/Writers/Docx.hs10
-rw-r--r--src/Text/Pandoc/Writers/HTML.hs21
-rw-r--r--src/Text/Pandoc/Writers/LaTeX.hs13
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-24 14:45:09 +0000