git.iko.soy/typeable/pandoc
on master help sign in
Rewrote LaTeX writer to use the prettyprinting library,
1827ab4fiddlosopher
src/Text/Pandoc/Writers/LaTeX.hs+130−104
@@ -31,10 +31,11 @@ module Text.Pandoc.Writers.LaTeX ( writeLaTeX ) where
31import Text.Pandoc.Definition
31import Text.Pandoc.Definition
32import Text.Pandoc.Shared
32import Text.Pandoc.Shared
33import Text.Printf ( printf )
33import Text.Printf ( printf )
34−import Data.List ( (\\), isInfixOf )
34+import Data.List ( (\\), isInfixOf, intersperse )
35import Data.Char ( toLower )
35import Data.Char ( toLower )
36import qualified Data.Set as S
36import qualified Data.Set as S
37import Control.Monad.State
37import Control.Monad.State
38+import Text.PrettyPrint.HughesPJ hiding ( Str )
38
39
39data WriterState =
40data WriterState =
40 WriterState { stIncludes :: S.Set String -- strings to include in header
41 WriterState { stIncludes :: S.Set String -- strings to include in header
@@ -51,51 +52,56 @@ addToHeader str = do
51-- | Convert Pandoc to LaTeX.
52-- | Convert Pandoc to LaTeX.
52writeLaTeX :: WriterOptions -> Pandoc -> String
53writeLaTeX :: WriterOptions -> Pandoc -> String
53writeLaTeX options document =
54writeLaTeX options document =
54− evalState (pandocToLaTeX options document) $
55+ render $ evalState (pandocToLaTeX options document) $
55 WriterState { stIncludes = S.empty, stInNote = False, stOLLevel = 1 }
56 WriterState { stIncludes = S.empty, stInNote = False, stOLLevel = 1 }
56
57
57−pandocToLaTeX :: WriterOptions -> Pandoc -> State WriterState String
58+pandocToLaTeX :: WriterOptions -> Pandoc -> State WriterState Doc
58pandocToLaTeX options (Pandoc meta blocks) = do
59pandocToLaTeX options (Pandoc meta blocks) = do
59 main <- blockListToLaTeX blocks
60 main <- blockListToLaTeX blocks
60 head <- if writerStandalone options
61 head <- if writerStandalone options
61 then latexHeader options meta
62 then latexHeader options meta
62− else return ""
63+ else return empty
63− let body = writerIncludeBefore options ++ main ++
64+ let before = if null (writerIncludeBefore options)
64− writerIncludeAfter options
65+ then empty
66+ else text (writerIncludeBefore options)
67+ let after = if null (writerIncludeAfter options)
68+ then empty
69+ else text (writerIncludeAfter options)
70+ let body = before $$ main $$ after
65 let toc = if writerTableOfContents options
71 let toc = if writerTableOfContents options
66− then "\\tableofcontents\n\n"
72+ then text "\\tableofcontents\n"
67− else ""
73+ else empty
68 let foot = if writerStandalone options
74 let foot = if writerStandalone options
69− then "\n\\end{document}\n"
75+ then text "\\end{document}"
70− else ""
76+ else empty
71− return $ head ++ toc ++ body ++ foot
77+ return $ head $$ toc $$ body $$ foot
72
78
73-- | Insert bibliographic information into LaTeX header.
79-- | Insert bibliographic information into LaTeX header.
74latexHeader :: WriterOptions -- ^ Options, including LaTeX header
80latexHeader :: WriterOptions -- ^ Options, including LaTeX header
75 -> Meta -- ^ Meta with bibliographic information
81 -> Meta -- ^ Meta with bibliographic information
76− -> State WriterState String
82+ -> State WriterState Doc
77latexHeader options (Meta title authors date) = do
83latexHeader options (Meta title authors date) = do
78 titletext <- if null title
84 titletext <- if null title
79− then return ""
85+ then return empty
80− else do title' <- inlineListToLaTeX title
86+ else inlineListToLaTeX title >>= return . inCmd "title"
81− return $ "\\title{" ++ title' ++ "}\n"
82− extras <- get >>= (return . unlines . S.toList. stIncludes)
87+ headerIncludes <- get >>= return . S.toList . stIncludes
88+ let extras = text $ unlines headerIncludes
83− let verbatim = if "\\usepackage{fancyvrb}" `isInfixOf` extras
89+ let verbatim = if "\\usepackage{fancyvrb}" `elem` headerIncludes
84− then "\\VerbatimFootnotes % allows verbatim text in footnotes\n"
90+ then text "\\VerbatimFootnotes % allows verbatim text in footnotes"
85− else ""
91+ else empty
86− let authorstext = "\\author{" ++
92+ let authorstext = text $ "\\author{" ++
87− joinWithSep "\\\\" (map stringToLaTeX authors) ++ "}\n"
93+ joinWithSep "\\\\" (map stringToLaTeX authors) ++ "}"
88 let datetext = if date == ""
94 let datetext = if date == ""
89− then ""
95+ then empty
90− else "\\date{" ++ stringToLaTeX date ++ "}\n"
96+ else text $ "\\date{" ++ stringToLaTeX date ++ "}"
91− let maketitle = if null title then "" else "\\maketitle\n"
97+ let maketitle = if null title then empty else text "\\maketitle"
92 let secnumline = if (writerNumberSections options)
98 let secnumline = if (writerNumberSections options)
93− then ""
99+ then empty
94− else "\\setcounter{secnumdepth}{0}\n"
100+ else text "\\setcounter{secnumdepth}{0}"
95− let baseHeader = writerHeader options
101+ let baseHeader = text $ writerHeader options
96− let header = baseHeader ++ extras
102+ let header = baseHeader $$ extras
97− return $ header ++ secnumline ++ verbatim ++ titletext ++ authorstext ++
103+ return $ header $$ secnumline $$ verbatim $$ titletext $$ authorstext $$
98− datetext ++ "\\begin{document}\n" ++ maketitle ++ "\n"
104+ datetext $$ text "\\begin{document}" $$ maketitle $$ text ""
99
105
100-- escape things as needed for LaTeX
106-- escape things as needed for LaTeX
101
107
@@ -110,6 +116,10 @@ stringToLaTeX = escapeStringUsing latexEscapes
110 , ('>', "\\textgreater{}")
116 , ('>', "\\textgreater{}")
111 ]
117 ]
112
118
119+-- | Puts contents into LaTeX command.
120+inCmd :: String -> Doc -> Doc
121+inCmd cmd contents = char '\\' <> text cmd <> braces contents
122+
113-- | Remove all code elements from list of inline elements
123-- | Remove all code elements from list of inline elements
114-- (because it's illegal to have verbatim inside some command arguments)
124-- (because it's illegal to have verbatim inside some command arguments)
115deVerb :: [Inline] -> [Inline]
125deVerb :: [Inline] -> [Inline]
@@ -120,23 +130,26 @@ deVerb (other:rest) = other:(deVerb rest)
120
130
121-- | Convert Pandoc block element to LaTeX.
131-- | Convert Pandoc block element to LaTeX.
122blockToLaTeX :: Block -- ^ Block to convert
132blockToLaTeX :: Block -- ^ Block to convert
123− -> State WriterState String
133+ -> State WriterState Doc
124−blockToLaTeX Null = return ""
134+blockToLaTeX Null = return empty
125−blockToLaTeX (Plain lst) = inlineListToLaTeX lst >>= return . (++ "\n")
135+blockToLaTeX (Plain lst) = wrapped inlineListToLaTeX lst >>= return
136+blockToLaTeX (Para lst) =
126−blockToLaTeX (Para lst) = inlineListToLaTeX lst >>= return . (++ "\n\n")
137+ wrapped inlineListToLaTeX lst >>= return . (<> char '\n')
127blockToLaTeX (BlockQuote lst) = do
138blockToLaTeX (BlockQuote lst) = do
128 contents <- blockListToLaTeX lst
139 contents <- blockListToLaTeX lst
129− return $ "\\begin{quote}\n" ++ contents ++ "\\end{quote}\n"
140+ return $ text "\\begin{quote}" $$ contents $$ text "\\end{quote}"
130blockToLaTeX (CodeBlock str) = do
141blockToLaTeX (CodeBlock str) = do
131 st <- get
142 st <- get
132− if stInNote st
143+ env <- if stInNote st
133− then do addToHeader "\\usepackage{fancyvrb}"
144+ then do addToHeader "\\usepackage{fancyvrb}"
134− return $ "\\begin{Verbatim}\n" ++ str ++ "\n\\end{Verbatim}\n"
145+ return "Verbatim"
135− else return $ "\\begin{verbatim}\n" ++ str ++ "\n\\end{verbatim}\n"
146+ else return "verbatim"
147+ return $ text ("\\begin{" ++ env ++ "}\n") <> text str <>
148+ text ("\n\\end{" ++ env ++ "}")
136−blockToLaTeX (RawHtml str) = return ""
149+blockToLaTeX (RawHtml str) = return empty
137blockToLaTeX (BulletList lst) = do
150blockToLaTeX (BulletList lst) = do
138 items <- mapM listItemToLaTeX lst
151 items <- mapM listItemToLaTeX lst
139− return $ "\\begin{itemize}\n" ++ concat items ++ "\\end{itemize}\n"
152+ return $ text "\\begin{itemize}" $$ vcat items $$ text "\\end{itemize}"
140blockToLaTeX (OrderedList (start, numstyle, numdelim) lst) = do
153blockToLaTeX (OrderedList (start, numstyle, numdelim) lst) = do
141 st <- get
154 st <- get
142 let oldlevel = stOLLevel st
155 let oldlevel = stOLLevel st
@@ -145,26 +158,29 @@ blockToLaTeX (OrderedList (start, numstyle, numdelim) lst) = do
145 modify (\st -> st {stOLLevel = oldlevel})
158 modify (\st -> st {stOLLevel = oldlevel})
146 exemplar <- if numstyle /= DefaultStyle || numdelim /= DefaultDelim
159 exemplar <- if numstyle /= DefaultStyle || numdelim /= DefaultDelim
147 then do addToHeader "\\usepackage{enumerate}"
160 then do addToHeader "\\usepackage{enumerate}"
161+ return $ char '[' <>
148− return $ "[" ++ head (orderedListMarkers (1, numstyle, numdelim)) ++ "]"
162+ text (head (orderedListMarkers (1, numstyle,
163+ numdelim))) <> char ']'
149− else return ""
164+ else return empty
150 let resetcounter = if start /= 1 && oldlevel <= 4
165 let resetcounter = if start /= 1 && oldlevel <= 4
151− then "\\setcounter{enum" ++
166+ then text $ "\\setcounter{enum" ++
152 map toLower (toRomanNumeral oldlevel) ++
167 map toLower (toRomanNumeral oldlevel) ++
153− "}{" ++ show (start - 1) ++ "}\n"
168+ "}{" ++ show (start - 1) ++ "}"
154− else ""
169+ else empty
155− return $ "\\begin{enumerate}" ++ exemplar ++ "\n" ++
170+ return $ text "\\begin{enumerate}" <> exemplar $$ resetcounter $$
156− resetcounter ++ concat items ++ "\\end{enumerate}\n"
171+ vcat items $$ text "\\end{enumerate}"
157blockToLaTeX (DefinitionList lst) = do
172blockToLaTeX (DefinitionList lst) = do
158 items <- mapM defListItemToLaTeX lst
173 items <- mapM defListItemToLaTeX lst
159− return $ "\\begin{description}\n" ++ concat items ++ "\\end{description}\n"
174+ return $ text "\\begin{description}" $$ vcat items $$
175+ text "\\end{description}"
160−blockToLaTeX HorizontalRule = return $
176+blockToLaTeX HorizontalRule = return $ text $
161− "\\begin{center}\\rule{3in}{0.4pt}\\end{center}\n\n"
177+ "\\begin{center}\\rule{3in}{0.4pt}\\end{center}\n"
162blockToLaTeX (Header level lst) = do
178blockToLaTeX (Header level lst) = do
163− text <- inlineListToLaTeX (deVerb lst)
179+ txt <- inlineListToLaTeX (deVerb lst)
164 return $ if (level > 0) && (level <= 3)
180 return $ if (level > 0) && (level <= 3)
165− then "\\" ++ (concat (replicate (level - 1) "sub")) ++
181+ then text ("\\" ++ (concat (replicate (level - 1) "sub")) ++
166− "section{" ++ text ++ "}\n\n"
182+ "section{") <> txt <> text "}\n"
167− else text ++ "\n\n"
183+ else txt <> char '\n'
168blockToLaTeX (Table caption aligns widths heads rows) = do
184blockToLaTeX (Table caption aligns widths heads rows) = do
169 headers <- tableRowToLaTeX heads
185 headers <- tableRowToLaTeX heads
170 captionText <- inlineListToLaTeX caption
186 captionText <- inlineListToLaTeX caption
@@ -180,34 +196,37 @@ blockToLaTeX (Table caption aligns widths heads rows) = do
180 "\\hspace{0pt}}p{" ++ width ++
196 "\\hspace{0pt}}p{" ++ width ++
181 "\\columnwidth}")
197 "\\columnwidth}")
182 colWidths aligns
198 colWidths aligns
183− let tableBody = "\\begin{tabular}{" ++ colDescriptors ++ "}\n" ++
199+ let tableBody = text ("\\begin{tabular}{" ++ colDescriptors ++ "}") $$
184− headers ++ "\\hline\n" ++ concat rows' ++ "\\end{tabular}\n"
200+ headers $$ text "\\hline" $$ vcat rows' $$
201+ text "\\end{tabular}"
185− let centered str = "\\begin{center}\n" ++ str ++ "\\end{center}\n"
202+ let centered txt = text "\\begin{center}" $$ txt $$ text "\\end{center}"
186 addToHeader "\\usepackage{array}\n\
203 addToHeader "\\usepackage{array}\n\
187 \% This is needed because raggedright in table elements redefines \\\\:\n\
204 \% This is needed because raggedright in table elements redefines \\\\:\n\
188 \\\newcommand{\\PreserveBackslash}[1]{\\let\\temp=\\\\#1\\let\\\\=\\temp}\n\
205 \\\newcommand{\\PreserveBackslash}[1]{\\let\\temp=\\\\#1\\let\\\\=\\temp}\n\
189 \\\let\\PBS=\\PreserveBackslash"
206 \\\let\\PBS=\\PreserveBackslash"
190− return $ if null captionText
207+ return $ if isEmpty captionText
191− then centered tableBody ++ "\n"
208+ then centered tableBody <> char '\n'
192− else "\\begin{table}[h]\n" ++ centered tableBody ++
209+ else text "\\begin{table}[h]" $$ centered tableBody $$
193− "\\caption{" ++ captionText ++ "}\n" ++ "\\end{table}\n\n"
210+ inCmd "caption" captionText $$ text "\\end{table}\n"
194
211
195−blockListToLaTeX lst = mapM blockToLaTeX lst >>= return . concat
212+blockListToLaTeX lst = mapM blockToLaTeX lst >>= return . vcat
196
213
197−tableRowToLaTeX cols =
214+tableRowToLaTeX cols = mapM blockListToLaTeX cols >>=
198− mapM blockListToLaTeX cols >>= return . (++ "\\\\\n") . (joinWithSep " & ")
215+ return . ($$ text "\\\\") . foldl (\row item -> row $$
216+ (if isEmpty row then empty else text " & ") <> item) empty
199
217
200−listItemToLaTeX lst = blockListToLaTeX lst >>= return . ("\\item "++)
218+listItemToLaTeX lst = blockListToLaTeX lst >>= return . (text "\\item " $$) .
219+ (nest 2)
201
220
202defListItemToLaTeX (term, def) = do
221defListItemToLaTeX (term, def) = do
203 term' <- inlineListToLaTeX $ deVerb term
222 term' <- inlineListToLaTeX $ deVerb term
204 def' <- blockListToLaTeX def
223 def' <- blockListToLaTeX def
205− return $ "\\item[" ++ term' ++ "] " ++ def'
224+ return $ text "\\item[" <> term' <> text "]" $$ def'
206
225
207-- | Convert list of inline elements to LaTeX.
226-- | Convert list of inline elements to LaTeX.
208inlineListToLaTeX :: [Inline] -- ^ Inlines to convert
227inlineListToLaTeX :: [Inline] -- ^ Inlines to convert
209− -> State WriterState String
228+ -> State WriterState Doc
210−inlineListToLaTeX lst = mapM inlineToLaTeX lst >>= return . concat
229+inlineListToLaTeX lst = mapM inlineToLaTeX lst >>= return . hcat
211
230
212isQuoted :: Inline -> Bool
231isQuoted :: Inline -> Bool
213isQuoted (Quoted _ _) = True
232isQuoted (Quoted _ _) = True
@@ -216,68 +235,75 @@ isQuoted _ = False
216
235
217-- | Convert inline element to LaTeX
236-- | Convert inline element to LaTeX
218inlineToLaTeX :: Inline -- ^ Inline to convert
237inlineToLaTeX :: Inline -- ^ Inline to convert
219− -> State WriterState String
238+ -> State WriterState Doc
220−inlineToLaTeX (Emph lst) = do
239+inlineToLaTeX (Emph lst) =
221− contents <- inlineListToLaTeX $ deVerb lst
240+ inlineListToLaTeX (deVerb lst) >>= return . inCmd "emph"
222− return $ "\\emph{" ++ contents ++ "}"
223−inlineToLaTeX (Strong lst) = do
241+inlineToLaTeX (Strong lst) =
224− contents <- inlineListToLaTeX $ deVerb lst
242+ inlineListToLaTeX (deVerb lst) >>= return . inCmd "textbf"
225− return $ "\\textbf{" ++ contents ++ "}"
226inlineToLaTeX (Strikeout lst) = do
243inlineToLaTeX (Strikeout lst) = do
227 contents <- inlineListToLaTeX $ deVerb lst
244 contents <- inlineListToLaTeX $ deVerb lst
228 addToHeader "\\usepackage[normalem]{ulem}"
245 addToHeader "\\usepackage[normalem]{ulem}"
229− return $ "\\sout{" ++ contents ++ "}"
246+ return $ inCmd "sout" contents
230−inlineToLaTeX (Superscript lst) = do
247+inlineToLaTeX (Superscript lst) =
231− contents <- inlineListToLaTeX $ deVerb lst
248+ inlineListToLaTeX (deVerb lst) >>= return . inCmd "textsuperscript"
232− return $ "\\textsuperscript{" ++ contents ++ "}"
233inlineToLaTeX (Subscript lst) = do
249inlineToLaTeX (Subscript lst) = do
234 contents <- inlineListToLaTeX $ deVerb lst
250 contents <- inlineListToLaTeX $ deVerb lst
235 -- oddly, latex includes \textsuperscript but not \textsubscript
251 -- oddly, latex includes \textsuperscript but not \textsubscript
236 -- so we have to define it:
252 -- so we have to define it:
237 addToHeader "\\newcommand{\\textsubscript}[1]{\\ensuremath{_{\\scriptsize\\textrm{#1}}}}"
253 addToHeader "\\newcommand{\\textsubscript}[1]{\\ensuremath{_{\\scriptsize\\textrm{#1}}}}"
238− return $ "\\textsubscript{" ++ contents ++ "}"
254+ return $ inCmd "textsubscript" contents
239inlineToLaTeX (Code str) = do
255inlineToLaTeX (Code str) = do
240 st <- get
256 st <- get
241 if stInNote st
257 if stInNote st
242 then do addToHeader "\\usepackage{fancyvrb}"
258 then do addToHeader "\\usepackage{fancyvrb}"
243 else return ()
259 else return ()
244 let chr = ((enumFromTo '!' '~') \\ str) !! 0
260 let chr = ((enumFromTo '!' '~') \\ str) !! 0
245− return $ "\\verb" ++ [chr] ++ str ++ [chr]
261+ return $ text $ "\\verb" ++ [chr] ++ str ++ [chr]
246inlineToLaTeX (Quoted SingleQuote lst) = do
262inlineToLaTeX (Quoted SingleQuote lst) = do
247 contents <- inlineListToLaTeX lst
263 contents <- inlineListToLaTeX lst
248− let s1 = if (not (null lst)) && (isQuoted (head lst)) then "\\," else ""
264+ let s1 = if (not (null lst)) && (isQuoted (head lst))
265+ then text "\\,"
266+ else empty
249− let s2 = if (not (null lst)) && (isQuoted (last lst)) then "\\," else ""
267+ let s2 = if (not (null lst)) && (isQuoted (last lst))
268+ then text "\\,"
269+ else empty
250− return $ "`" ++ s1 ++ contents ++ s2 ++ "'"
270+ return $ char '`' <> s1 <> contents <> s2 <> char '\''
251inlineToLaTeX (Quoted DoubleQuote lst) = do
271inlineToLaTeX (Quoted DoubleQuote lst) = do
252 contents <- inlineListToLaTeX lst
272 contents <- inlineListToLaTeX lst
253− let s1 = if (not (null lst)) && (isQuoted (head lst)) then "\\," else ""
273+ let s1 = if (not (null lst)) && (isQuoted (head lst))
274+ then text "\\,"
275+ else empty
254− let s2 = if (not (null lst)) && (isQuoted (last lst)) then "\\," else ""
276+ let s2 = if (not (null lst)) && (isQuoted (last lst))
277+ then text "\\,"
278+ else empty
255− return $ "``" ++ s1 ++ contents ++ s2 ++ "''"
279+ return $ text "``" <> s1 <> contents <> s2 <> text "''"
256−inlineToLaTeX Apostrophe = return "'"
280+inlineToLaTeX Apostrophe = return $ char '\''
257−inlineToLaTeX EmDash = return "---"
281+inlineToLaTeX EmDash = return $ text "---"
258−inlineToLaTeX EnDash = return "--"
282+inlineToLaTeX EnDash = return $ text "--"
259−inlineToLaTeX Ellipses = return "\\ldots{}"
283+inlineToLaTeX Ellipses = return $ text "\\ldots{}"
260−inlineToLaTeX (Str str) = return $ stringToLaTeX str
284+inlineToLaTeX (Str str) = return $ text $ stringToLaTeX str
261−inlineToLaTeX (TeX str) = return str
285+inlineToLaTeX (TeX str) = return $ text str
262−inlineToLaTeX (HtmlInline str) = return ""
286+inlineToLaTeX (HtmlInline str) = return empty
263−inlineToLaTeX (LineBreak) = return "\\\\\n"
287+inlineToLaTeX (LineBreak) = return $ text "\\\\"
264−inlineToLaTeX Space = return " "
288+inlineToLaTeX Space = return $ char ' '
265−inlineToLaTeX (Link text (src, _)) = do
289+inlineToLaTeX (Link txt (src, _)) = do
266 addToHeader "\\usepackage[breaklinks=true]{hyperref}"
290 addToHeader "\\usepackage[breaklinks=true]{hyperref}"
267− case text of
291+ case txt of
268 [Code x] | x == src -> -- autolink
292 [Code x] | x == src -> -- autolink
269 do addToHeader "\\usepackage{url}"
293 do addToHeader "\\usepackage{url}"
270− return $ "\\url{" ++ x ++ "}"
294+ return $ text $ "\\url{" ++ x ++ "}"
271− _ -> do contents <- inlineListToLaTeX $ deVerb text
295+ _ -> do contents <- inlineListToLaTeX $ deVerb txt
272− return $ "\\href{" ++ src ++ "}{" ++ contents ++ "}"
296+ return $ text ("\\href{" ++ src ++ "}{") <> contents <>
297+ char '}'
273inlineToLaTeX (Image alternate (source, tit)) = do
298inlineToLaTeX (Image alternate (source, tit)) = do
274 addToHeader "\\usepackage{graphicx}"
299 addToHeader "\\usepackage{graphicx}"
275− return $ "\\includegraphics{" ++ source ++ "}"
300+ return $ text $ "\\includegraphics{" ++ source ++ "}"
276inlineToLaTeX (Note contents) = do
301inlineToLaTeX (Note contents) = do
277 st <- get
302 st <- get
278 put (st {stInNote = True})
303 put (st {stInNote = True})
279 contents' <- blockListToLaTeX contents
304 contents' <- blockListToLaTeX contents
280 modify (\st -> st {stInNote = False})
305 modify (\st -> st {stInNote = False})
306+ return $ text "\\footnote{" $$
281− return $ "\\footnote{" ++ stripTrailingNewlines contents' ++ "\n}"
307+ (nest 11 $ text (stripTrailingNewlines $ render contents') <> text "\n}")
282 -- note: the \n before } is important; removing it causes problems
308 -- note: the \n before } is important; removing it causes problems
283 -- if a Verbatim environment occurs at the end of the footnote.
309 -- if a Verbatim environment occurs at the end of the footnote.