{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ViewPatterns #-}
module Text.Pandoc.Writers.Docbook ( writeDocbook4, writeDocbook5 ) where
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 (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
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
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
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
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
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
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)
plainToPara :: Block -> Block
plainToPara :: Block -> Block
plainToPara (Plain x :: [Inline]
x) = [Inline] -> Block
Para [Inline]
x
plainToPara x :: Block
x = Block
x
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
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'
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
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 -> []
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
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
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
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
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
| 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
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
| 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
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
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
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"
inlineToDocbook _ Space = Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
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 = [("id", Text
id') | Bool -> Bool
not (Text -> Bool
T.null Text
id')]
role :: [(Text, Text)]
role = [("role", [Text] -> Text
T.unwords [Text]
cls) | Bool -> Bool
not ([Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
cls)]