1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
|
-- | Converts Pandoc to reStructuredText.
module Text.Pandoc.Writers.RST (
writeRST
) where
import Text.Pandoc.Definition
import Text.Pandoc.Shared
import List ( nubBy )
import Text.PrettyPrint.HughesPJ hiding ( Str )
-- | Convert Pandoc to reStructuredText.
writeRST :: WriterOptions -> Pandoc -> String
writeRST options (Pandoc meta blocks) =
let (main, refs) = unzip $ map (blockToRST (writerTabStop options))
(reformatBlocks $ replaceReferenceLinks blocks)
top = if (writerStandalone options) then
(metaToRST meta) $$ text (writerHeader options)
else
empty in
let refs' = nubBy (\x y -> (render x) == (render y)) refs in -- remove duplicate keys
let body = text (writerIncludeBefore options) <>
vcat main $$ text (writerIncludeAfter options) in
render $ top <> body $$ vcat refs'
-- | Escape special RST characters.
escapeString :: String -> String
escapeString = backslashEscape "`\\|*_"
-- | Convert list of inline elements into one 'Doc' of wrapped text and another
-- containing references.
wrappedRST :: [Inline] -> (Doc, Doc)
wrappedRST lst =
let words = splitBySpace lst in
(fsep $ map (fcat . (map (fst . inlineToRST))) words, vcat (map (snd . inlineToRST) lst))
-- | Remove reference keys, and make sure there are blanks before each list.
reformatBlocks :: [Block] -> [Block]
reformatBlocks [] = []
reformatBlocks ((Plain x):(OrderedList y):rest) =
(Para x):(reformatBlocks ((OrderedList y):rest))
reformatBlocks ((Plain x):(BulletList y):rest) = (Para x):(reformatBlocks ((BulletList y):rest))
reformatBlocks ((OrderedList x):rest) =
(OrderedList (map reformatBlocks x)):(reformatBlocks rest)
reformatBlocks ((BulletList x):rest) = (BulletList (map reformatBlocks x)):(reformatBlocks rest)
reformatBlocks ((BlockQuote x):rest) = (BlockQuote (reformatBlocks x)):(reformatBlocks rest)
reformatBlocks ((Note ref x):rest) = (Note ref (reformatBlocks x)):(reformatBlocks rest)
reformatBlocks ((Key x1 y1):rest) = reformatBlocks rest
reformatBlocks (x:rest) = x:(reformatBlocks rest)
-- | Convert bibliographic information to 'Doc'.
metaToRST :: Meta -> Doc
metaToRST (Meta title authors date) =
(titleToRST title) <> (authorsToRST authors) <> (dateToRST date)
-- | Convert title to 'Doc'.
titleToRST :: [Inline] -> Doc
titleToRST [] = empty
titleToRST lst =
let title = fst $ inlineListToRST lst in
let titleLength = length $ render title in
let border = text (replicate titleLength '=') in
border <> char '\n' <> title <> char '\n' <> border <> text "\n\n"
-- | Convert author list to 'Doc'.
authorsToRST :: [String] -> Doc
authorsToRST [] = empty
authorsToRST (first:rest) = text ":Author: " <> text first <> char '\n' <> (authorsToRST rest)
-- | Convert date to 'Doc'.
dateToRST :: String -> Doc
dateToRST [] = empty
dateToRST str = text ":Date: " <> text (escapeString str) <> char '\n'
-- | Convert Pandoc block element to a 'Doc' containing the main text and
-- another one containing any references.
blockToRST :: Int -- ^ tab stop
-> Block -- ^ block element to convert
-> (Doc, Doc) -- ^ first element is text, second is references for end of file
blockToRST tabStop Blank = (text "\n", empty)
blockToRST tabStop Null = (empty, empty)
blockToRST tabStop (Plain lst) = wrappedRST lst
blockToRST tabStop (Para [TeX str]) = -- raw latex block
let str' = if (endsWith '\n' str) then (str ++ "\n") else (str ++ "\n\n") in
(hang (text "\n.. raw:: latex\n") 3 (vcat $ map text (lines str')), empty)
blockToRST tabStop (Para lst) = ((fst $ wrappedRST lst) <> (text "\n"), snd $ wrappedRST lst)
blockToRST tabStop (BlockQuote lst) =
let (main, refs) = unzip $ map (blockToRST tabStop) lst in
((nest tabStop $ vcat $ main) <> text "\n", vcat refs)
blockToRST tabStop (Note ref blocks) =
let (main, refs) = unzip $ map (blockToRST tabStop) blocks in
((hang (text ".. [" <> text (escapeString ref) <> text "] ") 3 (vcat main)), vcat refs)
blockToRST tabStop (Key txt (Src src tit)) =
(text "ERROR - KEY FOUND", empty) -- shouldn't have a key here
blockToRST tabStop (CodeBlock str) =
(hang (text "::\n") tabStop (vcat $ map text (lines ('\n':(str ++ "\n")))), empty)
blockToRST tabStop (RawHtml str) =
let str' = if (endsWith '\n' str) then (str ++ "\n") else (str ++ "\n\n") in
(hang (text "\n.. raw:: html\n") 3 (vcat $ map text (lines str')), empty)
blockToRST tabStop (BulletList lst) =
let (main, refs) = unzip $ map (bulletListItemToRST tabStop) lst in
(vcat main <> text "\n", vcat refs)
blockToRST tabStop (OrderedList lst) =
let (main, refs) =
unzip $ zipWith (orderedListItemToRST tabStop) (enumFromTo 1 (length lst)) lst in
(vcat main <> text "\n", vcat refs)
blockToRST tabStop HorizontalRule = (text "--------------\n", empty)
blockToRST tabStop (Header level lst) =
let (headerText, refs) = inlineListToRST lst in
let headerLength = length $ render headerText in
let headerChar = if (level > 5) then ' ' else "=-~^'" !! (level - 1) in
let border = text $ replicate headerLength headerChar in
(headerText <> char '\n' <> border <> char '\n', refs)
-- | Convert bullet list item (list of blocks) to reStructuredText.
-- Returns a pair of 'Doc', the first the main text, the second references
bulletListItemToRST :: Int -- ^ tab stop
-> [Block] -- ^ list item (list of blocks)
-> (Doc, Doc)
bulletListItemToRST tabStop list =
let (main, refs) = unzip $ map (blockToRST tabStop) list in
(hang (text "- ") tabStop (vcat main), (vcat refs))
-- | Convert an ordered list item (list of blocks) to reStructuredText.
-- Returns a pair of 'Doc', the first the main text, the second references
orderedListItemToRST :: Int -- ^ tab stop
-> Int -- ^ ordinal number of list item
-> [Block] -- ^ list item (list of blocks)
-> (Doc, Doc)
orderedListItemToRST tabStop num list =
let (main, refs) = unzip $ map (blockToRST tabStop) list
spacer = if (length (show num) < 2) then " " else "" in
(hang (text ((show num) ++ "." ++ spacer)) tabStop (vcat main), (vcat refs))
-- | Convert a list of inline elements to reStructuredText.
-- Returns a pair of 'Doc', the first the main text, the second references.
inlineListToRST :: [Inline] -> (Doc, Doc)
inlineListToRST lst = let (main, refs) = unzip $ map inlineToRST lst in
(hcat main, hcat refs)
-- | Convert an inline element to reStructuredText.
-- Returns a pair of 'Doc', the first the main text, the second references.
inlineToRST :: Inline -> (Doc, Doc) -- second Doc is list of refs for end of file
inlineToRST (Emph lst) = let (main, refs) = inlineListToRST lst in
(text "*" <> main <> text "*", refs)
inlineToRST (Strong lst) = let (main, refs) = inlineListToRST lst in
(text "**" <> main <> text "**", refs)
inlineToRST (Code str) = (text $ "``" ++ str ++ "``", empty)
inlineToRST (Str str) = (text $ escapeString str, empty)
inlineToRST (TeX str) = (text str, empty)
inlineToRST (HtmlInline str) = (empty, empty)
inlineToRST (LineBreak) = inlineToRST Space -- RST doesn't have line breaks
inlineToRST Space = (char ' ', empty)
--
-- Note: can assume reference links have been replaced where possible with explicit links.
--
inlineToRST (Link txt (Src src tit)) =
let (linktext, ref') = if (null txt) || (txt == [Str ""]) then
(text "link", empty)
else
inlineListToRST $ normalizeSpaces txt in
let link = char '`' <> linktext <> text "`_"
linktext' = render linktext in
let linktext'' = if (':' `elem` linktext') then "`" ++ linktext' ++ "`" else linktext' in
let ref = text ".. _" <> text linktext'' <> text ": " <> text src in
(link, ref' $$ ref)
inlineToRST (Link txt (Ref [])) =
let (linktext, refs) = inlineListToRST txt in
(char '[' <> linktext <> char ']', refs)
inlineToRST (Link txt (Ref ref)) =
let (linktext, refs1) = inlineListToRST txt
(reftext, refs2) = inlineListToRST ref in
(char '[' <> linktext <> text "][" <> reftext <> char ']', refs1 $$ refs2)
inlineToRST (Image alternate (Src source tit)) =
let (alt, ref') = if (null alternate) || (alternate == [Str ""]) then
(text "image", empty)
else
inlineListToRST $ normalizeSpaces alternate in
let link = char '|' <> alt <> char '|' in
let ref = text ".. " <> link <> text " image:: " <> text source in
(link, ref' $$ ref)
inlineToRST (Image alternate (Ref [])) =
let (alttext, refs) = inlineListToRST alternate in
(char '|' <> alttext <> char '|', refs)
-- The following case won't normally occur...
inlineToRST (Image alternate (Ref ref)) =
let (alttext, refs1) = inlineListToRST alternate
(reftext, refs2) = inlineListToRST ref in
(char '|' <> alttext <> char '|', refs1 $$ refs2)
inlineToRST (NoteRef ref) = (text " [" <> text (escapeString ref) <> char ']' <> char '_', empty)
|
