@@ -35,16 +35,27 @@ import Data.List ( (\\), intersperse )
3535import Control.Monad.State
3636import Text.PrettyPrint.HughesPJ hiding ( Str )
3737
38−type WriterState = Int -- number of next URL reference
38+data WriterState =
39+ WriterState { stNextRef :: Int -- number of next URL reference
40+ , stOrderedListLevel :: Int -- level of ordered list
41+ , stOptions :: WriterOptions -- writer options
42+ }
43+
44+orderedListStyles = cycle ["[n]","[a]", "[r]", "[g]"]
3945
4046-- | Convert Pandoc to ConTeXt.
4147writeConTeXt :: WriterOptions -> Pandoc -> String
42−writeConTeXt options document = render $
43− evalState (pandocToConTeXt options document) 1
48+writeConTeXt options document =
49+ let defaultWriterState = WriterState { stNextRef = 1
50+ , stOrderedListLevel = 0
51+ , stOptions = options
52+ }
53+ in render $
54+ evalState (pandocToConTeXt options document) defaultWriterState
4455
4556pandocToConTeXt :: WriterOptions -> Pandoc -> State WriterState Doc
4657pandocToConTeXt options (Pandoc meta blocks) = do
47− main <- blockListToConTeXt options blocks
58+ main <- blockListToConTeXt blocks
4859 let before = if null (writerIncludeBefore options)
4960 then empty
5061 else text $ writerIncludeBefore options
@@ -70,7 +81,7 @@ contextHeader :: WriterOptions -- ^ Options, including ConTeXt header
7081contextHeader options (Meta title authors date) = do
7182 titletext <- if null title
7283 then return empty
73− else inlineListToConTeXt options title
84+ else inlineListToConTeXt title
7485 let authorstext = if null authors
7586 then ""
7687 else if length authors == 1
@@ -111,26 +122,35 @@ stringToConTeXt :: String -> String
111122stringToConTeXt = concatMap escapeCharForConTeXt
112123
113124-- | Convert Pandoc block element to ConTeXt.
114−blockToConTeXt :: WriterOptions
115− -> Block
125+blockToConTeXt :: Block
116126 -> State WriterState Doc
117−blockToConTeXt opts Null = return empty
118−blockToConTeXt opts (Plain lst) =
119− wrapTeXIfNeeded opts False (inlineListToConTeXt opts) lst >>= return
120−blockToConTeXt opts (Para lst) =
121− wrapTeXIfNeeded opts False (inlineListToConTeXt opts) lst >>= return . (<> char '\n')
122−blockToConTeXt opts (BlockQuote lst) = do
123− contents <- blockListToConTeXt opts lst
127+blockToConTeXt Null = return empty
128+blockToConTeXt (Plain lst) = do
129+ st <- get
130+ let options = stOptions st
131+ contents <- wrapTeXIfNeeded options False inlineListToConTeXt lst
132+ return contents
133+blockToConTeXt (Para lst) = do
134+ st <- get
135+ let options = stOptions st
136+ contents <- wrapTeXIfNeeded options False inlineListToConTeXt lst
137+ return $ contents <> char '\n'
138+blockToConTeXt (BlockQuote lst) = do
139+ contents <- blockListToConTeXt lst
124140 return $ text "\\startblockquote\n" $$ contents $$ text "\\stopblockquote"
125−blockToConTeXt opts (CodeBlock str) =
141+blockToConTeXt (CodeBlock str) =
126142 return $ text $ "\\starttyping\n" ++ str ++ "\n\\stoptyping\n" -- \n needed
127143 -- 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 (start, style, delim) lst) = do
133− contents <- mapM (listItemToConTeXt opts) lst
144+blockToConTeXt (RawHtml str) = return empty
145+blockToConTeXt (BulletList lst) = do
146+ contents <- mapM listItemToConTeXt lst
147+ return $ text "\\startitemize" $$ vcat contents $$ text "\\stopitemize\n"
148+blockToConTeXt (OrderedList (start, style, delim) lst) = do
149+ st <- get
150+ let level = stOrderedListLevel st
151+ put $ st {stOrderedListLevel = level + 1}
152+ contents <- mapM listItemToConTeXt lst
153+ put $ st {stOrderedListLevel = level}
134154 let start' = if start == 1 then "" else "start=" ++ show start
135155 let delim' = case delim of
136156 DefaultDelim -> ""
@@ -148,7 +168,7 @@ blockToConTeXt opts (OrderedList (start, style, delim) lst) = do
148168 then ""
149169 else "[" ++ joinWithSep "," specs2Items ++ "]"
150170 let style' = case style of
151− DefaultStyle -> if null specs2 then "" else "[]"
171+ DefaultStyle -> orderedListStyles !! level
152172 Decimal -> "[n]"
153173 LowerRoman -> "[r]"
154174 UpperRoman -> "[R]"
@@ -157,17 +177,19 @@ blockToConTeXt opts (OrderedList (start, style, delim) lst) = do
157177 let specs = style' ++ specs2
158178 return $ text ("\\startitemize" ++ specs) $$ vcat contents $$
159179 text "\\stopitemize\n"
160−blockToConTeXt opts (DefinitionList lst) =
161− mapM (defListItemToConTeXt opts) lst >>= return . (<> char '\n') . vcat
162−blockToConTeXt opts HorizontalRule = return $ text "\\thinrule\n"
163−blockToConTeXt opts (Header level lst) = do
164− contents <- inlineListToConTeXt opts lst
180+blockToConTeXt (DefinitionList lst) =
181+ mapM defListItemToConTeXt lst >>= return . (<> char '\n') . vcat
182+blockToConTeXt HorizontalRule = return $ text "\\thinrule\n"
183+blockToConTeXt (Header level lst) = do
184+ contents <- inlineListToConTeXt lst
185+ st <- get
186+ let opts = stOptions st
165187 let base = if writerNumberSections opts then "section" else "subject"
166188 return $ if level >= 1 && level <= 5
167189 then char '\\' <> text (concat (replicate (level - 1) "sub")) <>
168190 text base <> char '{' <> contents <> char '}' <> char '\n'
169191 else contents <> char '\n'
170−blockToConTeXt opts (Table caption aligns widths heads rows) = do
192+blockToConTeXt (Table caption aligns widths heads rows) = do
171193 let colWidths = map printDecimal widths
172194 let colDescriptor colWidth alignment = (case alignment of
173195 AlignLeft -> 'l'
@@ -177,10 +199,10 @@ blockToConTeXt opts (Table caption aligns widths heads rows) = do
177199 "p(" ++ colWidth ++ "\\textwidth)|"
178200 let colDescriptors = "|" ++ (concat $
179201 zipWith colDescriptor colWidths aligns)
180− headers <- tableRowToConTeXt opts heads
181− captionText <- inlineListToConTeXt opts caption
202+ headers <- tableRowToConTeXt heads
203+ captionText <- inlineListToConTeXt caption
182204 let captionText' = if null caption then text "none" else captionText
183− rows' <- mapM (tableRowToConTeXt opts) rows
205+ rows' <- mapM tableRowToConTeXt rows
184206 return $ text "\\placetable[here]{" <> captionText' <> char '}' $$
185207 text "\\starttable[" <> text colDescriptors <> char ']' $$
186208 text "\\HL" $$ headers $$ text "\\HL" $$
@@ -189,31 +211,30 @@ blockToConTeXt opts (Table caption aligns widths heads rows) = do
189211printDecimal :: Float -> String
190212printDecimal = printf "%.2f"
191213
192−tableRowToConTeXt opts cols = do
193− cols' <- mapM (blockListToConTeXt opts) cols
214+tableRowToConTeXt cols = do
215+ cols' <- mapM blockListToConTeXt cols
194216 return $ (vcat (map (text "\\NC " <>) cols')) $$
195217 text "\\NC\\AR"
196218
197−listItemToConTeXt opts list = blockListToConTeXt opts list >>=
219+listItemToConTeXt list = blockListToConTeXt list >>=
198220 return . (text "\\item " $$) . (nest 2)
199221
200−orderedListItemToConTeXt opts marker list = blockListToConTeXt opts list >>=
222+orderedListItemToConTeXt marker list = blockListToConTeXt list >>=
201223 return . (text ("\\sym{" ++ marker ++ "} ") $$) . (nest 2)
202224
203−defListItemToConTeXt opts (term, def) = do
204− term' <- inlineListToConTeXt opts term
205− def' <- blockListToConTeXt opts def
225+defListItemToConTeXt (term, def) = do
226+ term' <- inlineListToConTeXt term
227+ def' <- blockListToConTeXt def
206228 return $ text "\\startdescr{" <> term' <> char '}' $$ def' $$ text "\\stopdescr"
207229
208230-- | Convert list of block elements to ConTeXt.
209−blockListToConTeXt :: WriterOptions -> [Block] -> State WriterState Doc
210−blockListToConTeXt opts lst = mapM (blockToConTeXt opts) lst >>= return . vcat
231+blockListToConTeXt :: [Block] -> State WriterState Doc
232+blockListToConTeXt lst = mapM blockToConTeXt lst >>= return . vcat
211233
212234-- | Convert list of inline elements to ConTeXt.
213−inlineListToConTeXt :: WriterOptions
214− -> [Inline] -- ^ Inlines to convert
235+inlineListToConTeXt :: [Inline] -- ^ Inlines to convert
215236 -> State WriterState Doc
216−inlineListToConTeXt opts lst = mapM (inlineToConTeXt opts) lst >>= return . hcat
237+inlineListToConTeXt lst = mapM inlineToConTeXt lst >>= return . hcat
217238
218239isQuoted :: Inline -> Bool
219240isQuoted (Quoted _ _) = True
@@ -221,55 +242,55 @@ isQuoted Apostrophe = True
221242isQuoted _ = False
222243
223244-- | Convert inline element to ConTeXt
224−inlineToConTeXt :: WriterOptions
225− -> Inline -- ^ Inline to convert
245+inlineToConTeXt :: Inline -- ^ Inline to convert
226246 -> State WriterState Doc
227−inlineToConTeXt opts (Emph lst) = do
228− contents <- inlineListToConTeXt opts lst
247+inlineToConTeXt (Emph lst) = do
248+ contents <- inlineListToConTeXt lst
229249 return $ text "{\\em " <> contents <> char '}'
230−inlineToConTeXt opts (Strong lst) = do
231− contents <- inlineListToConTeXt opts lst
250+inlineToConTeXt (Strong lst) = do
251+ contents <- inlineListToConTeXt lst
232252 return $ text "{\\bf " <> contents <> char '}'
233−inlineToConTeXt opts (Strikeout lst) = do
234− contents <- inlineListToConTeXt opts lst
253+inlineToConTeXt (Strikeout lst) = do
254+ contents <- inlineListToConTeXt lst
235255 return $ text "\\overstrikes{" <> contents <> char '}'
236−inlineToConTeXt opts (Superscript lst) = do
237− contents <- inlineListToConTeXt opts lst
256+inlineToConTeXt (Superscript lst) = do
257+ contents <- inlineListToConTeXt lst
238258 return $ text "\\high{" <> contents <> char '}'
239−inlineToConTeXt opts (Subscript lst) = do
240− contents <- inlineListToConTeXt opts lst
259+inlineToConTeXt (Subscript lst) = do
260+ contents <- inlineListToConTeXt lst
241261 return $ text "\\low{" <> contents <> char '}'
242−inlineToConTeXt opts (Code str) = return $ text $ "\\type{" ++ str ++ "}"
243−inlineToConTeXt opts (Quoted SingleQuote lst) = do
244− contents <- inlineListToConTeXt opts lst
262+inlineToConTeXt (Code str) = return $ text $ "\\type{" ++ str ++ "}"
263+inlineToConTeXt (Quoted SingleQuote lst) = do
264+ contents <- inlineListToConTeXt lst
245265 return $ text "\\quote{" <> contents <> char '}'
246−inlineToConTeXt opts (Quoted DoubleQuote lst) = do
247− contents <- inlineListToConTeXt opts lst
266+inlineToConTeXt (Quoted DoubleQuote lst) = do
267+ contents <- inlineListToConTeXt lst
248268 return $ text "\\quotation{" <> contents <> char '}'
249−inlineToConTeXt opts Apostrophe = return $ char '\''
250−inlineToConTeXt opts EmDash = return $ text "---"
251−inlineToConTeXt opts EnDash = return $ text "--"
252−inlineToConTeXt opts Ellipses = return $ text "\\ldots{}"
253−inlineToConTeXt opts (Str str) = return $ text $ stringToConTeXt str
254−inlineToConTeXt opts (TeX str) = return $ text str
255−inlineToConTeXt opts (HtmlInline str) = return empty
256−inlineToConTeXt opts (LineBreak) = return $ text "\\crlf\n"
257−inlineToConTeXt opts Space = return $ char ' '
258−inlineToConTeXt opts (Link [Code str] (src, tit)) = -- since ConTeXt has its own
259− inlineToConTeXt opts (Link [Str str] (src, tit)) -- way of printing links...
260−inlineToConTeXt opts (Link txt (src, _)) = do
261− next <- get
262− put (next + 1)
269+inlineToConTeXt Apostrophe = return $ char '\''
270+inlineToConTeXt EmDash = return $ text "---"
271+inlineToConTeXt EnDash = return $ text "--"
272+inlineToConTeXt Ellipses = return $ text "\\ldots{}"
273+inlineToConTeXt (Str str) = return $ text $ stringToConTeXt str
274+inlineToConTeXt (TeX str) = return $ text str
275+inlineToConTeXt (HtmlInline str) = return empty
276+inlineToConTeXt (LineBreak) = return $ text "\\crlf\n"
277+inlineToConTeXt Space = return $ char ' '
278+inlineToConTeXt (Link [Code str] (src, tit)) = -- since ConTeXt has its own
279+ inlineToConTeXt (Link [Str str] (src, tit)) -- way of printing links...
280+inlineToConTeXt (Link txt (src, _)) = do
281+ st <- get
282+ let next = stNextRef st
283+ put $ st {stNextRef = next + 1}
263284 let ref = show next
264− label <- inlineListToConTeXt opts txt
285+ label <- inlineListToConTeXt txt
265286 return $ text "\\useurl[" <> text ref <> text "][" <> text src <>
266287 text "][][" <> label <> text "]\\from[" <> text ref <> char ']'
267−inlineToConTeXt opts (Image alternate (src, tit)) = do
268− alt <- inlineListToConTeXt opts alternate
288+inlineToConTeXt (Image alternate (src, tit)) = do
289+ alt <- inlineListToConTeXt alternate
269290 return $ text "\\placefigure\n[]\n[fig:" <> alt <> text "]\n{" <>
270291 text tit <> text "}\n{\\externalfigure[" <> text src <> text "]}"
271−inlineToConTeXt opts (Note contents) = do
272− contents' <- blockListToConTeXt opts contents
292+inlineToConTeXt (Note contents) = do
293+ contents' <- blockListToConTeXt contents
273294 return $ text " \\footnote{" <>
274295 text (stripTrailingNewlines $ render contents') <>
275296 char '}'