{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards     #-}
{-# LANGUAGE ViewPatterns      #-}
{- |
   Module      : Text.Pandoc.Writers.Docbook
   Copyright   : Copyright (C) 2006-2021 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

Conversion of 'Pandoc' documents to Docbook XML.
-}
module Text.Pandoc.Writers.Docbook ( writeDocbook4, writeDocbook5 ) where
import Control.Monad.Reader
import Data.Generics (everywhere, mkT)
import Data.Maybe (isNothing)
import Data.Monoid (Any (..))
import Data.Text (Text)
import qualified Data.Text as T
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
import Text.Pandoc.Definition
import Text.Pandoc.Highlighting (languages, languagesByExtension)
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared
import Text.Pandoc.Walk
import Text.Pandoc.Writers.Math
import Text.Pandoc.XML
import Text.TeXMath
import qualified Text.XML.Light as Xml

data DocBookVersion = DocBook4 | DocBook5
     deriving (DocBookVersion -> DocBookVersion -> Bool
(DocBookVersion -> DocBookVersion -> Bool)
-> (DocBookVersion -> DocBookVersion -> Bool) -> Eq DocBookVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DocBookVersion -> DocBookVersion -> Bool
$c/= :: DocBookVersion -> DocBookVersion -> Bool
== :: DocBookVersion -> DocBookVersion -> Bool
$c== :: DocBookVersion -> DocBookVersion -> Bool
Eq, Int -> DocBookVersion -> ShowS
[DocBookVersion] -> ShowS
DocBookVersion -> String
(Int -> DocBookVersion -> ShowS)
-> (DocBookVersion -> String)
-> ([DocBookVersion] -> ShowS)
-> Show DocBookVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DocBookVersion] -> ShowS
$cshowList :: [DocBookVersion] -> ShowS
show :: DocBookVersion -> String
$cshow :: DocBookVersion -> String
showsPrec :: Int -> DocBookVersion -> ShowS
$cshowsPrec :: Int -> DocBookVersion -> ShowS
Show)

type DB = ReaderT DocBookVersion

-- | Get level of the top-level headers based on the configured top-level division.
-- The header level can then be used to determine appropriate DocBook element
-- for each subdivision associated with a header.
-- The numbering here follows LaTeX's internal numbering
getStartLvl :: WriterOptions -> Int
getStartLvl :: WriterOptions -> Int
getStartLvl WriterOptions
opts =
  case WriterOptions -> TopLevelDivision
writerTopLevelDivision WriterOptions
opts of
       TopLevelDivision
TopLevelPart    -> -Int
1
       TopLevelDivision
TopLevelChapter -> Int
0
       TopLevelDivision
TopLevelSection -> Int
1
       TopLevelDivision
TopLevelDefault -> Int
1

-- | Get correct name for the id attribute based on DocBook version.
-- DocBook 4 used custom id attribute but DocBook 5 adopted the xml:id specification.
-- https://www.w3.org/TR/xml-id/
idName :: DocBookVersion -> Text
idName :: DocBookVersion -> Text
idName DocBookVersion
DocBook5 = Text
"xml:id"
idName DocBookVersion
DocBook4 = Text
"id"

-- | Convert list of authors to a docbook <author> section
authorToDocbook :: PandocMonad m => WriterOptions -> [Inline] -> DB m B.Inlines
authorToDocbook :: WriterOptions -> [Inline] -> DB m Inlines
authorToDocbook WriterOptions
opts [Inline]
name' = do
  Text
name <- Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing (Doc Text -> Text)
-> ReaderT DocBookVersion m (Doc Text)
-> ReaderT DocBookVersion m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
name'
  let colwidth :: Maybe Int
colwidth = if WriterOptions -> WrapOption
writerWrapText WriterOptions
opts WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
                    then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
opts
                    else Maybe Int
forall a. Maybe a
Nothing
  Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DB m Inlines) -> Inlines -> DB m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines
