{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards     #-}
{- |
   Module      : Text.Pandoc.Writers.DocBook
   Copyright   : Copyright (C) 2006-2024 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.List (nub, partition)
import Data.Maybe (isNothing)
import Data.Monoid (All (..), 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.URI
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
$c== :: DocBookVersion -> DocBookVersion -> Bool
== :: DocBookVersion -> DocBookVersion -> Bool
$c/= :: DocBookVersion -> DocBookVersion -> Bool
/= :: 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
$cshowsPrec :: Int -> DocBookVersion -> ShowS
showsPrec :: Int -> DocBookVersion -> ShowS
$cshow :: DocBookVersion -> String
show :: DocBookVersion -> String
$cshowList :: [DocBookVersion] -> ShowS
showList :: [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
  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 = 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
  return $ B.rawInline "docbook" $
    render colwidth $ inTags True "personname" [] $
      if T.any (== ',') name
         then -- last name first
              let (lastname, rest) = T.break (==',') name
                  firstname = Text -> Text
triml Text
rest in
              inTagsSimple "firstname" (literal $ escapeStringForXML firstname) <>
              inTagsSimple "surname" (literal $ escapeStringForXML lastname)
         else -- last name last
              let namewords = Text -> [Text]
T.words Text
name
                  lengthname = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
namewords
                  (firstname, lastname) = case 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. HasCallStack => [a] -> a
last [Text]
namewords)
               in inTagsSimple "firstname" (literal $ escapeStringForXML firstname) $$
                  inTagsSimple "surname" (literal $ escapeStringForXML lastname)

writeDocBook4 :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeDocBook4 :: forall (m :: * -> *).
PandocMonad m =>
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 :: forall (m :: * -> *).
PandocMonad m =>
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 :: 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 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)
  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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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' = Text -> [Inlines] -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
forall b. ToMetaValue b => Text -> b -> Meta -> Meta
B.setMeta Text
"author" [Inlines]
auths' Meta
meta
  metadata <- metaToContext opts
                 fromBlocks
                 (inlinesToDocBook opts)
                 meta'
  main <- fromBlocks blocks
  let 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
  return $ render colwidth $
    (if writerPreferAscii opts then fmap toEntities else id) $
    case writerTemplate 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 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocBook WriterOptions
opts = ([Doc Text] -> Doc Text)
-> ReaderT DocBookVersion m [Doc Text]
-> ReaderT DocBookVersion m (Doc Text)
forall a b.
(a -> b)
-> ReaderT DocBookVersion m a -> ReaderT DocBookVersion m b
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]
 -> ReaderT DocBookVersion m (Doc Text))
