@@ -33,36 +33,44 @@ import Text.Pandoc.Shared
3333import Text.Printf ( printf )
3434import Data.List ( (\\), intersperse )
3535import Control.Monad.State
36+import Text.PrettyPrint.HughesPJ hiding ( Str )
3637
3738type WriterState = Int -- number of next URL reference
3839
3940-- | Convert Pandoc to ConTeXt.
4041writeConTeXt :: WriterOptions -> Pandoc -> String
41−writeConTeXt options document = evalState (pandocToConTeXt options document) 1
42+writeConTeXt options document = render $
43+ evalState (pandocToConTeXt options document) 1
4244
43−pandocToConTeXt :: WriterOptions -> Pandoc -> State WriterState String
45+pandocToConTeXt :: WriterOptions -> Pandoc -> State WriterState Doc
4446pandocToConTeXt options (Pandoc meta blocks) = do
45− main <- blockListToConTeXt blocks
46− let body = writerIncludeBefore options ++ main ++ writerIncludeAfter options
47+ main <- blockListToConTeXt options blocks
48+ let before = if null (writerIncludeBefore options)
49+ then empty
50+ else text $ writerIncludeBefore options
51+ let after = if null (writerIncludeAfter options)
52+ then empty
53+ else text $ writerIncludeAfter options
54+ let body = before $$ main $$ after
4755 head <- if writerStandalone options
4856 then contextHeader options meta
49− else return ""
57+ else return empty
5058 let toc = if writerTableOfContents options
51− then "\\placecontent\n\n"
52− else ""
59+ then text "\\placecontent\n"
60+ else empty
5361 let foot = if writerStandalone options
54− then "\n\\stoptext\n"
55− else ""
56− return $ head ++ toc ++ body ++ foot
62+ then text "\\stoptext\n"
63+ else empty
64+ return $ head $$ toc $$ body $$ foot
5765
5866-- | Insert bibliographic information into ConTeXt header.
5967contextHeader :: WriterOptions -- ^ Options, including ConTeXt header
6068 -> Meta -- ^ Meta with bibliographic information
61− -> State WriterState String
69+ -> State WriterState Doc
6270contextHeader options (Meta title authors date) = do
6371 titletext <- if null title
64− then return ""
65− else inlineListToConTeXt title
72+ then return empty
73+ else inlineListToConTeXt options title
6674 let authorstext = if null authors
6775 then ""
6876 else if length authors == 1
@@ -72,14 +80,11 @@ contextHeader options (Meta title authors date) = do
7280 let datetext = if date == ""
7381 then ""
7482 else stringToConTeXt date
75− let titleblock = "\\doctitle{" ++ titletext ++ "}\n\
76− \ \\author{" ++ authorstext ++ "}\n\
77− \ \\date{" ++ datetext ++ "}\n\n"
78− let setupheads = if (writerNumberSections options)
79− then "\\setupheads[sectionnumber=yes, style=\\bf]\n"
80− else "\\setupheads[sectionnumber=no, style=\\bf]\n"
81− let header = writerHeader options
82− return $ header ++ setupheads ++ titleblock ++ "\\starttext\n\\maketitle\n\n"
83+ let titleblock = text "\\doctitle{" <> titletext <> char '}' $$
84+ text ("\\author{" ++ authorstext ++ "}") $$
85+ text ("\\date{" ++ datetext ++ "}")
86+ let header = text $ writerHeader options
87+ return $ header $$ titleblock $$ text "\\starttext\n\\maketitle\n"
8388
8489-- escape things as needed for ConTeXt
8590
@@ -106,43 +111,49 @@ stringToConTeXt :: String -> String
106111stringToConTeXt = concatMap escapeCharForConTeXt
107112
108113-- | Convert Pandoc block element to ConTeXt.
109−blockToConTeXt :: Block -> State WriterState String
110−blockToConTeXt Null = return ""
111−blockToConTeXt (Plain lst) = inlineListToConTeXt lst >>= return . (++ "\n")
112−blockToConTeXt (Para lst) = inlineListToConTeXt lst >>= return . (++ "\n\n")
113−blockToConTeXt (BlockQuote lst) = do
114− contents <- blockListToConTeXt lst
115− return $ "\\startblockquote\n" ++ contents ++ "\\stopblockquote\n\n"
116−blockToConTeXt (CodeBlock str) =
117− return $ "\\starttyping\n" ++ str ++ "\n\\stoptyping\n"
118−blockToConTeXt (RawHtml str) = return ""
119−blockToConTeXt (BulletList lst) = do
120− contents <- mapM listItemToConTeXt lst
121− return $ "\\startltxitem\n" ++ concat contents ++ "\\stopltxitem\n"
122−blockToConTeXt (OrderedList attribs lst) = case attribs of
114+blockToConTeXt :: WriterOptions
115+ -> Block
116+ -> State WriterState Doc
117+blockToConTeXt opts Null = return empty
118+blockToConTeXt opts (Plain lst) =
119+ wrapTeXIfNeeded opts (inlineListToConTeXt opts) lst >>= return
120+blockToConTeXt opts (Para lst) =
121+ wrapTeXIfNeeded opts (inlineListToConTeXt opts) lst >>= return . (<> char '\n')
122+blockToConTeXt opts (BlockQuote lst) = do
123+ contents <- blockListToConTeXt opts lst
124+ return $ text "\\startblockquote" $$ contents $$ text "\\stopblockquote"
125+blockToConTeXt opts (CodeBlock str) =
126+ return $ text $ "\\starttyping\n" ++ str ++ "\n\\stoptyping\n" -- \n needed
127+ -- because \stoptyping can't have anything after it
128+blockToConTeXt opts (RawHtml str) = return empty
129+blockToConTeXt opts (BulletList lst) = do
130+ contents <- mapM (listItemToConTeXt opts) lst
131+ return $ text "\\startltxitem" $$ vcat contents $$ text "\\stopltxitem"
132+blockToConTeXt opts (OrderedList attribs lst) = case attribs of
123133 (1, DefaultStyle, DefaultDelim) -> do
124− contents <- mapM listItemToConTeXt lst
125− return $ "\\startltxenum\n" ++ concat contents ++ "\\stopltxenum\n"
134+ contents <- mapM (listItemToConTeXt opts) lst
135+ return $ text "\\startltxenum"$$ vcat contents $$ text "\\stopltxenum"
126136 _ -> do
127137 let markers = take (length lst) $ orderedListMarkers attribs
128− contents <- zipWithM orderedListItemToConTeXt markers lst
138+ contents <- zipWithM (orderedListItemToConTeXt opts) markers lst
129139 let markerWidth = maximum $ map length markers
130140 let markerWidth' = if markerWidth < 3
131141 then ""
132142 else "[width=" ++
133143 show ((markerWidth + 2) `div` 2) ++ "em]"
134− return $ "\\startitemize" ++ markerWidth' ++ "\n" ++ concat contents ++
135− "\\stopitemize\n"
136−blockToConTeXt (DefinitionList lst) =
137− mapM defListItemToConTeXt lst >>= return . (++ "\n") . concat
138−blockToConTeXt HorizontalRule = return "\\thinrule\n\n"
139−blockToConTeXt (Header level lst) = do
140− contents <- inlineListToConTeXt lst
144+ return $ text ("\\startitemize" ++ markerWidth') $$ vcat contents $$
145+ text "\\stopitemize"
146+blockToConTeXt opts (DefinitionList lst) =
147+ mapM (defListItemToConTeXt opts) lst >>= return . (<> char '\n') . vcat
148+blockToConTeXt opts HorizontalRule = return $ text "\\thinrule\n"
149+blockToConTeXt opts (Header level lst) = do
150+ contents <- inlineListToConTeXt opts lst
151+ let base = if writerNumberSections opts then "section" else "subject"
141152 return $ if level > 0 && level <= 3
142− then "\\" ++ concat (replicate (level - 1) "sub") ++
143− "section{" ++ contents ++ "}\n\n"
144− else contents ++ "\n\n"
145−blockToConTeXt (Table caption aligns widths heads rows) = do
153+ then char '\\' <> text (concat (replicate (level - 1) "sub")) <>
154+ text base <> char '{' <> contents <> char '}' <> char '\n'
155+ else contents <> char '\n'
156+blockToConTeXt opts (Table caption aligns widths heads rows) = do
146157 let colWidths = map printDecimal widths
147158 let colDescriptor colWidth alignment = (case alignment of
148159 AlignLeft -> 'l'
@@ -152,43 +163,43 @@ blockToConTeXt (Table caption aligns widths heads rows) = do
152163 "p(" ++ colWidth ++ "\\textwidth)|"
153164 let colDescriptors = "|" ++ (concat $
154165 zipWith colDescriptor colWidths aligns)
155− headers <- tableRowToConTeXt heads
156− captionText <- inlineListToConTeXt caption
157− let captionText' = if null caption then "none" else captionText
158− rows' <- mapM tableRowToConTeXt rows
159− return $ "\\placetable[here]{" ++ captionText' ++ "}\n\\starttable[" ++
160− colDescriptors ++ "]\n" ++ "\\HL\n" ++ headers ++ "\\HL\n" ++
161− concat rows' ++ "\\HL\n\\stoptable\n\n"
166+ headers <- tableRowToConTeXt opts heads
167+ captionText <- inlineListToConTeXt opts caption
168+ let captionText' = if null caption then text "none" else captionText
169+ rows' <- mapM (tableRowToConTeXt opts) rows
170+ return $ text "\\placetable[here]{" <> captionText' <> char '}' $$
171+ text "\\starttable[" <> text colDescriptors <> char ']' $$
172+ text "\\HL" $$ headers $$ text "\\HL" $$
173+ vcat rows' $$ text "\\HL\n\\stoptable\n"
162174
163175printDecimal :: Float -> String
164176printDecimal = printf "%.2f"
165177
166−tableRowToConTeXt cols = do
167− cols' <- mapM blockListToConTeXt cols
168− return $ "\\NC " ++ (concat $ intersperse "\\NC " cols') ++ "\\NC\\AR\n"
178+tableRowToConTeXt opts cols = do
179+ cols' <- mapM (blockListToConTeXt opts) cols
180+ return $ (vcat (map (text "\\NC " <>) cols')) $$
181+ text "\\NC\\AR"
169182
170−listItemToConTeXt list = do
171− contents <- blockListToConTeXt list
172− return $ "\\item " ++ contents
183+listItemToConTeXt opts list = blockListToConTeXt opts list >>=
184+ return . (text "\\item " $$) . (nest 2)
173185
174−orderedListItemToConTeXt marker list = do
175− contents <- blockListToConTeXt list
176− return $ "\\sym{" ++ marker ++ "} " ++ contents
186+orderedListItemToConTeXt opts marker list = blockListToConTeXt opts list >>=
187+ return . (text ("\\sym{" ++ marker ++ "} ") $$) . (nest 2)
177188
178−defListItemToConTeXt (term, def) = do
179− term' <- inlineListToConTeXt term
180− def' <- blockListToConTeXt def
181− return $ "\\startdescr{" ++ term' ++ "}\n" ++
182− def' ++ "\n\\stopdescr\n"
189+defListItemToConTeXt opts (term, def) = do
190+ term' <- inlineListToConTeXt opts term
191+ def' <- blockListToConTeXt opts def
192+ return $ text "\\startdescr{" <> term' <> char '}' $$ def' $$ text "\\stopdescr"
183193
184194-- | Convert list of block elements to ConTeXt.
185−blockListToConTeXt :: [Block] -> State WriterState String
186−blockListToConTeXt lst = mapM blockToConTeXt lst >>= return . concat
195+blockListToConTeXt :: WriterOptions -> [Block] -> State WriterState Doc
196+blockListToConTeXt opts lst = mapM (blockToConTeXt opts) lst >>= return . vcat
187197
188198-- | Convert list of inline elements to ConTeXt.
189−inlineListToConTeXt :: [Inline] -- ^ Inlines to convert
190− -> State WriterState String
191−inlineListToConTeXt lst = mapM inlineToConTeXt lst >>= return . concat
199+inlineListToConTeXt :: WriterOptions
200+ -> [Inline] -- ^ Inlines to convert
201+ -> State WriterState Doc
202+inlineListToConTeXt opts lst = mapM (inlineToConTeXt opts) lst >>= return . hcat
192203
193204isQuoted :: Inline -> Bool
194205isQuoted (Quoted _ _) = True
@@ -196,53 +207,56 @@ isQuoted Apostrophe = True
196207isQuoted _ = False
197208
198209-- | Convert inline element to ConTeXt
199−inlineToConTeXt :: Inline -- ^ Inline to convert
200− -> State WriterState String
201−inlineToConTeXt (Emph lst) = do
202− contents <- inlineListToConTeXt lst
203− return $ "{\\em " ++ contents ++ "}"
204−inlineToConTeXt (Strong lst) = do
205− contents <- inlineListToConTeXt lst
206− return $ "{\\bf " ++ contents ++ "}"
207−inlineToConTeXt (Strikeout lst) = do
208− contents <- inlineListToConTeXt lst
209− return $ "\\overstrikes{" ++ contents ++ "}"
210−inlineToConTeXt (Superscript lst) = do
211− contents <- inlineListToConTeXt lst
212− return $ "\\high{" ++ contents ++ "}"
213−inlineToConTeXt (Subscript lst) = do
214− contents <- inlineListToConTeXt lst
215− return $ "\\low{" ++ contents ++ "}"
216−inlineToConTeXt (Code str) = return $ "\\type{" ++ str ++ "}"
217−inlineToConTeXt (Quoted SingleQuote lst) = do
218− contents <- inlineListToConTeXt lst
219− return $ "\\quote{" ++ contents ++ "}"
220−inlineToConTeXt (Quoted DoubleQuote lst) = do
221− contents <- inlineListToConTeXt lst
222− return $ "\\quotation{" ++ contents ++ "}"
223−inlineToConTeXt Apostrophe = return "'"
224−inlineToConTeXt EmDash = return "---"
225−inlineToConTeXt EnDash = return "--"
226−inlineToConTeXt Ellipses = return "\\ldots{}"
227−inlineToConTeXt (Str str) = return $ stringToConTeXt str
228−inlineToConTeXt (TeX str) = return str
229−inlineToConTeXt (HtmlInline str) = return ""
230−inlineToConTeXt (LineBreak) = return "\\crlf\n"
231−inlineToConTeXt Space = return " "
232−inlineToConTeXt (Link [Code str] (src, tit)) = -- since ConTeXt has its own
233− inlineToConTeXt (Link [Str str] (src, tit)) -- way of printing links...
234−inlineToConTeXt (Link text (src, _)) = do
210+inlineToConTeXt :: WriterOptions
211+ -> Inline -- ^ Inline to convert
212+ -> State WriterState Doc
213+inlineToConTeXt opts (Emph lst) = do
214+ contents <- inlineListToConTeXt opts lst
215+ return $ text "{\\em " <> contents <> char '}'
216+inlineToConTeXt opts (Strong lst) = do
217+ contents <- inlineListToConTeXt opts lst
218+ return $ text "{\\bf " <> contents <> char '}'
219+inlineToConTeXt opts (Strikeout lst) = do
220+ contents <- inlineListToConTeXt opts lst
221+ return $ text "\\overstrikes{" <> contents <> char '}'
222+inlineToConTeXt opts (Superscript lst) = do
223+ contents <- inlineListToConTeXt opts lst
224+ return $ text "\\high{" <> contents <> char '}'
225+inlineToConTeXt opts (Subscript lst) = do
226+ contents <- inlineListToConTeXt opts lst
227+ return $ text "\\low{" <> contents <> char '}'
228+inlineToConTeXt opts (Code str) = return $ text $ "\\type{" ++ str ++ "}"
229+inlineToConTeXt opts (Quoted SingleQuote lst) = do
230+ contents <- inlineListToConTeXt opts lst
231+ return $ text "\\quote{" <> contents <> char '}'
232+inlineToConTeXt opts (Quoted DoubleQuote lst) = do
233+ contents <- inlineListToConTeXt opts lst
234+ return $ text "\\quotation{" <> contents <> char '}'
235+inlineToConTeXt opts Apostrophe = return $ char '\''
236+inlineToConTeXt opts EmDash = return $ text "---"
237+inlineToConTeXt opts EnDash = return $ text "--"
238+inlineToConTeXt opts Ellipses = return $ text "\\ldots{}"
239+inlineToConTeXt opts (Str str) = return $ text $ stringToConTeXt str
240+inlineToConTeXt opts (TeX str) = return $ text str
241+inlineToConTeXt opts (HtmlInline str) = return empty
242+inlineToConTeXt opts (LineBreak) = return $ text "\\crlf\n"
243+inlineToConTeXt opts Space = return $ char ' '
244+inlineToConTeXt opts (Link [Code str] (src, tit)) = -- since ConTeXt has its own
245+ inlineToConTeXt opts (Link [Str str] (src, tit)) -- way of printing links...
246+inlineToConTeXt opts (Link txt (src, _)) = do
235247 next <- get
236248 put (next + 1)
237249 let ref = show next
238− label <- inlineListToConTeXt text
239− return $ "\\useurl[" ++ ref ++ "][" ++ src ++ "][][" ++ label ++
240− "]\\from[" ++ ref ++ "]"
241−inlineToConTeXt (Image alternate (src, tit)) = do
242− alt <- inlineListToConTeXt alternate
243− return $ "\\placefigure\n[]\n[fig:" ++ alt ++ "]\n{" ++
244− tit ++ "}\n{\\externalfigure[" ++ src ++ "]}"
245−inlineToConTeXt (Note contents) = do
246− contents' <- blockListToConTeXt contents
247− return $ "\\footnote{" ++ contents' ++ "}"
250+ label <- inlineListToConTeXt opts txt
251+ return $ text "\\useurl[" <> text ref <> text "][" <> text src <>
252+ text "][][" <> label <> text "]\\from[" <> text ref <> char ']'
253+inlineToConTeXt opts (Image alternate (src, tit)) = do
254+ alt <- inlineListToConTeXt opts alternate
255+ return $ text "\\placefigure\n[]\n[fig:" <> alt <> text "]\n{" <>
256+ text tit <> text "}\n{\\externalfigure[" <> text src <> text "]}"
257+inlineToConTeXt opts (Note contents) = do
258+ contents' <- blockListToConTeXt opts contents
259+ return $ text "\\footnote{" <>
260+ text (stripTrailingNewlines $ render contents') <>
261+ char '}'
248262