{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- |
--   Module      : Text.Pandoc.Writers.XML
--   Copyright   : Copyright (C) 2025- Massimiliano Farinella and John MacFarlane
--   License     : GNU GPL, version 2 or above
--
--   Maintainer  : Massimiliano Farinella <massifrg@gmail.com>
--   Stability   : WIP
--   Portability : portable
--
-- Conversion of 'Pandoc' documents to (pandoc specific) xml markup.
module Text.Pandoc.Writers.XML (writeXML) where

import Data.Map (Map, toList)
import Data.Maybe (mapMaybe)
import qualified Data.Text as T
import Data.Version (versionBranch)
import Text.Pandoc.Class.PandocMonad (PandocMonad)
import Text.Pandoc.Definition
import Text.Pandoc.Options (WriterOptions (..))
import Text.Pandoc.XML.Light
import qualified Text.Pandoc.XML.Light as XML
import Text.Pandoc.XMLFormat
import Text.XML.Light (xml_header)

type PandocAttr = Text.Pandoc.Definition.Attr

writeXML :: (PandocMonad m) => WriterOptions -> Pandoc -> m T.Text
writeXML :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeXML WriterOptions
_ Pandoc
doc = do
  Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ Pandoc -> Text
pandocToXmlText Pandoc
doc

text_node :: T.Text -> Content
text_node :: Text -> Content
text_node Text
text = CData -> Content
Text (CDataKind -> Text -> Maybe Line -> CData
CData CDataKind
CDataText Text
text Maybe Line
forall a. Maybe a
Nothing)

emptyElement :: T.Text -> Element
emptyElement :: Text -> Element
emptyElement Text
tag =
  Element
    { elName :: QName
elName = Text -> QName
unqual Text
tag,
      elAttribs :: [Attr]
elAttribs = [],
      elContent :: [Content]
elContent = [],
      elLine :: Maybe Line
elLine = Maybe Line
forall a. Maybe a
Nothing
    }

elementWithContents :: T.Text -> [Content] -> Element
elementWithContents :: Text -> [Content] -> Element
elementWithContents Text
tag [Content]
contents =
  Element
    { elName :: QName
elName = Text -> QName
unqual Text
tag,
      elAttribs :: [Attr]
elAttribs = [],
      elContent :: [Content]
elContent = [Content]
contents,
      elLine :: Maybe Line
elLine = Maybe Line
forall a. Maybe a
Nothing
    }

elementWithAttributes :: T.Text -> [XML.Attr] -> Element
elementWithAttributes :: Text -> [Attr] -> Element
elementWithAttributes Text
tag [Attr]
attributes =
  Element
    { elName :: QName
elName = Text -> QName
unqual Text
tag,
      elAttribs :: [Attr]
elAttribs = [Attr]
attributes,
      elContent :: [Content]
elContent = [],
      elLine :: Maybe Line
elLine = Maybe Line
forall a. Maybe a
Nothing
    }

elementWithAttrAndContents :: T.Text -> PandocAttr -> [Content] -> Element
elementWithAttrAndContents :: Text -> PandocAttr -> [Content] -> Element
elementWithAttrAndContents Text
tag PandocAttr
attr [Content]
contents = PandocAttr -> Element -> Element
addAttrAttributes PandocAttr
attr (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> [Content] -> Element
elementWithContents Text
tag [Content]
contents

asBlockOfInlines :: Element -> [Content]
asBlockOfInlines :: Element -> [Content]
asBlockOfInlines Element
el = [Element -> Content
Elem Element
el, Text -> Content
text_node Text
"\n"]

asBlockOfBlocks :: Element -> [Content]
asBlockOfBlocks :: Element -> [Content]
asBlockOfBlocks Element
el = [Element -> Content
Elem Element
newline_before_first, Content
newline]
  where
    newline :: Content
newline = Text -> Content
text_node Text
"\n"
    newline_before_first :: Element
newline_before_first = if [Content] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Element -> [Content]
elContent Element
el) then Element
el else [Content] -> Element -> Element
prependContents [Content
newline] Element
el

itemName :: (Show a) => a -> T.Text
itemName :: forall a. Show a => a -> Text
itemName a
a = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') (a -> String
forall a. Show a => a -> String
show a
a)

intAsText :: Int -> T.Text
intAsText :: Int -> Text
intAsText Int
i = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
i

itemAsEmptyElement :: (Show a) => a -> Element
itemAsEmptyElement :: forall a. Show a => a -> Element
itemAsEmptyElement a
item = Text -> Element
emptyElement (Text -> Element) -> Text -> Element
forall a b. (a -> b) -> a -> b
$ a -> Text
forall a. Show a => a -> Text
itemName a
item

pandocToXmlText :: Pandoc -> T.Text
pandocToXmlText :: Pandoc -> Text
pandocToXmlText (Pandoc (Meta Map Text MetaValue
meta) [Block]
blocks) = Element -> Text
with_header (Element -> Text) -> (Element -> Element) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Element
with_blocks (Element -> Element) -> (Element -> Element) -> Element -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Element
with_meta (Element -> Element) -> (Element -> Element) -> Element -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Element
with_version (Element -> Text) -> Element -> Text
forall a b. (a -> b) -> a -> b
$ Element
el
  where
    el :: Element
el = [Content] -> Element -> Element
prependContents [Text -> Content
text_node Text
"\n"] (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> Element
emptyElement Text
"Pandoc"
    with_version :: Element -> Element
with_version = Text -> Text -> Element -> Element
addAttribute Text
atNameApiVersion (Text -> [Text] -> Text
T.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Text
T.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) ([Int] -> [Text]) -> [Int] -> [Text]
forall a b. (a -> b) -> a -> b
$ Version -> [Int]
versionBranch Version
pandocTypesVersion)
    with_meta :: Element -> Element
