@@ -40,16 +40,26 @@ import Control.Monad.State
4040
4141type Notes = [[Block]]
4242type Refs = KeyTable
43−type WriterState = (Notes, Refs, Refs) -- first Refs is links, second pictures
43+data WriterState =
44+ WriterState { stNotes :: [[Block]]
45+ , stLinks :: KeyTable
46+ , stImages :: KeyTable
47+ , stIncludes :: [Doc]
48+ , stOptions :: WriterOptions
49+ }
4450
4551-- | Convert Pandoc to RST.
4652writeRST :: WriterOptions -> Pandoc -> String
4753writeRST opts document =
48− render $ evalState (pandocToRST opts document) ([],[],[])
54+ let st = WriterState { stNotes = [], stLinks = [],
55+ stImages = [], stIncludes = [],
56+ stOptions = opts }
57+ in render $ evalState (pandocToRST document) st
4958
5059-- | Return RST representation of document.
51−pandocToRST :: WriterOptions -> Pandoc -> State WriterState Doc
52−pandocToRST opts (Pandoc meta blocks) = do
60+pandocToRST :: Pandoc -> State WriterState Doc
61+pandocToRST (Pandoc meta blocks) = do
62+ opts <- get >>= (return . stOptions)
5363 let before = writerIncludeBefore opts
5464 let after = writerIncludeAfter opts
5565 before' = if null before then empty else text before
@@ -58,60 +68,57 @@ pandocToRST opts (Pandoc meta blocks) = do
5868 let head = if (writerStandalone opts)
5969 then metaBlock $+$ text (writerHeader opts)
6070 else empty
61− body <- blockListToRST opts blocks
62− (notes, _, _) <- get
63− notes' <- notesToRST opts (reverse notes)
64− (_, refs, pics) <- get -- note that the notes may contain refs
65− refs' <- keyTableToRST opts (reverse refs)
66− pics' <- pictTableToRST opts (reverse pics)
67− return $ head $+$ before' $+$ body $+$ notes' $+$ text "" $+$ refs' $+$
68− pics' $+$ after'
71+ body <- blockListToRST blocks
72+ notes <- get >>= (notesToRST . reverse . stNotes)
73+ -- note that the notes may contain refs, so we do them first
74+ refs <- get >>= (keyTableToRST . reverse . stLinks)
75+ pics <- get >>= (pictTableToRST . reverse . stImages)
76+ return $ head $+$ before' $+$ body $+$ notes $+$ text "" $+$ refs $+$
77+ pics $+$ after'
6978
7079-- | Return RST representation of reference key table.
71−keyTableToRST :: WriterOptions -> KeyTable -> State WriterState Doc
72−keyTableToRST opts refs = mapM (keyToRST opts) refs >>= return . vcat
80+keyTableToRST :: KeyTable -> State WriterState Doc
81+keyTableToRST refs = mapM keyToRST refs >>= return . vcat
7382
7483-- | Return RST representation of a reference key.
75−keyToRST :: WriterOptions
76− -> ([Inline], (String, String))
84+keyToRST :: ([Inline], (String, String))
7785 -> State WriterState Doc
78−keyToRST opts (label, (src, tit)) = do
79− label' <- inlineListToRST opts label
86+keyToRST (label, (src, tit)) = do
87+ label' <- inlineListToRST label
8088 let label'' = if ':' `elem` (render label')
8189 then char '`' <> label' <> char '`'
8290 else label'
8391 return $ text ".. _" <> label'' <> text ": " <> text src
8492
8593-- | Return RST representation of notes.
86−notesToRST :: WriterOptions -> [[Block]] -> State WriterState Doc
87−notesToRST opts notes =
88− mapM (\(num, note) -> noteToRST opts num note) (zip [1..] notes) >>=
94+notesToRST :: [[Block]] -> State WriterState Doc
95+notesToRST notes =
96+ mapM (\(num, note) -> noteToRST num note) (zip [1..] notes) >>=
8997 return . vcat
9098
9199-- | Return RST representation of a note.
92−noteToRST :: WriterOptions -> Int -> [Block] -> State WriterState Doc
93−noteToRST opts num note = do
94− contents <- blockListToRST opts note
100+noteToRST :: Int -> [Block] -> State WriterState Doc
101+noteToRST num note = do
102+ contents <- blockListToRST note
95103 let marker = text ".. [" <> text (show num) <> text "] "
96104 return $ hang marker 3 contents
97105
98106-- | Return RST representation of picture reference table.
99−pictTableToRST :: WriterOptions -> KeyTable -> State WriterState Doc
100−pictTableToRST opts refs = mapM (pictToRST opts) refs >>= return . vcat
107+pictTableToRST :: KeyTable -> State WriterState Doc
108+pictTableToRST refs = mapM pictToRST refs >>= return . vcat
101109
102110-- | Return RST representation of a picture substitution reference.
103−pictToRST :: WriterOptions
104− -> ([Inline], (String, String))
105− -> State WriterState Doc
106−pictToRST opts (label, (src, _)) = do
107− label' <- inlineListToRST opts label
111+pictToRST :: ([Inline], (String, String))
112+ -> State WriterState Doc
113+pictToRST (label, (src, _)) = do
114+ label' <- inlineListToRST label
108115 return $ text ".. " <> char '|' <> label' <> char '|' <> text " image:: " <>
109116 text src
110117
111118-- | Take list of inline elements and return wrapped doc.
112119wrappedRST :: WriterOptions -> [Inline] -> State WriterState Doc
113−wrappedRST opts inlines = mapM (wrapIfNeeded opts (inlineListToRST opts))
114− (splitBy LineBreak inlines) >>= return . vcat
120+wrappedRST opts inlines = mapM (wrapIfNeeded opts inlineListToRST)
121+ (splitBy LineBreak inlines) >>= return . vcat
115122
116123-- | Escape special characters for RST.
117124escapeString :: String -> String
@@ -120,7 +127,7 @@ escapeString = escapeStringUsing (backslashEscapes "`\\|*_")
120127-- | Convert bibliographic information into RST header.
121128metaToRST :: WriterOptions -> Meta -> State WriterState Doc
122129metaToRST opts (Meta title authors date) = do
123− title' <- titleToRST opts title
130+ title' <- titleToRST title
124131 authors' <- authorsToRST authors
125132 date' <- dateToRST date
126133 let toc = if writerTableOfContents opts
@@ -128,10 +135,10 @@ metaToRST opts (Meta title authors date) = do
128135 else empty
129136 return $ title' $+$ authors' $+$ date' $+$ toc
130137
131−titleToRST :: WriterOptions -> [Inline] -> State WriterState Doc
132−titleToRST opts [] = return empty
133−titleToRST opts lst = do
134− contents <- inlineListToRST opts lst
138+titleToRST :: [Inline] -> State WriterState Doc
139+titleToRST [] = return empty
140+titleToRST lst = do
141+ contents <- inlineListToRST lst
135142 let titleLength = length $ render contents
136143 let border = text (replicate titleLength '=')
137144 return $ border $+$ contents $+$ border <> text "\n"
@@ -147,35 +154,40 @@ dateToRST [] = return empty
147154dateToRST str = return $ text ":Date: " <> text (escapeString str)
148155
149156-- | Convert Pandoc block element to RST.
150−blockToRST :: WriterOptions -- ^ Options
151− -> Block -- ^ Block element
152− -> State WriterState Doc
153−blockToRST opts Null = return empty
154−blockToRST opts (Plain inlines) = wrappedRST opts inlines
155−blockToRST opts (Para inlines) = do
157+blockToRST :: Block -- ^ Block element
158+ -> State WriterState Doc
159+blockToRST Null = return empty
160+blockToRST (Plain inlines) = do
161+ opts <- get >>= (return . stOptions)
162+ wrappedRST opts inlines
163+blockToRST (Para inlines) = do
164+ opts <- get >>= (return . stOptions)
156165 contents <- wrappedRST opts inlines
157166 return $ contents <> text "\n"
158−blockToRST opts (RawHtml str) =
167+blockToRST (RawHtml str) =
159168 let str' = if "\n" `isSuffixOf` str then str ++ "\n" else str ++ "\n\n" in
160169 return $ hang (text "\n.. raw:: html\n") 3 $ vcat $ map text (lines str')
161−blockToRST opts HorizontalRule = return $ text "--------------\n"
162−blockToRST opts (Header level inlines) = do
163− contents <- inlineListToRST opts inlines
170+blockToRST HorizontalRule = return $ text "--------------\n"
171+blockToRST (Header level inlines) = do
172+ contents <- inlineListToRST inlines
164173 let headerLength = length $ render contents
165174 let headerChar = if level > 5 then ' ' else "=-~^'" !! (level - 1)
166175 let border = text $ replicate headerLength headerChar
167176 return $ contents $+$ border <> text "\n"
168−blockToRST opts (CodeBlock str) = return $ (text "::\n") $+$
169− (nest (writerTabStop opts) $ vcat $ map text (lines str)) <> text "\n"
170−blockToRST opts (BlockQuote blocks) = do
171− contents <- blockListToRST opts blocks
172− return $ (nest (writerTabStop opts) contents) <> text "\n"
173−blockToRST opts (Table caption aligns widths headers rows) = do
174− caption' <- inlineListToRST opts caption
177+blockToRST (CodeBlock str) = do
178+ tabstop <- get >>= (return . writerTabStop . stOptions)
179+ return $ (text "::\n") $+$
180+ (nest tabstop $ vcat $ map text (lines str)) <> text "\n"
181+blockToRST (BlockQuote blocks) = do
182+ tabstop <- get >>= (return . writerTabStop . stOptions)
183+ contents <- blockListToRST blocks
184+ return $ (nest tabstop contents) <> text "\n"
185+blockToRST (Table caption aligns widths headers rows) = do
186+ caption' <- inlineListToRST caption
175187 let caption'' = if null caption
176188 then empty
177189 else text "" $+$ (text "Table: " <> caption')
178− headers' <- mapM (blockListToRST opts) headers
190+ headers' <- mapM blockListToRST headers
179191 let widthsInChars = map (floor . (78 *)) widths
180192 let alignHeader alignment = case alignment of
181193 AlignLeft -> leftAlignBlock
@@ -190,7 +202,7 @@ blockToRST opts (Table caption aligns widths headers rows) = do
190202 middle = hcatBlocks $ intersperse sep blocks
191203 let makeRow = hpipeBlocks . zipWith docToBlock widthsInChars
192204 let head = makeRow headers'
193− rows' <- mapM (\row -> do cols <- mapM (blockListToRST opts) row
205+ rows' <- mapM (\row -> do cols <- mapM blockListToRST row
194206 return $ makeRow cols) rows
195207 let tableWidth = sum widthsInChars
196208 let maxRowHeight = maximum $ map heightOfBlock (head:rows')
@@ -201,11 +213,11 @@ blockToRST opts (Table caption aligns widths headers rows) = do
201213 let body = vcat $ intersperse (border '-') $ map blockToDoc rows'
202214 return $ border '-' $+$ blockToDoc head $+$ border '=' $+$ body $+$
203215 border '-' $$ caption'' $$ text ""
204−blockToRST opts (BulletList items) = do
205− contents <- mapM (bulletListItemToRST opts) items
216+blockToRST (BulletList items) = do
217+ contents <- mapM bulletListItemToRST items
206218 -- ensure that sublists have preceding blank line
207219 return $ text "" $+$ vcat contents <> text "\n"
208−blockToRST opts (OrderedList (start, style, delim) items) = do
220+blockToRST (OrderedList (start, style, delim) items) = do
209221 let markers = if start == 1 && style == DefaultStyle && delim == DefaultDelim
210222 then take (length items) $ repeat "#."
211223 else take (length items) $ orderedListMarkers
@@ -213,112 +225,110 @@ blockToRST opts (OrderedList (start, style, delim) items) = do
213225 let maxMarkerLength = maximum $ map length markers
214226 let markers' = map (\m -> let s = maxMarkerLength - length m
215227 in m ++ replicate s ' ') markers
216− contents <- mapM (\(item, num) -> orderedListItemToRST opts item num) $
228+ contents <- mapM (\(item, num) -> orderedListItemToRST item num) $
217229 zip markers' items
218230 -- ensure that sublists have preceding blank line
219231 return $ text "" $+$ vcat contents <> text "\n"
220−blockToRST opts (DefinitionList items) = do
221− contents <- mapM (definitionListItemToRST opts) items
232+blockToRST (DefinitionList items) = do
233+ contents <- mapM definitionListItemToRST items
222234 return $ (vcat contents) <> text "\n"
223235
224236-- | Convert bullet list item (list of blocks) to RST.
225−bulletListItemToRST :: WriterOptions -> [Block] -> State WriterState Doc
226−bulletListItemToRST opts items = do
227− contents <- blockListToRST opts items
237+bulletListItemToRST :: [Block] -> State WriterState Doc
238+bulletListItemToRST items = do
239+ contents <- blockListToRST items
228240 return $ hang (text "- ") 3 contents
229241
230242-- | Convert ordered list item (a list of blocks) to RST.
231−orderedListItemToRST :: WriterOptions -- ^ options
232− -> String -- ^ marker for list item
233− -> [Block] -- ^ list item (list of blocks)
234− -> State WriterState Doc
235−orderedListItemToRST opts marker items = do
236− contents <- blockListToRST opts items
243+orderedListItemToRST :: String -- ^ marker for list item
244+ -> [Block] -- ^ list item (list of blocks)
245+ -> State WriterState Doc
246+orderedListItemToRST marker items = do
247+ contents <- blockListToRST items
237248 return $ hang (text marker) (length marker + 1) contents
238249
239250-- | Convert defintion list item (label, list of blocks) to RST.
240−definitionListItemToRST :: WriterOptions -> ([Inline], [Block]) -> State WriterState Doc
241−definitionListItemToRST opts (label, items) = do
242− label <- inlineListToRST opts label
243− contents <- blockListToRST opts items
244− return $ label $+$ nest (writerTabStop opts) contents
251+definitionListItemToRST :: ([Inline], [Block]) -> State WriterState Doc
252+definitionListItemToRST (label, items) = do
253+ label <- inlineListToRST label
254+ contents <- blockListToRST items
255+ tabstop <- get >>= (return . writerTabStop . stOptions)
256+ return $ label $+$ nest tabstop contents
245257
246258-- | Convert list of Pandoc block elements to RST.
247−blockListToRST :: WriterOptions -- ^ Options
248− -> [Block] -- ^ List of block elements
249− -> State WriterState Doc
250−blockListToRST opts blocks =
251− mapM (blockToRST opts) blocks >>= return . vcat
259+blockListToRST :: [Block] -- ^ List of block elements
260+ -> State WriterState Doc
261+blockListToRST blocks = mapM blockToRST blocks >>= return . vcat
252262
253263-- | Convert list of Pandoc inline elements to RST.
254−inlineListToRST :: WriterOptions -> [Inline] -> State WriterState Doc
255−inlineListToRST opts lst = mapM (inlineToRST opts) lst >>= return . hcat
264+inlineListToRST :: [Inline] -> State WriterState Doc
265+inlineListToRST lst = mapM inlineToRST lst >>= return . hcat
256266
257267-- | Convert Pandoc inline element to RST.
258−inlineToRST :: WriterOptions -> Inline -> State WriterState Doc
259−inlineToRST opts (Emph lst) = do
260− contents <- inlineListToRST opts lst
268+inlineToRST :: Inline -> State WriterState Doc
269+inlineToRST (Emph lst) = do
270+ contents <- inlineListToRST lst
261271 return $ char '*' <> contents <> char '*'
262−inlineToRST opts (Strong lst) = do
263− contents <- inlineListToRST opts lst
272+inlineToRST (Strong lst) = do
273+ contents <- inlineListToRST lst
264274 return $ text "**" <> contents <> text "**"
265−inlineToRST opts (Strikeout lst) = do
266− contents <- inlineListToRST opts lst
275+inlineToRST (Strikeout lst) = do
276+ contents <- inlineListToRST lst
267277 return $ text "[STRIKEOUT:" <> contents <> char ']'
268−inlineToRST opts (Superscript lst) = do
269− contents <- inlineListToRST opts lst
278+inlineToRST (Superscript lst) = do
279+ contents <- inlineListToRST lst
270280 return $ text "\\ :sup:`" <> contents <> text "`\\ "
271−inlineToRST opts (Subscript lst) = do
272− contents <- inlineListToRST opts lst
281+inlineToRST (Subscript lst) = do
282+ contents <- inlineListToRST lst
273283 return $ text "\\ :sub:`" <> contents <> text "`\\ "
274−inlineToRST opts (Quoted SingleQuote lst) = do
275− contents <- inlineListToRST opts lst
284+inlineToRST (Quoted SingleQuote lst) = do
285+ contents <- inlineListToRST lst
276286 return $ char '\'' <> contents <> char '\''
277−inlineToRST opts (Quoted DoubleQuote lst) = do
278− contents <- inlineListToRST opts lst
287+inlineToRST (Quoted DoubleQuote lst) = do
288+ contents <- inlineListToRST lst
279289 return $ char '"' <> contents <> char '"'
280−inlineToRST opts EmDash = return $ text "--"
281−inlineToRST opts EnDash = return $ char '-'
282−inlineToRST opts Apostrophe = return $ char '\''
283−inlineToRST opts Ellipses = return $ text "..."
284−inlineToRST opts (Code str) = return $ text $ "``" ++ str ++ "``"
285−inlineToRST opts (Str str) = return $ text $ escapeString str
286−inlineToRST opts (Math str) = return $ text $ "$" ++ str ++ "$"
287−inlineToRST opts (TeX str) = return empty
288−inlineToRST opts (HtmlInline str) = return empty
289−inlineToRST opts (LineBreak) = return $ char ' ' -- RST doesn't have linebreaks
290−inlineToRST opts Space = return $ char ' '
291−inlineToRST opts (Link [Code str] (src, tit)) | src == str ||
290+inlineToRST EmDash = return $ text "--"
291+inlineToRST EnDash = return $ char '-'
292+inlineToRST Apostrophe = return $ char '\''
293+inlineToRST Ellipses = return $ text "..."
294+inlineToRST (Code str) = return $ text $ "``" ++ str ++ "``"
295+inlineToRST (Str str) = return $ text $ escapeString str
296+inlineToRST (Math str) = return $ text $ "$" ++ str ++ "$"
297+inlineToRST (TeX str) = return empty
298+inlineToRST (HtmlInline str) = return empty
299+inlineToRST (LineBreak) = return $ char ' ' -- RST doesn't have linebreaks
300+inlineToRST Space = return $ char ' '
301+inlineToRST (Link [Code str] (src, tit)) | src == str ||
292302 src == "mailto:" ++ str = do
293303 let srcSuffix = if isPrefixOf "mailto:" src then drop 7 src else src
294304 return $ text srcSuffix
295−inlineToRST opts (Link txt (src, tit)) = do
296− let useReferenceLinks = writerReferenceLinks opts
297− linktext <- inlineListToRST opts $ normalizeSpaces txt
305+inlineToRST (Link txt (src, tit)) = do
306+ useReferenceLinks <- get >>= (return . writerReferenceLinks . stOptions)
307+ linktext <- inlineListToRST $ normalizeSpaces txt
298308 if useReferenceLinks
299− then do (notes, refs, pics) <- get
309+ then do refs <- get >>= (return . stLinks)
300310 let refs' = if (txt, (src, tit)) `elem` refs
301311 then refs
302312 else (txt, (src, tit)):refs
303− put (notes, refs', pics)
313+ modify $ \st -> st { stLinks = refs' }
304314 return $ char '`' <> linktext <> text "`_"
305315 else return $ char '`' <> linktext <> text " <" <> text src <> text ">`_"
306−inlineToRST opts (Image alternate (source, tit)) = do
307− (notes, refs, pics) <- get
316+inlineToRST (Image alternate (source, tit)) = do
317+ pics <- get >>= (return . stImages)
308318 let labelsUsed = map fst pics
309319 let txt = if null alternate || alternate == [Str ""] ||
310320 alternate `elem` labelsUsed
311− then [Str $ "image" ++ show (length refs)]
321+ then [Str $ "image" ++ show (length pics)]
312322 else alternate
313323 let pics' = if (txt, (source, tit)) `elem` pics
314324 then pics
315325 else (txt, (source, tit)):pics
316− put (notes, refs, pics')
317− label <- inlineListToRST opts txt
326+ modify $ \st -> st { stImages = pics' }
327+ label <- inlineListToRST txt
318328 return $ char '|' <> label <> char '|'
319−inlineToRST opts (Note contents) = do
329+inlineToRST (Note contents) = do
320330 -- add to notes in state
321− modify (\(notes, refs, pics) -> (contents:notes, refs, pics))
322− (notes, _, _) <- get
323− let ref = show $ (length notes)
331+ notes <- get >>= (return . stNotes)
332+ modify $ \st -> st { stNotes = contents:notes }
333+ let ref = show $ (length notes) + 1
324334 return $ text " [" <> text ref <> text "]_"