@@ -1,3 +1,4 @@
1+{-# LANGUAGE OverloadedStrings #-}
12{-
23Copyright (C) 2015 John MacFarlane <jgm@berkeley.edu>
34
@@ -34,13 +35,14 @@ module Text.Pandoc.Writers.CommonMark (writeCommonMark) where
3435import CMarkGFM
3536import Control.Monad.State.Strict (State, get, modify, runState)
3637import Data.Foldable (foldrM)
37−import Data.Monoid (Any (..))
38+import Data.Monoid (Any (..), (<>))
39+import Data.List (transpose)
3840import Data.Text (Text)
3941import qualified Data.Text as T
4042import Text.Pandoc.Class (PandocMonad)
4143import Text.Pandoc.Definition
4244import Text.Pandoc.Options
43−import Text.Pandoc.Shared (isTightList, linesToPara)
45+import Text.Pandoc.Shared (isTightList, linesToPara, substitute)
4446import Text.Pandoc.Templates (renderTemplate')
4547import Text.Pandoc.Walk (walkM, walk, query)
4648import Text.Pandoc.Writers.HTML (writeHtml5String)
@@ -53,8 +55,6 @@ writeCommonMark opts (Pandoc meta blocks) = do
5355 notes' = if null notes
5456 then []
5557 else [OrderedList (1, Decimal, Period) $ reverse notes]
56− let softBreakToSpace SoftBreak = Space
57− softBreakToSpace x = x
5858 let blocks'' = if writerWrapText opts == WrapNone
5959 then walk softBreakToSpace blocks'
6060 else blocks'
@@ -68,6 +68,10 @@ writeCommonMark opts (Pandoc meta blocks) = do
6868 Nothing -> return main
6969 Just tpl -> renderTemplate' tpl context
7070
71+softBreakToSpace :: Inline -> Inline
72+softBreakToSpace SoftBreak = Space
73+softBreakToSpace x = x
74+
7175processNotes :: Inline -> State [[Block]] Inline
7276processNotes (Note bs) = do
7377 modify (bs :)
@@ -147,23 +151,78 @@ blockToNodes opts (DefinitionList items) ns =
147151 Plain (term ++ [LineBreak] ++ xs) : ys ++ concat zs
148152 dlToBullet (term, xs) =
149153 Para term : concat xs
150−blockToNodes opts t@(Table _capt aligns widths headers rows) ns = do
151− let allrows = headers:rows
154+blockToNodes opts t@(Table capt aligns widths headers rows) ns = do
155+ let allcells = concat (headers:rows)
152156 let isLineBreak LineBreak = Any True
153157 isLineBreak _ = Any False
158+ let isPlainOrPara [Para _] = True
159+ isPlainOrPara [Plain _] = True
160+ isPlainOrPara [] = True
161+ isPlainOrPara _ = False
154162 let isSimple = all (==0) widths &&
155− not ( getAny (query isLineBreak allrows) )
163+ all isPlainOrPara allcells &&
164+ not ( getAny (query isLineBreak allcells) )
156165 if isEnabled Ext_pipe_tables opts && isSimple
157166 then do
158− let toAlign AlignDefault = NoAlignment
159− toAlign AlignLeft = LeftAligned
160− toAlign AlignCenter = CenterAligned
161− toAlign AlignRight = RightAligned
162− let aligns' = map toAlign aligns
163− let toCell bs = node TABLE_CELL <$> blocksToNodes opts bs
164− let toRow cells = node TABLE_ROW <$> mapM toCell cells
165− cmrows <- mapM toRow allrows
166− return (node (TABLE aligns') cmrows : ns)
167+ -- We construct a table manually as a CUSTOM_BLOCK, for
168+ -- two reasons: (1) cmark-gfm currently doesn't support
169+ -- rendering TABLE nodes; (2) we can align the column sides;
170+ -- (3) we can render the caption as a regular paragraph.
171+ let capt' = node PARAGRAPH (inlinesToNodes opts capt)
172+ -- backslash | in code and raw:
173+ let fixPipe (Code attr xs) =
174+ Code attr (substitute "|" "\\|" xs)
175+ fixPipe (RawInline format xs) =
176+ RawInline format (substitute "|" "\\|" xs)
177+ fixPipe x = x
178+ let toCell [Plain ils] = T.strip
179+ $ nodeToCommonmark [] Nothing
180+ $ node (CUSTOM_INLINE mempty mempty)
181+ $ inlinesToNodes opts
182+ $ walk (fixPipe . softBreakToSpace) ils
183+ toCell [Para ils] = T.strip
184+ $ nodeToCommonmark [] Nothing
185+ $ node (CUSTOM_INLINE mempty mempty)
186+ $ inlinesToNodes opts
187+ $ walk (fixPipe . softBreakToSpace) ils
188+ toCell [] = ""
189+ toCell xs = error $ "toCell encountered " ++ show xs
190+ let separator = " | "
191+ let starter = "| "
192+ let ender = " |"
193+ let rawheaders = map toCell headers
194+ let rawrows = map (map toCell) rows
195+ let maximum' [] = 0
196+ maximum' xs = maximum xs
197+ let colwidths = map (maximum' . map T.length) $
198+ transpose (rawheaders:rawrows)
199+ let toHeaderLine len AlignDefault = T.replicate len "-"
200+ toHeaderLine len AlignLeft = ":" <>
201+ T.replicate (max (len - 1) 1) "-"
202+ toHeaderLine len AlignRight =
203+ T.replicate (max (len - 1) 1) "-" <> ":"
204+ toHeaderLine len AlignCenter = ":" <>
205+ T.replicate (max (len - 2) 1) (T.pack "-") <> ":"
206+ let rawheaderlines = zipWith toHeaderLine colwidths aligns
207+ let headerlines = starter <> T.intercalate separator rawheaderlines <>
208+ ender
209+ let padContent (align, w) t' =
210+ let padding = w - T.length t'
211+ halfpadding = padding `div` 2
212+ in case align of
213+ AlignRight -> T.replicate padding " " <> t'
214+ AlignCenter -> T.replicate halfpadding " " <> t' <>
215+ T.replicate (padding - halfpadding) " "
216+ _ -> t' <> T.replicate padding " "
217+ let toRow xs = starter <> T.intercalate separator
218+ (zipWith padContent (zip aligns colwidths) xs) <>
219+ ender
220+ let table' = toRow rawheaders <> "\n" <> headerlines <> "\n" <>
221+ T.intercalate "\n" (map toRow rawrows)
222+ return (node (CUSTOM_BLOCK table' mempty) [] :
223+ if null capt
224+ then ns
225+ else capt' : ns)
167226 else do -- fall back to raw HTML
168227 s <- writeHtml5String def $! Pandoc nullMeta [t]
169228 return (node (HTML_BLOCK s) [] : ns)