db37b71 · typeable/pandoc

git.iko.soy/typeable/pandoc

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.

commitdb37b71d9a12bbd9370d68a472a0553f07661aec authorJohn MacFarlane <jgm@berkeley.edu> dateMon 13 Mar 2017, 11:38 (10 years ago) parentefcb51b

5 files changed+44−25

compare with master

unifiedsplit

src/Text/Pandoc/Highlighting.hs+9−10 src/Text/Pandoc/Logging.hs+6 src/Text/Pandoc/Writers/Docx.hs+7−3 src/Text/Pandoc/Writers/HTML.hs+13−8 src/Text/Pandoc/Writers/LaTeX.hs+9−4

src/Text/Pandoc/Highlighting.hs+9−10

@@ -79,7 +79,7 @@ languagesByExtension ext =

7979highlight :: (FormatOptions -> [SourceLine] -> a) -- ^ Formatter

8080 -> Attr -- ^ Attributes of the CodeBlock

8181 -> String -- ^ Raw contents of the CodeBlock

82− -> Maybe a -- ^ Maybe the formatted result

82+ -> Either String a

8383highlight formatter (_, classes, keyvals) rawCode =

8484 let firstNum = fromMaybe 1 (safeRead (fromMaybe "1" $ lookup "startFrom" keyvals))

