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

-- |
--   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 GHC.Generics
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

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
opts 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
$ WriterOptions -> Pandoc -> Text
pandocToXmlText WriterOptions
opts 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

-- | Extract the name of a value's constructor via GHC.Generics.
class GConName f where
  gConName :: f p -> String

instance (GConName f) => GConName (M1 D d f) where
  gConName :: forall p. M1 D d f p -> String
gConName (M1 f p
x) = f p -> String
forall p. f p -> String
forall (f :: * -> *) p. GConName f => f p -> String
gConName f p
x

instance (GConName f, GConName g) => GConName (f :+: g) where
  gConName :: forall p. (:+:) f g p -> String
gConName (L1 f p
x) = f p -> String
forall p. f p -> String
forall (f :: * -> *) p. GConName f => f p -> String
gConName f p
x
  gConName (R1 g p
x) = g p -> String
forall p. g p -> String
forall (f :: * -> *) p. GConName f => f p -> String
gConName g p
x

instance (Constructor c) => GConName (M1 C c f) where
  gConName :: forall p. M1 C c f p -> String
gConName = M1 C c f p -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t c f a -> String
conName

itemName :: (Generic a, GConName (Rep a)) => a -> T.Text
itemName :: forall a. (Generic a, GConName (Rep a)) => a -> Text
itemName = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rep a (ZonkAny 0) -> String
forall p. Rep a p -> String
forall (f :: * -> *) p. GConName f => f p -> String
gConName (Rep a (ZonkAny 0) -> String)
-> (a -> Rep a (ZonkAny 0)) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a (ZonkAny 0)
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from

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 :: (Generic a, GConName (Rep a)) => a -> Element
itemAsEmptyElement :: forall a. (Generic a, GConName (Rep a)) => a -> Element
itemAsEmptyElement a
item = Text -> Element
emptyElement (Text -> Element) -> Text -> Element
forall a b. (a -> b) -> a -> b
$ a -> Text
forall a. (Generic a, GConName (Rep a)) => a -> Text
itemName a
item

pandocToXmlText :: WriterOptions -> Pandoc -> T.Text
pandocToXmlText :: WriterOptions -> Pandoc -> Text
pandocToXmlText WriterOptions
opts (Pandoc (Meta Map Text MetaValue
meta) [Block]
blocks) =
  case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
       Just Template Text
_ -> -- standalone document; include Pandoc and Meta
         ConfigPP -> Element -> Text