B.rawInline Text
"docbook" (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$
    Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth (Doc Text -> Text) -> Doc Text -> Text
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"personname" [] (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
      if (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',') Text
name
         then -- last name first
              let (Text
lastname, Text
rest) = (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
',') Text
name
                  firstname :: Text
firstname = Text -> Text
triml Text
rest in
              Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"firstname" (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
firstname) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
              Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"surname" (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
lastname)
         else -- last name last
              let namewords :: [Text]
namewords = Text -> [Text]
T.words Text
name
                  lengthname :: Int
lengthname = [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
namewords
                  (Text
firstname, Text
lastname) = case Int
lengthname of
                    Int
0 -> (Text
"",Text
"")
                    Int
1 -> (Text
"", Text
name)
                    Int
n -> ([Text] -> Text
T.unwords (Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [Text]
namewords), [Text] -> Text
forall a. [a] -> a
last [Text]
namewords)
               in Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"firstname" (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
firstname) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
                  Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"surname" (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
lastname)

writeDocbook4 :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeDocbook4 :: WriterOptions -> Pandoc -> m Text
writeDocbook4 WriterOptions
opts Pandoc
d =
  ReaderT DocBookVersion m Text -> DocBookVersion -> m Text
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (WriterOptions -> Pandoc -> ReaderT DocBookVersion m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> DB m Text
writeDocbook WriterOptions
opts Pandoc
d) DocBookVersion
DocBook4

writeDocbook5 :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeDocbook5 :: WriterOptions -> Pandoc -> m Text
writeDocbook5 WriterOptions
opts Pandoc
d =
  ReaderT DocBookVersion m Text -> DocBookVersion -> m Text
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (WriterOptions -> Pandoc -> ReaderT DocBookVersion m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> DB m Text
writeDocbook WriterOptions
opts Pandoc
d) DocBookVersion
DocBook5

-- | Convert Pandoc document to string in Docbook format.
writeDocbook :: PandocMonad m => WriterOptions -> Pandoc -> DB m Text
writeDocbook :: WriterOptions -> Pandoc -> DB m Text
writeDocbook WriterOptions
opts (Pandoc Meta
meta [Block]
blocks) = do
  let colwidth :: Maybe Int
colwidth = if WriterOptions -> WrapOption
writerWrapText WriterOptions
opts WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
                    then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
opts
                    else Maybe Int
forall a. Maybe a
Nothing
  let startLvl :: Int
startLvl = WriterOptions -> Int
getStartLvl WriterOptions
opts
  let fromBlocks :: [Block] -> DB m (Doc Text)
fromBlocks = WriterOptions -> [Block] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocbook WriterOptions
opts ([Block] -> DB m (Doc Text))
-> ([Block] -> [Block]) -> [Block] -> DB m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                   Bool -> Maybe Int -> [Block] -> [Block]
makeSections Bool
False (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
startLvl)
  [Inlines]
auths' <- ([Inline] -> ReaderT DocBookVersion m Inlines)
-> [[Inline]] -> ReaderT DocBookVersion m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [Inline] -> ReaderT DocBookVersion m Inlines
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m Inlines
authorToDocbook WriterOptions
opts) ([[Inline]] -> ReaderT DocBookVersion m [Inlines])
-> [[Inline]] -> ReaderT DocBookVersion m [Inlines]
forall a b. (a -> b) -> a -> b
$ Meta -> [[Inline]]
docAuthors Meta
meta
  let meta' :: Meta
meta' = Text -> [Inlines] -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
B.setMeta Text
"author" [Inlines]
auths' Meta
meta
  Context Text
metadata <- WriterOptions
-> ([Block] -> DB m (Doc Text))
-> ([Inline] -> DB m (Doc Text))
-> Meta
-> ReaderT DocBookVersion m (Context Text)
forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
opts
                 [Block] -> DB m (Doc Text)
fromBlocks
                 (WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts)
                 Meta
meta'
  Doc Text
main <- [Block] -> DB m (Doc Text)
fromBlocks [Block]
blocks
  let context :: Context Text
context = Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Doc Text
main
              (Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"mathml" (case WriterOptions -> HTMLMathMethod
writerHTMLMathMethod WriterOptions
opts of
                                          HTMLMathMethod
MathML -> Bool
True
                                          HTMLMathMethod
_      -> Bool
False) Context Text
metadata
  Text -> DB m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> DB m Text) -> Text -> DB m Text
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth (Doc Text -> Text) -> Doc Text -> Text
forall a b. (a -> b) -> a -> b
$
    (if WriterOptions -> Bool
writerPreferAscii WriterOptions
opts then (Text -> Text) -> Doc Text -> Doc Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
toEntities else Doc Text -> Doc Text
forall a. a -> a
id) (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
    case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
         Maybe (Template Text)
Nothing  -> Doc Text
main
         Just Template Text
tpl -> Template Text -> Context Text -> Doc Text
forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl Context Text
context

-- | Convert a list of Pandoc blocks to Docbook.
blocksToDocbook :: PandocMonad m => WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocbook :: WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocbook WriterOptions
opts = ([Doc Text] -> Doc Text)
-> ReaderT DocBookVersion m [Doc Text] -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat (ReaderT DocBookVersion m [Doc Text] -> DB m (Doc Text))
-> ([Block] -> ReaderT DocBookVersion m [Doc Text])
-> [Block]
-> DB m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> DB m (Doc Text))
-> [Block] -> ReaderT DocBookVersion m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> Block -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> DB m (Doc Text)
blockToDocbook WriterOptions
opts)

-- | Auxiliary function to convert Plain block to Para.
plainToPara :: Block -> Block
plainToPara :: Block -> Block
plainToPara (Plain [Inline]
x) = [Inline] -> Block
Para [Inline]
x
plainToPara Block
x         = Block
x

-- | Convert a list of pairs of terms and definitions into a list of
-- Docbook varlistentrys.
deflistItemsToDocbook :: PandocMonad m
                      => WriterOptions -> [([Inline],[[Block]])] -> DB m (Doc Text)
deflistItemsToDocbook :: WriterOptions -> [([Inline], [[Block]])] -> DB m (Doc Text)
deflistItemsToDocbook WriterOptions
opts [([Inline], [[Block]])]
items =
  [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> ReaderT DocBookVersion m [Doc Text] -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([Inline], [[Block]]) -> DB m (Doc Text))
-> [([Inline], [[Block]])] -> ReaderT DocBookVersion m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (([Inline] -> [[Block]] -> DB m (Doc Text))
-> ([Inline], [[Block]]) -> DB m (Doc Text)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (WriterOptions -> [Inline] -> [[Block]] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> [[Block]] -> DB m (Doc Text)
deflistItemToDocbook WriterOptions
opts)) [([Inline], [[Block]])]
items

-- | Convert a term and a list of blocks into a Docbook varlistentry.
deflistItemToDocbook :: PandocMonad m
                     => WriterOptions -> [Inline] -> [[Block]] -> DB m (Doc Text)
deflistItemToDocbook :: WriterOptions -> [Inline] -> [[Block]] -> DB m (Doc Text)
deflistItemToDocbook WriterOptions
opts [Inline]
term [[Block]]
defs = do
  Doc Text
term' <- WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
term
  Doc Text
def' <- WriterOptions -> [Block] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocbook WriterOptions
opts ([Block] -> DB m (Doc Text)) -> [Block] -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ ([Block] -> [Block]) -> [[Block]] -> [Block]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Block -> Block) -> [Block] -> [Block]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
plainToPara) [[Block]]
defs
  Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"varlistentry" (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
      Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"term" Doc Text
term' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
      Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"listitem" Doc Text
def'

-- | Convert a list of lists of blocks to a list of Docbook list items.
listItemsToDocbook :: PandocMonad m => WriterOptions -> [[Block]] -> DB m (Doc Text)
listItemsToDocbook :: WriterOptions -> [[Block]] -> DB m (Doc Text)
listItemsToDocbook WriterOptions
opts [[Block]]
items = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> ReaderT DocBookVersion m [Doc Text] -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Block] -> DB m (Doc Text))
-> [[Block]] -> ReaderT DocBookVersion m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [Block] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
listItemToDocbook WriterOptions
opts) [[Block]]
items

