312349b · typeable/pandoc

1+{-# LANGUAGE OverloadedStrings #-}

1{-

2{-

3

4

34import CMarkGFM

35import CMarkGFM

35import Control.Monad.State.Strict (State, get, modify, runState)

36import Control.Monad.State.Strict (State, get, modify, runState)

36import Data.Foldable (foldrM)

37import Data.Foldable (foldrM)

37−import Data.Monoid (Any (..))

38+import Data.Monoid (Any (..), (<>))

39+import Data.List (transpose)

38import Data.Text (Text)

40import Data.Text (Text)

39import qualified Data.Text as T

41import qualified Data.Text as T

40import Text.Pandoc.Class (PandocMonad)

42import Text.Pandoc.Class (PandocMonad)

41import Text.Pandoc.Definition

43import Text.Pandoc.Definition

42import Text.Pandoc.Options

44import Text.Pandoc.Options

43−import Text.Pandoc.Shared (isTightList, linesToPara)

45+import Text.Pandoc.Shared (isTightList, linesToPara, substitute)

44import Text.Pandoc.Templates (renderTemplate')

46import Text.Pandoc.Templates (renderTemplate')

45import Text.Pandoc.Walk (walkM, walk, query)

47import Text.Pandoc.Walk (walkM, walk, query)

46import Text.Pandoc.Writers.HTML (writeHtml5String)

48import Text.Pandoc.Writers.HTML (writeHtml5String)

53 notes' = if null notes

55 notes' = if null notes

54 then []

56 then []

55 else [OrderedList (1, Decimal, Period) $ reverse notes]

57 else [OrderedList (1, Decimal, Period) $ reverse notes]

56− let softBreakToSpace SoftBreak = Space

57− softBreakToSpace x = x

58 let blocks'' = if writerWrapText opts == WrapNone

59 then walk softBreakToSpace blocks'

60 else blocks'

68 Nothing -> return main

69 Just tpl -> renderTemplate' tpl context

70

71+softBreakToSpace :: Inline -> Inline

72+softBreakToSpace SoftBreak = Space

73+softBreakToSpace x = x

74+

71processNotes :: Inline -> State [[Block]] Inline

75processNotes :: Inline -> State [[Block]] Inline

72processNotes (Note bs) = do

76processNotes (Note bs) = do

73 modify (bs :)

77 modify (bs :)

147 Plain (term ++ [LineBreak] ++ xs) : ys ++ concat zs

151 Plain (term ++ [LineBreak] ++ xs) : ys ++ concat zs

148 dlToBullet (term, xs) =

152 dlToBullet (term, xs) =

149 Para term : concat xs

153 Para term : concat xs

150−blockToNodes opts t@(Table _capt aligns widths headers rows) ns = do

154+blockToNodes opts t@(Table capt aligns widths headers rows) ns = do

151− let allrows = headers:rows

155+ let allcells = concat (headers:rows)

152 let isLineBreak LineBreak = Any True

156 let isLineBreak LineBreak = Any True

153 isLineBreak _ = Any False

157 isLineBreak _ = Any False

158+ let isPlainOrPara [Para _] = True

159+ isPlainOrPara [Plain _] = True

160+ isPlainOrPara [] = True

161+ isPlainOrPara _ = False

154 let isSimple = all (==0) widths &&

162 let isSimple = all (==0) widths &&

163+ all isPlainOrPara allcells &&

155− not ( getAny (query isLineBreak allrows) )

164+ not ( getAny (query isLineBreak allcells) )

156 if isEnabled Ext_pipe_tables opts && isSimple

165 if isEnabled Ext_pipe_tables opts && isSimple

157 then do

166 then do

158− let toAlign AlignDefault = NoAlignment

167+ -- We construct a table manually as a CUSTOM_BLOCK, for

159− toAlign AlignLeft = LeftAligned

168+ -- two reasons: (1) cmark-gfm currently doesn't support

160− toAlign AlignCenter = CenterAligned

169+ -- rendering TABLE nodes; (2) we can align the column sides;

161− toAlign AlignRight = RightAligned

170+ -- (3) we can render the caption as a regular paragraph.

162− let aligns' = map toAlign aligns

171+ let capt' = node PARAGRAPH (inlinesToNodes opts capt)

163− let toCell bs = node TABLE_CELL <$> blocksToNodes opts bs

172+ -- backslash | in code and raw:

164− let toRow cells = node TABLE_ROW <$> mapM toCell cells

173+ let fixPipe (Code attr xs) =

165− cmrows <- mapM toRow allrows

174+ Code attr (substitute "|" "\\|" xs)

166− return (node (TABLE aligns') cmrows : ns)

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)

167 else do -- fall back to raw HTML

226 else do -- fall back to raw HTML

168 s <- writeHtml5String def $! Pandoc nullMeta [t]

227 s <- writeHtml5String def $! Pandoc nullMeta [t]

169 return (node (HTML_BLOCK s) [] : ns)

228 return (node (HTML_BLOCK s) [] : ns)