{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards     #-}
{-# LANGUAGE ViewPatterns      #-}
{- |
   Module      : Text.Pandoc.Writers.Docbook
   Copyright   : Copyright (C) 2006-2019 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 Prelude
import Control.Monad.Reader
import Data.Generics (everywhere, mkT)
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, report)
import Text.Pandoc.Definition
import Text.Pandoc.Highlighting (languages, languagesByExtension)
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared
import Text.Pandoc.Walk
import Text.Pandoc.Writers.Math
import Text.Pandoc.XML
import Text.TeXMath
import qualified Text.XML.Light as Xml

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

type DB = ReaderT DocBookVersion

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

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

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

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

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

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

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

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

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

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

imageToDocbook :: WriterOptions -> Attr -> Text -> Doc Text
imageToDocbook :: WriterOptions -> Attr -> Text -> Doc Text
imageToDocbook _ attr :: Attr
attr src :: Text
src = Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag "imagedata" ([(Text, Text)] -> Doc Text) -> [(Text, Text)] -> Doc Text
forall a b. (a -> b) -> a -> b
$
  ("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 "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 "depth"
    go :: Direction -> a -> [(a, Text)]
go dir :: Direction
dir dstr :: a
dstr = case Direction -> Attr -> Maybe Dimension
dimension Direction
dir Attr
attr of
                    Just a :: Dimension
a  -> [(a
dstr, Dimension -> Text
forall a. Show a => a -> Text
tshow Dimension
a)]
                    Nothing -> []

-- | Convert a Pandoc block element to Docbook.
blockToDocbook :: PandocMonad m => WriterOptions -> Block -> DB m (Doc Text)
blockToDocbook :: WriterOptions -> Block -> DB m (Doc Text)
blockToDocbook _ Null = Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
-- Add ids to paragraphs in divs with ids - this is needed for
-- pandoc-citeproc to get link anchors in bibliographies:
blockToDocbook opts :: WriterOptions
opts (Div (id' :: Text
id',"section":_,_) (Header lvl :: Int
lvl _ ils :: [Inline]
ils : xs :: [Block]
xs)) = do
  DocBookVersion
version <- ReaderT DocBookVersion m DocBookVersion
forall r (m :: * -> *). MonadReader r m => m r
ask
  -- Docbook doesn't allow sections with no content, so insert some if needed
  let bs :: [Block]
bs = if [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
xs
              then [[Inline] -> Block
Para []]
              else [Block]
xs
      tag :: Text
tag = case Int
lvl of
                 -1                   -> "part"
                 0                    -> "chapter"
                 n :: Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 1 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 5 -> if DocBookVersion
version DocBookVersion -> DocBookVersion -> Bool
forall a. Eq a => a -> a -> Bool
== DocBookVersion
DocBook5
                                              then "section"
                                              else "sect" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n
                 _                    -> "simplesect"
      idName :: Text
idName = if DocBookVersion
version DocBookVersion -> DocBookVersion -> Bool
forall a. Eq a => a -> a -> Bool
== DocBookVersion
DocBook5
                 then "xml:id"
                 else "id"
      idAttr :: [(Text, Text)]
idAttr = [(Text
idName, 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')]
      nsAttr :: [(Text, Text)]
nsAttr = if DocBookVersion
version DocBookVersion -> DocBookVersion -> Bool
forall a. Eq a => a -> a -> Bool
== DocBookVersion
DocBook5 Bool -> Bool -> Bool
&& Int
lvl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then [("xmlns", "http://docbook.org/ns/docbook"),("xmlns:xlink", "http://www.w3.org/1999/xlink")]
                                      else []
      attribs :: [(Text, Text)]
attribs = [(Text, Text)]
nsAttr [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
idAttr
  Doc Text
title' <- WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
ils
  Doc Text
contents <- WriterOptions -> [Block] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocbook WriterOptions
opts [Block]
bs
  Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
tag [(Text, Text)]
attribs (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple "title" Doc Text
title' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents
blockToDocbook opts :: WriterOptions
opts (Div (ident :: Text
ident,_,_) [Para lst :: [Inline]
lst]) =
  let attribs :: [(Text, Text)]
attribs = [("id", Text
ident) | Bool -> Bool
not (Text -> Bool
T.null Text
ident)] in
  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 "literallayout" [(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] -> DB 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 "para" [(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] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
blockToDocbook opts :: WriterOptions
opts (Div (ident :: Text
ident,_,_) bs :: [Block]
bs) = do
  Doc Text
contents <- 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]
bs)
  Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$
    (if Text -> Bool
T.null Text
ident
        then Doc Text
forall a. Monoid a => a
mempty
        else Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag "anchor" [("id", Text
ident)]) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents
blockToDocbook _ h :: Block
h@Header{} = do
  -- should be handled by Div section above, except inside lists/blockquotes
  LogMessage -> ReaderT DocBookVersion m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ReaderT DocBookVersion m ())
-> LogMessage -> ReaderT DocBookVersion m ()
forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
h
  Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToDocbook opts :: WriterOptions
opts (Plain lst :: [Inline]
lst) = WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
-- title beginning with fig: indicates that the image is a figure
blockToDocbook opts :: WriterOptions
opts (Para [Image attr :: Attr
attr txt :: [Inline]
txt (src :: Text
src,Text -> Text -> Maybe Text
T.stripPrefix "fig:" -> Just _)]) = do
  Doc Text
alt <- WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
txt
  let capt :: Doc Text
capt = if [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
txt
                then Doc Text
forall a. Doc a
empty
                else Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple "title" Doc Text
alt
  Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented "figure" (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
        Doc Text
capt Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
        Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented "mediaobject" (
           Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented "imageobject"
             (WriterOptions -> Attr -> Text -> Doc Text
imageToDocbook WriterOptions
opts Attr
attr Text
src) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
           Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple "textobject" (Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple "phrase" Doc Text
alt))
blockToDocbook opts :: WriterOptions
opts (Para lst :: [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 "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 "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 opts :: WriterOptions
opts (LineBlock lns :: [[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 opts :: WriterOptions
opts (BlockQuote blocks :: [Block]
blocks) =
  Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented "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 _ (CodeBlock (_,classes :: [Text]
classes,_) str :: Text
str) = Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$
  Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal ("<programlisting" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
lang Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ">") 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 "</programlisting>")
    where lang :: Text
lang  = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
langs
                     then ""
                     else " language=\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeStringForXML ([Text] -> Text
forall a. [a] -> a
head [Text]
langs) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                          "\""
          isLang :: Text -> Bool
isLang l :: Text
l    = Text -> Text
T.toLower Text
l Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.toLower [Text]
languages
          langsFrom :: Text -> [Text]
langsFrom s :: Text
s = if Text -> Bool
isLang Text
s
                           then [Text
s]
                           else Text -> [Text]
languagesByExtension (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 opts :: WriterOptions
opts (BulletList lst :: [[Block]]
lst) = do
  let attribs :: [(Text, Text)]
attribs = [("spacing", "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 "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 _ (OrderedList _ []) = Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToDocbook opts :: WriterOptions
opts (OrderedList (start :: Int
start, numstyle :: ListNumberStyle
numstyle, _) (first :: [Block]
first:rest :: [[Block]]
rest)) = do
  let numeration :: [(Text, Text)]
numeration = case ListNumberStyle
numstyle of
                       DefaultStyle -> []
                       Decimal      -> [("numeration", "arabic")]
                       Example      -> [("numeration", "arabic")]
                       UpperAlpha   -> [("numeration", "upperalpha")]
                       LowerAlpha   -> [("numeration", "loweralpha")]
                       UpperRoman   -> [("numeration", "upperroman")]
                       LowerRoman   -> [("numeration", "lowerroman")]
      spacing :: [(Text, Text)]
spacing    = [("spacing", "compact") | [[Block]] -> Bool
isTightList ([Block]
first[Block] -> [[Block]] -> [[Block]]
forall a. a -> [a] -> [a]
:[[Block]]
rest)]
      attribs :: [(Text, Text)]
attribs    = [(Text, Text)]
numeration [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
spacing
  Doc Text
items <- if Int
start Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1
              then WriterOptions -> [[Block]] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> DB m (Doc Text)
listItemsToDocbook WriterOptions
opts ([Block]
first[Block] -> [[Block]] -> [[Block]]
forall a. a -> [a] -> [a]
:[[Block]]
rest)
              else do
                Doc Text
first' <- WriterOptions -> [Block] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocbook WriterOptions
opts ((Block -> Block) -> [Block] -> [Block]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
plainToPara [Block]
first)
                Doc Text
rest' <- WriterOptions -> [[Block]] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> DB m (Doc Text)
listItemsToDocbook WriterOptions
opts [[Block]]
rest
                Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$
                  Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True "listitem" [("override",Int -> Text
forall a. Show a => a -> Text
tshow Int
start)] Doc Text
first' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
                   Doc Text
rest'
  Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True "orderedlist" [(Text, Text)]
attribs Doc Text
items
blockToDocbook opts :: WriterOptions
opts (DefinitionList lst :: [([Inline], [[Block]])]
lst) = do
  let attribs :: [(Text, Text)]
attribs = [("spacing", "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 "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 _ b :: Block
b@(RawBlock f :: Format
f str :: Text
str)
  | Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== "docbook" = Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str -- raw XML block
  | Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== "html"    = do
                     DocBookVersion
version <- ReaderT DocBookVersion m DocBookVersion
forall r (m :: * -> *). MonadReader r m => m r
ask
                     if DocBookVersion
version DocBookVersion -> DocBookVersion -> Bool
forall a. Eq a => a -> a -> Bool
== DocBookVersion
DocBook5
                        then Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty -- No html in Docbook5
                        else Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str -- allow html for backwards compatibility
  | Bool
otherwise      = do
      LogMessage -> ReaderT DocBookVersion m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ReaderT DocBookVersion m ())
-> LogMessage -> ReaderT DocBookVersion m ()
forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
b
      Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToDocbook _ HorizontalRule = Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty -- not semantic
blockToDocbook opts :: WriterOptions
opts (Table caption :: [Inline]
caption aligns :: [Alignment]
aligns widths :: [Double]
widths headers :: [[Block]]
headers rows :: [[[Block]]]
rows) = do
  Doc Text
captionDoc <- if [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
caption
                   then Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
                   else Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented "title" (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                         WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
caption
  let tableType :: Text
tableType    = if Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
captionDoc then "informaltable" else "table"
      percent :: a -> Text
percent w :: a
w    = Integer -> Text
forall a. Show a => a -> Text
tshow (a -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate (100a -> a -> a
forall a. Num a => a -> a -> a
*a
w) :: Integer) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "*"
      coltags :: Doc Text
coltags = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ (Double -> Alignment -> Doc Text)
-> [Double] -> [Alignment] -> [Doc Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\w :: Double
w al :: Alignment
al -> Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag "colspec"
                       ([("colwidth", Double -> Text
forall a. RealFrac a => a -> Text
percent Double
w) | Double
w Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> 0] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<>
                        [("align", Alignment -> Text
alignmentToString Alignment
al)])) [Double]
widths [Alignment]
aligns
  Doc Text
head' <- if ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers
              then Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
              else Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented "thead" (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [[Block]] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> DB m (Doc Text)
tableRowToDocbook WriterOptions
opts [[Block]]
headers
  Doc Text
body' <- (Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented "tbody" (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat) ([Doc Text] -> Doc Text)
-> ReaderT DocBookVersion m [Doc Text] -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
              ([[Block]] -> DB m (Doc Text))
-> [[[Block]]] -> ReaderT DocBookVersion m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [[Block]] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> DB m (Doc Text)
tableRowToDocbook WriterOptions
opts) [[[Block]]]
rows
  Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
tableType (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text
captionDoc Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
        Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True "tgroup" [("cols", Int -> Text
forall a. Show a => a -> Text
tshow ([[Block]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Block]]
headers))] (
         Doc Text
coltags Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
head' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
body')

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

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

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

tableItemToDocbook :: PandocMonad m
                   => WriterOptions
                   -> [Block]
                   -> DB m (Doc Text)
tableItemToDocbook :: WriterOptions -> [Block] -> DB m (Doc Text)
tableItemToDocbook opts :: WriterOptions
opts item :: [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 "entry" [] (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat) ([Doc Text] -> Doc Text)
-> ReaderT DocBookVersion m [Doc Text] -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> DB m (Doc Text))
-> [Block] -> ReaderT DocBookVersion m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> Block -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> DB m (Doc Text)
blockToDocbook WriterOptions
opts) [Block]
item

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

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

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

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