-- | Convert a list of blocks into a Docbook list item.
listItemToDocbook :: PandocMonad m => WriterOptions -> [Block] -> DB m (Doc Text)
listItemToDocbook :: WriterOptions -> [Block] -> DB m (Doc Text)
listItemToDocbook WriterOptions
opts [Block]
item =
  Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"listitem" (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Block] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocbook WriterOptions
opts ((Block -> Block) -> [Block] -> [Block]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
plainToPara [Block]
item)

imageToDocbook :: WriterOptions -> Attr -> Text -> Doc Text
imageToDocbook :: WriterOptions -> Attr -> Text -> Doc Text
imageToDocbook WriterOptions
_ Attr
attr Text
src = Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"imagedata" ([(Text, Text)] -> Doc Text) -> [(Text, Text)] -> Doc Text
forall a b. (a -> b) -> a -> b
$
  (Text
"fileref", Text
src) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: Attr -> [(Text, Text)]
idAndRole Attr
attr [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
dims
  where
    dims :: [(Text, Text)]
dims = Direction -> Text -> [(Text, Text)]
forall a. Direction -> a -> [(a, Text)]
go Direction
Width Text
"width" [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> Direction -> Text -> [(Text, Text)]
forall a. Direction -> a -> [(a, Text)]
go Direction
Height Text
"depth"
    go :: Direction -> a -> [(a, Text)]
go Direction
dir a
dstr = case Direction -> Attr -> Maybe Dimension
dimension Direction
dir Attr
attr of
                    Just Dimension
a  -> [(a
dstr, Dimension -> Text
forall a. Show a => a -> Text
tshow Dimension
a)]
                    Maybe Dimension
Nothing -> []

-- | Convert a Pandoc block element to Docbook.
blockToDocbook :: PandocMonad m => WriterOptions -> Block -> DB m (Doc Text)
blockToDocbook :: WriterOptions -> Block -> DB m (Doc Text)
blockToDocbook WriterOptions
_ Block
Null = Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
-- Add ids to paragraphs in divs with ids - this is needed for
-- pandoc-citeproc to get link anchors in bibliographies:
blockToDocbook WriterOptions
opts (Div (Text
id',Text
"section":[Text]
_,[(Text, Text)]
_) (Header Int
lvl (Text
_,[Text]
_,[(Text, Text)]
attrs) [Inline]
ils : [Block]
xs)) = do
  DocBookVersion
version <- ReaderT DocBookVersion m DocBookVersion
forall r (m :: * -> *). MonadReader r m => m r
ask
  -- Docbook doesn't allow sections with no content, so insert some if needed
  let bs :: [Block]
bs = if [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
xs
              then [[Inline] -> Block
Para []]
              else [Block]
xs
      tag :: Text
tag = case Int
lvl of
                 -1                   -> Text
"part"
                 Int
0                    -> Text
"chapter"
                 Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
5 -> if DocBookVersion
version DocBookVersion -> DocBookVersion -> Bool
forall a. Eq a => a -> a -> Bool
== DocBookVersion
DocBook5
                                              then Text
"section"
                                              else Text
"sect" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n
                 Int
_                    -> Text
"simplesect"
      idAttr :: [(Text, Text)]
idAttr = [(DocBookVersion -> Text
idName DocBookVersion
version, WriterOptions -> Text
writerIdentifierPrefix WriterOptions
opts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
id') | Bool -> Bool
not (Text -> Bool
T.null Text
id')]
      -- We want to add namespaces to the root (top-level) element.
      nsAttr :: [(Text, Text)]
nsAttr = if DocBookVersion
version DocBookVersion -> DocBookVersion -> Bool
forall a. Eq a => a -> a -> Bool
== DocBookVersion
DocBook5 Bool -> Bool -> Bool
&& Int
lvl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== WriterOptions -> Int
getStartLvl WriterOptions
opts Bool -> Bool -> Bool
&& Maybe (Template Text) -> Bool
forall a. Maybe a -> Bool
isNothing (WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts)
      -- Though, DocBook 4 does not support namespaces and
      -- standalone documents will include them in the template.
                 then [(Text
"xmlns", Text
"http://docbook.org/ns/docbook"),(Text
"xmlns:xlink", Text
"http://www.w3.org/1999/xlink")]
                 else []
      
      -- Populate miscAttr with Header.Attr.attributes, filtering out non-valid DocBook section attributes, id, and xml:id
      miscAttr :: [(Text, Text)]
miscAttr = ((Text, Text) -> Bool) -> [(Text, Text)] -> [(Text, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (DocBookVersion -> (Text, Text) -> Bool
isSectionAttr DocBookVersion
version) [(Text, Text)]
attrs
      attribs :: [(Text, Text)]
attribs = [(Text, Text)]
nsAttr [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
idAttr [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
miscAttr
  Doc Text
title' <- WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
ils
  Doc Text
contents <- WriterOptions -> [Block] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocbook WriterOptions
opts [Block]
bs
  Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
tag [(Text, Text)]
attribs (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"title" Doc Text
title' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents
blockToDocbook WriterOptions
opts (Div (Text
ident,[Text]
classes,[(Text, Text)]
_) [Block]
bs) = do
  DocBookVersion
version <- ReaderT DocBookVersion m DocBookVersion
forall r (m :: * -> *). MonadReader r m => m r
ask
  let identAttribs :: [(Text, Text)]
identAttribs = [(DocBookVersion -> Text
idName DocBookVersion
version, Text
ident) | Bool -> Bool
not (Text -> Bool
T.null Text
ident)]
      admonitions :: [Text]
admonitions = [Text
"caution",Text
"danger",Text
"important",Text
"note",Text
"tip",Text
"warning"]
  case [Text]
classes of
    (Text
l:[Text]
_) | Text
l Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
admonitions -> do
        let (Maybe (DB m (Doc Text))
mTitleBs, [Block]
bodyBs) =
                case [Block]
bs of
                  -- Matches AST produced by the DocBook reader → Markdown writer → Markdown reader chain.
                  (Div (Text
_,[Text
"title"],[(Text, Text)]
_) [Para [Inline]
ts] : [Block]
rest) -> (DB m (Doc Text) -> Maybe (DB m (Doc Text))
forall a. a -> Maybe a
Just (WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
ts), [Block]
rest)
                  -- Matches AST produced by the Docbook reader.
                  (Div (Text
_,[Text
"title"],[(Text, Text)]
_) [Block]
ts : [Block]
rest) -> (DB m (Doc Text) -> Maybe (DB m (Doc Text))
forall a. a -> Maybe a
Just (WriterOptions -> [Block] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocbook WriterOptions
opts [Block]
ts), [Block]
rest)
                  [Block]
_ -> (Maybe (DB m (Doc Text))
forall a. Maybe a
Nothing, [Block]
bs)
        Doc Text
admonitionTitle <- case Maybe (DB m (Doc Text))
mTitleBs of
                              Maybe (DB m (Doc Text))
Nothing -> Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Monoid a => a
mempty
                              -- id will be attached to the admonition so let’s pass empty identAttrs.
                              Just DB m (Doc Text)
titleBs -> Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"title" [] (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DB m (Doc Text)
titleBs
        Doc Text
admonitionBody <- [(Text, Text)] -> [Block] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[(Text, Text)] -> [Block] -> ReaderT DocBookVersion m (Doc Text)
handleDivBody [] [Block]
bodyBs
        Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
l [(Text, Text)]
identAttribs (Doc Text
admonitionTitle Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
admonitionBody))
    [Text]
_ -> [(Text, Text)] -> [Block] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[(Text, Text)] -> [Block] -> ReaderT DocBookVersion m (Doc Text)
handleDivBody [(Text, Text)]
identAttribs [Block]
bs
  where
    handleDivBody :: [(Text, Text)] -> [Block] -> ReaderT DocBookVersion m (Doc Text)
handleDivBody [(Text, Text)]
identAttribs [Para [Inline]
lst] =
      if [Inline] -> Bool
hasLineBreaks [Inline]
lst
         then Doc Text -> Doc Text
forall a. Doc a -> Doc a
flush (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"literallayout" [(Text, Text)]
identAttribs
                             (Doc Text -> Doc Text)
-> ReaderT DocBookVersion m (Doc Text)
-> ReaderT DocBookVersion m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
         else Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"para" [(Text, Text)]
identAttribs (Doc Text -> Doc Text)
-> ReaderT DocBookVersion m (Doc Text)
-> ReaderT DocBookVersion m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
    handleDivBody [(Text, Text)]
identAttribs [Block]
bodyBs = do
      Doc Text
contents <- WriterOptions -> [Block] -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocbook WriterOptions
opts ((Block -> Block) -> [Block] -> [Block]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
plainToPara [Block]
bodyBs)
      Doc Text -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> ReaderT DocBookVersion m (Doc Text))
-> Doc Text -> ReaderT DocBookVersion m (Doc Text)
forall a b. (a -> b) -> a -> b
$
        (if [(Text, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, Text)]
identAttribs
            then Doc Text
forall a. Monoid a => a
mempty
            else Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"anchor" [(Text, Text)]
identAttribs) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents
blockToDocbook WriterOptions
_ h :: Block
h@Header{} = do
  -- should be handled by Div section above, except inside lists/blockquotes
  LogMessage -> ReaderT DocBookVersion m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ReaderT DocBookVersion m ())
-> LogMessage -> ReaderT DocBookVersion m ()
forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
h
  Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToDocbook WriterOptions
opts (Plain [Inline]
lst) = WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
-- title beginning with fig: indicates that the image is a figure
blockToDocbook WriterOptions
opts (Para [Image Attr
attr [Inline]
txt (Text
src,Text -> Text -> Maybe Text
T.stripPrefix Text
"fig:" -> Just Text
_)]) = do
  Doc Text
alt <- WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
txt
  let capt :: Doc Text
capt = if [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
txt
                then Doc Text
forall a. Doc a
empty
                else Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"title" Doc Text
alt
  Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"figure" (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
        Doc Text
capt Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
        Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"mediaobject" (
           Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"imageobject"
             (WriterOptions -> Attr -> Text -> Doc Text
imageToDocbook WriterOptions
opts Attr
attr Text
src) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"textobject" (Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"phrase" Doc Text
alt))
blockToDocbook WriterOptions
opts (Para [Inline]
lst)
  | [Inline] -> Bool
hasLineBreaks [Inline]
lst = Doc Text -> Doc Text
forall a. Doc a -> Doc a
flush (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"literallayout"
                        (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
  | Bool
otherwise         = Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"para" (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
blockToDocbook WriterOptions
opts (LineBlock [[Inline]]
lns) =
  WriterOptions -> Block -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> DB m (Doc Text)
blockToDocbook WriterOptions
opts (Block -> DB m (Doc Text)) -> Block -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Block
linesToPara [[Inline]]
lns
blockToDocbook WriterOptions
opts (BlockQuote [Block]
blocks) =
  Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"blockquote" (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Block] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocbook WriterOptions
opts [Block]
blocks
blockToDocbook WriterOptions
opts (CodeBlock (Text
_,[Text]
classes,[(Text, Text)]
_) Text
str) = Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$
  Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text
"<programlisting" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
lang Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
     Doc Text -> Doc Text
forall a. Doc a -> Doc a
flush (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Text
escapeStringForXML Text
str) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"</programlisting>")
    where lang :: Text
lang  = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
langs
                     then Text
""
                     else Text
" language=\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeStringForXML ([Text] -> Text
forall a. [a] -> a
head [Text]
langs) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                          Text
"\""
          syntaxMap :: SyntaxMap
syntaxMap = WriterOptions -> SyntaxMap
writerSyntaxMap WriterOptions
opts
          isLang :: Text -> Bool
isLang Text
l    = Text -> Text
T.toLower Text
l Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.toLower (SyntaxMap -> [Text]
languages SyntaxMap
syntaxMap)
          langsFrom :: Text -> [Text]
langsFrom Text
s = if Text -> Bool
isLang Text
s
                           then [Text
s]
                           else (SyntaxMap -> Text -> [Text]
languagesByExtension SyntaxMap
syntaxMap) (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text
s
          langs :: [Text]
langs       = (Text -> [Text]) -> [Text] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Text -> [Text]
langsFrom [Text]
classes
blockToDocbook WriterOptions
opts (BulletList [[Block]]
lst) = do
  let attribs :: [(Text, Text)]
attribs = [(Text
"spacing", Text
"compact") | [[Block]] -> Bool
isTightList [[Block]]
lst]
  Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"itemizedlist" [(Text, Text)]
attribs (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [[Block]] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> DB m (Doc Text)
listItemsToDocbook WriterOptions
opts [[Block]]
lst
blockToDocbook WriterOptions
_ (OrderedList ListAttributes
_ []) = Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToDocbook WriterOptions
opts (OrderedList (Int
start, ListNumberStyle
numstyle, ListNumberDelim
_) ([Block]
first:[[Block]]
rest)) = do
  let numeration :: [(Text, Text)]
numeration = case ListNumberStyle
numstyle of
                       ListNumberStyle
DefaultStyle -> []
                       ListNumberStyle
Decimal      -> [(Text
"numeration", Text
"arabic")]
                       ListNumberStyle
Example      -> [(Text
"numeration", Text
"arabic")]
                       ListNumberStyle
UpperAlpha   -> [(Text
"numeration", Text
"upperalpha")]
                       ListNumberStyle
LowerAlpha   -> [(Text
"numeration", Text
"loweralpha")]
                       ListNumberStyle
UpperRoman   -> [(Text
"numeration", Text
"upperroman")]
                       ListNumberStyle
LowerRoman   -> [(Text
"numeration", Text
"lowerroman")]
      spacing :: [(Text, Text)]
spacing    = [(Text
"spacing", Text
"compact") | [[Block]] -> Bool
isTightList ([Block]
first[Block] -> [[Block]] -> [[Block]]
forall a. a -> [a] -> [a]
:[[Block]]
rest)]
      attribs :: [(Text, Text)]
attribs    = [(Text, Text)]
numeration [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
spacing
  Doc Text
items <- if Int
start Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
              then WriterOptions -> [[Block]] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> DB m (Doc Text)
listItemsToDocbook WriterOptions
opts ([Block]
first[Block] -> [[Block]] -> [[Block]]
forall a. a -> [a] -> [a]
:[[Block]]
rest)
              else do
                Doc Text
first' <- WriterOptions -> [Block] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocbook WriterOptions
opts ((Block -> Block) -> [Block] -> [Block]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
plainToPara [Block]
first)
                Doc Text
rest' <- WriterOptions -> [[Block]] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> DB m (Doc Text)
listItemsToDocbook WriterOptions
opts [[Block]]
rest
                Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$
                  Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"listitem" [(Text
"override",Int -> Text
forall a. Show a => a -> Text
tshow Int
start)] Doc Text
first' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
                   Doc Text
rest'
  Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"orderedlist" [(Text, Text)]
attribs Doc Text
items
blockToDocbook WriterOptions
opts (DefinitionList [([Inline], [[Block]])]
lst) = do
  let attribs :: [(Text, Text)]
attribs = [(Text
"spacing", Text
"compact") | [[Block]] -> Bool
isTightList ([[Block]] -> Bool) -> [[Block]] -> Bool
forall a b. (a -> b) -> a -> b
$ (([Inline], [[Block]]) -> [[Block]])
-> [([Inline], [[Block]])] -> [[Block]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Inline], [[Block]]) -> [[Block]]
forall a b. (a, b) -> b
snd [([Inline], [[Block]])]
lst]
  Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"variablelist" [(Text, Text)]
attribs (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [([Inline], [[Block]])] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [([Inline], [[Block]])] -> DB m (Doc Text)
deflistItemsToDocbook WriterOptions
opts [([Inline], [[Block]])]
lst
blockToDocbook WriterOptions
_ b :: Block
b@(RawBlock Format
f Text
str)
  | Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
"docbook" = Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str -- raw XML block
  | Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
"html"    = do
                     DocBookVersion
version <- ReaderT DocBookVersion m DocBookVersion
forall r (m :: * -> *). MonadReader r m => m r
ask
                     if DocBookVersion
version DocBookVersion -> DocBookVersion -> Bool
forall a. Eq a => a -> a -> Bool
== DocBookVersion
DocBook5
                        then Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty -- No html in Docbook5
                        else Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str -- allow html for backwards compatibility
  | Bool
otherwise      = do
      LogMessage -> ReaderT DocBookVersion m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ReaderT DocBookVersion m ())
-> LogMessage -> ReaderT DocBookVersion m ()
forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
b
      Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToDocbook WriterOptions
_ Block
HorizontalRule = Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty -- not semantic
blockToDocbook WriterOptions
opts (Table Attr
_ Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot) = do
  let ([Inline]
caption, [Alignment]
aligns, [Double]
widths, [[Block]]
headers, [[[Block]]]
rows) = Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
toLegacyTable Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot
  Doc Text
captionDoc <- if [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
caption
                   then Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
                   else Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"title" (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                         WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
caption
  let tableType :: Text
tableType    = if Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
captionDoc then Text
"informaltable" else Text
"table"
      percent :: a -> Text
percent a
w    = Integer -> Text
forall a. Show a => a -> Text
tshow (a -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate (a
100a -> a -> a
forall a. Num a => a -> a -> a
*a
w) :: Integer) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"*"
      coltags :: Doc Text
coltags = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ (Double -> Alignment -> Doc Text)
-> [Double] -> [Alignment] -> [Doc Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Double
w Alignment
al -> Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"colspec"
                       ([(Text
"colwidth", Double -> Text
forall a. RealFrac a => a -> Text
percent Double
w) | Double
w Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<>
                        [(Text
"align", Alignment -> Text
alignmentToString Alignment
al)])) [Double]
widths [Alignment]
aligns
  Doc Text
head' <- if ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers
              then Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
              else Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"thead" (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [[Block]] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> DB m (Doc Text)
tableRowToDocbook WriterOptions
opts [[Block]]
headers
  Doc Text
body' <- Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"tbody" (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> ReaderT DocBookVersion m [Doc Text] -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
              ([[Block]] -> DB m (Doc Text))
-> [[[Block]]] -> ReaderT DocBookVersion m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [[Block]] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> DB m (Doc Text)
tableRowToDocbook WriterOptions
opts) [[[Block]]]
rows
  Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
tableType (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text
captionDoc Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
        Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"tgroup" [(Text
"cols", Int -> Text
forall a. Show a => a -> Text
tshow ([Alignment] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Alignment]
aligns))] (
         Doc Text
coltags Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
head' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
body')

hasLineBreaks :: [Inline] -> Bool
hasLineBreaks :: [Inline] -> Bool
hasLineBreaks = Any -> Bool
getAny (Any -> Bool) -> ([Inline] -> Any) -> [Inline] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Any) -> [Inline] -> Any
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> Any
isLineBreak ([Inline] -> Any) -> ([Inline] -> [Inline]) -> [Inline] -> Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Inline) -> [Inline] -> [Inline]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
removeNote
  where
    removeNote :: Inline -> Inline
    removeNote :: Inline -> Inline
removeNote (Note [Block]
_) = Text -> Inline
Str Text
""
    removeNote Inline
x        = Inline
x
    isLineBreak :: Inline -> Any
    isLineBreak :: Inline -> Any
isLineBreak Inline
LineBreak = Bool -> Any
Any Bool
True
    isLineBreak Inline
_         = Bool -> Any
Any Bool
False

alignmentToString :: Alignment -> Text
alignmentToString :: Alignment -> Text
alignmentToString Alignment
alignment = case Alignment
alignment of
                                 Alignment
AlignLeft    -> Text
"left"
                                 Alignment
AlignRight   -> Text
"right"
                                 Alignment
AlignCenter  -> Text
"center"
                                 Alignment
AlignDefault -> Text
"left"

tableRowToDocbook :: PandocMonad m
                  => WriterOptions
                  -> [[Block]]
                  -> DB m (Doc Text)
tableRowToDocbook :: WriterOptions -> [[Block]] -> DB m (Doc Text)
tableRowToDocbook WriterOptions
opts [[Block]]
cols =
  Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"row" (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> ReaderT DocBookVersion m [Doc Text] -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Block] -> DB m (Doc Text))
-> [[Block]] -> ReaderT DocBookVersion m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [Block] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
tableItemToDocbook WriterOptions
opts) [[Block]]
cols

tableItemToDocbook :: PandocMonad m
                   => WriterOptions
                   -> [Block]
                   -> DB m (Doc Text)
tableItemToDocbook :: WriterOptions -> [Block] -> DB m (Doc Text)
tableItemToDocbook WriterOptions
opts [Block]
item =
  Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"entry" [] (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> ReaderT DocBookVersion m [Doc Text] -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> DB m (Doc Text))
-> [Block] -> ReaderT DocBookVersion m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> Block -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> DB m (Doc Text)
blockToDocbook WriterOptions
opts) [Block]
item

-- | Convert a list of inline elements to Docbook.
inlinesToDocbook :: PandocMonad m => WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook :: WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat ([Doc Text] -> Doc Text)
-> ReaderT DocBookVersion m [Doc Text] -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> DB m (Doc Text))
-> [Inline] -> ReaderT DocBookVersion m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> Inline -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> DB m (Doc Text)
inlineToDocbook WriterOptions
opts) [Inline]
lst

-- | Convert an inline element to Docbook.
inlineToDocbook :: PandocMonad m => WriterOptions -> Inline -> DB m (Doc Text)
inlineToDocbook :: WriterOptions -> Inline -> DB m (Doc Text)
inlineToDocbook WriterOptions
_ (Str Text
str) = Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
str
inlineToDocbook WriterOptions
opts (Emph [Inline]
lst) =
  Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"emphasis" (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
inlineToDocbook WriterOptions
opts (Underline [Inline]
lst) =
  Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"emphasis" [(Text
"role", Text
"underline")] (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
inlineToDocbook WriterOptions
opts (Strong [Inline]
lst) =
  Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"emphasis" [(Text
"role", Text
"strong")] (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
inlineToDocbook WriterOptions
opts (Strikeout [Inline]
lst) =
  Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"emphasis" [(Text
"role", Text
"strikethrough")] (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
inlineToDocbook WriterOptions
opts (Superscript [Inline]
lst) =
  Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"superscript" (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
inlineToDocbook WriterOptions
opts (Subscript [Inline]
lst) =
  Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"subscript" (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
inlineToDocbook WriterOptions
opts (SmallCaps [Inline]
lst) =
  Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"emphasis" [(Text
"role", Text
"smallcaps")] (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
inlineToDocbook WriterOptions
opts (Quoted QuoteType
_ [Inline]
lst) =
  Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"quote" (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
inlineToDocbook WriterOptions
opts (Cite [Citation]
_ [Inline]
lst) =
  WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
inlineToDocbook WriterOptions
opts (Span (Text
ident,[Text]
_,[(Text, Text)]
_) [Inline]
ils) = do
  DocBookVersion
version <- ReaderT DocBookVersion m DocBookVersion
forall r (m :: * -> *). MonadReader r m => m r
ask
  ((if Text -> Bool
T.null Text
ident
       then Doc Text
forall a. Monoid a => a
mempty
       else Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"anchor" [(DocBookVersion -> Text
idName DocBookVersion
version, Text
ident)]) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>) (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
ils
inlineToDocbook WriterOptions
_ (Code Attr
_ Text
str) =
  Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"literal" (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Text
escapeStringForXML Text
str)
inlineToDocbook WriterOptions
opts (Math MathType
t Text
str)
  | HTMLMathMethod -> Bool
isMathML (WriterOptions -> HTMLMathMethod
writerHTMLMathMethod WriterOptions
opts) = do
    Either Inline Element
res <- (DisplayType -> [Exp] -> Element)
-> MathType
-> Text
-> ReaderT DocBookVersion m (Either Inline Element)
forall (m :: * -> *) a.
PandocMonad m =>
(DisplayType -> [Exp] -> a)
-> MathType -> Text -> m (Either Inline a)
convertMath DisplayType -> [Exp] -> Element
writeMathML MathType
t Text
str
    case Either Inline Element
res of
         Right Element
r  -> Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
tagtype
                     (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ConfigPP -> Element -> String
Xml.ppcElement ConfigPP
conf
                     (Element -> String) -> Element -> String
forall a b. (a -> b) -> a -> b
$ Element -> Element
fixNS
                     (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Element -> Element
removeAttr Element
r
         Left Inline
il  -> WriterOptions -> Inline -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> DB m (Doc Text)
inlineToDocbook WriterOptions
opts Inline
il
  | Bool
otherwise =
     MathType -> Text -> ReaderT DocBookVersion m [Inline]
forall (m :: * -> *).
PandocMonad m =>
MathType -> Text -> m [Inline]
texMathToInlines MathType
t Text
str ReaderT DocBookVersion m [Inline]
-> ([Inline] -> DB m (Doc Text)) -> DB m (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts
     where tagtype :: Text
tagtype = case MathType
t of
                       MathType
InlineMath  -> Text
"inlineequation"
                       MathType
DisplayMath -> Text
"informalequation"
           conf :: ConfigPP
conf = (QName -> Bool) -> ConfigPP -> ConfigPP
Xml.useShortEmptyTags (Bool -> QName -> Bool
forall a b. a -> b -> a
const Bool
False) ConfigPP
Xml.defaultConfigPP
           removeAttr :: Element -> Element
removeAttr Element
e = Element
e{ elAttribs :: [Attr]
Xml.elAttribs = [] }
           fixNS' :: QName -> QName
fixNS' QName
qname = QName
qname{ qPrefix :: Maybe String
Xml.qPrefix = String -> Maybe String
forall a. a -> Maybe a
Just String
"mml" }
           fixNS :: Element -> Element
fixNS = (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere ((QName -> QName) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT QName -> QName
fixNS')
inlineToDocbook WriterOptions
_ il :: Inline
il@(RawInline Format
f Text
x)
  | Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
"html" Bool -> Bool -> Bool
|| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
"docbook" = Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
x
  | Bool
otherwise                     = do
      LogMessage -> ReaderT DocBookVersion m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ReaderT DocBookVersion m ())
-> LogMessage -> ReaderT DocBookVersion m ()
forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
il
      Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
inlineToDocbook WriterOptions
_ Inline
LineBreak = Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\n"
-- currently ignore, would require the option to add custom
-- styles to the document
inlineToDocbook WriterOptions
_ Inline
Space = Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
-- because we use \n for LineBreak, we can't do soft breaks:
inlineToDocbook WriterOptions
_ Inline
SoftBreak = Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
inlineToDocbook WriterOptions
opts (Link Attr
attr [Inline]
txt (Text
src, Text
_))
  | Just Text
email <- Text -> Text -> Maybe Text
T.stripPrefix Text
"mailto:" Text
src =
      let emailLink :: Doc Text
emailLink = Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"email" (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
                      Text -> Text
escapeStringForXML Text
email
      in  case [Inline]
txt of
           [Str Text
s] | Text -> Text
escapeURI Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
email -> Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
emailLink
           [Inline]
_             -> do Doc Text
contents <- WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
txt
                               Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
<+>
                                          Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char Char
'(' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
emailLink Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char Char
')'
  | Bool
otherwise = do
      DocBookVersion
version <- ReaderT DocBookVersion m DocBookVersion
forall r (m :: * -> *). MonadReader r m => m r
ask
      (if Text
"#" Text -> Text -> Bool
`T.isPrefixOf` Text
src
            then Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"link" ([(Text, Text)] -> Doc Text -> Doc Text)
-> [(Text, Text)] -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ (Text
"linkend", WriterOptions -> Text
writerIdentifierPrefix WriterOptions
opts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.drop Int
1 Text
src) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: Attr -> [(Text, Text)]
idAndRole Attr
attr
            else if DocBookVersion
version DocBookVersion -> DocBookVersion -> Bool
forall a. Eq a => a -> a -> Bool
== DocBookVersion
DocBook5
                    then Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"link" ([(Text, Text)] -> Doc Text -> Doc Text)
-> [(Text, Text)] -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ (Text
"xlink:href", Text
src) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: Attr -> [(Text, Text)]
idAndRole Attr
attr
                    else Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"ulink" ([(Text, Text)] -> Doc Text -> Doc Text)
-> [(Text, Text)] -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ (Text
"url", Text
src) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: Attr -> [(Text, Text)]
idAndRole Attr
attr )
        (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
txt
inlineToDocbook WriterOptions
opts (Image Attr
attr [Inline]
_ (Text
src, Text
tit)) = Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$
  let titleDoc :: Doc Text
titleDoc = if Text -> Bool
T.null Text
tit
                   then Doc Text
forall a. Doc a
empty
                   else Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"objectinfo" (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
                        Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"title" (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
tit)
  in  Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"inlinemediaobject" (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"imageobject" (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
      Doc Text
titleDoc Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ WriterOptions -> Attr -> Text -> Doc Text
imageToDocbook WriterOptions
opts Attr
attr Text
src
inlineToDocbook WriterOptions
opts (Note [Block]
contents) =
  Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"footnote" (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Block] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocbook WriterOptions
opts [Block]
contents

isMathML :: HTMLMathMethod -> Bool
isMathML :: HTMLMathMethod -> Bool
isMathML HTMLMathMethod
MathML = Bool
True
isMathML HTMLMathMethod
_      = Bool
False

idAndRole :: Attr -> [(Text, Text)]
idAndRole :: Attr -> [(Text, Text)]
idAndRole (Text
id',[Text]
cls,[(Text, Text)]
_) = [(Text, Text)]
ident [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
role
  where
    ident :: [(Text, Text)]
ident = [(Text
"id", Text
id') | Bool -> Bool
not (Text -> Bool
T.null Text
id')]
    role :: [(Text, Text)]
role  = [(Text
"role", [Text] -> Text
T.unwords [Text]
cls) | Bool -> Bool
not ([Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
cls)]

isSectionAttr :: DocBookVersion -> (Text, Text) -> Bool
isSectionAttr :: DocBookVersion -> (Text, Text) -> Bool
isSectionAttr DocBookVersion
_ (Text
"label",Text
_) = Bool
True
isSectionAttr DocBookVersion
_ (Text
"status",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"annotations",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"dir",Text
"ltr") = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"dir",Text
"rtl") = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"dir",Text
"lro") = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"dir",Text
"rlo") = Bool
True
isSectionAttr DocBookVersion
_ (Text
"remap",Text
_) = Bool
True
isSectionAttr DocBookVersion
_ (Text
"revisionflag",Text
"changed") = Bool
True
isSectionAttr DocBookVersion
_ (Text
"revisionflag",Text
"added") = Bool
True
isSectionAttr DocBookVersion
_ (Text
"revisionflag",Text
"deleted") = Bool
True
isSectionAttr DocBookVersion
_ (Text
"revisionflag",Text
"off") = Bool
True
isSectionAttr DocBookVersion
_ (Text
"role",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"version",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"xml:base",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"xml:lang",Text
_) = Bool
True
isSectionAttr DocBookVersion
_ (Text
"xreflabel",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"linkend",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"linkends",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"xlink:actuate",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"xlink:arcrole",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"xlink:from",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"xlink:href",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"xlink:label",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"xlink:role",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"xlink:show",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"xlink:title",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"xlink:to",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"xlink:type",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook4 (Text
"arch",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook4 (Text
"condition",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook4 (Text
"conformance",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook4 (Text
"lang",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook4 (Text
"os",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook4 (Text
"revision",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook4 (Text
"security",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook4 (Text
"vendor",Text
_) = Bool
True
isSectionAttr DocBookVersion
_ (Text
_,Text
_) = Bool
False