@@ -36,7 +36,7 @@ import Text.Pandoc.Readers.TeXMath
3636import Text.Pandoc.Highlighting ( highlightHtml, defaultHighlightingCss )
3737import Numeric ( showHex )
3838import Data.Char ( ord, toLower, isAlpha )
39−import Data.List ( isPrefixOf, intersperse, find )
39+import Data.List ( isPrefixOf, intersperse )
4040import qualified Data.Set as S
4141import Control.Monad.State
4242import Text.XHtml.Transitional
@@ -53,7 +53,11 @@ defaultWriterState = WriterState {stNotes= [], stIds = [],
5353 stMath = False, stCSS = S.empty}
5454
5555-- Helpers to render HTML with the appropriate function.
56−render opts = if writerWrapText opts then renderHtml else showHtml
56+
57+render :: (HTML html) => WriterOptions -> html -> String
58+render opts = if writerWrapText opts then renderHtml else showHtml
59+
60+renderFragment :: (HTML html) => WriterOptions -> html -> String
5761renderFragment opts = if writerWrapText opts
5862 then renderHtmlFragment
5963 else showHtmlFragment
@@ -112,15 +116,15 @@ writeHtml opts (Pandoc (Meta tit authors date) blocks) =
112116 noHtml
113117 _ -> noHtml
114118 else noHtml
115− head = header $ metadata +++ math +++ css +++
119+ head' = header $ metadata +++ math +++ css +++
116120 primHtml (writerHeader opts)
117121 notes = reverse (stNotes newstate)
118122 before = primHtml $ writerIncludeBefore opts
119123 after = primHtml $ writerIncludeAfter opts
120124 thebody = before +++ titleHeader +++ toc +++ blocks' +++
121− footnoteSection opts notes +++ after
125+ footnoteSection notes +++ after
122126 in if writerStandalone opts
123− then head +++ body thebody
127+ then head' +++ body thebody
124128 else thebody
125129
126130-- | Construct table of contents from list of header blocks and identifiers.
@@ -137,11 +141,11 @@ tableOfContents opts headers ids =
137141-- | Converts an Element to a list item for a table of contents,
138142-- retrieving the appropriate identifier from state.
139143elementToListItem :: WriterOptions -> Element -> State WriterState Html
140−elementToListItem opts (Blk _) = return noHtml
144+elementToListItem _ (Blk _) = return noHtml
141145elementToListItem opts (Sec headerText subsecs) = do
142146 st <- get
143147 let ids = stIds st
144− let (id, rest) = if null ids
148+ let (id', rest) = if null ids
145149 then ("", [])
146150 else (head ids, tail ids)
147151 put $ st {stIds = rest}
@@ -150,13 +154,13 @@ elementToListItem opts (Sec headerText subsecs) = do
150154 let subList = if null subHeads
151155 then noHtml
152156 else unordList subHeads
153− return $ (anchor ! [href ("#" ++ id), identifier ("TOC-" ++ id)] $ txt) +++
157+ return $ (anchor ! [href ("#" ++ id'), identifier ("TOC-" ++ id')] $ txt) +++
154158 subList
155159
156160-- | Convert list of Note blocks to a footnote <div>.
157161-- Assumes notes are sorted.
158−footnoteSection :: WriterOptions -> [Html] -> Html
159−footnoteSection opts notes =
162+footnoteSection :: [Html] -> Html
163+footnoteSection notes =
160164 if null notes
161165 then noHtml
162166 else thediv ! [theclass "footnotes"] $ hr +++ (olist << notes)
@@ -164,37 +168,37 @@ footnoteSection opts notes =
164168
165169-- | Parse a mailto link; return Just (name, domain) or Nothing.
166170parseMailto :: String -> Maybe (String, String)
167−parseMailto ('m':'a':'i':'l':'t':'o':':':address) =
168− let (name, rest) = span (/='@') address
171+parseMailto ('m':'a':'i':'l':'t':'o':':':addr) =
172+ let (name', rest) = span (/='@') addr
169173 domain = drop 1 rest
170− in Just (name, domain)
174+ in Just (name', domain)
171175parseMailto _ = Nothing
172176
173177-- | Obfuscate a "mailto:" link using Javascript.
174178obfuscateLink :: WriterOptions -> String -> String -> Html
175−obfuscateLink opts text src =
176− let src' = map toLower src
177− in case parseMailto src' of
178− (Just (name, domain)) ->
179+obfuscateLink opts txt s =
180+ let s' = map toLower s
181+ in case parseMailto s' of
182+ (Just (name', domain)) ->
179183 let domain' = substitute "." " dot " domain
180184 at' = obfuscateChar '@'
181185 (linkText, altText) =
182− if text == drop 7 src' -- autolink
183− then ("'<code>'+e+'</code>'", name ++ " at " ++ domain')
184− else ("'" ++ text ++ "'", text ++ " (" ++ name ++ " at " ++
186+ if txt == drop 7 s' -- autolink
187+ then ("'<code>'+e+'</code>'", name' ++ " at " ++ domain')
188+ else ("'" ++ txt ++ "'", txt ++ " (" ++ name' ++ " at " ++
185189 domain' ++ ")")
186190 in if writerStrictMarkdown opts
187191 then -- need to use primHtml or &'s are escaped to & in URL
188− primHtml $ "<a href=\"" ++ (obfuscateString src')
189− ++ "\">" ++ (obfuscateString text) ++ "</a>"
192+ primHtml $ "<a href=\"" ++ (obfuscateString s')
193+ ++ "\">" ++ (obfuscateString txt) ++ "</a>"
190194 else (script ! [thetype "text/javascript"] $
191195 primHtml ("\n<!--\nh='" ++
192196 obfuscateString domain ++ "';a='" ++ at' ++ "';n='" ++
193− obfuscateString name ++ "';e=n+a+h;\n" ++
197+ obfuscateString name' ++ "';e=n+a+h;\n" ++
194198 "document.write('<a h'+'ref'+'=\"ma'+'ilto'+':'+e+'\">'+" ++
195199 linkText ++ "+'<\\/'+'a'+'>');\n// -->\n")) +++
196200 noscript (primHtml $ obfuscateString altText)
197− _ -> anchor ! [href src] $ primHtml text -- malformed email
201+ _ -> anchor ! [href s] $ primHtml txt -- malformed email
198202
199203-- | Obfuscate character as entity.
200204obfuscateChar :: Char -> String
@@ -227,6 +231,7 @@ addToCSS item = do
227231inlineListToIdentifier :: [Inline] -> String
228232inlineListToIdentifier = dropWhile (not . isAlpha) . inlineListToIdentifier'
229233
234+inlineListToIdentifier' :: [Inline] -> [Char]
230235inlineListToIdentifier' [] = ""
231236inlineListToIdentifier' (x:xs) =
232237 xAsText ++ inlineListToIdentifier' xs
@@ -266,12 +271,12 @@ uniqueIdentifiers ls =
266271
267272-- | Convert Pandoc block element to HTML.
268273blockToHtml :: WriterOptions -> Block -> State WriterState Html
269−blockToHtml opts Null = return $ noHtml
274+blockToHtml _ Null = return $ noHtml
270275blockToHtml opts (Plain lst) = inlineListToHtml opts lst
271276blockToHtml opts (Para lst) = inlineListToHtml opts lst >>= (return . paragraph)
272−blockToHtml opts (RawHtml str) = return $ primHtml str
273−blockToHtml opts (HorizontalRule) = return $ hr
274−blockToHtml opts (CodeBlock attr@(_,classes,_) rawCode) = do
277+blockToHtml _ (RawHtml str) = return $ primHtml str
278+blockToHtml _ (HorizontalRule) = return $ hr
279+blockToHtml _ (CodeBlock attr@(_,classes,_) rawCode) = do
275280 case highlightHtml attr rawCode of
276281 Left _ -> -- change leading newlines into <br /> tags, because some
277282 -- browsers ignore leading newlines in pre blocks
@@ -294,22 +299,22 @@ blockToHtml opts (BlockQuote blocks) =
294299 [OrderedList attribs lst] ->
295300 blockToHtml (opts {writerIncremental = inc})
296301 (OrderedList attribs lst)
297− otherwise -> blockListToHtml opts blocks >>=
302+ _ -> blockListToHtml opts blocks >>=
298303 (return . blockquote)
299304 else blockListToHtml opts blocks >>= (return . blockquote)
300305blockToHtml opts (Header level lst) = do
301306 contents <- inlineListToHtml opts lst
302307 st <- get
303308 let ids = stIds st
304− let (id, rest) = if null ids
309+ let (id', rest) = if null ids
305310 then ("", [])
306311 else (head ids, tail ids)
307312 put $ st {stIds = rest}
308313 let attribs = if writerStrictMarkdown opts && not (writerTableOfContents opts)
309314 then []
310− else [identifier id]
315+ else [identifier id']
311316 let contents' = if writerTableOfContents opts
312− then anchor ! [href ("#TOC-" ++ id)] $ contents
317+ then anchor ! [href ("#TOC-" ++ id')] $ contents
313318 else contents
314319 return $ case level of
315320 1 -> h1 contents' ! attribs
@@ -346,40 +351,56 @@ blockToHtml opts (DefinitionList lst) = do
346351 then [theclass "incremental"]
347352 else []
348353 return $ defList ! attribs $ contents
349−blockToHtml opts (Table capt aligns widths headers rows) = do
354+blockToHtml opts (Table capt aligns widths headers rows') = do
350355 let alignStrings = map alignmentToString aligns
351356 captionDoc <- if null capt
352357 then return noHtml
353358 else inlineListToHtml opts capt >>= return . caption
354359 colHeads <- colHeadsToHtml opts alignStrings
355360 widths headers
356− rows' <- mapM (tableRowToHtml opts alignStrings) rows
357− return $ table $ captionDoc +++ colHeads +++ rows'
358−
361+ rows'' <- mapM (tableRowToHtml opts alignStrings) rows'
362+ return $ table $ captionDoc +++ colHeads +++ rows''
363+
364+colHeadsToHtml :: WriterOptions
365+ -> [[Char]]
366+ -> [Float]
367+ -> [[Block]]
368+ -> State WriterState Html
359369colHeadsToHtml opts alignStrings widths headers = do
360370 heads <- sequence $ zipWith3
361− (\align width item -> tableItemToHtml opts th align width item)
371+ (\alignment columnwidth item -> tableItemToHtml opts th alignment columnwidth item)
362372 alignStrings widths headers
363373 return $ tr $ toHtmlFromList heads
364374
375+alignmentToString :: Alignment -> [Char]
365376alignmentToString alignment = case alignment of
366377 AlignLeft -> "left"
367378 AlignRight -> "right"
368379 AlignCenter -> "center"
369380 AlignDefault -> "left"
370381
371−tableRowToHtml opts aligns cols =
372− (sequence $ zipWith3 (tableItemToHtml opts td) aligns (repeat 0) cols) >>=
382+tableRowToHtml :: WriterOptions
383+ -> [[Char]]
384+ -> [[Block]]
385+ -> State WriterState Html
386+tableRowToHtml opts aligns columns =
387+ (sequence $ zipWith3 (tableItemToHtml opts td) aligns (repeat 0) columns) >>=
373388 return . tr . toHtmlFromList
374389
375−tableItemToHtml opts tag align' width item = do
390+tableItemToHtml :: WriterOptions
391+ -> (Html -> Html)
392+ -> [Char]
393+ -> Float
394+ -> [Block]
395+ -> State WriterState Html
396+tableItemToHtml opts tag' align' width' item = do
376397 contents <- blockListToHtml opts item
377398 let attrib = [align align'] ++
378− if width /= 0
379− then [thestyle ("width: " ++ show (truncate (100*width)) ++
399+ if width' /= 0
400+ then [thestyle ("width: " ++ show (truncate (100*width')) ++
380401 "%;")]
381402 else []
382− return $ tag ! attrib $ contents
403+ return $ tag' ! attrib $ contents
383404
384405blockListToHtml :: WriterOptions -> [Block] -> State WriterState Html
385406blockListToHtml opts lst =
@@ -428,22 +449,22 @@ inlineToHtml opts inline =
428449 PlainMath ->
429450 inlineListToHtml opts (readTeXMath str) >>=
430451 return . (thespan ! [theclass "math"]))
431− (TeX str) -> return noHtml
452+ (TeX _) -> return noHtml
432453 (HtmlInline str) -> return $ primHtml str
433− (Link [Code str] (src,tit)) | "mailto:" `isPrefixOf` src ->
434− return $ obfuscateLink opts str src
435− (Link txt (src,tit)) | "mailto:" `isPrefixOf` src -> do
454+ (Link [Code str] (s,_)) | "mailto:" `isPrefixOf` s ->
455+ return $ obfuscateLink opts str s
456+ (Link txt (s,_)) | "mailto:" `isPrefixOf` s -> do
436457 linkText <- inlineListToHtml opts txt
437− return $ obfuscateLink opts (show linkText) src
438− (Link txt (src,tit)) -> do
458+ return $ obfuscateLink opts (show linkText) s
459+ (Link txt (s,tit)) -> do
439460 linkText <- inlineListToHtml opts txt
440− return $ anchor ! ([href src] ++
461+ return $ anchor ! ([href s] ++
441462 if null tit then [] else [title tit]) $
442463 linkText
443− (Image txt (source,tit)) -> do
464+ (Image txt (s,tit)) -> do
444465 alternate <- inlineListToHtml opts txt
445466 let alternate' = renderFragment opts alternate
446− let attributes = [src source] ++
467+ let attributes = [src s] ++
447468 (if null tit
448469 then []
449470 else [title tit]) ++