with_meta = [Content] -> Element -> Element
appendContents (Map Text MetaValue -> Text -> [Content]
metaMapToXML Map Text MetaValue
meta Text
"meta")
    with_blocks :: Element -> Element
with_blocks = [Content] -> Element -> Element
appendContents (Element -> [Content]
asBlockOfBlocks (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ Text -> [Content] -> Element
elementWithContents Text
"blocks" ([Content] -> Element) -> [Content] -> Element
forall a b. (a -> b) -> a -> b
$ [Block] -> [Content]
blocksToXML [Block]
blocks)
    with_header :: Element -> T.Text
    with_header :: Element -> Text
with_header Element
e = [Text] -> Text
T.concat [String -> Text
T.pack String
xml_header, Text
"\n", Element -> Text
showElement Element
e]

metaMapToXML :: Map T.Text MetaValue -> T.Text -> [Content]
metaMapToXML :: Map Text MetaValue -> Text -> [Content]
metaMapToXML Map Text MetaValue
mmap Text
tag = Element -> [Content]
asBlockOfBlocks (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ Text -> [Content] -> Element
elementWithContents Text
tag [Content]
entries
  where
    entries :: [Content]
entries = ((Text, MetaValue) -> [Content])
-> [(Text, MetaValue)] -> [Content]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text, MetaValue) -> [Content]
to_entry ([(Text, MetaValue)] -> [Content])
-> [(Text, MetaValue)] -> [Content]
forall a b. (a -> b) -> a -> b
$ Map Text MetaValue -> [(Text, MetaValue)]
forall k a. Map k a -> [(k, a)]
toList Map Text MetaValue
mmap
    to_entry :: (T.Text, MetaValue) -> [Content]
    to_entry :: (Text, MetaValue) -> [Content]
to_entry (Text
text, MetaValue
metavalue) = Element -> [Content]
asBlockOfBlocks Element
with_key
      where
        entry :: Element
entry = Text -> [Content] -> Element
elementWithContents Text
tgNameMetaMapEntry ([Content] -> Element) -> [Content] -> Element
forall a b. (a -> b) -> a -> b
$ MetaValue -> [Content]
metaValueToXML MetaValue
metavalue
        with_key :: Element
with_key = Text -> Text -> Element -> Element
addAttribute Text
atNameMetaMapEntryKey Text
text Element
entry

metaValueToXML :: MetaValue -> [Content]
metaValueToXML :: MetaValue -> [Content]
metaValueToXML MetaValue
value =
  let name :: Text
name = MetaValue -> Text
forall a. Show a => a -> Text
itemName MetaValue
value
      el :: Element
el = MetaValue -> Element
forall a. Show a => a -> Element
itemAsEmptyElement MetaValue
value
   in case (MetaValue
value) of
        MetaBool Bool
b -> Element -> [Content]
asBlockOfInlines (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Element -> Element
addAttribute Text
atNameMetaBoolValue Text
bool_value Element
el
          where
            bool_value :: Text
bool_value = if Bool
b then Text
"true" else Text
"false"
        MetaString Text
s -> Element -> [Content]
asBlockOfInlines (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ [Content] -> Element -> Element
appendContents [Text -> Content
text_node Text
s] Element
el
        MetaInlines [Inline]
inlines -> Element -> [Content]
asBlockOfInlines (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ [Content] -> Element -> Element
appendContents ([Inline] -> [Content]
inlinesToXML [Inline]
inlines) Element
el
        MetaBlocks [Block]
blocks -> Element -> [Content]
asBlockOfBlocks (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ [Content] -> Element -> Element
appendContents ([Block] -> [Content]
blocksToXML [Block]
blocks) Element
el
        MetaList [MetaValue]
items -> Element -> [Content]
asBlockOfBlocks (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ [Content] -> Element -> Element
appendContents ((MetaValue -> [Content]) -> [MetaValue] -> [Content]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap MetaValue -> [Content]
metaValueToXML [MetaValue]
items) Element
el
        MetaMap Map Text MetaValue
mm -> Map Text MetaValue -> Text -> [Content]
metaMapToXML Map Text MetaValue
mm Text
name

blocksToXML :: [Block] -> [Content]
blocksToXML :: [Block] -> [Content]
blocksToXML [Block]
blocks = (Block -> [Content]) -> [Block] -> [Content]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Block -> [Content]
blockToXML [Block]
blocks

inlinesToXML :: [Inline] -> [Content]
inlinesToXML :: [Inline] -> [Content]
inlinesToXML [Inline]
inlines = (InlineContent -> [Content]) -> [InlineContent] -> [Content]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap InlineContent -> [Content]
inlineContentToContents ([Inline] -> [InlineContent] -> [InlineContent]
ilsToIlsContent [Inline]
inlines [])

data InlineContent
  = NormalInline Inline
  | ElSpace Int
  | ElStr T.Text

ilsToIlsContent :: [Inline] -> [InlineContent] -> [InlineContent]
ilsToIlsContent :: [Inline] -> [InlineContent] -> [InlineContent]
ilsToIlsContent (Inline
Space : [Inline]
xs) [] = [Inline] -> [InlineContent] -> [InlineContent]
ilsToIlsContent [Inline]
xs [Int -> InlineContent
ElSpace Int
1]
ilsToIlsContent (Inline
Space : [Inline]
xs) (NormalInline Inline
Space : [InlineContent]
cs) = [Inline] -> [InlineContent] -> [InlineContent]
ilsToIlsContent [Inline]
xs (Int -> InlineContent
ElSpace Int
2 InlineContent -> [InlineContent] -> [InlineContent]
forall a. a -> [a] -> [a]
: [InlineContent]
cs)
ilsToIlsContent (Inline
Space : [Inline]
xs) (ElSpace Int
n : [InlineContent]
cs) = [Inline] -> [InlineContent] -> [InlineContent]
ilsToIlsContent [Inline]
xs (Int -> InlineContent
ElSpace (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) InlineContent -> [InlineContent] -> [InlineContent]
forall a. a -> [a] -> [a]
: [InlineContent]
cs)
-- empty Str are always encoded as <Str />
ilsToIlsContent (Str Text
"" : [Inline]
xs) [InlineContent]
ilct = [Inline] -> [InlineContent] -> [InlineContent]
ilsToIlsContent [Inline]
xs (Text -> InlineContent
ElStr Text
"" InlineContent -> [InlineContent] -> [InlineContent]
forall a. a -> [a] -> [a]
: [InlineContent]
ilct)
-- Str s1, Str s2 -> s1<Str content="s2">
ilsToIlsContent (Str Text
s2 : [Inline]
xs) (NormalInline str1 :: Inline
str1@(Str Text
_) : [InlineContent]
ilct) = [Inline] -> [InlineContent] -> [InlineContent]
ilsToIlsContent [Inline]
xs (Text -> InlineContent
ElStr Text
s2 InlineContent -> [InlineContent] -> [InlineContent]
forall a. a -> [a] -> [a]
: Inline -> InlineContent
NormalInline Inline
str1 InlineContent -> [InlineContent] -> [InlineContent]
forall a. a -> [a] -> [a]
: [InlineContent]
ilct)
--
ilsToIlsContent (Str Text
s : [Inline]
xs) [InlineContent]
ilct =
  if (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') Text
s
    then [Inline] -> [InlineContent] -> [InlineContent]
ilsToIlsContent [Inline]
xs (Text -> InlineContent
ElStr Text
s InlineContent -> [InlineContent] -> [InlineContent]
forall a. a -> [a] -> [a]
: [InlineContent]
ilct)
    else [Inline] -> [InlineContent] -> [InlineContent]
ilsToIlsContent [Inline]
xs (Inline -> InlineContent
NormalInline (Text -> Inline
Str Text
s) InlineContent -> [InlineContent] -> [InlineContent]
forall a. a -> [a] -> [a]
: [InlineContent]
ilct)
ilsToIlsContent (Inline
x : [Inline]
xs) [InlineContent]
ilct = [Inline] -> [InlineContent] -> [InlineContent]
ilsToIlsContent [Inline]
xs (Inline -> InlineContent
NormalInline Inline
x InlineContent -> [InlineContent] -> [InlineContent]
forall a. a -> [a] -> [a]
: [InlineContent]
ilct)
ilsToIlsContent [] [InlineContent]
ilct = [InlineContent] -> [InlineContent]
forall a. [a] -> [a]
reverse ([InlineContent] -> [InlineContent])
-> [InlineContent] -> [InlineContent]
forall a b. (a -> b) -> a -> b
$ [InlineContent] -> [InlineContent]
lastSpaceAsElem [InlineContent]
ilct
  where
    lastSpaceAsElem :: [InlineContent] -> [InlineContent]
    lastSpaceAsElem :: [InlineContent] -> [InlineContent]
lastSpaceAsElem (NormalInline Inline
Space : [InlineContent]
xs) = Int -> InlineContent
ElSpace Int
1 InlineContent -> [InlineContent] -> [InlineContent]
forall a. a -> [a] -> [a]
: [InlineContent]
xs
    lastSpaceAsElem [InlineContent]
ilcts = [InlineContent]
ilcts

inlineContentToContents :: InlineContent -> [Content]
inlineContentToContents :: InlineContent -> [Content]
inlineContentToContents (NormalInline Inline
il) = Inline -> [Content]
inlineToXML Inline
il
inlineContentToContents (ElSpace Int
1) = [Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ Text -> Element
emptyElement Text
"Space"]
inlineContentToContents (ElSpace Int
n) = [Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Element -> Element
addAttribute Text
atNameSpaceCount (Int -> Text
intAsText Int
n) (Text -> Element
emptyElement Text
"Space")]
inlineContentToContents (ElStr Text
"") = [Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ Text -> Element
emptyElement Text
"Str"]
inlineContentToContents (ElStr Text
s) = [Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Element -> Element
addAttribute Text
atNameStrContent Text
s (Text -> Element
emptyElement Text
"Str")]

asContents :: Element -> [Content]
asContents :: Element -> [Content]
asContents Element
el = [Element -> Content
Elem Element
el]

wrapBlocks :: T.Text -> [Block] -> [Content]
wrapBlocks :: Text -> [Block] -> [Content]
wrapBlocks Text
tag [Block]
blocks = Element -> [Content]
asBlockOfBlocks (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ Text -> [Content] -> Element
elementWithContents Text
tag ([Content] -> Element) -> [Content] -> Element
forall a b. (a -> b) -> a -> b
$ [Block] -> [Content]
blocksToXML [Block]
blocks

wrapArrayOfBlocks :: T.Text -> [[Block]] -> [Content]
wrapArrayOfBlocks :: Text -> [[Block]] -> [Content]
wrapArrayOfBlocks Text
tag [[Block]]
array = ([Block] -> [Content]) -> [[Block]] -> [Content]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text -> [Block] -> [Content]
wrapBlocks Text
tag) [[Block]]
array

-- wrapInlines :: T.Text -> [Inline] -> [Content]
-- wrapInlines tag inlines = asBlockOfInlines $ element_with_contents tag $ inlinesToXML inlines

blockToXML :: Block -> [Content]
blockToXML :: Block -> [Content]
blockToXML Block
block =
  let el :: Element
el = Block -> Element
forall a. Show a => a -> Element
itemAsEmptyElement Block
block
   in case (Block
block) of
        Para [Inline]
inlines -> Element -> [Content]
asBlockOfInlines (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ [Content] -> Element -> Element
appendContents ([Inline] -> [Content]
inlinesToXML [Inline]
inlines) Element
el
        Header Int
level (Text
idn, [Text]
cls, [(Text, Text)]
attrs) [Inline]
inlines -> Element -> [Content]
asBlockOfInlines (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ [Content] -> Element -> Element
appendContents ([Inline] -> [Content]
inlinesToXML [Inline]
inlines) Element
with_attr
          where
            with_attr :: Element
with_attr = PandocAttr -> Element -> Element
addAttrAttributes (Text
idn, [Text]
cls, [(Text, Text)]
attrs [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(Text
atNameLevel, Int -> Text
intAsText Int
level)]) Element
el
        Plain [Inline]
inlines -> Element -> [Content]
asBlockOfInlines (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ [Content] -> Element -> Element
appendContents ([Inline] -> [Content]
inlinesToXML [Inline]
inlines) Element
el
        Div PandocAttr
attr [Block]
blocks -> Element -> [Content]
asBlockOfBlocks (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ [Content] -> Element -> Element
appendContents ([Block] -> [Content]
blocksToXML [Block]
blocks) Element
with_attr
          where
            with_attr :: Element
with_attr = PandocAttr -> Element -> Element
addAttrAttributes PandocAttr
attr Element
el
        BulletList [[Block]]
items -> Element -> [Content]
asBlockOfBlocks (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ [Content] -> Element -> Element
appendContents (Text -> [[Block]] -> [Content]
wrapArrayOfBlocks Text
tgNameListItem [[Block]]
items) Element
el
        OrderedList (Int
start, ListNumberStyle
style, ListNumberDelim
delim) [[Block]]
items -> Element -> [Content]
asBlockOfBlocks (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ Element -> Element
with_contents (Element -> Element) -> (Element -> Element) -> Element -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Element
with_attrs (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Element
el
          where
            with_attrs :: Element -> Element
with_attrs =
              [Attr] -> Element -> Element
addAttributes
                ( [(Text, Text)] -> [Attr]
validAttributes
                    [ (Text
atNameStart, Int -> Text
intAsText Int
start),
                      (Text
atNameNumberStyle, ListNumberStyle -> Text
forall a. Show a => a -> Text
itemName ListNumberStyle
style),
                      (Text
atNameNumberDelim, ListNumberDelim -> Text
forall a. Show a => a -> Text
itemName ListNumberDelim
delim)
                    ]
                )
            with_contents :: Element -> Element
with_contents = [Content] -> Element -> Element
appendContents (Text -> [[Block]] -> [Content]
wrapArrayOfBlocks Text
tgNameListItem [[Block]]
items)
        BlockQuote [Block]
blocks -> Element -> [Content]
asBlockOfBlocks (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ [Content] -> Element -> Element
appendContents ([Block] -> [Content]
blocksToXML [Block]
blocks) Element
el
        Block
HorizontalRule -> Element -> [Content]
asBlockOfInlines Element
el
        CodeBlock PandocAttr
attr Text
text -> Element -> [Content]
asBlockOfInlines (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ Element -> Element
with_contents (Element -> Element) -> (Element -> Element) -> Element -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Element
with_attr (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Element
el
          where
            with_contents :: Element -> Element
with_contents = [Content] -> Element -> Element
appendContents [Text -> Content
text_node Text
text]
            with_attr :: Element -> Element
with_attr = PandocAttr -> Element -> Element
addAttrAttributes PandocAttr
attr
        LineBlock [[Inline]]
lins -> Element -> [Content]
asBlockOfBlocks (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ [Content] -> Element -> Element
appendContents (([Inline] -> [Content]) -> [[Inline]] -> [Content]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Inline] -> [Content]
wrapInlines [[Inline]]
lins) Element
el
          where
            wrapInlines :: [Inline] -> [Content]
wrapInlines [Inline]
inlines = Element -> [Content]
asContents (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ [Content] -> Element -> Element
appendContents ([Inline] -> [Content]
inlinesToXML [Inline]
inlines) (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> Element
emptyElement Text
tgNameLineItem
        Table PandocAttr
attr Caption
caption [ColSpec]
colspecs TableHead
thead [TableBody]
tbodies TableFoot
tfoot -> Element -> [Content]
asBlockOfBlocks (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ Element -> Element
with_foot (Element -> Element) -> (Element -> Element) -> Element -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Element
with_bodies (Element -> Element) -> (Element -> Element) -> Element -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Element
with_head (Element -> Element) -> (Element -> Element) -> Element -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Element
with_colspecs (Element -> Element) -> (Element -> Element) -> Element -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Element
with_caption (Element -> Element) -> (Element -> Element) -> Element -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Element
with_attr (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Element
el
          where
            with_attr :: Element -> Element
with_attr = PandocAttr -> Element -> Element
addAttrAttributes PandocAttr
attr
            with_caption :: Element -> Element
with_caption = [Content] -> Element -> Element
appendContents (Caption -> [Content]
captionToXML Caption
caption)
            with_colspecs :: Element -> Element
with_colspecs = [Content] -> Element -> Element
appendContents ([ColSpec] -> [Content]
colSpecsToXML [ColSpec]
colspecs)
            with_head :: Element -> Element
with_head = [Content] -> Element -> Element
appendContents (TableHead -> [Content]
tableHeadToXML TableHead
thead)
            with_bodies :: Element -> Element
with_bodies = [Content] -> Element -> Element
appendContents ((TableBody -> [Content]) -> [TableBody] -> [Content]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap TableBody -> [Content]
tableBodyToXML [TableBody]
tbodies)
            with_foot :: Element -> Element
with_foot = [Content] -> Element -> Element
appendContents (TableFoot -> [Content]
tableFootToXML TableFoot
tfoot)
        Figure PandocAttr
attr Caption
caption [Block]
blocks -> Element -> [Content]
asBlockOfBlocks (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ Element -> Element
with_contents (Element -> Element) -> (Element -> Element) -> Element -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Element
with_caption (Element -> Element) -> (Element -> Element) -> Element -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Element
with_attr (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Element
el
          where
            with_attr :: Element -> Element
with_attr = PandocAttr -> Element -> Element
addAttrAttributes PandocAttr
attr
            with_caption :: Element -> Element
with_caption = [Content] -> Element -> Element
appendContents (Caption -> [Content]
captionToXML Caption
caption)
            with_contents :: Element -> Element
with_contents = [Content] -> Element -> Element
appendContents ([Block] -> [Content]
blocksToXML [Block]
blocks)
        RawBlock (Format Text
format) Text
text -> Element -> [Content]
asContents (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ [Content] -> Element -> Element
appendContents [Text -> Content
text_node Text
text] Element
raw
          where
            raw :: Element
raw = Text -> Text -> Element -> Element
addAttribute Text
atNameFormat Text
format Element
el
        DefinitionList [([Inline], [[Block]])]
items -> Element -> [Content]
asBlockOfBlocks (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ [Content] -> Element -> Element
appendContents ((([Inline], [[Block]]) -> Content)
-> [([Inline], [[Block]])] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map ([Inline], [[Block]]) -> Content
definitionListItemToXML [([Inline], [[Block]])]
items) Element
el

inlineToXML :: Inline -> [Content]
inlineToXML :: Inline -> [Content]
inlineToXML Inline
inline =
  let el :: Element
el = Inline -> Element
forall a. Show a => a -> Element
itemAsEmptyElement Inline
inline
      wrapInlines :: [Inline] -> [Content]
wrapInlines [Inline]
inlines = Element -> [Content]
asContents (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ [Content] -> Element -> Element
appendContents ([Inline] -> [Content]
inlinesToXML [Inline]
inlines) Element
el
   in case (Inline
inline) of
        Inline
Space -> [Text -> Content
text_node Text
" "]
        Str Text
s -> [Text -> Content
text_node Text
s]
        Emph [Inline]
inlines -> [Inline] -> [Content]
wrapInlines [Inline]
inlines
        Strong [Inline]
inlines -> [Inline] -> [Content]
wrapInlines [Inline]
inlines
        Quoted QuoteType
quote_type [Inline]
inlines -> Element -> [Content]
asContents (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ [Content] -> Element -> Element
appendContents ([Inline] -> [Content]
inlinesToXML [Inline]
inlines) Element
quoted
          where
            quoted :: Element
quoted = Text -> Text -> Element -> Element
addAttribute Text
atNameQuoteType (QuoteType -> Text
forall a. Show a => a -> Text
itemName QuoteType
quote_type) Element
el
        Underline [Inline]
inlines -> [Inline] -> [Content]
wrapInlines [Inline]
inlines
        Strikeout [Inline]
inlines -> [Inline] -> [Content]
wrapInlines [Inline]
inlines
        SmallCaps [Inline]
inlines -> [Inline] -> [Content]
wrapInlines [Inline]
inlines
        Superscript [Inline]
inlines -> [Inline] -> [Content]
wrapInlines [Inline]
inlines
        Subscript [Inline]
inlines -> [Inline] -> [Content]
wrapInlines [Inline]
inlines
        Inline
SoftBreak -> Element -> [Content]
asContents Element
el
        Inline
LineBreak -> Element -> [Content]
asContents Element
el
        Span PandocAttr
attr [Inline]
inlines -> Element -> [Content]
asContents (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ [Content] -> Element -> Element
appendContents ([Inline] -> [Content]
inlinesToXML [Inline]
inlines) Element
with_attr
          where
            with_attr :: Element
with_attr = PandocAttr -> Element -> Element
addAttrAttributes PandocAttr
attr Element
el
        Link (Text
idn, [Text]
cls, [(Text, Text)]
attrs) [Inline]
inlines (Text
url, Text
title) -> Element -> [Content]
asContents (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ [Content] -> Element -> Element
appendContents ([Inline] -> [Content]
inlinesToXML [Inline]
inlines) Element
with_attr
          where
            with_attr :: Element
with_attr = PandocAttr -> Element -> Element
addAttrAttributes (Text
idn, [Text]
cls, [(Text, Text)]
attrs [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(Text
atNameLinkUrl, Text
url), (Text
atNameTitle, Text
title)]) Element
el
        Image (Text
idn, [Text]
cls, [(Text, Text)]
attrs) [Inline]
inlines (Text
url, Text
title) -> Element -> [Content]
asContents (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ [Content] -> Element -> Element
appendContents ([Inline] -> [Content]
inlinesToXML [Inline]
inlines) Element
with_attr
          where
            with_attr :: Element
with_attr = PandocAttr -> Element -> Element
addAttrAttributes (Text
idn, [Text]
cls, [(Text, Text)]
attrs [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(Text
atNameImageUrl, Text
url), (Text
atNameTitle, Text
title)]) Element
el
        RawInline (Format Text
format) Text
text -> Element -> [Content]
asContents (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ [Content] -> Element -> Element
appendContents [Text -> Content
text_node Text
text] Element
raw
          where
            raw :: Element
raw = Text -> Text -> Element -> Element
addAttribute Text
atNameFormat Text
format Element
el
        Math MathType
math_type Text
text -> Element -> [Content]
asContents (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ [Content] -> Element -> Element
appendContents [Text -> Content
text_node Text
text] Element
math
          where
            math :: Element
math = Text -> Text -> Element -> Element
addAttribute Text
atNameMathType (MathType -> Text
forall a. Show a => a -> Text
itemName MathType
math_type) Element
el
        Code PandocAttr
attr Text
text -> Element -> [Content]
asContents (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ [Content] -> Element -> Element
appendContents [Text -> Content
text_node Text
text] Element
with_attr
          where
            with_attr :: Element
with_attr = PandocAttr -> Element -> Element
addAttrAttributes PandocAttr
attr Element
el
        Note [Block]
blocks -> Element -> [Content]
asContents (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ [Content] -> Element -> Element
appendContents ([Block] -> [Content]
blocksToXML [Block]
blocks) Element
el
        Cite [Citation]
citations [Inline]
inlines -> Element -> [Content]
asContents (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ [Content] -> Element -> Element
appendContents ([Inline] -> [Content]
inlinesToXML [Inline]
inlines) Element
with_citations
          where
            with_citations :: Element
with_citations = [Citation] -> Element -> Element
addCitations [Citation]
citations Element
el

-- TODO: don't let an attribute overwrite id or class
maybeAttribute :: (T.Text, T.Text) -> Maybe XML.Attr
maybeAttribute :: (Text, Text) -> Maybe Attr
maybeAttribute (Text
_, Text
"") = Maybe Attr
forall a. Maybe a
Nothing
maybeAttribute (Text
"", Text
_) = Maybe Attr
forall a. Maybe a
Nothing
maybeAttribute (Text
name, Text
value) = Attr -> Maybe Attr
forall a. a -> Maybe a
Just (Attr -> Maybe Attr) -> Attr -> Maybe Attr
forall a b. (a -> b) -> a -> b
$ QName -> Text -> Attr
XML.Attr (Text -> QName
unqual Text
name) Text
value

validAttributes :: [(T.Text, T.Text)] -> [XML.Attr]
validAttributes :: [(Text, Text)] -> [Attr]
validAttributes [(Text, Text)]
pairs = ((Text, Text) -> Maybe Attr) -> [(Text, Text)] -> [Attr]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text, Text) -> Maybe Attr
maybeAttribute [(Text, Text)]
pairs

appendContents :: [Content] -> Element -> Element
appendContents :: [Content] -> Element -> Element
appendContents [Content]
newContents Element
el = Element
el {elContent = (elContent el) ++ newContents}

prependContents :: [Content] -> Element -> Element
prependContents :: [Content] -> Element -> Element
prependContents [Content]
newContents Element
el = Element
el {elContent = newContents ++ (elContent el)}

addAttributes :: [XML.Attr] -> Element -> Element
addAttributes :: [Attr] -> Element -> Element
addAttributes [Attr]
newAttrs Element
el = Element
el {elAttribs = newAttrs ++ elAttribs el}

addAttribute :: T.Text -> T.Text -> Element -> Element
addAttribute :: Text -> Text -> Element -> Element
addAttribute Text
attr_name Text
attr_value Element
el = Element
el {elAttribs = new_attr : elAttribs el}
  where
    new_attr :: Attr
new_attr = QName -> Text -> Attr
XML.Attr (Text -> QName
unqual Text
attr_name) Text
attr_value

addAttrAttributes :: PandocAttr -> Element -> Element
addAttrAttributes :: PandocAttr -> Element -> Element
addAttrAttributes (Text
identifier, [Text]
classes, [(Text, Text)]
attributes) Element
el = [Attr] -> Element -> Element
addAttributes [Attr]
attrs' Element
el
  where
    attrs' :: [Attr]
attrs' = ((Text, Text) -> Maybe Attr) -> [(Text, Text)] -> [Attr]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text, Text) -> Maybe Attr
maybeAttribute ((Text
"id", Text
identifier) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: (Text
"class", Text -> [Text] -> Text
T.intercalate Text
" " [Text]
classes) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
attributes)

addCitations :: [Citation] -> Element -> Element
addCitations :: [Citation] -> Element -> Element
addCitations [Citation]
citations Element
el = [Content] -> Element -> Element
appendContents [Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ Text -> [Content] -> Element
elementWithContents Text
tgNameCitations ([Content] -> Element) -> [Content] -> Element
forall a b. (a -> b) -> a -> b
$ (Text -> Content
text_node Text
"\n") Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: (Citation -> [Content]) -> [Citation] -> [Content]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Citation -> [Content]
citation_to_elem [Citation]
citations] Element
el
  where
    citation_to_elem :: Citation -> [Content]
    citation_to_elem :: Citation -> [Content]
citation_to_elem Citation
citation = Element -> [Content]
asBlockOfInlines Element
with_suffix
      where
        cit_elem :: Element
cit_elem = Text -> [Attr] -> Element
elementWithAttributes (Citation -> Text
forall a. Show a => a -> Text
itemName Citation
citation) [Attr]
attrs
        prefix :: [Inline]
prefix = Citation -> [Inline]
citationPrefix Citation
citation
        suffix :: [Inline]
suffix = Citation -> [Inline]
citationSuffix Citation
citation
        with_prefix :: Element
with_prefix =
          if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
prefix
            then Element
cit_elem
            else [Content] -> Element -> Element
appendContents [Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ Text -> [Content] -> Element
elementWithContents Text
tgNameCitationPrefix ([Content] -> Element) -> [Content] -> Element
forall a b. (a -> b) -> a -> b
$ [Inline] -> [Content]
inlinesToXML [Inline]
prefix] Element
cit_elem
        with_suffix :: Element
with_suffix =
          if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
suffix
            then Element
with_prefix
            else [Content] -> Element -> Element
appendContents [Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ Text -> [Content] -> Element
elementWithContents Text
tgNameCitationSuffix ([Content] -> Element) -> [Content] -> Element
forall a b. (a -> b) -> a -> b
$ [Inline] -> [Content]
inlinesToXML [Inline]
suffix] Element
with_prefix
        attrs :: [Attr]
attrs =
          ((Text, Text) -> Attr) -> [(Text, Text)] -> [Attr]
forall a b. (a -> b) -> [a] -> [b]
map
            (\(Text
n, Text
v) -> QName -> Text -> Attr
XML.Attr (Text -> QName
unqual Text
n) Text
v)
            [ (Text
"id", Citation -> Text
citationId Citation
citation),
              (Text
atNameCitationMode, String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ CitationMode -> String
forall a. Show a => a -> String
show (CitationMode -> String) -> CitationMode -> String
forall a b. (a -> b) -> a -> b
$ Citation -> CitationMode
citationMode Citation
citation),
              (Text
atNameCitationNoteNum, Int -> Text
intAsText (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Citation -> Int
citationNoteNum Citation
citation),
              (Text
atNameCitationHash, Int -> Text
intAsText (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Citation -> Int
citationHash Citation
citation)
            ]

definitionListItemToXML :: ([Inline], [[Block]]) -> Content
definitionListItemToXML :: ([Inline], [[Block]]) -> Content
definitionListItemToXML ([Inline]
inlines, [[Block]]
defs) = Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ Text -> [Content] -> Element
elementWithContents Text
tgNameDefListItem ([Content] -> Element) -> [Content] -> Element
forall a b. (a -> b) -> a -> b
$ [Content]
term [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ Text -> [[Block]] -> [Content]
wrapArrayOfBlocks Text
tgNameDefListDef [[Block]]
defs
  where
    term :: [Content]
term = Element -> [Content]
asBlockOfInlines (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ [Content] -> Element -> Element
appendContents ([Inline] -> [Content]
inlinesToXML [Inline]
inlines) (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Text -> Element
emptyElement Text
tgNameDefListTerm

captionToXML :: Caption -> [Content]
captionToXML :: Caption -> [Content]
captionToXML (Caption Maybe [Inline]
short [Block]
blocks) = Element -> [Content]
asBlockOfBlocks Element
with_short_caption
  where
    el :: Element
el = Text -> [Content] -> Element
elementWithContents Text
"Caption" ([Content] -> Element) -> [Content] -> Element
forall a b. (a -> b) -> a -> b
$ [Block] -> [Content]
blocksToXML [Block]
blocks
    with_short_caption :: Element
with_short_caption = case (Maybe [Inline]
short) of
      Just [Inline]
inlines -> [Content] -> Element -> Element
prependContents (Element -> [Content]
asBlockOfInlines (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ Text -> [Content] -> Element
elementWithContents Text
tgNameShortCaption ([Content] -> Element) -> [Content] -> Element
forall a b. (a -> b) -> a -> b
$ [Inline] -> [Content]
inlinesToXML [Inline]
inlines) Element
el
      Maybe [Inline]
_ -> Element
el

colSpecToXML :: (Alignment, ColWidth) -> [Content]
colSpecToXML :: ColSpec -> [Content]
colSpecToXML (Alignment
align, ColWidth
cw) = Element -> [Content]
asBlockOfInlines Element
colspec
  where
    colspec :: Element
colspec = Text -> [Attr] -> Element
elementWithAttributes Text
"ColSpec" ([Attr] -> Element) -> [Attr] -> Element
forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> [Attr]
validAttributes [(Text
atNameAlignment, Alignment -> Text
forall a. Show a => a -> Text
itemName Alignment
align), (Text
atNameColWidth, Text
colwidth)]
    colwidth :: Text
colwidth = case (ColWidth
cw) of
      ColWidth Double
d -> String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
d
      ColWidth
ColWidthDefault -> Text
"0"

colSpecsToXML :: [(Alignment, ColWidth)] -> [Content]
colSpecsToXML :: [ColSpec] -> [Content]
colSpecsToXML [ColSpec]
colspecs = Element -> [Content]
asBlockOfBlocks (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ Text -> [Content] -> Element
elementWithContents Text
tgNameColspecs ([Content] -> Element) -> [Content] -> Element
forall a b. (a -> b) -> a -> b
$ (ColSpec -> [Content]) -> [ColSpec] -> [Content]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ColSpec -> [Content]
colSpecToXML [ColSpec]
colspecs

tableHeadToXML :: TableHead -> [Content]
tableHeadToXML :: TableHead -> [Content]
tableHeadToXML (TableHead PandocAttr
attr [Row]
rows) = Element -> [Content]
asBlockOfBlocks (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ Text -> PandocAttr -> [Content] -> Element
elementWithAttrAndContents Text
"TableHead" PandocAttr
attr ([Content] -> Element) -> [Content] -> Element
forall a b. (a -> b) -> a -> b
$ (Row -> [Content]) -> [Row] -> [Content]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Row -> [Content]
rowToXML [Row]
rows

tableBodyToXML :: TableBody -> [Content]
tableBodyToXML :: TableBody -> [Content]
tableBodyToXML (TableBody (Text
idn, [Text]
cls, [(Text, Text)]
attrs) (RowHeadColumns Int
headcols) [Row]
hrows [Row]
brows) = Element -> [Content]
asBlockOfBlocks (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ Text -> PandocAttr -> [Content] -> Element
elementWithAttrAndContents Text
"TableBody" PandocAttr
attr [Content]
children
  where
    attr :: PandocAttr
attr = (Text
idn, [Text]
cls, (Text
atNameRowHeadColumns, Int -> Text
intAsText Int
headcols) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
attrs)
    header_rows :: [Content]
header_rows = Element -> [Content]
asBlockOfBlocks (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ Text -> [Content] -> Element
elementWithContents Text
tgNameBodyHeader ([Content] -> Element) -> [Content] -> Element
forall a b. (a -> b) -> a -> b
$ (Row -> [Content]) -> [Row] -> [Content]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Row -> [Content]
rowToXML [Row]
hrows
    body_rows :: [Content]
body_rows = Element -> [Content]
asBlockOfBlocks (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ Text -> [Content] -> Element
elementWithContents Text
tgNameBodyBody ([Content] -> Element) -> [Content] -> Element
forall a b. (a -> b) -> a -> b
$ (Row -> [Content]) -> [Row] -> [Content]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Row -> [Content]
rowToXML [Row]
brows
    children :: [Content]
children = [Content]
header_rows [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Content]
body_rows

tableFootToXML :: TableFoot -> [Content]
tableFootToXML :: TableFoot -> [Content]
tableFootToXML (TableFoot PandocAttr
attr [Row]
rows) = Element -> [Content]
asBlockOfBlocks (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ Text -> PandocAttr -> [Content] -> Element
elementWithAttrAndContents Text
"TableFoot" PandocAttr
attr ([Content] -> Element) -> [Content] -> Element
forall a b. (a -> b) -> a -> b
$ (Row -> [Content]) -> [Row] -> [Content]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Row -> [Content]
rowToXML [Row]
rows

rowToXML :: Row -> [Content]
rowToXML :: Row -> [Content]
rowToXML (Row PandocAttr
attr [Cell]
cells) = Element -> [Content]
asBlockOfBlocks (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ Text -> PandocAttr -> [Content] -> Element
elementWithAttrAndContents Text
"Row" PandocAttr
attr ([Content] -> Element) -> [Content] -> Element
forall a b. (a -> b) -> a -> b
$ (Cell -> [Content]) -> [Cell] -> [Content]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Cell -> [Content]
cellToXML [Cell]
cells

cellToXML :: Cell -> [Content]
cellToXML :: Cell -> [Content]
cellToXML (Cell (Text
idn, [Text]
cls, [(Text, Text)]
attrs) Alignment
alignment (RowSpan Int
rowspan) (ColSpan Int
colspan) [Block]
blocks) = Element -> [Content]
asBlockOfBlocks (Element -> [Content]) -> Element -> [Content]
forall a b. (a -> b) -> a -> b
$ Text -> PandocAttr -> [Content] -> Element
elementWithAttrAndContents Text
"Cell" PandocAttr
attr ([Content] -> Element) -> [Content] -> Element
forall a b. (a -> b) -> a -> b
$ [Block] -> [Content]
blocksToXML [Block]
blocks
  where
    with_alignment :: [(Text, Text)] -> [(Text, Text)]
with_alignment [(Text, Text)]
a = (Text
atNameAlignment, Alignment -> Text
forall a. Show a => a -> Text
itemName Alignment
alignment) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
a
    with_rowspan :: [(Text, Text)] -> [(Text, Text)]
with_rowspan [(Text, Text)]
a = if Int
rowspan Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then (Text
atNameRowspan, Int -> Text
intAsText Int
rowspan) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
a else [(Text, Text)]
a
    with_colspan :: [(Text, Text)] -> [(Text, Text)]
with_colspan [(Text, Text)]
a = if Int
colspan Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then (Text
atNameColspan, Int -> Text
intAsText Int
colspan) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
a else [(Text, Text)]
a
    attrs' :: [(Text, Text)]
attrs' = ([(Text, Text)] -> [(Text, Text)]
with_colspan ([(Text, Text)] -> [(Text, Text)])
-> ([(Text, Text)] -> [(Text, Text)])
-> [(Text, Text)]
-> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Text)] -> [(Text, Text)]
with_rowspan ([(Text, Text)] -> [(Text, Text)])
-> ([(Text, Text)] -> [(Text, Text)])
-> [(Text, Text)]
-> [(Text, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Text)] -> [(Text, Text)]
with_alignment) [(Text, Text)]
attrs
    attr :: PandocAttr
attr = (Text
idn, [Text]
cls, [(Text, Text)]
attrs')