{-# 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.Maybe (isNothing)
import Data.Monoid (Any (..))
import Data.Text (Text)
import qualified Data.Text as T
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
import Text.Pandoc.Definition
import Text.Pandoc.Highlighting (languages, languagesByExtension)
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared
import Text.Pandoc.Walk
import Text.Pandoc.Writers.Math
import Text.Pandoc.XML
import Text.TeXMath
import qualified Text.XML.Light as Xml
data DocBookVersion = DocBook4 | DocBook5
deriving (DocBookVersion -> DocBookVersion -> Bool
(DocBookVersion -> DocBookVersion -> Bool)
-> (DocBookVersion -> DocBookVersion -> Bool) -> Eq DocBookVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DocBookVersion -> DocBookVersion -> Bool
$c/= :: DocBookVersion -> DocBookVersion -> Bool
== :: DocBookVersion -> DocBookVersion -> Bool
$c== :: DocBookVersion -> DocBookVersion -> Bool
Eq, Int -> DocBookVersion -> ShowS
[DocBookVersion] -> ShowS
DocBookVersion -> String
(Int -> DocBookVersion -> ShowS)
-> (DocBookVersion -> String)
-> ([DocBookVersion] -> ShowS)
-> Show DocBookVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DocBookVersion] -> ShowS
$cshowList :: [DocBookVersion] -> ShowS
show :: DocBookVersion -> String
$cshow :: DocBookVersion -> String
showsPrec :: Int -> DocBookVersion -> ShowS
$cshowsPrec :: Int -> DocBookVersion -> ShowS
Show)
type DB = ReaderT DocBookVersion
getStartLvl :: WriterOptions -> Int
getStartLvl :: WriterOptions -> Int
getStartLvl WriterOptions
opts =
case WriterOptions -> TopLevelDivision
writerTopLevelDivision WriterOptions
opts of
TopLevelDivision
TopLevelPart -> -Int
1
TopLevelDivision
TopLevelChapter -> Int
0
TopLevelDivision
TopLevelSection -> Int
1
TopLevelDivision
TopLevelDefault -> Int
1
idName :: DocBookVersion -> Text
idName :: DocBookVersion -> Text
idName DocBookVersion
DocBook5 = Text
"xml:id"
idName DocBookVersion
DocBook4 = Text
"id"
authorToDocbook :: PandocMonad m => WriterOptions -> [Inline] -> DB m B.Inlines
authorToDocbook :: WriterOptions -> [Inline] -> DB m Inlines
authorToDocbook WriterOptions
opts [Inline]
name' = do
Text
name <- Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing (Doc Text -> Text)
-> ReaderT DocBookVersion m (Doc Text)
-> ReaderT DocBookVersion m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
name'
let colwidth :: Maybe Int
colwidth = if WriterOptions -> WrapOption
writerWrapText WriterOptions
opts WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
opts
else Maybe Int
forall a. Maybe a
Nothing
Inlines -> DB m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> DB m Inlines) -> Inlines -> DB m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines
B.rawInline Text
"docbook" (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$
Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth (Doc Text -> Text) -> Doc Text -> Text
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"personname" [] (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
if (Char -> Bool) -> Text -> Bool
T.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',') Text
name
then
let (Text
lastname, Text
rest) = (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
',') Text
name
firstname :: Text
firstname = Text -> Text
triml Text
rest in
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"firstname" (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
firstname) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"surname" (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
lastname)
else
let namewords :: [Text]
namewords = Text -> [Text]
T.words Text
name
lengthname :: Int
lengthname = [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
namewords
(Text
firstname, Text
lastname) = case Int
lengthname of
Int
0 -> (Text
"",Text
"")
Int
1 -> (Text
"", Text
name)
Int
n -> ([Text] -> Text
T.unwords (Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [Text]
namewords), [Text] -> Text
forall a. [a] -> a
last [Text]
namewords)
in Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"firstname" (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
firstname) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"surname" (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
lastname)
writeDocbook4 :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeDocbook4 :: WriterOptions -> Pandoc -> m Text
writeDocbook4 WriterOptions
opts Pandoc
d =
ReaderT DocBookVersion m Text -> DocBookVersion -> m Text
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (WriterOptions -> Pandoc -> ReaderT DocBookVersion m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> DB m Text
writeDocbook WriterOptions
opts Pandoc
d) DocBookVersion
DocBook4
writeDocbook5 :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeDocbook5 :: WriterOptions -> Pandoc -> m Text
writeDocbook5 WriterOptions
opts Pandoc
d =
ReaderT DocBookVersion m Text -> DocBookVersion -> m Text
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (WriterOptions -> Pandoc -> ReaderT DocBookVersion m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> DB m Text
writeDocbook WriterOptions
opts Pandoc
d) DocBookVersion
DocBook5
writeDocbook :: PandocMonad m => WriterOptions -> Pandoc -> DB m Text
writeDocbook :: WriterOptions -> Pandoc -> DB m Text
writeDocbook WriterOptions
opts (Pandoc Meta
meta [Block]
blocks) = do
let colwidth :: Maybe Int
colwidth = if WriterOptions -> WrapOption
writerWrapText WriterOptions
opts WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
opts
else Maybe Int
forall a. Maybe a
Nothing
let startLvl :: Int
startLvl = WriterOptions -> Int
getStartLvl WriterOptions
opts
let fromBlocks :: [Block] -> DB m (Doc Text)
fromBlocks = WriterOptions -> [Block] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocbook WriterOptions
opts ([Block] -> DB m (Doc Text))
-> ([Block] -> [Block]) -> [Block] -> DB m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Bool -> Maybe Int -> [Block] -> [Block]
makeSections Bool
False (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
startLvl)
[Inlines]
auths' <- ([Inline] -> ReaderT DocBookVersion m Inlines)
-> [[Inline]] -> ReaderT DocBookVersion m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [Inline] -> ReaderT DocBookVersion m Inlines
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m Inlines
authorToDocbook WriterOptions
opts) ([[Inline]] -> ReaderT DocBookVersion m [Inlines])
-> [[Inline]] -> ReaderT DocBookVersion m [Inlines]
forall a b. (a -> b) -> a -> b
$ Meta -> [[Inline]]
docAuthors Meta
meta
let meta' :: Meta
meta' = Text -> [Inlines] -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
B.setMeta Text
"author" [Inlines]
auths' Meta
meta
Context Text
metadata <- WriterOptions
-> ([Block] -> DB m (Doc Text))
-> ([Inline] -> DB m (Doc Text))
-> Meta
-> ReaderT DocBookVersion m (Context Text)
forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
opts
[Block] -> DB m (Doc Text)
fromBlocks
(WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts)
Meta
meta'
Doc Text
main <- [Block] -> DB m (Doc Text)
fromBlocks [Block]
blocks
let context :: Context Text
context = Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Doc Text
main
(Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"mathml" (case WriterOptions -> HTMLMathMethod
writerHTMLMathMethod WriterOptions
opts of
HTMLMathMethod
MathML -> Bool
True
HTMLMathMethod
_ -> Bool
False) Context Text
metadata
Text -> DB m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> DB m Text) -> Text -> DB m Text
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth (Doc Text -> Text) -> Doc Text -> Text
forall a b. (a -> b) -> a -> b
$
(if WriterOptions -> Bool
writerPreferAscii WriterOptions
opts then (Text -> Text) -> Doc Text -> Doc Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
toEntities else Doc Text -> Doc Text
forall a. a -> a
id) (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
Maybe (Template Text)
Nothing -> Doc Text
main
Just Template Text
tpl -> Template Text -> Context Text -> Doc Text
forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl Context Text
context
blocksToDocbook :: PandocMonad m => WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocbook :: WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocbook WriterOptions
opts = ([Doc Text] -> Doc Text)
-> ReaderT DocBookVersion m [Doc Text] -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat (ReaderT DocBookVersion m [Doc Text] -> DB m (Doc Text))
-> ([Block] -> ReaderT DocBookVersion m [Doc Text])
-> [Block]
-> DB m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> DB m (Doc Text))
-> [Block] -> ReaderT DocBookVersion m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> Block -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> DB m (Doc Text)
blockToDocbook WriterOptions
opts)
plainToPara :: Block -> Block
plainToPara :: Block -> Block
plainToPara (Plain [Inline]
x) = [Inline] -> Block
Para [Inline]
x
plainToPara Block
x = Block
x
deflistItemsToDocbook :: PandocMonad m
=> WriterOptions -> [([Inline],[[Block]])] -> DB m (Doc Text)
deflistItemsToDocbook :: WriterOptions -> [([Inline], [[Block]])] -> DB m (Doc Text)
deflistItemsToDocbook WriterOptions
opts [([Inline], [[Block]])]
items =
[Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> ReaderT DocBookVersion m [Doc Text] -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([Inline], [[Block]]) -> DB m (Doc Text))
-> [([Inline], [[Block]])] -> ReaderT DocBookVersion m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (([Inline] -> [[Block]] -> DB m (Doc Text))
-> ([Inline], [[Block]]) -> DB m (Doc Text)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (WriterOptions -> [Inline] -> [[Block]] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> [[Block]] -> DB m (Doc Text)
deflistItemToDocbook WriterOptions
opts)) [([Inline], [[Block]])]
items
deflistItemToDocbook :: PandocMonad m
=> WriterOptions -> [Inline] -> [[Block]] -> DB m (Doc Text)
deflistItemToDocbook :: WriterOptions -> [Inline] -> [[Block]] -> DB m (Doc Text)
deflistItemToDocbook WriterOptions
opts [Inline]
term [[Block]]
defs = do
Doc Text
term' <- WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
term
Doc Text
def' <- WriterOptions -> [Block] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocbook WriterOptions
opts ([Block] -> DB m (Doc Text)) -> [Block] -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ ([Block] -> [Block]) -> [[Block]] -> [Block]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Block -> Block) -> [Block] -> [Block]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
plainToPara) [[Block]]
defs
Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"varlistentry" (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"term" Doc Text
term' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"listitem" Doc Text
def'
listItemsToDocbook :: PandocMonad m => WriterOptions -> [[Block]] -> DB m (Doc Text)
listItemsToDocbook :: WriterOptions -> [[Block]] -> DB m (Doc Text)
listItemsToDocbook WriterOptions
opts [[Block]]
items = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> ReaderT DocBookVersion m [Doc Text] -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Block] -> DB m (Doc Text))
-> [[Block]] -> ReaderT DocBookVersion m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [Block] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
listItemToDocbook WriterOptions
opts) [[Block]]
items
listItemToDocbook :: PandocMonad m => WriterOptions -> [Block] -> DB m (Doc Text)
listItemToDocbook :: WriterOptions -> [Block] -> DB m (Doc Text)
listItemToDocbook WriterOptions
opts [Block]
item =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"listitem" (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Block] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocbook WriterOptions
opts ((Block -> Block) -> [Block] -> [Block]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
plainToPara [Block]
item)
imageToDocbook :: WriterOptions -> Attr -> Text -> Doc Text
imageToDocbook :: WriterOptions -> Attr -> Text -> Doc Text
imageToDocbook WriterOptions
_ Attr
attr Text
src = Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"imagedata" ([(Text, Text)] -> Doc Text) -> [(Text, Text)] -> Doc Text
forall a b. (a -> b) -> a -> b
$
(Text
"fileref", Text
src) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: Attr -> [(Text, Text)]
idAndRole Attr
attr [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
dims
where
dims :: [(Text, Text)]
dims = Direction -> Text -> [(Text, Text)]
forall a. Direction -> a -> [(a, Text)]
go Direction
Width Text
"width" [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> Direction -> Text -> [(Text, Text)]
forall a. Direction -> a -> [(a, Text)]
go Direction
Height Text
"depth"
go :: Direction -> a -> [(a, Text)]
go Direction
dir a
dstr = case Direction -> Attr -> Maybe Dimension
dimension Direction
dir Attr
attr of
Just Dimension
a -> [(a
dstr, Dimension -> Text
forall a. Show a => a -> Text
tshow Dimension
a)]
Maybe Dimension
Nothing -> []
blockToDocbook :: PandocMonad m => WriterOptions -> Block -> DB m (Doc Text)
blockToDocbook :: WriterOptions -> Block -> DB m (Doc Text)
blockToDocbook WriterOptions
_ Block
Null = Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToDocbook WriterOptions
opts (Div (Text
id',Text
"section":[Text]
_,[(Text, Text)]
_) (Header Int
lvl Attr
_ [Inline]
ils : [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 -> Text
"part"
Int
0 -> Text
"chapter"
Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
5 -> if DocBookVersion
version DocBookVersion -> DocBookVersion -> Bool
forall a. Eq a => a -> a -> Bool
== DocBookVersion
DocBook5
then Text
"section"
else Text
"sect" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n
Int
_ -> Text
"simplesect"
idAttr :: [(Text, Text)]
idAttr = [(DocBookVersion -> Text
idName DocBookVersion
version, WriterOptions -> Text
writerIdentifierPrefix WriterOptions
opts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
id') | Bool -> Bool
not (Text -> Bool
T.null Text
id')]
nsAttr :: [(Text, Text)]
nsAttr = if DocBookVersion
version DocBookVersion -> DocBookVersion -> Bool
forall a. Eq a => a -> a -> Bool
== DocBookVersion
DocBook5 Bool -> Bool -> Bool
&& Int
lvl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== WriterOptions -> Int
getStartLvl WriterOptions
opts Bool -> Bool -> Bool
&& Maybe (Template Text) -> Bool
forall a. Maybe a -> Bool
isNothing (WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts)
then [(Text
"xmlns", Text
"http://docbook.org/ns/docbook"),(Text
"xmlns:xlink", Text
"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 Text
"title" Doc Text
title' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents
blockToDocbook WriterOptions
opts (Div (Text
ident,[Text]
classes,[(Text, Text)]
_) [Block]
bs) = do
DocBookVersion
version <- ReaderT DocBookVersion m DocBookVersion
forall r (m :: * -> *). MonadReader r m => m r
ask
let identAttribs :: [(Text, Text)]
identAttribs = [(DocBookVersion -> Text
idName DocBookVersion
version, Text
ident) | Bool -> Bool
not (Text -> Bool
T.null Text
ident)]
admonitions :: [Text]
admonitions = [Text
"attention",Text
"caution",Text
"danger",Text
"error",Text
"hint",
Text
"important",Text
"note",Text
"tip",Text
"warning"]
case [Text]
classes of
(Text
l:[Text]
_) | Text
l Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
admonitions -> do
let (Maybe (DB m (Doc Text))
mTitleBs, [Block]
bodyBs) =
case [Block]
bs of
(Div (Text
_,[Text
"title"],[(Text, Text)]
_) [Para [Inline]
ts] : [Block]
rest) -> (DB m (Doc Text) -> Maybe (DB m (Doc Text))
forall a. a -> Maybe a
Just (WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
ts), [Block]
rest)
(Div (Text
_,[Text
"title"],[(Text, Text)]
_) [Block]
ts : [Block]
rest) -> (DB m (Doc Text) -> Maybe (DB m (Doc Text))
forall a. a -> Maybe a
Just (WriterOptions -> [Block] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocbook WriterOptions
opts [Block]
ts), [Block]
rest)
[Block]
_ -> (Maybe (DB m (Doc Text))
forall a. Maybe a
Nothing, [Block]
bs)
Doc Text
admonitionTitle <- case Maybe (DB m (Doc Text))
mTitleBs of
Maybe (DB m (Doc Text))
Nothing -> Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Monoid a => a
mempty
Just DB m (Doc Text)
titleBs -> Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"title" [] (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DB m (Doc Text)
titleBs
Doc Text
admonitionBody <- [(Text, Text)] -> [Block] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[(Text, Text)] -> [Block] -> ReaderT DocBookVersion m (Doc Text)
handleDivBody [] [Block]
bodyBs
Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
l [(Text, Text)]
identAttribs (Doc Text
admonitionTitle Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
admonitionBody))
[Text]
_ -> [(Text, Text)] -> [Block] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
[(Text, Text)] -> [Block] -> ReaderT DocBookVersion m (Doc Text)
handleDivBody [(Text, Text)]
identAttribs [Block]
bs
where
handleDivBody :: [(Text, Text)] -> [Block] -> ReaderT DocBookVersion m (Doc Text)
handleDivBody [(Text, Text)]
identAttribs [Para [Inline]
lst] =
if [Inline] -> Bool
hasLineBreaks [Inline]
lst
then Doc Text -> Doc Text
forall a. Doc a -> Doc a
flush (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"literallayout" [(Text, Text)]
identAttribs
(Doc Text -> Doc Text)
-> ReaderT DocBookVersion m (Doc Text)
-> ReaderT DocBookVersion m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
else Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"para" [(Text, Text)]
identAttribs (Doc Text -> Doc Text)
-> ReaderT DocBookVersion m (Doc Text)
-> ReaderT DocBookVersion m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
handleDivBody [(Text, Text)]
identAttribs [Block]
bodyBs = do
Doc Text
contents <- WriterOptions -> [Block] -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocbook WriterOptions
opts ((Block -> Block) -> [Block] -> [Block]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
plainToPara [Block]
bodyBs)
Doc Text -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> ReaderT DocBookVersion m (Doc Text))
-> Doc Text -> ReaderT DocBookVersion m (Doc Text)
forall a b. (a -> b) -> a -> b
$
(if [(Text, Text)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, Text)]
identAttribs
then Doc Text
forall a. Monoid a => a
mempty
else Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"anchor" [(Text, Text)]
identAttribs) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents
blockToDocbook WriterOptions
_ h :: Block
h@Header{} = do
LogMessage -> ReaderT DocBookVersion m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ReaderT DocBookVersion m ())
-> LogMessage -> ReaderT DocBookVersion m ()
forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
h
Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToDocbook WriterOptions
opts (Plain [Inline]
lst) = WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
blockToDocbook WriterOptions
opts (Para [Image Attr
attr [Inline]
txt (Text
src,Text -> Text -> Maybe Text
T.stripPrefix Text
"fig:" -> Just Text
_)]) = do
Doc Text
alt <- WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
txt
let capt :: Doc Text
capt = if [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
txt
then Doc Text
forall a. Doc a
empty
else Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"title" Doc Text
alt
Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"figure" (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
Doc Text
capt Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"mediaobject" (
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"imageobject"
(WriterOptions -> Attr -> Text -> Doc Text
imageToDocbook WriterOptions
opts Attr
attr Text
src) Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"textobject" (Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"phrase" Doc Text
alt))
blockToDocbook WriterOptions
opts (Para [Inline]
lst)
| [Inline] -> Bool
hasLineBreaks [Inline]
lst = Doc Text -> Doc Text
forall a. Doc a -> Doc a
flush (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"literallayout"
(Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
| Bool
otherwise = Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"para" (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
blockToDocbook WriterOptions
opts (LineBlock [[Inline]]
lns) =
WriterOptions -> Block -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> DB m (Doc Text)
blockToDocbook WriterOptions
opts (Block -> DB m (Doc Text)) -> Block -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Block
linesToPara [[Inline]]
lns
blockToDocbook WriterOptions
opts (BlockQuote [Block]
blocks) =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"blockquote" (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Block] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocbook WriterOptions
opts [Block]
blocks
blockToDocbook WriterOptions
_ (CodeBlock (Text
_,[Text]
classes,[(Text, Text)]
_) Text
str) = Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$
Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text
"<programlisting" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
lang Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
Doc Text -> Doc Text
forall a. Doc a -> Doc a
flush (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Text
escapeStringForXML Text
str) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"</programlisting>")
where lang :: Text
lang = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
langs
then Text
""
else Text
" language=\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeStringForXML ([Text] -> Text
forall a. [a] -> a
head [Text]
langs) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
Text
"\""
isLang :: Text -> Bool
isLang Text
l = Text -> Text
T.toLower Text
l Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.toLower [Text]
languages
langsFrom :: Text -> [Text]
langsFrom 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 WriterOptions
opts (BulletList [[Block]]
lst) = do
let attribs :: [(Text, Text)]
attribs = [(Text
"spacing", Text
"compact") | [[Block]] -> Bool
isTightList [[Block]]
lst]
Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"itemizedlist" [(Text, Text)]
attribs (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [[Block]] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> DB m (Doc Text)
listItemsToDocbook WriterOptions
opts [[Block]]
lst
blockToDocbook WriterOptions
_ (OrderedList ListAttributes
_ []) = Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToDocbook WriterOptions
opts (OrderedList (Int
start, ListNumberStyle
numstyle, ListNumberDelim
_) ([Block]
first:[[Block]]
rest)) = do
let numeration :: [(Text, Text)]
numeration = case ListNumberStyle
numstyle of
ListNumberStyle
DefaultStyle -> []
ListNumberStyle
Decimal -> [(Text
"numeration", Text
"arabic")]
ListNumberStyle
Example -> [(Text
"numeration", Text
"arabic")]
ListNumberStyle
UpperAlpha -> [(Text
"numeration", Text
"upperalpha")]
ListNumberStyle
LowerAlpha -> [(Text
"numeration", Text
"loweralpha")]
ListNumberStyle
UpperRoman -> [(Text
"numeration", Text
"upperroman")]
ListNumberStyle
LowerRoman -> [(Text
"numeration", Text
"lowerroman")]
spacing :: [(Text, Text)]
spacing = [(Text
"spacing", Text
"compact") | [[Block]] -> Bool
isTightList ([Block]
first[Block] -> [[Block]] -> [[Block]]
forall a. a -> [a] -> [a]
:[[Block]]
rest)]
attribs :: [(Text, Text)]
attribs = [(Text, Text)]
numeration [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
spacing
Doc Text
items <- if Int
start Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
then WriterOptions -> [[Block]] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> DB m (Doc Text)
listItemsToDocbook WriterOptions
opts ([Block]
first[Block] -> [[Block]] -> [[Block]]
forall a. a -> [a] -> [a]
:[[Block]]
rest)
else do
Doc Text
first' <- WriterOptions -> [Block] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocbook WriterOptions
opts ((Block -> Block) -> [Block] -> [Block]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
plainToPara [Block]
first)
Doc Text
rest' <- WriterOptions -> [[Block]] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> DB m (Doc Text)
listItemsToDocbook WriterOptions
opts [[Block]]
rest
Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$
Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"listitem" [(Text
"override",Int -> Text
forall a. Show a => a -> Text
tshow Int
start)] Doc Text
first' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Doc Text
rest'
Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"orderedlist" [(Text, Text)]
attribs Doc Text
items
blockToDocbook WriterOptions
opts (DefinitionList [([Inline], [[Block]])]
lst) = do
let attribs :: [(Text, Text)]
attribs = [(Text
"spacing", Text
"compact") | [[Block]] -> Bool
isTightList ([[Block]] -> Bool) -> [[Block]] -> Bool
forall a b. (a -> b) -> a -> b
$ (([Inline], [[Block]]) -> [[Block]])
-> [([Inline], [[Block]])] -> [[Block]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Inline], [[Block]]) -> [[Block]]
forall a b. (a, b) -> b
snd [([Inline], [[Block]])]
lst]
Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"variablelist" [(Text, Text)]
attribs (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [([Inline], [[Block]])] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [([Inline], [[Block]])] -> DB m (Doc Text)
deflistItemsToDocbook WriterOptions
opts [([Inline], [[Block]])]
lst
blockToDocbook WriterOptions
_ b :: Block
b@(RawBlock Format
f Text
str)
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
"docbook" = Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
"html" = do
DocBookVersion
version <- ReaderT DocBookVersion m DocBookVersion
forall r (m :: * -> *). MonadReader r m => m r
ask
if DocBookVersion
version DocBookVersion -> DocBookVersion -> Bool
forall a. Eq a => a -> a -> Bool
== DocBookVersion
DocBook5
then Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
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 WriterOptions
_ Block
HorizontalRule = Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToDocbook WriterOptions
opts (Table Attr
_ Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot) = do
let ([Inline]
caption, [Alignment]
aligns, [Double]
widths, [[Block]]
headers, [[[Block]]]
rows) = Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
toLegacyTable Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot
Doc Text
captionDoc <- if [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
caption
then Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
else Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"title" (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
caption
let tableType :: Text
tableType = if Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
captionDoc then Text
"informaltable" else Text
"table"
percent :: a -> Text
percent a
w = Integer -> Text
forall a. Show a => a -> Text
tshow (a -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate (a
100a -> a -> a
forall a. Num a => a -> a -> a
*a
w) :: Integer) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"*"
coltags :: Doc Text
coltags = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ (Double -> Alignment -> Doc Text)
-> [Double] -> [Alignment] -> [Doc Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Double
w Alignment
al -> Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"colspec"
([(Text
"colwidth", Double -> Text
forall a. RealFrac a => a -> Text
percent Double
w) | Double
w Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<>
[(Text
"align", Alignment -> Text
alignmentToString Alignment
al)])) [Double]
widths [Alignment]
aligns
Doc Text
head' <- if ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers
then Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
else Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"thead" (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [[Block]] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> DB m (Doc Text)
tableRowToDocbook WriterOptions
opts [[Block]]
headers
Doc Text
body' <- Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"tbody" (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> ReaderT DocBookVersion m [Doc Text] -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
([[Block]] -> DB m (Doc Text))
-> [[[Block]]] -> ReaderT DocBookVersion m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [[Block]] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> DB m (Doc Text)
tableRowToDocbook WriterOptions
opts) [[[Block]]]
rows
Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
tableType (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text
captionDoc Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"tgroup" [(Text
"cols", Int -> Text
forall a. Show a => a -> Text
tshow ([Alignment] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Alignment]
aligns))] (
Doc Text
coltags Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
head' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
body')
hasLineBreaks :: [Inline] -> Bool
hasLineBreaks :: [Inline] -> Bool
hasLineBreaks = Any -> Bool
getAny (Any -> Bool) -> ([Inline] -> Any) -> [Inline] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Any) -> [Inline] -> Any
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> Any
isLineBreak ([Inline] -> Any) -> ([Inline] -> [Inline]) -> [Inline] -> Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Inline) -> [Inline] -> [Inline]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
removeNote
where
removeNote :: Inline -> Inline
removeNote :: Inline -> Inline
removeNote (Note [Block]
_) = Text -> Inline
Str Text
""
removeNote Inline
x = Inline
x
isLineBreak :: Inline -> Any
isLineBreak :: Inline -> Any
isLineBreak Inline
LineBreak = Bool -> Any
Any Bool
True
isLineBreak Inline
_ = Bool -> Any
Any Bool
False
alignmentToString :: Alignment -> Text
alignmentToString :: Alignment -> Text
alignmentToString Alignment
alignment = case Alignment
alignment of
Alignment
AlignLeft -> Text
"left"
Alignment
AlignRight -> Text
"right"
Alignment
AlignCenter -> Text
"center"
Alignment
AlignDefault -> Text
"left"
tableRowToDocbook :: PandocMonad m
=> WriterOptions
-> [[Block]]
-> DB m (Doc Text)
tableRowToDocbook :: WriterOptions -> [[Block]] -> DB m (Doc Text)
tableRowToDocbook WriterOptions
opts [[Block]]
cols =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"row" (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> ReaderT DocBookVersion m [Doc Text] -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Block] -> DB m (Doc Text))
-> [[Block]] -> ReaderT DocBookVersion m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> [Block] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
tableItemToDocbook WriterOptions
opts) [[Block]]
cols
tableItemToDocbook :: PandocMonad m
=> WriterOptions
-> [Block]
-> DB m (Doc Text)
tableItemToDocbook :: WriterOptions -> [Block] -> DB m (Doc Text)
tableItemToDocbook WriterOptions
opts [Block]
item =
Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"entry" [] (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> ReaderT DocBookVersion m [Doc Text] -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> DB m (Doc Text))
-> [Block] -> ReaderT DocBookVersion m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> Block -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> DB m (Doc Text)
blockToDocbook WriterOptions
opts) [Block]
item
inlinesToDocbook :: PandocMonad m => WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook :: WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat ([Doc Text] -> Doc Text)
-> ReaderT DocBookVersion m [Doc Text] -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> DB m (Doc Text))
-> [Inline] -> ReaderT DocBookVersion m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> Inline -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> DB m (Doc Text)
inlineToDocbook WriterOptions
opts) [Inline]
lst
inlineToDocbook :: PandocMonad m => WriterOptions -> Inline -> DB m (Doc Text)
inlineToDocbook :: WriterOptions -> Inline -> DB m (Doc Text)
inlineToDocbook WriterOptions
_ (Str Text
str) = Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
str
inlineToDocbook WriterOptions
opts (Emph [Inline]
lst) =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"emphasis" (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
inlineToDocbook WriterOptions
opts (Underline [Inline]
lst) =
Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"emphasis" [(Text
"role", Text
"underline")] (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
inlineToDocbook WriterOptions
opts (Strong [Inline]
lst) =
Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"emphasis" [(Text
"role", Text
"strong")] (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
inlineToDocbook WriterOptions
opts (Strikeout [Inline]
lst) =
Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"emphasis" [(Text
"role", Text
"strikethrough")] (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
inlineToDocbook WriterOptions
opts (Superscript [Inline]
lst) =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"superscript" (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
inlineToDocbook WriterOptions
opts (Subscript [Inline]
lst) =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"subscript" (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
inlineToDocbook WriterOptions
opts (SmallCaps [Inline]
lst) =
Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"emphasis" [(Text
"role", Text
"smallcaps")] (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
inlineToDocbook WriterOptions
opts (Quoted QuoteType
_ [Inline]
lst) =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"quote" (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
inlineToDocbook WriterOptions
opts (Cite [Citation]
_ [Inline]
lst) =
WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
lst
inlineToDocbook WriterOptions
opts (Span (Text
ident,[Text]
_,[(Text, Text)]
_) [Inline]
ils) = do
DocBookVersion
version <- ReaderT DocBookVersion m DocBookVersion
forall r (m :: * -> *). MonadReader r m => m r
ask
((if Text -> Bool
T.null Text
ident
then Doc Text
forall a. Monoid a => a
mempty
else Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"anchor" [(DocBookVersion -> Text
idName DocBookVersion
version, Text
ident)]) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>) (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
ils
inlineToDocbook WriterOptions
_ (Code Attr
_ Text
str) =
Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"literal" (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Text
escapeStringForXML Text
str)
inlineToDocbook WriterOptions
opts (Math MathType
t Text
str)
| HTMLMathMethod -> Bool
isMathML (WriterOptions -> HTMLMathMethod
writerHTMLMathMethod WriterOptions
opts) = do
Either Inline Element
res <- (DisplayType -> [Exp] -> Element)
-> MathType
-> Text
-> ReaderT DocBookVersion m (Either Inline Element)
forall (m :: * -> *) a.
PandocMonad m =>
(DisplayType -> [Exp] -> a)
-> MathType -> Text -> m (Either Inline a)
convertMath DisplayType -> [Exp] -> Element
writeMathML MathType
t Text
str
case Either Inline Element
res of
Right Element
r -> Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
tagtype
(Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ConfigPP -> Element -> String
Xml.ppcElement ConfigPP
conf
(Element -> String) -> Element -> String
forall a b. (a -> b) -> a -> b
$ Element -> Element
fixNS
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Element -> Element
removeAttr Element
r
Left Inline
il -> WriterOptions -> Inline -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> DB m (Doc Text)
inlineToDocbook WriterOptions
opts Inline
il
| Bool
otherwise =
MathType -> Text -> ReaderT DocBookVersion m [Inline]
forall (m :: * -> *).
PandocMonad m =>
MathType -> Text -> m [Inline]
texMathToInlines MathType
t Text
str ReaderT DocBookVersion m [Inline]
-> ([Inline] -> DB m (Doc Text)) -> DB m (Doc Text)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts
where tagtype :: Text
tagtype = case MathType
t of
MathType
InlineMath -> Text
"inlineequation"
MathType
DisplayMath -> Text
"informalequation"
conf :: ConfigPP
conf = (QName -> Bool) -> ConfigPP -> ConfigPP
Xml.useShortEmptyTags (Bool -> QName -> Bool
forall a b. a -> b -> a
const Bool
False) ConfigPP
Xml.defaultConfigPP
removeAttr :: Element -> Element
removeAttr Element
e = Element
e{ elAttribs :: [Attr]
Xml.elAttribs = [] }
fixNS' :: QName -> QName
fixNS' QName
qname = QName
qname{ qPrefix :: Maybe String
Xml.qPrefix = String -> Maybe String
forall a. a -> Maybe a
Just String
"mml" }
fixNS :: Element -> Element
fixNS = (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere ((QName -> QName) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT QName -> QName
fixNS')
inlineToDocbook WriterOptions
_ il :: Inline
il@(RawInline Format
f Text
x)
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
"html" Bool -> Bool -> Bool
|| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
"docbook" = Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
x
| Bool
otherwise = do
LogMessage -> ReaderT DocBookVersion m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ReaderT DocBookVersion m ())
-> LogMessage -> ReaderT DocBookVersion m ()
forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
il
Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
inlineToDocbook WriterOptions
_ Inline
LineBreak = Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\n"
inlineToDocbook WriterOptions
_ Inline
Space = Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
inlineToDocbook WriterOptions
_ Inline
SoftBreak = Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
inlineToDocbook WriterOptions
opts (Link Attr
attr [Inline]
txt (Text
src, Text
_))
| Just Text
email <- Text -> Text -> Maybe Text
T.stripPrefix Text
"mailto:" Text
src =
let emailLink :: Doc Text
emailLink = Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"email" (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
Text -> Text
escapeStringForXML Text
email
in case [Inline]
txt of
[Str Text
s] | Text -> Text
escapeURI Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
email -> Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
emailLink
[Inline]
_ -> do Doc Text
contents <- WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
txt
Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
contents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
<+>
Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char Char
'(' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
emailLink Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char Char
')'
| Bool
otherwise = do
DocBookVersion
version <- ReaderT DocBookVersion m DocBookVersion
forall r (m :: * -> *). MonadReader r m => m r
ask
(if Text
"#" Text -> Text -> Bool
`T.isPrefixOf` Text
src
then Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"link" ([(Text, Text)] -> Doc Text -> Doc Text)
-> [(Text, Text)] -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ (Text
"linkend", WriterOptions -> Text
writerIdentifierPrefix WriterOptions
opts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.drop Int
1 Text
src) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: Attr -> [(Text, Text)]
idAndRole Attr
attr
else if DocBookVersion
version DocBookVersion -> DocBookVersion -> Bool
forall a. Eq a => a -> a -> Bool
== DocBookVersion
DocBook5
then Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"link" ([(Text, Text)] -> Doc Text -> Doc Text)
-> [(Text, Text)] -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ (Text
"xlink:href", Text
src) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: Attr -> [(Text, Text)]
idAndRole Attr
attr
else Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"ulink" ([(Text, Text)] -> Doc Text -> Doc Text)
-> [(Text, Text)] -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ (Text
"url", Text
src) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: Attr -> [(Text, Text)]
idAndRole Attr
attr )
(Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocbook WriterOptions
opts [Inline]
txt
inlineToDocbook WriterOptions
opts (Image Attr
attr [Inline]
_ (Text
src, Text
tit)) = Doc Text -> DB m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$
let titleDoc :: Doc Text
titleDoc = if Text -> Bool
T.null Text
tit
then Doc Text
forall a. Doc a
empty
else Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"objectinfo" (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"title" (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
tit)
in Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"inlinemediaobject" (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"imageobject" (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
Doc Text
titleDoc Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ WriterOptions -> Attr -> Text -> Doc Text
imageToDocbook WriterOptions
opts Attr
attr Text
src
inlineToDocbook WriterOptions
opts (Note [Block]
contents) =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"footnote" (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Block] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocbook WriterOptions
opts [Block]
contents
isMathML :: HTMLMathMethod -> Bool
isMathML :: HTMLMathMethod -> Bool
isMathML HTMLMathMethod
MathML = Bool
True
isMathML HTMLMathMethod
_ = Bool
False
idAndRole :: Attr -> [(Text, Text)]
idAndRole :: Attr -> [(Text, Text)]
idAndRole (Text
id',[Text]
cls,[(Text, Text)]
_) = [(Text, Text)]
ident [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
role
where
ident :: [(Text, Text)]
ident = [(Text
"id", Text
id') | Bool -> Bool
not (Text -> Bool
T.null Text
id')]
role :: [(Text, Text)]
role = [(Text
"role", [Text] -> Text
T.unwords [Text]
cls) | Bool -> Bool
not ([Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
cls)]