8585 fmtOpts = defaultFormatOpts{

@@ -92,18 +92,17 @@ highlight formatter (_, classes, keyvals) rawCode =

9292 rawCode' = T.pack rawCode

9393 in case msum (map (\l -> lookupSyntax l defaultSyntaxMap) classes') of

9494 Nothing

95− | numberLines fmtOpts -> Just

95+ | numberLines fmtOpts -> Right

9696 $ formatter fmtOpts{ codeClasses = [],

9797 containerClasses = classes' }

98− $ map (\ln -> [(NormalTok, ln)]) $ T.lines rawCode'

99− | otherwise -> Nothing

98+ $ map (\ln -> [(NormalTok, ln)])

99+ $ T.lines rawCode'

100+ | otherwise -> Left ""

100101 Just syntax ->

101− case tokenize tokenizeOpts syntax rawCode' of

102− Right slines -> Just $

103− formatter fmtOpts{ codeClasses =

104− [T.toLower (sShortname syntax)],

105− containerClasses = classes' } slines

106− Left _ -> Nothing

102+ (formatter fmtOpts{ codeClasses =

103+ [T.toLower (sShortname syntax)],

104+ containerClasses = classes' }) <$>

105+ tokenize tokenizeOpts syntax rawCode'

107106

108107-- Functions for correlating latex listings package's language names

109108-- with skylighting language names:

src/Text/Pandoc/Logging.hs+6

@@ -80,6 +80,7 @@ data LogMessage =

8080 | Fetching String

8181 | NoTitleElement String

8282 | NoLangSpecified

83+ | CouldNotHighlight String

8384 deriving (Show, Eq, Data, Ord, Typeable, Generic)

8485

8586instance ToJSON LogMessage where

@@ -164,6 +165,8 @@ instance ToJSON LogMessage where

164165 NoTitleElement fallback ->

165166 ["fallback" .= Text.pack fallback]

166167 NoLangSpecified -> []

168+ CouldNotHighlight msg ->

169+ ["message" .= Text.pack msg]

167170

168171showPos :: SourcePos -> String

169172showPos pos = sn ++ "line " ++

@@ -233,6 +236,8 @@ showLogMessage msg =

233236 NoLangSpecified ->

234237 "No value for 'lang' was specified in the metadata.\n" ++

235238 "It is recommended that lang be specified for this format."

239+ CouldNotHighlight msg ->

240+ "Could not highlight code block:\n" ++ msg

236241

237242messageVerbosity:: LogMessage -> Verbosity

238243messageVerbosity msg =

@@ -259,3 +264,4 @@ messageVerbosity msg =

259264 Fetching{} -> INFO

260265 NoTitleElement{} -> WARNING

261266 NoLangSpecified -> INFO

267+ CouldNotHighlight{} -> WARNING

src/Text/Pandoc/Writers/Docx.hs+7−3

@@ -1156,9 +1156,13 @@ inlineToOpenXML' opts (Code attrs str) = do

11561156 [ rCustomStyle (show toktype) ]

11571157 , mknode "w:t" [("xml:space","preserve")] (T.unpack tok) ]

11581158 withTextProp (rCustomStyle "VerbatimChar")

1159− $ case writerHighlightStyle opts >> highlight formatOpenXML attrs str of

1160− Just h -> return h

1161− Nothing -> unhighlighted

1159+ $ if isNothing (writerHighlightStyle opts)

1160+ then unhighlighted

1161+ else case highlight formatOpenXML attrs str of

1162+ Right h -> return h

1163+ Left msg -> do

1164+ unless (null msg) $ report $ CouldNotHighlight msg

1165+ unhighlighted

11621166inlineToOpenXML' opts (Note bs) = do

11631167 notes <- gets stFootnotes

11641168 notenum <- (lift . lift) getUniqueId

src/Text/Pandoc/Writers/HTML.hs+13−8

@@ -644,11 +644,14 @@ blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do

644644 hlCode = if isJust (writerHighlightStyle opts)

645645 then highlight formatHtmlBlock

646646 (id',classes',keyvals) adjCode

647− else Nothing

647+ else Left ""

648648 case hlCode of

649− Nothing -> return $ addAttrs opts (id',classes,keyvals)

649+ Left msg -> do

650+ unless (null msg) $

651+ report $ CouldNotHighlight msg

652+ return $ addAttrs opts (id',classes,keyvals)

650653 $ H.pre $ H.code $ toHtml adjCode

651− Just h -> modify (\st -> st{ stHighlighting = True }) >>

654+ Right h -> modify (\st -> st{ stHighlighting = True }) >>

652655 return (addAttrs opts (id',[],keyvals) h)

653656blockToHtml opts (BlockQuote blocks) = do

654657 -- in S5, treat list in blockquote specially

@@ -872,17 +875,19 @@ inlineToHtml opts inline = do

872875 (Emph lst) -> inlineListToHtml opts lst >>= return . H.em

873876 (Strong lst) -> inlineListToHtml opts lst >>= return . H.strong

874877 (Code attr str) -> case hlCode of

875− Nothing -> return

876− $ addAttrs opts attr

877− $ H.code $ strToHtml str

878− Just h -> do

878+ Left msg -> do

879+ unless (null msg) $

880+ report $ CouldNotHighlight msg

881+ return $ addAttrs opts attr

882+ $ H.code $ strToHtml str

883+ Right h -> do

879884 modify $ \st -> st{ stHighlighting = True }

880885 return $ addAttrs opts (id',[],keyvals) h

881886 where (id',_,keyvals) = attr

882887 hlCode = if isJust (writerHighlightStyle opts)

883888 then highlight formatHtmlInline

884889 attr str

885− else Nothing

890+ else Left ""

886891 (Strikeout lst) -> inlineListToHtml opts lst >>=

887892 return . H.del

888893 (SmallCaps lst) -> inlineListToHtml opts lst >>=

src/Text/Pandoc/Writers/LaTeX.hs+9−4

@@ -540,8 +540,11 @@ blockToLaTeX (CodeBlock (identifier,classes,keyvalAttr) str) = do

540540 "\\end{lstlisting}") $$ cr

541541 let highlightedCodeBlock =

542542 case highlight formatLaTeXBlock ("",classes,keyvalAttr) str of

543− Nothing -> rawCodeBlock

544− Just h -> modify (\st -> st{ stHighlighting = True }) >>

543+ Left msg -> do

544+ unless (null msg) $

545+ report $ CouldNotHighlight msg

546+ rawCodeBlock

547+ Right h -> modify (\st -> st{ stHighlighting = True }) >>

545548 return (flush $ linkAnchor $$ text (T.unpack h))

546549 case () of

547550 _ | isEnabled Ext_literate_haskell opts && "haskell" `elem` classes &&

@@ -958,8 +961,10 @@ inlineToLaTeX (Code (_,classes,_) str) = do

958961 return $ text $ "\\lstinline" ++ listingsopt ++ [chr] ++ str ++ [chr]

959962 highlightCode = do

960963 case highlight formatLaTeXInline ("",classes,[]) str of

961− Nothing -> rawCode

962− Just h -> modify (\st -> st{ stHighlighting = True }) >>

964+ Left msg -> do

965+ unless (null msg) $ report $ CouldNotHighlight msg

966+ rawCode

967+ Right h -> modify (\st -> st{ stHighlighting = True }) >>

963968 return (text (T.unpack h))

964969 rawCode = liftM (text . (\s -> "\\texttt{" ++ escapeSpaces s ++ "}"))

965970 $ stringToLaTeX CodeString str