{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards     #-}
{- |
   Module      : Text.Pandoc.Writers.Docbook
   Copyright   : Copyright (C) 2006-2022 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
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
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 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m Inlines
authorToDocbook WriterOptions
opts [Inline]
name' = do
  Text
name <- forall a. HasChars a => Maybe Int -> Doc a -> a
render forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
                    then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
opts
                    else forall a. Maybe a
Nothing
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines
B.rawInline Text
"docbook" forall a b. (a -> b) -> a -> b
$
    forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"personname" [] forall a b. (a -> b) -> a -> b
$
      if (Char -> Bool) -> Text -> Bool
T.any (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 (forall a. Eq a => a -> a -> Bool
==Char
',') Text
name
                  firstname :: Text
firstname = Text -> Text
triml Text
rest in
              forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"firstname" (forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
firstname) forall a. Semigroup a => a -> a -> a
<>
              forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"surname" (forall a. HasChars a => a -> Doc a
literal 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 = 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 (forall a. Int -> [a] -> [a]
take (Int
nforall a. Num a => a -> a -> a
-Int
1) [Text]
namewords), forall a. [a] -> a
last [Text]
namewords)
               in forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"firstname" (forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
firstname) forall a. Doc a -> Doc a -> Doc a
$$
                  forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"surname" (forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
lastname)

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

writeDocbook5 :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeDocbook5 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeDocbook5 WriterOptions
opts Pandoc
d =
  forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (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 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> DB m Text
writeDocbook WriterOptions
opts Pandoc
doc = do
  let Pandoc Meta
meta [Block]
blocks = Pandoc -> Pandoc
ensureValidXmlIdentifiers Pandoc
doc
  let colwidth :: Maybe Int
colwidth = if WriterOptions -> WrapOption
writerWrapText WriterOptions
opts forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
                    then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
opts
                    else forall a. Maybe a
Nothing
  let startLvl :: Int
startLvl = WriterOptions -> Int
getStartLvl WriterOptions
opts
  let fromBlocks :: [Block] -> DB m (Doc Text)
fromBlocks = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocbook WriterOptions
opts forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                   Bool -> Maybe Int -> [Block] -> [Block]
makeSections Bool
False (forall a. a -> Maybe a
Just Int
startLvl)
  [Inlines]
auths' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m Inlines
authorToDocbook WriterOptions
opts) forall a b. (a -> b) -> a -> b
$ Meta -> [[Inline]]
docAuthors Meta
meta
  let meta' :: Meta
meta' = forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
B.setMeta Text
"author" [Inlines]
auths' Meta
meta
  Context Text
metadata <- 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
                 (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 = forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Doc Text
main
              forall a b. (a -> b) -> a -> b
$ 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
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth forall a b. (a -> b) -> a -> b
$
    (if WriterOptions -> Bool
writerPreferAscii WriterOptions
opts then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
toEntities else forall a. a -> a
id) 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 -> 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 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocbook WriterOptions
opts = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [Doc a] -> Doc a
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (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 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [([Inline], [[Block]])] -> DB m (Doc Text)
deflistItemsToDocbook WriterOptions
opts [([Inline], [[Block]])]
items =
  forall a. [Doc a] -> Doc a
vcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (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 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> [[Block]] -> DB m (Doc Text)
deflistItemToDocbook WriterOptions
opts [Inline]
term [[Block]]
defs = do
  Doc Text
term' <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
term
  Doc Text
def' <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocbook WriterOptions
opts forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
plainToPara) [[Block]]
defs
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"varlistentry" forall a b. (a -> b) -> a -> b
$
      forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"term" Doc Text
term' forall a. Doc a -> Doc a -> Doc a
$$
      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 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> DB m (Doc Text)
listItemsToDocbook WriterOptions
opts [[Block]]
items = forall a. [Doc a] -> Doc a
vcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (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 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
listItemToDocbook WriterOptions
opts [Block]
item =
  forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"listitem" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocbook WriterOptions
opts (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 = forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"imagedata" forall a b. (a -> b) -> a -> b
$
  (Text
"fileref", Text
src) forall a. a -> [a] -> [a]
: Attr -> [(Text, Text)]
idAndRole Attr
attr forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
dims
  where
    dims :: [(Text, Text)]
dims = forall {a}. Direction -> a -> [(a, Text)]
go Direction
Width Text
"width" forall a. Semigroup a => a -> a -> a
<> 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, 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 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> DB m (Doc Text)
blockToDocbook WriterOptions
_ Block
Null = forall (m :: * -> *) a. Monad m => a -> m a
return 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 <- 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 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 forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= Int
5 -> if DocBookVersion
version forall a. Eq a => a -> a -> Bool
== DocBookVersion
DocBook5
                                              then Text
"section"
                                              else Text
"sect" forall a. Semigroup a => a -> a -> a
<> 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 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 forall a. Eq a => a -> a -> Bool
== DocBookVersion
DocBook5 Bool -> Bool -> Bool
&& Int
lvl forall a. Eq a => a -> a -> Bool
== WriterOptions -> Int
getStartLvl WriterOptions
opts Bool -> Bool -> 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 = forall a. (a -> Bool) -> [a] -> [a]
filter (DocBookVersion -> (Text, Text) -> Bool
isSectionAttr DocBookVersion
version) [(Text, Text)]
attrs
      attribs :: [(Text, Text)]
attribs = [(Text, Text)]
nsAttr forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
idAttr forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
miscAttr
  Doc Text
title' <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
ils
  Doc Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocbook WriterOptions
opts [Block]
bs
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
tag [(Text, Text)]
attribs forall a b. (a -> b) -> a -> b
$ forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"title" Doc Text
title' 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 <- 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 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) -> (forall a. a -> Maybe a
Just (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) -> (forall a. a -> Maybe a
Just (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocbook WriterOptions
opts [Block]
ts), [Block]
rest)
                  [Block]
_ -> (forall a. Maybe a
Nothing, [Block]
bs)
        Doc Text
admonitionTitle <- case Maybe (DB m (Doc Text))
mTitleBs of
                              Maybe (DB m (Doc Text))
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return 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 -> forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"title" [] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DB m (Doc Text)
titleBs
        Doc Text
admonitionBody <- forall {m :: * -> *}.
PandocMonad m =>
[(Text, Text)] -> [Block] -> ReaderT DocBookVersion m (Doc Text)
handleDivBody [] [Block]
bodyBs
        forall (m :: * -> *) a. Monad m => a -> m a
return (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 forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
admonitionBody))
    [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 forall a. Doc a -> Doc a
flush forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => Doc a -> Doc a
nowrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"literallayout" [(Text, Text)]
identAttribs
                             forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
         else forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"para" [(Text, Text)]
identAttribs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocbook WriterOptions
opts (forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
plainToPara [Block]
bodyBs)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, Text)]
identAttribs
            then forall a. Monoid a => a
mempty
            else forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"anchor" [(Text, Text)]
identAttribs) 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
  forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
h
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
blockToDocbook WriterOptions
opts (Plain [Inline]
lst) = 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 (SimpleFigure Attr
attr [Inline]
txt (Text
src, Text
_)) = do
  Doc Text
alt <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
txt
  let capt :: Doc Text
capt = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
txt
                then forall a. Doc a
empty
                else forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"title" Doc Text
alt
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"figure" forall a b. (a -> b) -> a -> b
$
        Doc Text
capt forall a. Doc a -> Doc a -> Doc a
$$
        forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"mediaobject" (
           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) forall a. Doc a -> Doc a -> Doc a
$$
           forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"textobject" (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 = forall a. Doc a -> Doc a
flush forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => Doc a -> Doc a
nowrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"literallayout"
                        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
  | Bool
otherwise         = forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"para" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
blockToDocbook WriterOptions
opts (LineBlock [[Inline]]
lns) =
  forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> DB m (Doc Text)
blockToDocbook WriterOptions
opts forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Block
linesToPara [[Inline]]
lns
blockToDocbook WriterOptions
opts (BlockQuote [Block]
blocks) =
  forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"blockquote" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
  forall a. HasChars a => a -> Doc a
literal (Text
"<programlisting" forall a. Semigroup a => a -> a -> a
<> Text
lang forall a. Semigroup a => a -> a -> a
<> Text
">") forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<>
     forall a. Doc a -> Doc a
flush (forall a. HasChars a => a -> Doc a
literal (Text -> Text
escapeStringForXML Text
str) forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
"</programlisting>")
    where lang :: Text
lang  = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
langs
                     then Text
""
                     else Text
" language=\"" forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeStringForXML (forall a. [a] -> a
head [Text]
langs) 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` 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) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower forall a b. (a -> b) -> a -> b
$ Text
s
          langs :: [Text]
langs       = 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]
  forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"itemizedlist" [(Text, Text)]
attribs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> DB m (Doc Text)
listItemsToDocbook WriterOptions
opts [[Block]]
lst
blockToDocbook WriterOptions
_ (OrderedList ListAttributes
_ []) = forall (m :: * -> *) a. Monad m => a -> m a
return 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]
firstforall a. a -> [a] -> [a]
:[[Block]]
rest)]
      attribs :: [(Text, Text)]
attribs    = [(Text, Text)]
numeration forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
spacing
  Doc Text
items <- if Int
start forall a. Eq a => a -> a -> Bool
== Int
1
              then forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> DB m (Doc Text)
listItemsToDocbook WriterOptions
opts ([Block]
firstforall a. a -> [a] -> [a]
:[[Block]]
rest)
              else do
                Doc Text
first' <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocbook WriterOptions
opts (forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
plainToPara [Block]
first)
                Doc Text
rest' <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> DB m (Doc Text)
listItemsToDocbook WriterOptions
opts [[Block]]
rest
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                  forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"listitem" [(Text
"override",forall a. Show a => a -> Text
tshow Int
start)] Doc Text
first' forall a. Doc a -> Doc a -> Doc a
$$
                   Doc Text
rest'
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd [([Inline], [[Block]])]
lst]
  forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"variablelist" [(Text, Text)]
attribs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall a. Eq a => a -> a -> Bool
== Format
"docbook" = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
str -- raw XML block
  | Format
f forall a. Eq a => a -> a -> Bool
== Format
"html"    = do
                     DocBookVersion
version <- forall r (m :: * -> *). MonadReader r m => m r
ask
                     if DocBookVersion
version forall a. Eq a => a -> a -> Bool
== DocBookVersion
DocBook5
                        then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty -- No html in Docbook5
                        else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
str -- allow html for backwards compatibility
  | Bool
otherwise      = do
      forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
b
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
blockToDocbook WriterOptions
_ Block
HorizontalRule = forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
caption
                   then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
                   else forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"title" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                         forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
caption
  let tableType :: Text
tableType    = if forall a. Doc a -> Bool
isEmpty Doc Text
captionDoc then Text
"informaltable" else Text
"table"
      percent :: a -> Text
percent a
w    = forall a. Show a => a -> Text
tshow (forall a b. (RealFrac a, Integral b) => a -> b
truncate (a
100forall a. Num a => a -> a -> a
*a
w) :: Integer) forall a. Semigroup a => a -> a -> a
<> Text
"*"
      coltags :: Doc Text
coltags = forall a. [Doc a] -> Doc a
vcat forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Double
w Alignment
al -> forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"colspec"
                       ([(Text
"colwidth", forall {a}. RealFrac a => a -> Text
percent Double
w) | Double
w forall a. Ord a => a -> a -> Bool
> Double
0] forall a. Semigroup a => a -> a -> a
<>
                        [(Text
"align", Alignment -> Text
alignmentToString Alignment
al)])) [Double]
widths [Alignment]
aligns
  Doc Text
head' <- if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers
              then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
              else forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"thead" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> DB m (Doc Text)
tableRowToDocbook WriterOptions
opts [[Block]]
headers
  Doc Text
body' <- forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"tbody" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Doc a] -> Doc a
vcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
              forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> DB m (Doc Text)
tableRowToDocbook WriterOptions
opts) [[[Block]]]
rows
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
tableType forall a b. (a -> b) -> a -> b
$ Doc Text
captionDoc forall a. Doc a -> Doc a -> Doc a
$$
        forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"tgroup" [(Text
"cols", forall a. Show a => a -> Text
tshow (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Alignment]
aligns))] (
         Doc Text
coltags forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
head' forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
body')

hasLineBreaks :: [Inline] -> Bool
hasLineBreaks :: [Inline] -> Bool
hasLineBreaks = Any -> Bool
getAny forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> Any
isLineBreak forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> DB m (Doc Text)
tableRowToDocbook WriterOptions
opts [[Block]]
cols =
  forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"row" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Doc a] -> Doc a
vcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (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 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
tableItemToDocbook WriterOptions
opts [Block]
item =
  forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"entry" [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Doc a] -> Doc a
vcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (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 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst = forall a. [Doc a] -> Doc a
hcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (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 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> DB m (Doc Text)
inlineToDocbook WriterOptions
_ (Str Text
str) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
str
inlineToDocbook WriterOptions
opts (Emph [Inline]
lst) =
  forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"emphasis" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
inlineToDocbook WriterOptions
opts (Underline [Inline]
lst) =
  forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"emphasis" [(Text
"role", Text
"underline")] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
inlineToDocbook WriterOptions
opts (Strong [Inline]
lst) =
  forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"emphasis" [(Text
"role", Text
"strong")] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
inlineToDocbook WriterOptions
opts (Strikeout [Inline]
lst) =
  forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"emphasis" [(Text
"role", Text
"strikethrough")] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
inlineToDocbook WriterOptions
opts (Superscript [Inline]
lst) =
  forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"superscript" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
inlineToDocbook WriterOptions
opts (Subscript [Inline]
lst) =
  forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"subscript" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
inlineToDocbook WriterOptions
opts (SmallCaps [Inline]
lst) =
  forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"emphasis" [(Text
"role", Text
"smallcaps")] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
inlineToDocbook WriterOptions
opts (Quoted QuoteType
_ [Inline]
lst) =
  forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"quote" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
inlineToDocbook WriterOptions
opts (Cite [Citation]
_ [Inline]
lst) =
  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 <- forall r (m :: * -> *). MonadReader r m => m r
ask
  ((if Text -> Bool
T.null Text
ident
       then forall a. Monoid a => a
mempty
       else forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"anchor" [(DocBookVersion -> Text
idName DocBookVersion
version, Text
ident)]) forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
ils
inlineToDocbook WriterOptions
_ (Code Attr
_ Text
str) =
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"literal" forall a b. (a -> b) -> a -> b
$ 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 <- 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  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
tagtype
                     forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ ConfigPP -> Element -> String
Xml.ppcElement ConfigPP
conf
                     forall a b. (a -> b) -> a -> b
$ Element -> Element
fixNS
                     forall a b. (a -> b) -> a -> b
$ Element -> Element
removeAttr Element
r
         Left Inline
il  -> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> DB m (Doc Text)
inlineToDocbook WriterOptions
opts Inline
il
  | Bool
otherwise =
     forall (m :: * -> *).
PandocMonad m =>
MathType -> Text -> m [Inline]
texMathToInlines MathType
t Text
str forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 (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 = 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 (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 forall a. Eq a => a -> a -> Bool
== Format
"html" Bool -> Bool -> Bool
|| Format
f forall a. Eq a => a -> a -> Bool
== Format
"docbook" = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
x
  | Bool
otherwise                     = do
      forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
il
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
inlineToDocbook WriterOptions
_ Inline
LineBreak = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
space
-- because we use \n for LineBreak, we can't do soft breaks:
inlineToDocbook WriterOptions
_ Inline
SoftBreak = forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"email" forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal 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 forall a. Eq a => a -> a -> Bool
== Text
email -> forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
emailLink
           [Inline]
_             -> do Doc Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
txt
                               forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
contents forall a. Doc a -> Doc a -> Doc a
<+>
                                          forall a. HasChars a => Char -> Doc a
char Char
'(' forall a. Semigroup a => a -> a -> a
<> Doc Text
emailLink forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Char -> Doc a
char Char
')'
  | Bool
otherwise = do
      DocBookVersion
version <- forall r (m :: * -> *). MonadReader r m => m r
ask
      (if Text
"#" Text -> Text -> Bool
`T.isPrefixOf` Text
src
            then let tag :: Text
tag = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
txt then Text
"xref" else Text
"link"
                 in  forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
tag forall a b. (a -> b) -> a -> b
$
                     (Text
"linkend", WriterOptions -> Text
writerIdentifierPrefix WriterOptions
opts forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.drop Int
1 Text
src) forall a. a -> [a] -> [a]
: Attr -> [(Text, Text)]
idAndRole Attr
attr
            else if DocBookVersion
version forall a. Eq a => a -> a -> Bool
== DocBookVersion
DocBook5
                    then forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"link" forall a b. (a -> b) -> a -> b
$ (Text
"xlink:href", Text
src) forall a. a -> [a] -> [a]
: Attr -> [(Text, Text)]
idAndRole Attr
attr
                    else forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"ulink" forall a b. (a -> b) -> a -> b
$ (Text
"url", Text
src) forall a. a -> [a] -> [a]
: Attr -> [(Text, Text)]
idAndRole Attr
attr )
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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)) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
  let titleDoc :: Doc Text
titleDoc = if Text -> Bool
T.null Text
tit
                   then forall a. Doc a
empty
                   else forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"objectinfo" forall a b. (a -> b) -> a -> b
$
                        forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"title" (forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
tit)
  in  forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"inlinemediaobject" forall a b. (a -> b) -> a -> b
$ forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"imageobject" forall a b. (a -> b) -> a -> b
$
      Doc Text
titleDoc 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) =
  forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"footnote" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 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 (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