ppcTopElement ConfigPP
configPP (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
       Maybe (Template Text)
Nothing -> -- fragment; just include blocks, as native writer does
         [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Content -> Text) -> [Content] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (ConfigPP -> Content -> Text
ppcContent ConfigPP
configPP) [Content]
block_contents
 where
   el :: Element
el = Text -> Element
emptyElement Text
"Pandoc"
   with_version :: Element -> Element
with_version = Text -> Text -> Element -> Element
addAttribute Text
atNameApiVersion Text
version
   version :: Text
version = (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 ([Content] -> Element -> Element)
-> [Content] -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Element -> [Content]
asContents Element
block_element
   block_element :: Element
block_element = Text -> [Content] -> Element
elementWithContents Text
"blocks" [Content]
block_contents
   block_contents :: [Content]
block_contents = [Block] -> [Content]
blocksToXML [Block]
blocks

-- | Pretty-printing configuration: the contents of elements that
-- contain inline content are kept on a single line, so that no
-- significant whitespace is added inside them.
configPP :: ConfigPP
configPP :: ConfigPP
configPP = (QName -> Bool) -> ConfigPP -> ConfigPP
useInlineTags (Text -> Bool
isInlineTag (Text -> Bool) -> (QName -> Text) -> QName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> Text
qName) ConfigPP
prettyConfigPP

-- | Check whether a tag is for an element with inline content.
isInlineTag :: T.Text -> Bool
isInlineTag :: Text -> Bool
isInlineTag Text
t =
  case Text
t of
    Text
"Para" -> Bool
True
    Text
"Plain" -> Bool
True
    Text
"Header" -> Bool
True
    Text
"MetaInlines" -> Bool
True
    Text
"Emph" -> Bool
True
    Text
"Strong" -> Bool
True
    Text
"Strikeout" -> Bool
True
    Text
"Superscript" -> Bool
True
    Text
"Subscript" -> Bool
True
    Text
"SmallCaps" -> Bool
True
    Text
"Underline" -> Bool
True
    Text
"Quoted" -> Bool
True
    Text
"Cite" -> Bool
True
    Text
"Link" -> Bool
True
    Text
"Image" -> Bool
True
    Text
"Span" -> Bool
True
    Text
_ ->
      Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
tgNameLineItem
        Bool -> Bool -> Bool
|| Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
tgNameDefListTerm
        Bool -> Bool -> Bool
|| Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
tgNameCitationPrefix
        Bool -> Bool -> Bool
|| Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
tgNameCitationSuffix
        Bool -> Bool -> Bool
|| Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
tgNameShortCaption

metaMapToXML :: Map T.Text MetaValue -> T.Text -> [Content]
metaMapToXML :: Map Text MetaValue -> Text -> [Content]
metaMapToXML Map Text MetaValue
mmap Text
tag = Element -> [Content]
asContents (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]
asContents 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. (Generic a, GConName (Rep a)) => a -> Text
itemName MetaValue
value
      el :: Element
el = MetaValue -> Element
forall a. (Generic a, GConName (Rep a)) => a -> Element
itemAsEmptyElement MetaValue
value
   in case (MetaValue
value) of
        MetaBool Bool
b -> Element -> [Content]
asContents (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]
asContents (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]
asContents (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]
asContents (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]
asContents (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 = (Content -> [Content]) -> [Content] -> [Content]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Content -> [Content]
wsRunsAsElements ([Content] -> [Content]) -> [Content] -> [Content]
forall a b. (a -> b) -> a -> b
$ [Content] -> [Content]
mergeTextNodes ([Content] -> [Content]) -> [Content] -> [Content]
forall a b. (a -> b) -> a -> b
$ (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 [])

-- | Merge consecutive text nodes into a single text node; otherwise
-- the pretty-printer would render each one on a line of its own.
mergeTextNodes :: [Content] -> [Content]
mergeTextNodes :: [Content] -> [Content]
mergeTextNodes (Text (CData CDataKind
CDataText Text
t Maybe Line
_) : [Content]
rest) =
  Text -> Content
text_node ([Text] -> Text
T.concat (Text
t Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ts)) Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content] -> [Content]
mergeTextNodes [Content]
rest'
  where
    ([Text]
ts, [Content]
rest') = [Content] -> ([Text], [Content])
textRun [Content]
rest
    textRun :: [Content] -> ([Text], [Content])
textRun (Text (CData CDataKind
CDataText Text
t' Maybe Line
_) : [Content]
cs) =
      let ([Text]
ts', [Content]
cs') = [Content] -> ([Text], [Content])
textRun [Content]
cs in (Text
t' Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ts', [Content]
cs')
    textRun [Content]
cs = ([], [Content]
cs)
mergeTextNodes (Content
c : [Content]
rest) = Content
c Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content] -> [Content]
mergeTextNodes [Content]
rest
mergeTextNodes [] = []

-- | A whitespace run in a text node is read back as a single Space
-- (a run of spaces) or a single SoftBreak (a run containing a
-- newline), so runs like " \n" or "\n\n" would not roundtrip: encode
-- them as sequences of Space and SoftBreak elements instead.
wsRunsAsElements :: Content -> [Content]
wsRunsAsElements :: Content -> [Content]
wsRunsAsElements (Text (CData CDataKind
CDataText Text
t Maybe Line
_))
  | Bool
hasLongWsRun = [Text] -> [Text] -> [Content]
go [] ((Char -> Char -> Bool) -> Text -> [Text]
T.groupBy (\Char
a Char
b -> Char -> Bool
isWs Char
a Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Bool
isWs Char
b) Text
t)
  where
    isWs :: Char -> Bool
isWs Char
ch = Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n'
    -- a whitespace run needs encoding only if it is longer than one
    -- character (single-character runs are " " or "\n", which are
    -- kept); the common case of no such run avoids the work below
    hasLongWsRun :: Bool
hasLongWsRun = (Bool, Bool) -> Bool
forall a b. (a, b) -> a
fst ((Bool, Bool) -> Bool) -> (Bool, Bool) -> Bool
forall a b. (a -> b) -> a -> b
$ ((Bool, Bool) -> Char -> (Bool, Bool))
-> (Bool, Bool) -> Text -> (Bool, Bool)
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' (Bool, Bool) -> Char -> (Bool, Bool)
adjacent (Bool
False, Bool
False) Text
t
    adjacent :: (Bool, Bool) -> Char -> (Bool, Bool)
adjacent (Bool
found, Bool
prevWs) Char
ch =
      let ws :: Bool
ws = Char -> Bool
isWs Char
ch in (Bool
found Bool -> Bool -> Bool
|| (Bool
prevWs Bool -> Bool -> Bool
&& Bool
ws), Bool
ws)
    keep :: Text -> Bool
keep Text
r = Text
r Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
" " Bool -> Bool -> Bool
|| Text
r Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"\n" Bool -> Bool -> Bool
|| Bool -> Bool
not ((Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isWs Text
r)
    go :: [Text] -> [Text] -> [Content]
go [Text]
acc (Text
r : [Text]
rs)
      | Text -> Bool
keep Text
r = [Text] -> [Text] -> [Content]
go (Text
r Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
acc) [Text]
rs
      | Bool
otherwise = [Text] -> [Content]
flush [Text]
acc [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ (Char -> Content) -> String -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Content
toElem (Text -> String
T.unpack Text
r) [Content] -> [Content] -> [Content]
forall a. [a] -> [a] -> [a]
++ [Text] -> [Text] -> [Content]
go [] [Text]
rs
    go [Text]
acc [] = [Text] -> [Content]
flush [Text]
acc
    flush :: [Text] -> [Content]
flush [] = []
    flush [Text]
acc = [Text -> Content
text_node (Text -> Content) -> Text -> Content
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
acc]
    toElem :: Char -> Content
toElem Char
'\n' = Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ Text -> Element
emptyElement Text
"SoftBreak"
    toElem Char
_ = Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$ Text -> Element
emptyElement Text
"Space"
wsRunsAsElements Content
c = [Content
c]

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]
asContents (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 = asContents $ element_with_contents tag $ inlinesToXML inlines

blockToXML :: Block -> [Content]
blockToXML :: Block -> [Content]
blockToXML Block
block =
  let el :: Element
el = Block -> Element
forall a. (Generic a, GConName (Rep a)) => a -> Element
itemAsEmptyElement Block
block
   in case (Block
block) of
        Para [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
        Header Int
level (Text
idn, [Text]
cls, [(Text, Text)]
attrs) [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 (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]
asContents (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]
asContents (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]
asContents (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]
asContents (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. (Generic a, GConName (Rep a)) => a -> Text
itemName ListNumberStyle
style),
                      (Text
atNameNumberDelim, ListNumberDelim -> Text
forall a. (Generic a, GConName (Rep 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]
asContents (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]
asContents Element
el
        CodeBlock PandocAttr
attr Text
text -> Element -> [Content]
asContents (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]
asContents (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]
asContents (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]
asContents (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]
asContents (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. (Generic a, GConName (Rep 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. (Generic a, GConName (Rep 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 -> [Text -> Content
text_node Text
"\n"]
        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 -> Text -> [(Text, Text)]
optionalAttribute Text
atNameLinkUrl Text
url [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ Text -> Text -> [(Text, Text)]
optionalAttribute 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 -> Text -> [(Text, Text)]
optionalAttribute Text
atNameImageUrl Text
url [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ Text -> Text -> [(Text, Text)]
optionalAttribute 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. (Generic a, GConName (Rep 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
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 -> QName) -> Text -> QName
forall a b. (a -> b) -> a -> b
$ Text -> Text
encodeAttrName Text
name) Text
value

-- | An optional attribute, omitted when its value is empty (the
-- reader treats a missing attribute as an empty value).
optionalAttribute :: T.Text -> T.Text -> [(T.Text, T.Text)]
optionalAttribute :: Text -> Text -> [(Text, Text)]
optionalAttribute Text
_ Text
"" = []
optionalAttribute Text
name Text
value = [(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, Text)] -> [Attr]) -> [(Text, Text)] -> [Attr]
forall a b. (a -> b) -> a -> b
$
        Text -> Text -> [(Text, Text)]
optionalAttribute Text
"id" Text
identifier
          [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ Text -> Text -> [(Text, Text)]
optionalAttribute 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
$ (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]
asContents Element
with_suffix
      where
        cit_elem :: Element
cit_elem = Text -> [Attr] -> Element
elementWithAttributes (Citation -> Text
forall a. (Generic a, GConName (Rep 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, CitationMode -> Text
forall a. (Generic a, GConName (Rep a)) => a -> Text
itemName (CitationMode -> Text) -> CitationMode -> Text
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]
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
tgNameDefListTerm

captionToXML :: Caption -> [Content]
captionToXML :: Caption -> [Content]
captionToXML (Caption Maybe [Inline]
short [Block]
blocks) = Element -> [Content]
asContents 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]
asContents (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]
asContents 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. (Generic a, GConName (Rep 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]
asContents (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]
asContents (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]
asContents (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]
asContents (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]
asContents (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]
asContents (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]
asContents (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]
asContents (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. (Generic a, GConName (Rep 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')