-> ([Block] -> ReaderT DocBookVersion m [Doc Text])
-> [Block]
-> ReaderT DocBookVersion m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> ReaderT DocBookVersion 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> Block -> ReaderT DocBookVersion 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 :: forall (m :: * -> *).
PandocMonad m =>
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]
-> ReaderT DocBookVersion m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([Inline], [[Block]]) -> ReaderT DocBookVersion 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (([Inline] -> [[Block]] -> ReaderT DocBookVersion m (Doc Text))
-> ([Inline], [[Block]]) -> ReaderT DocBookVersion m (Doc Text)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (WriterOptions
-> [Inline] -> [[Block]] -> ReaderT DocBookVersion 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 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> [[Block]] -> DB m (Doc Text)
deflistItemToDocBook WriterOptions
opts [Inline]
term [[Block]]
defs = do
  term' <- WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
term
  def' <- blocksToDocBook opts $ concatMap (map plainToPara) defs
  return $ inTagsIndented "varlistentry" $
      inTagsIndented "term" term' $$
      inTagsIndented "listitem" 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 = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([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
<$> ([Block] -> ReaderT DocBookVersion 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> [Block] -> ReaderT DocBookVersion 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 :: forall (m :: * -> *).
PandocMonad m =>
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)
-> ReaderT DocBookVersion m (Doc Text)
-> ReaderT DocBookVersion m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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]
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)
-- Add ids to paragraphs in divs with ids - this is needed for
-- pandoc-citeproc to get link anchors in bibliographies:
blockToDocBook :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> DB m (Doc Text)
blockToDocBook WriterOptions
opts (Div (Text
id',Text
"section":[Text]
_,[(Text, Text)]
_) (Header Int
lvl (Text
_,[Text]
classes,[(Text, Text)]
attrs) [Inline]
ils : [Block]
xs)) = do
  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 = if [Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
xs
              then [[Inline] -> Block
Para []]
              else [Block]
xs
      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 = [(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 = 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
      -- Also enrich the role attribute with certain class tokens
      miscAttr = [(Text, Text)] -> [Text] -> [(Text, Text)]
enrichRole (((Text, Text) -> Bool) -> [(Text, Text)] -> [(Text, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (DocBookVersion -> (Text, Text) -> Bool
isSectionAttr DocBookVersion
version) [(Text, Text)]
attrs) [Text]
classes
      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
  title' <- inlinesToDocBook opts ils
  contents <- blocksToDocBook opts bs
  return $ inTags True tag attribs $ inTagsSimple "title" title' $$ contents
blockToDocBook WriterOptions
opts (Div (Text
ident,[Text]
classes,[(Text, Text)]
_) [Block]
bs) = do
  version <- ReaderT DocBookVersion m DocBookVersion
forall r (m :: * -> *). MonadReader r m => m r
ask
  let identAttribs = [(DocBookVersion -> Text
idName DocBookVersion
version, Text
ident) | Bool -> Bool
not (Text -> Bool
T.null Text
ident)]
      admonitions = [Text
"caution",Text
"danger",Text
"important",Text
"note",Text
"tip",Text
"warning"]
  case classes of
    (Text
l:[Text]
_) | Text
l Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> 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)
        admonitionTitle <- case Maybe (DB m (Doc Text))
mTitleBs of
                              Maybe (DB m (Doc Text))
Nothing -> Doc Text -> DB m (Doc Text)
forall a. a -> ReaderT DocBookVersion m a
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 -> Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple 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
        admonitionBody <- handleDivBody [] bodyBs
        return (inTags True l identAttribs (admonitionTitle $$ 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
      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)
      return $
        (if null identAttribs
            then mempty
            else selfClosingTag "anchor" identAttribs) $$ 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 a. a -> ReaderT DocBookVersion m a
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
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 a. a -> ReaderT DocBookVersion m a
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  = case [Text]
langs of
                     [] -> Text
""
                     (Text
l:[Text]
_) -> Text
" language=\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeStringForXML Text
l 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 a. Eq a => a -> [a] -> 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 a. a -> ReaderT DocBookVersion m a
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
  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
                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)
                rest' <- listItemsToDocBook opts rest
                return $
                  inTags True "listitem" [("override",tshow start)] first' $$
                   rest'
  return $ inTags True "orderedlist" attribs 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 a. a -> ReaderT DocBookVersion m a
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
                     version <- ReaderT DocBookVersion m DocBookVersion
forall r (m :: * -> *). MonadReader r m => m r
ask
                     if version == DocBook5
                        then return empty -- No html in DocBook5
                        else return $ literal 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 a. a -> ReaderT DocBookVersion m a
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 a. a -> ReaderT DocBookVersion m a
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
  captionDoc <- if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
caption
                   then Doc Text -> DB m (Doc Text)
forall a. a -> ReaderT DocBookVersion m a
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
inTagsSimple 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    = if Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
captionDoc then Text
"informaltable" else Text
"table"
      percent a
w    = Integer -> Text
forall a. Show a => a -> Text
tshow (a -> Integer
forall b. Integral b => a -> b
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] -> 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
  head' <- if all null headers
              then return empty
              else inTagsIndented "thead" <$> tableRowToDocBook opts headers
  body' <- inTagsIndented "tbody" . vcat <$>
              mapM (tableRowToDocBook opts) rows
  return $ inTagsIndented tableType $ captionDoc $$
        inTags True "tgroup" [("cols", tshow (length aligns))] (
         coltags $$ head' $$ body')
blockToDocBook WriterOptions
opts (Figure Attr
attr capt :: Caption
capt@(Caption Maybe [Inline]
_ [Block]
caption) [Block]
body) = do
  -- TODO: probably better to handle nested figures as mediaobject
  let isAcceptable :: Block -> All
isAcceptable = \case
        Table {}  -> Bool -> All
All Bool
False
        Figure {} -> Bool -> All
All Bool
False
        Block
_         -> Bool -> All
All Bool
True
  if Bool -> Bool
not (Bool -> Bool) -> (All -> Bool) -> All -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. All -> Bool
getAll (All -> Bool) -> All -> Bool
forall a b. (a -> b) -> a -> b
$ (Block -> All) -> [Block] -> All
forall c. Monoid c => (Block -> c) -> [Block] -> c
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Block -> All
isAcceptable [Block]
body
    -- Fallback to a div if the content cannot be included in a figure
    then 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
$ Attr -> Caption -> [Block] -> Block
figureDiv Attr
attr Caption
capt [Block]
body
    else do
      title <- WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts ([Block] -> [Inline]
blocksToInlines [Block]
caption)
      let toMediaobject = \case
            Plain [Image Attr
imgAttr [Inline]
inlns (Text
src, Text
_)] -> do
              alt <- WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
inlns
              pure $ inTagsIndented "mediaobject" (
                inTagsIndented "imageobject"
                (imageToDocBook opts imgAttr src) $$
                if isEmpty alt
                then empty
                else inTagsSimple "textobject" (inTagsSimple "phrase" alt))
            Block
_ -> ReaderT DocBookVersion m DocBookVersion
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT DocBookVersion m DocBookVersion
-> (DocBookVersion -> DB m (Doc Text)) -> DB m (Doc Text)
forall a b.
ReaderT DocBookVersion m a
-> (a -> ReaderT DocBookVersion m b) -> ReaderT DocBookVersion m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                   DocBookVersion
DocBook4 -> Doc Text -> DB m (Doc Text)
forall a. a -> ReaderT DocBookVersion m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
forall a. Monoid a => a
mempty -- docbook4 requires media
                   DocBookVersion
DocBook5 -> WriterOptions -> [Block] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocBook WriterOptions
opts [Block]
body
      mediaobjects <- mapM toMediaobject body
      return $
        if isEmpty $ mconcat mediaobjects
        then mempty -- figures must have at least some content
        else inTagsIndented "figure" $
             inTagsSimple "title" title $$
             mconcat mediaobjects

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 c. Monoid c => (Inline -> c) -> [Inline] -> c
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 :: forall (m :: * -> *).
PandocMonad m =>
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]
-> ReaderT DocBookVersion m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Block] -> ReaderT DocBookVersion 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> [Block] -> ReaderT DocBookVersion 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 :: forall (m :: * -> *).
PandocMonad m =>
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]
-> ReaderT DocBookVersion m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> ReaderT DocBookVersion 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> Block -> ReaderT DocBookVersion 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 :: forall (m :: * -> *).
PandocMonad m =>
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]
-> ReaderT DocBookVersion m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> ReaderT DocBookVersion 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> Inline -> ReaderT DocBookVersion 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 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> DB m (Doc Text)
inlineToDocBook WriterOptions
_ (Str Text
str) = Doc Text -> ReaderT DocBookVersion m (Doc Text)
forall a. a -> ReaderT DocBookVersion m a
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
$ 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)
-> 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
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)
-> 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
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)
-> 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
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)
-> 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
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)
-> 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
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)
-> 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
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)
-> 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
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)
-> 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
inlineToDocBook WriterOptions
opts (Cite [Citation]
_ [Inline]
lst) =
  WriterOptions -> [Inline] -> ReaderT DocBookVersion 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
  version <- ReaderT DocBookVersion m DocBookVersion
