blob: dd7678f6335d2f872958765e65069fb99e735952 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
|
{-# LANGUAGE OverloadedStrings #-}
{- |
Module : Text.Pandoc.Writers.JATS.Table
Copyright : © 2020 Albert Krewinkel
License : GNU GPL, version 2 or above
Maintainer : Albert Krewinkel <tarleb@zeitkraut.de>
Stability : alpha
Portability : portable
Conversion of 'Pandoc' tables to JATS XML.
-}
module Text.Pandoc.Writers.JATS.Table
( tableToJATS
) where
import Control.Monad.Reader (asks)
import Data.Text (Text)
import Text.Pandoc.Class.PandocMonad (PandocMonad)
import Text.Pandoc.Definition
import Text.Pandoc.Options (WriterOptions)
import Text.DocLayout (Doc, empty, vcat, ($$))
import Text.Pandoc.Shared (tshow)
import Text.Pandoc.Writers.JATS.Types
import Text.Pandoc.Writers.Shared (toLegacyTable)
import Text.Pandoc.XML (inTags, inTagsIndented, selfClosingTag)
tableToJATS :: PandocMonad m
=> WriterOptions
-> Attr -> Caption -> [ColSpec] -> TableHead
-> [TableBody] -> TableFoot
-> JATS m (Doc Text)
tableToJATS opts _attr blkCapt specs th tb tf = do
blockToJATS <- asks jatsBlockWriter
let (caption, aligns, widths, headers, rows) =
toLegacyTable blkCapt specs th tb tf
captionDoc <- if null caption
then return mempty
else inTagsIndented "caption" <$> blockToJATS opts (Para caption)
tbl <- captionlessTable aligns widths headers rows
return $ inTags True "table-wrap" [] $ captionDoc $$ tbl
where
captionlessTable aligns widths headers rows = do
let percent w = tshow (truncate (100*w) :: Integer) <> "*"
let coltags = vcat $ zipWith (\w al -> selfClosingTag "col"
([("width", percent w) | w > 0] ++
[("align", alignmentToText al)])) widths aligns
thead <- if all null headers
then return empty
else inTagsIndented "thead" <$> tableRowToJATS opts True headers
tbody <- inTagsIndented "tbody" . vcat <$>
mapM (tableRowToJATS opts False) rows
return $ inTags True "table" [] $ coltags $$ thead $$ tbody
alignmentToText :: Alignment -> Text
alignmentToText alignment = case alignment of
AlignLeft -> "left"
AlignRight -> "right"
AlignCenter -> "center"
AlignDefault -> "left"
tableRowToJATS :: PandocMonad m
=> WriterOptions
-> Bool
-> [[Block]]
-> JATS m (Doc Text)
tableRowToJATS opts isHeader cols =
inTagsIndented "tr" . vcat <$> mapM (tableItemToJATS opts isHeader) cols
tableItemToJATS :: PandocMonad m
=> WriterOptions
-> Bool
-> [Block]
-> JATS m (Doc Text)
tableItemToJATS opts isHeader [Plain item] = do
inlinesToJATS <- asks jatsInlinesWriter
inTags False (if isHeader then "th" else "td") [] <$>
inlinesToJATS opts item
tableItemToJATS opts isHeader item = do
blockToJATS <- asks jatsBlockWriter
inTags False (if isHeader then "th" else "td") [] . vcat <$>
mapM (blockToJATS opts) item
|
