db37b71 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Highlighting: highlighting now returns an Either rather than Maybe.

db37b71John MacFarlane10 years ago

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

compare with master

unifiedsplit

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

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

80 -> Attr -- ^ Attributes of the CodeBlock

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

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

82+ -> Either String a

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

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

85 fmtOpts = defaultFormatOpts{

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

92 rawCode' = T.pack rawCode

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

94 Nothing

95− | numberLines fmtOpts -> Just

95+ | numberLines fmtOpts -> Right

96 $ formatter fmtOpts{ codeClasses = [],

97 containerClasses = classes' }

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

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

99+ $ T.lines rawCode'

99− | otherwise -> Nothing

100+ | otherwise -> Left ""

100 Just syntax ->

101 Just syntax ->

101− case tokenize tokenizeOpts syntax rawCode' of

102− Right slines -> Just $

103− formatter fmtOpts{ codeClasses =

102+ (formatter fmtOpts{ codeClasses =

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

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

105− containerClasses = classes' } slines

104+ containerClasses = classes' }) <$>

106− Left _ -> Nothing

105+ tokenize tokenizeOpts syntax rawCode'

107

106

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

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

109-- with skylighting language names:

108-- with skylighting language names:

src/Text/Pandoc/Logging.hs+6

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

80 | Fetching String

81 | NoTitleElement String

82 | NoLangSpecified

83+ | CouldNotHighlight String

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

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

85instance ToJSON LogMessage where

86instance ToJSON LogMessage where

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

164 NoTitleElement fallback ->

165 NoTitleElement fallback ->

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

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

166 NoLangSpecified -> []

167 NoLangSpecified -> []

168+ CouldNotHighlight msg ->

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

167

170

168showPos :: SourcePos -> String

171showPos :: SourcePos -> String

169showPos pos = sn ++ "line " ++

172showPos pos = sn ++ "line " ++

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

233 NoLangSpecified ->

236 NoLangSpecified ->

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

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

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

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

239+ CouldNotHighlight msg ->

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

236

241

237messageVerbosity:: LogMessage -> Verbosity

242messageVerbosity:: LogMessage -> Verbosity

238messageVerbosity msg =

243messageVerbosity msg =

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

259 Fetching{} -> INFO

264 Fetching{} -> INFO

260 NoTitleElement{} -> WARNING

265 NoTitleElement{} -> WARNING

261 NoLangSpecified -> INFO

266 NoLangSpecified -> INFO

267+ CouldNotHighlight{} -> WARNING

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

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

1156 [ rCustomStyle (show toktype) ]

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

1158 withTextProp (rCustomStyle "VerbatimChar")

1159+ $ if isNothing (writerHighlightStyle opts)

1160+ then unhighlighted

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

1161+ else case highlight formatOpenXML attrs str of

1160− Just h -> return h

1162+ Right h -> return h

1163+ Left msg -> do

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

1161− Nothing -> unhighlighted

1165+ unhighlighted

1162inlineToOpenXML' opts (Note bs) = do

1166inlineToOpenXML' opts (Note bs) = do

1163 notes <- gets stFootnotes

1167 notes <- gets stFootnotes

1164 notenum <- (lift . lift) getUniqueId

1168 notenum <- (lift . lift) getUniqueId

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

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

644 hlCode = if isJust (writerHighlightStyle opts)

645 then highlight formatHtmlBlock

646 (id',classes',keyvals) adjCode

647− else Nothing

647+ else Left ""

648 case hlCode of

649+ Left msg -> do

650+ unless (null msg) $

651+ report $ CouldNotHighlight msg

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

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

650 $ H.pre $ H.code $ toHtml adjCode

653 $ H.pre $ H.code $ toHtml adjCode

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

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

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

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

653blockToHtml opts (BlockQuote blocks) = do

656blockToHtml opts (BlockQuote blocks) = do

654 -- in S5, treat list in blockquote specially

657 -- in S5, treat list in blockquote specially

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

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

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

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

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

874 (Code attr str) -> case hlCode of

877 (Code attr str) -> case hlCode of

875− Nothing -> return

878+ Left msg -> do

879+ unless (null msg) $

880+ report $ CouldNotHighlight msg

876− $ addAttrs opts attr

881+ return $ addAttrs opts attr

877− $ H.code $ strToHtml str

882+ $ H.code $ strToHtml str

878− Just h -> do

883+ Right h -> do

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

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

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

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

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

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

882 hlCode = if isJust (writerHighlightStyle opts)

887 hlCode = if isJust (writerHighlightStyle opts)

883 then highlight formatHtmlInline

888 then highlight formatHtmlInline

884 attr str

889 attr str

885− else Nothing

890+ else Left ""

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

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

887 return . H.del

892 return . H.del

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

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

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

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

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

541 let highlightedCodeBlock =

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

543+ Left msg -> do

544+ unless (null msg) $

545+ report $ CouldNotHighlight msg

543− Nothing -> rawCodeBlock

546+ rawCodeBlock

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

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

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

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

546 case () of

549 case () of

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

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

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

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

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

959 highlightCode = do

962 highlightCode = do

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

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

964+ Left msg -> do

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

961− Nothing -> rawCode

966+ rawCode

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

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

963 return (text (T.unpack h))

968 return (text (T.unpack h))

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

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

965 $ stringToLaTeX CodeString str

970 $ stringToLaTeX CodeString str