forall r (m :: * -> *). MonadReader r m => m r
ask
  ((if T.null ident
       then mempty
       else selfClosingTag "anchor" [(idName version, ident)]) <>) <$>
    inlinesToDocBook opts ils
inlineToDocBook WriterOptions
_ (Code Attr
_ Text
str) =
  Doc Text -> ReaderT DocBookVersion m (Doc Text)
forall a. a -> ReaderT DocBookVersion m a
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
$ 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
    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 res of
         Right Element
r  -> Doc Text -> ReaderT DocBookVersion m (Doc Text)
forall a. a -> ReaderT DocBookVersion m a
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
$ 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 -> ReaderT DocBookVersion 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] -> ReaderT DocBookVersion m (Doc Text))
-> ReaderT DocBookVersion m (Doc Text)
forall a b.
ReaderT DocBookVersion m a
-> (a -> ReaderT DocBookVersion m b) -> ReaderT DocBookVersion m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WriterOptions -> [Inline] -> ReaderT DocBookVersion 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{ Xml.elAttribs = [] }
           fixNS' :: QName -> QName
fixNS' QName
qname = QName
qname{ Xml.qPrefix = Just "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 -> ReaderT DocBookVersion m (Doc Text)
forall a. a -> ReaderT DocBookVersion m a
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
$ 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 -> ReaderT DocBookVersion m (Doc Text)
forall a. a -> ReaderT DocBookVersion m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
inlineToDocBook WriterOptions
_ Inline
LineBreak = Doc Text -> ReaderT DocBookVersion m (Doc Text)
forall a. a -> ReaderT DocBookVersion m a
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
$ 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 -> ReaderT DocBookVersion m (Doc Text)
forall a. a -> ReaderT DocBookVersion m a
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 -> ReaderT DocBookVersion m (Doc Text)
forall a. a -> ReaderT DocBookVersion m a
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 -> ReaderT DocBookVersion m (Doc Text)
forall a. a -> ReaderT DocBookVersion m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
emailLink
           [Inline]
_             -> do contents <- WriterOptions -> [Inline] -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
txt
                               return $ contents <+>
                                          char '(' <> emailLink <> char ')'
  | Bool
otherwise = do
      version <- ReaderT DocBookVersion m DocBookVersion
forall r (m :: * -> *). MonadReader r m => m r
ask
      (if "#" `T.isPrefixOf` src
            then let tag = if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
txt then Text
"xref" else Text
"link"
                 in  inTags False tag $
                     ("linkend", writerIdentifierPrefix opts <> T.drop 1 src) :
                     idAndRole attr
            else if version == DocBook5
                    then inTags False "link" $ ("xlink:href", src) : idAndRole attr
                    else inTags False "ulink" $ ("url", src) : idAndRole attr )
        <$> inlinesToDocBook opts txt
inlineToDocBook WriterOptions
opts (Image Attr
attr [Inline]
ils (Text
src, Text
tit)) = Doc Text -> ReaderT DocBookVersion m (Doc Text)
forall a. a -> ReaderT DocBookVersion m a
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
$
  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
inTagsSimple 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)
      alt :: Doc Text
alt = if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
ils
               then Doc Text
forall a. Monoid a => a
mempty
               else Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"textobject" (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
"phrase" (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 ([Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils)
  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
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)
        Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
alt
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)
-> ReaderT DocBookVersion m (Doc Text)
-> ReaderT DocBookVersion m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Block] -> ReaderT DocBookVersion 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 a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
cls)]

-- Used in blockToDocBook for Header (section) to create or extend
-- the role attribute with candidate class tokens
enrichRole :: [(Text, Text)] -> [Text] -> [(Text, Text)]
enrichRole :: [(Text, Text)] -> [Text] -> [(Text, Text)]
enrichRole [(Text, Text)]
mattrs [Text]
cls = [(Text
"role", [Text] -> Text
T.unwords [Text]
roles) | [Text]
roles [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
/= []] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
nonRole
  where
    ([(Text, Text)]
roleAttr, [(Text, Text)]
nonRole) = ((Text, Text) -> Bool)
-> [(Text, Text)] -> ([(Text, Text)], [(Text, Text)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\(Text
key, Text
_v) -> Text
key Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"role") [(Text, Text)]
mattrs
    roles :: [Text]
roles = [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cand) [Text]
cls [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
forall a b. (a, b) -> b
snd [(Text, Text)]
roleAttr
    cand :: [Text]
cand = [Text
"unnumbered"]

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