{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
module Text.Pandoc.Writers.DocBook ( writeDocBook4, writeDocBook5 ) where
import Control.Monad.Reader
import Data.Generics (everywhere, mkT)
import Data.List (nub, partition)
import Data.Maybe (isNothing)
import Data.Monoid (All (..), Any (..))
import Data.Text (Text)
import qualified Data.Text as T
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
import Text.Pandoc.Definition
import Text.Pandoc.Highlighting (languages, languagesByExtension)
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.URI
import Text.Pandoc.Templates (renderTemplate)
import Text.Pandoc.Writers.Shared
import Text.Pandoc.Walk
import Text.Pandoc.Writers.Math
import Text.Pandoc.XML
import Text.TeXMath
import qualified Text.XML.Light as Xml
data DocBookVersion = DocBook4 | DocBook5
deriving (DocBookVersion -> DocBookVersion -> Bool
(DocBookVersion -> DocBookVersion -> Bool)
-> (DocBookVersion -> DocBookVersion -> Bool) -> Eq DocBookVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DocBookVersion -> DocBookVersion -> Bool
== :: DocBookVersion -> DocBookVersion -> Bool
$c/= :: DocBookVersion -> DocBookVersion -> Bool
/= :: DocBookVersion -> DocBookVersion -> Bool
Eq, Int -> DocBookVersion -> ShowS
[DocBookVersion] -> ShowS
DocBookVersion -> String
(Int -> DocBookVersion -> ShowS)
-> (DocBookVersion -> String)
-> ([DocBookVersion] -> ShowS)
-> Show DocBookVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DocBookVersion -> ShowS
showsPrec :: Int -> DocBookVersion -> ShowS
$cshow :: DocBookVersion -> String
show :: DocBookVersion -> String
$cshowList :: [DocBookVersion] -> ShowS
showList :: [DocBookVersion] -> ShowS
Show)
type DB = ReaderT DocBookVersion
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 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m Inlines
authorToDocBook WriterOptions
opts [Inline]
name' = do
name <- Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing (Doc Text -> Text)
-> ReaderT DocBookVersion m (Doc Text)
-> ReaderT DocBookVersion m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
name'
let colwidth = if WriterOptions -> WrapOption
writerWrapText WriterOptions
opts WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
opts
else Maybe Int
forall a. Maybe a
Nothing
return $ B.rawInline "docbook" $
render colwidth $ inTags True "personname" [] $
if T.any (== ',') name
then
let (lastname, rest) = T.break (==',') name
firstname = Text -> Text
triml Text
rest in
inTagsSimple "firstname" (literal $ escapeStringForXML firstname) <>
inTagsSimple "surname" (literal $ escapeStringForXML lastname)
else
let namewords = Text -> [Text]
T.words Text
name
lengthname = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
namewords
(firstname, lastname) = case lengthname of
Int
0 -> (Text
"",Text
"")
Int
1 -> (Text
"", Text
name)
Int
n -> ([Text] -> Text
T.unwords (Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [Text]
namewords), [Text] -> Text
forall a. HasCallStack => [a] -> a
last [Text]
namewords)
in inTagsSimple "firstname" (literal $ escapeStringForXML firstname) $$
inTagsSimple "surname" (literal $ escapeStringForXML lastname)
writeDocBook4 :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeDocBook4 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeDocBook4 WriterOptions
opts Pandoc
d =
ReaderT DocBookVersion m Text -> DocBookVersion -> m Text
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (WriterOptions -> Pandoc -> ReaderT DocBookVersion m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> DB m Text
writeDocBook WriterOptions
opts Pandoc
d) DocBookVersion
DocBook4
writeDocBook5 :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeDocBook5 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeDocBook5 WriterOptions
opts Pandoc
d =
ReaderT DocBookVersion m Text -> DocBookVersion -> m Text
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (WriterOptions -> Pandoc -> ReaderT DocBookVersion m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> DB m Text
writeDocBook WriterOptions
opts Pandoc
d) DocBookVersion
DocBook5
writeDocBook :: PandocMonad m => WriterOptions -> Pandoc -> DB m Text
writeDocBook :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> DB m Text
writeDocBook WriterOptions
opts Pandoc
doc = do
let Pandoc Meta
meta [Block]
blocks = Pandoc -> Pandoc
ensureValidXmlIdentifiers Pandoc
doc
let colwidth :: Maybe Int
colwidth = if WriterOptions -> WrapOption
writerWrapText WriterOptions
opts WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
then Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
opts
else Maybe Int
forall a. Maybe a
Nothing
let startLvl :: Int
startLvl = WriterOptions -> Int
getStartLvl WriterOptions
opts
let fromBlocks :: [Block] -> DB m (Doc Text)
fromBlocks = WriterOptions -> [Block] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocBook WriterOptions
opts ([Block] -> DB m (Doc Text))
-> ([Block] -> [Block]) -> [Block] -> DB m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Bool -> Maybe Int -> [Block] -> [Block]
makeSections Bool
False (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
startLvl)
auths' <- ([Inline] -> ReaderT DocBookVersion m Inlines)
-> [[Inline]] -> ReaderT DocBookVersion m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> [Inline] -> ReaderT DocBookVersion m Inlines
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m Inlines
authorToDocBook WriterOptions
opts) ([[Inline]] -> ReaderT DocBookVersion m [Inlines])
-> [[Inline]] -> ReaderT DocBookVersion m [Inlines]
forall a b. (a -> b) -> a -> b
$ Meta -> [[Inline]]
docAuthors Meta
meta
let meta' = Text -> [Inlines] -> Meta -> Meta
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
forall b. ToMetaValue b => Text -> b -> Meta -> Meta
B.setMeta Text
"author" [Inlines]
auths' Meta
meta
metadata <- metaToContext opts
fromBlocks
(inlinesToDocBook opts)
meta'
main <- fromBlocks blocks
let context = Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Doc Text
main
(Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"mathml" (case WriterOptions -> HTMLMathMethod
writerHTMLMathMethod WriterOptions
opts of
HTMLMathMethod
MathML -> Bool
True
HTMLMathMethod
_ -> Bool
False) Context Text
metadata
return $ render colwidth $
(if writerPreferAscii opts then fmap toEntities else id) $
case writerTemplate opts of
Maybe (Template Text)
Nothing -> Doc Text
main
Just Template Text
tpl -> Template Text -> Context Text -> Doc Text
forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl Context Text
context
blocksToDocBook :: PandocMonad m => WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocBook :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocBook WriterOptions
opts = ([Doc Text] -> Doc Text)
-> ReaderT DocBookVersion m [Doc Text]
-> ReaderT DocBookVersion m (Doc Text)
forall a b.
(a -> b)
-> ReaderT DocBookVersion m a -> ReaderT DocBookVersion m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat (ReaderT DocBookVersion m [Doc Text]
-> ReaderT DocBookVersion m (Doc Text))
-> ([Block] -> ReaderT DocBookVersion m [Doc Text])
-> [Block]
-> ReaderT DocBookVersion m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> ReaderT DocBookVersion m (Doc Text))
-> [Block] -> ReaderT DocBookVersion m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> Block -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> DB m (Doc Text)
blockToDocBook WriterOptions
opts)
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 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [([Inline], [[Block]])] -> DB m (Doc Text)
deflistItemsToDocBook WriterOptions
opts [([Inline], [[Block]])]
items =
[Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> ReaderT DocBookVersion m [Doc Text]
-> ReaderT DocBookVersion m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([Inline], [[Block]]) -> ReaderT DocBookVersion m (Doc Text))
-> [([Inline], [[Block]])] -> ReaderT DocBookVersion m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (([Inline] -> [[Block]] -> ReaderT DocBookVersion m (Doc Text))
-> ([Inline], [[Block]]) -> ReaderT DocBookVersion m (Doc Text)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (WriterOptions
-> [Inline] -> [[Block]] -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> [[Block]] -> DB m (Doc Text)
deflistItemToDocBook WriterOptions
opts)) [([Inline], [[Block]])]
items
deflistItemToDocBook :: PandocMonad m
=> WriterOptions -> [Inline] -> [[Block]]
-> DB m (Doc Text)
deflistItemToDocBook :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> [[Block]] -> DB m (Doc Text)
deflistItemToDocBook WriterOptions
opts [Inline]
term [[Block]]
defs = do
term' <- WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
term
def' <- blocksToDocBook opts $ concatMap (map plainToPara) defs
return $ inTagsIndented "varlistentry" $
inTagsIndented "term" term' $$
inTagsIndented "listitem" def'
listItemsToDocBook :: PandocMonad m
=> WriterOptions -> [[Block]] -> DB m (Doc Text)
listItemsToDocBook :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> DB m (Doc Text)
listItemsToDocBook WriterOptions
opts [[Block]]
items = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> ReaderT DocBookVersion m [Doc Text]
-> ReaderT DocBookVersion m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Block] -> ReaderT DocBookVersion m (Doc Text))
-> [[Block]] -> ReaderT DocBookVersion m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> [Block] -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
listItemToDocBook WriterOptions
opts) [[Block]]
items
listItemToDocBook :: PandocMonad m
=> WriterOptions -> [Block] -> DB m (Doc Text)
listItemToDocBook :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
listItemToDocBook WriterOptions
opts [Block]
item =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"listitem" (Doc Text -> Doc Text)
-> ReaderT DocBookVersion m (Doc Text)
-> ReaderT DocBookVersion m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Block] -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocBook WriterOptions
opts ((Block -> Block) -> [Block] -> [Block]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
plainToPara [Block]
item)
imageToDocBook :: WriterOptions -> Attr -> Text -> Doc Text
imageToDocBook :: WriterOptions -> Attr -> Text -> Doc Text
imageToDocBook WriterOptions
_ Attr
attr Text
src = Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"imagedata" ([(Text, Text)] -> Doc Text) -> [(Text, Text)] -> Doc Text
forall a b. (a -> b) -> a -> b
$
(Text
"fileref", Text
src) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: Attr -> [(Text, Text)]
idAndRole Attr
attr [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
dims
where
dims :: [(Text, Text)]
dims = Direction -> Text -> [(Text, Text)]
forall {a}. Direction -> a -> [(a, Text)]
go Direction
Width Text
"width" [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> Direction -> Text -> [(Text, Text)]
forall {a}. Direction -> a -> [(a, Text)]
go Direction
Height Text
"depth"
go :: Direction -> a -> [(a, Text)]
go Direction
dir a
dstr = case Direction -> Attr -> Maybe Dimension
dimension Direction
dir Attr
attr of
Just Dimension
a -> [(a
dstr, Dimension -> Text
forall a. Show a => a -> Text
tshow Dimension
a)]
Maybe Dimension
Nothing -> []
blockToDocBook :: PandocMonad m => WriterOptions -> Block -> DB m (Doc Text)
blockToDocBook :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> DB m (Doc Text)
blockToDocBook WriterOptions
opts (Div (Text
id',Text
"section":[Text]
_,[(Text, Text)]
_) (Header Int
lvl (Text
_,[Text]
classes,[(Text, Text)]
attrs) [Inline]
ils : [Block]
xs)) = do
version <- ReaderT DocBookVersion m DocBookVersion
forall r (m :: * -> *). MonadReader r m => m r
ask
let bs = if [Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
xs
then [[Inline] -> Block
Para []]
else [Block]
xs
tag = case Int
lvl of
-1 -> Text
"part"
Int
0 -> Text
"chapter"
Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
5 -> if DocBookVersion
version DocBookVersion -> DocBookVersion -> Bool
forall a. Eq a => a -> a -> Bool
== DocBookVersion
DocBook5
then Text
"section"
else Text
"sect" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n
Int
_ -> Text
"simplesect"
idAttr = [(DocBookVersion -> Text
idName DocBookVersion
version, WriterOptions -> Text
writerIdentifierPrefix WriterOptions
opts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
id') | Bool -> Bool
not (Text -> Bool
T.null Text
id')]
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 []
miscAttr = [(Text, Text)] -> [Text] -> [(Text, Text)]
enrichRole (((Text, Text) -> Bool) -> [(Text, Text)] -> [(Text, Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter (DocBookVersion -> (Text, Text) -> Bool
isSectionAttr DocBookVersion
version) [(Text, Text)]
attrs) [Text]
classes
attribs = [(Text, Text)]
nsAttr [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
idAttr [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
miscAttr
title' <- inlinesToDocBook opts ils
contents <- blocksToDocBook opts bs
return $ inTags True tag attribs $ inTagsSimple "title" title' $$ contents
blockToDocBook WriterOptions
opts (Div (Text
ident,[Text]
classes,[(Text, Text)]
_) [Block]
bs) = do
version <- ReaderT DocBookVersion m DocBookVersion
forall r (m :: * -> *). MonadReader r m => m r
ask
let identAttribs = [(DocBookVersion -> Text
idName DocBookVersion
version, Text
ident) | Bool -> Bool
not (Text -> Bool
T.null Text
ident)]
admonitions = [Text
"caution",Text
"danger",Text
"important",Text
"note",Text
"tip",Text
"warning"]
case classes of
(Text
l:[Text]
_) | Text
l Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
admonitions -> do
let (Maybe (DB m (Doc Text))
mTitleBs, [Block]
bodyBs) =
case [Block]
bs of
(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)
admonitionTitle <- case Maybe (DB m (Doc Text))
mTitleBs of
Maybe (DB m (Doc Text))
Nothing -> Doc Text -> DB m (Doc Text)
forall a. a -> ReaderT DocBookVersion m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Monoid a => a
mempty
Just DB m (Doc Text)
titleBs -> Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"title" (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DB m (Doc Text)
titleBs
admonitionBody <- handleDivBody [] bodyBs
return (inTags True l identAttribs (admonitionTitle $$ admonitionBody))
[Text]
_ -> [(Text, Text)] -> [Block] -> DB m (Doc Text)
forall {m :: * -> *}.
PandocMonad m =>
[(Text, Text)] -> [Block] -> ReaderT DocBookVersion m (Doc Text)
handleDivBody [(Text, Text)]
identAttribs [Block]
bs
where
handleDivBody :: [(Text, Text)] -> [Block] -> ReaderT DocBookVersion m (Doc Text)
handleDivBody [(Text, Text)]
identAttribs [Para [Inline]
lst] =
if [Inline] -> Bool
hasLineBreaks [Inline]
lst
then Doc Text -> Doc Text
forall a. Doc a -> Doc a
flush (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"literallayout" [(Text, Text)]
identAttribs
(Doc Text -> Doc Text)
-> ReaderT DocBookVersion m (Doc Text)
-> ReaderT DocBookVersion m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
lst
else Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"para" [(Text, Text)]
identAttribs (Doc Text -> Doc Text)
-> ReaderT DocBookVersion m (Doc Text)
-> ReaderT DocBookVersion m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
lst
handleDivBody [(Text, Text)]
identAttribs [Block]
bodyBs = do
contents <- WriterOptions -> [Block] -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocBook WriterOptions
opts ((Block -> Block) -> [Block] -> [Block]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
plainToPara [Block]
bodyBs)
return $
(if null identAttribs
then mempty
else selfClosingTag "anchor" identAttribs) $$ contents
blockToDocBook WriterOptions
_ h :: Block
h@Header{} = do
LogMessage -> ReaderT DocBookVersion m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ReaderT DocBookVersion m ())
-> LogMessage -> ReaderT DocBookVersion m ()
forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
h
Doc Text -> DB m (Doc Text)
forall a. a -> ReaderT DocBookVersion m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToDocBook WriterOptions
opts (Plain [Inline]
lst) = WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
lst
blockToDocBook WriterOptions
opts (Para [Inline]
lst)
| [Inline] -> Bool
hasLineBreaks [Inline]
lst = Doc Text -> Doc Text
forall a. Doc a -> Doc a
flush (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Text -> Doc Text
forall a. IsString a => Doc a -> Doc a
nowrap (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"literallayout"
(Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
lst
| Bool
otherwise = Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"para" (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
lst
blockToDocBook WriterOptions
opts (LineBlock [[Inline]]
lns) =
WriterOptions -> Block -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> DB m (Doc Text)
blockToDocBook WriterOptions
opts (Block -> DB m (Doc Text)) -> Block -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Block
linesToPara [[Inline]]
lns
blockToDocBook WriterOptions
opts (BlockQuote [Block]
blocks) =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"blockquote" (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Block] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocBook WriterOptions
opts [Block]
blocks
blockToDocBook WriterOptions
opts (CodeBlock (Text
_,[Text]
classes,[(Text, Text)]
_) Text
str) = Doc Text -> DB m (Doc Text)
forall a. a -> ReaderT DocBookVersion m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$
Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text
"<programlisting" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
lang Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">") Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>
Doc Text -> Doc Text
forall a. Doc a -> Doc a
flush (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Text
escapeStringForXML Text
str) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"</programlisting>")
where lang :: Text
lang = case [Text]
langs of
[] -> Text
""
(Text
l:[Text]
_) -> Text
" language=\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeStringForXML Text
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
syntaxMap :: SyntaxMap
syntaxMap = WriterOptions -> SyntaxMap
writerSyntaxMap WriterOptions
opts
isLang :: Text -> Bool
isLang Text
l = Text -> Text
T.toLower Text
l Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.toLower (SyntaxMap -> [Text]
languages SyntaxMap
syntaxMap)
langsFrom :: Text -> [Text]
langsFrom Text
s = if Text -> Bool
isLang Text
s
then [Text
s]
else (SyntaxMap -> Text -> [Text]
languagesByExtension SyntaxMap
syntaxMap) (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text
s
langs :: [Text]
langs = (Text -> [Text]) -> [Text] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Text -> [Text]
langsFrom [Text]
classes
blockToDocBook WriterOptions
opts (BulletList [[Block]]
lst) = do
let attribs :: [(Text, Text)]
attribs = [(Text
"spacing", Text
"compact") | [[Block]] -> Bool
isTightList [[Block]]
lst]
Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"itemizedlist" [(Text, Text)]
attribs (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [[Block]] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> DB m (Doc Text)
listItemsToDocBook WriterOptions
opts [[Block]]
lst
blockToDocBook WriterOptions
_ (OrderedList ListAttributes
_ []) = Doc Text -> DB m (Doc Text)
forall a. a -> ReaderT DocBookVersion m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToDocBook WriterOptions
opts (OrderedList (Int
start, ListNumberStyle
numstyle, ListNumberDelim
_) ([Block]
first:[[Block]]
rest)) = do
let numeration :: [(Text, Text)]
numeration = case ListNumberStyle
numstyle of
ListNumberStyle
DefaultStyle -> []
ListNumberStyle
Decimal -> [(Text
"numeration", Text
"arabic")]
ListNumberStyle
Example -> [(Text
"numeration", Text
"arabic")]
ListNumberStyle
UpperAlpha -> [(Text
"numeration", Text
"upperalpha")]
ListNumberStyle
LowerAlpha -> [(Text
"numeration", Text
"loweralpha")]
ListNumberStyle
UpperRoman -> [(Text
"numeration", Text
"upperroman")]
ListNumberStyle
LowerRoman -> [(Text
"numeration", Text
"lowerroman")]
spacing :: [(Text, Text)]
spacing = [(Text
"spacing", Text
"compact") | [[Block]] -> Bool
isTightList ([Block]
first[Block] -> [[Block]] -> [[Block]]
forall a. a -> [a] -> [a]
:[[Block]]
rest)]
attribs :: [(Text, Text)]
attribs = [(Text, Text)]
numeration [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
spacing
items <- if Int
start Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
then WriterOptions -> [[Block]] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> DB m (Doc Text)
listItemsToDocBook WriterOptions
opts ([Block]
first[Block] -> [[Block]] -> [[Block]]
forall a. a -> [a] -> [a]
:[[Block]]
rest)
else do
first' <- WriterOptions -> [Block] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocBook WriterOptions
opts ((Block -> Block) -> [Block] -> [Block]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
plainToPara [Block]
first)
rest' <- listItemsToDocBook opts rest
return $
inTags True "listitem" [("override",tshow start)] first' $$
rest'
return $ inTags True "orderedlist" attribs items
blockToDocBook WriterOptions
opts (DefinitionList [([Inline], [[Block]])]
lst) = do
let attribs :: [(Text, Text)]
attribs = [(Text
"spacing", Text
"compact") | [[Block]] -> Bool
isTightList ([[Block]] -> Bool) -> [[Block]] -> Bool
forall a b. (a -> b) -> a -> b
$ (([Inline], [[Block]]) -> [[Block]])
-> [([Inline], [[Block]])] -> [[Block]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Inline], [[Block]]) -> [[Block]]
forall a b. (a, b) -> b
snd [([Inline], [[Block]])]
lst]
Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"variablelist" [(Text, Text)]
attribs (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [([Inline], [[Block]])] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [([Inline], [[Block]])] -> DB m (Doc Text)
deflistItemsToDocBook WriterOptions
opts [([Inline], [[Block]])]
lst
blockToDocBook WriterOptions
_ b :: Block
b@(RawBlock Format
f Text
str)
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
"docbook" = Doc Text -> DB m (Doc Text)
forall a. a -> ReaderT DocBookVersion m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> DB m (Doc Text)) -> Doc Text -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
"html" = do
version <- ReaderT DocBookVersion m DocBookVersion
forall r (m :: * -> *). MonadReader r m => m r
ask
if version == DocBook5
then return empty
else return $ literal 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 a. a -> ReaderT DocBookVersion m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToDocBook WriterOptions
_ Block
HorizontalRule = Doc Text -> DB m (Doc Text)
forall a. a -> ReaderT DocBookVersion m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToDocBook WriterOptions
opts (Table Attr
_ Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot) = do
let ([Inline]
caption, [Alignment]
aligns, [Double]
widths, [[Block]]
headers, [[[Block]]]
rows) =
Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
toLegacyTable Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot
captionDoc <- if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
caption
then Doc Text -> DB m (Doc Text)
forall a. a -> ReaderT DocBookVersion m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
else Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"title" (Doc Text -> Doc Text) -> DB m (Doc Text) -> DB m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
caption
let tableType = if Doc Text -> Bool
forall a. Doc a -> Bool
isEmpty Doc Text
captionDoc then Text
"informaltable" else Text
"table"
percent a
w = Integer -> Text
forall a. Show a => a -> Text
tshow (a -> Integer
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (a
100a -> a -> a
forall a. Num a => a -> a -> a
*a
w) :: Integer) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"*"
coltags = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ (Double -> Alignment -> Doc Text)
-> [Double] -> [Alignment] -> [Doc Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Double
w Alignment
al -> Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"colspec"
([(Text
"colwidth", Double -> Text
forall {a}. RealFrac a => a -> Text
percent Double
w) | Double
w Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<>
[(Text
"align", Alignment -> Text
alignmentToString Alignment
al)])) [Double]
widths [Alignment]
aligns
head' <- if all null headers
then return empty
else inTagsIndented "thead" <$> tableRowToDocBook opts headers
body' <- inTagsIndented "tbody" . vcat <$>
mapM (tableRowToDocBook opts) rows
return $ inTagsIndented tableType $ captionDoc $$
inTags True "tgroup" [("cols", tshow (length aligns))] (
coltags $$ head' $$ body')
blockToDocBook WriterOptions
opts (Figure Attr
attr capt :: Caption
capt@(Caption Maybe [Inline]
_ [Block]
caption) [Block]
body) = do
let isAcceptable :: Block -> All
isAcceptable = \case
Table {} -> Bool -> All
All Bool
False
Figure {} -> Bool -> All
All Bool
False
Block
_ -> Bool -> All
All Bool
True
if Bool -> Bool
not (Bool -> Bool) -> (All -> Bool) -> All -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. All -> Bool
getAll (All -> Bool) -> All -> Bool
forall a b. (a -> b) -> a -> b
$ (Block -> All) -> [Block] -> All
forall c. Monoid c => (Block -> c) -> [Block] -> c
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Block -> All
isAcceptable [Block]
body
then WriterOptions -> Block -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> DB m (Doc Text)
blockToDocBook WriterOptions
opts (Block -> DB m (Doc Text)) -> Block -> DB m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Attr -> Caption -> [Block] -> Block
figureDiv Attr
attr Caption
capt [Block]
body
else do
title <- WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts ([Block] -> [Inline]
blocksToInlines [Block]
caption)
let toMediaobject = \case
Plain [Image Attr
imgAttr [Inline]
inlns (Text
src, Text
_)] -> do
alt <- WriterOptions -> [Inline] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
inlns
pure $ inTagsIndented "mediaobject" (
inTagsIndented "imageobject"
(imageToDocBook opts imgAttr src) $$
if isEmpty alt
then empty
else inTagsSimple "textobject" (inTagsSimple "phrase" alt))
Block
_ -> ReaderT DocBookVersion m DocBookVersion
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT DocBookVersion m DocBookVersion
-> (DocBookVersion -> DB m (Doc Text)) -> DB m (Doc Text)
forall a b.
ReaderT DocBookVersion m a
-> (a -> ReaderT DocBookVersion m b) -> ReaderT DocBookVersion m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
DocBookVersion
DocBook4 -> Doc Text -> DB m (Doc Text)
forall a. a -> ReaderT DocBookVersion m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
forall a. Monoid a => a
mempty
DocBookVersion
DocBook5 -> WriterOptions -> [Block] -> DB m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocBook WriterOptions
opts [Block]
body
mediaobjects <- mapM toMediaobject body
return $
if isEmpty $ mconcat mediaobjects
then mempty
else inTagsIndented "figure" $
inTagsSimple "title" title $$
mconcat mediaobjects
hasLineBreaks :: [Inline] -> Bool
hasLineBreaks :: [Inline] -> Bool
hasLineBreaks = Any -> Bool
getAny (Any -> Bool) -> ([Inline] -> Any) -> [Inline] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Any) -> [Inline] -> Any
forall c. Monoid c => (Inline -> c) -> [Inline] -> c
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> Any
isLineBreak ([Inline] -> Any) -> ([Inline] -> [Inline]) -> [Inline] -> Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inline -> Inline) -> [Inline] -> [Inline]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
removeNote
where
removeNote :: Inline -> Inline
removeNote :: Inline -> Inline
removeNote (Note [Block]
_) = Text -> Inline
Str Text
""
removeNote Inline
x = Inline
x
isLineBreak :: Inline -> Any
isLineBreak :: Inline -> Any
isLineBreak Inline
LineBreak = Bool -> Any
Any Bool
True
isLineBreak Inline
_ = Bool -> Any
Any Bool
False
alignmentToString :: Alignment -> Text
alignmentToString :: Alignment -> Text
alignmentToString Alignment
alignment = case Alignment
alignment of
Alignment
AlignLeft -> Text
"left"
Alignment
AlignRight -> Text
"right"
Alignment
AlignCenter -> Text
"center"
Alignment
AlignDefault -> Text
"left"
tableRowToDocBook :: PandocMonad m
=> WriterOptions
-> [[Block]]
-> DB m (Doc Text)
tableRowToDocBook :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> DB m (Doc Text)
tableRowToDocBook WriterOptions
opts [[Block]]
cols =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"row" (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> ReaderT DocBookVersion m [Doc Text]
-> ReaderT DocBookVersion m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Block] -> ReaderT DocBookVersion m (Doc Text))
-> [[Block]] -> ReaderT DocBookVersion m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> [Block] -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
tableItemToDocBook WriterOptions
opts) [[Block]]
cols
tableItemToDocBook :: PandocMonad m
=> WriterOptions
-> [Block]
-> DB m (Doc Text)
tableItemToDocBook :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
tableItemToDocBook WriterOptions
opts [Block]
item =
Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"entry" [] (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> ReaderT DocBookVersion m [Doc Text]
-> ReaderT DocBookVersion m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> ReaderT DocBookVersion m (Doc Text))
-> [Block] -> ReaderT DocBookVersion m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> Block -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> DB m (Doc Text)
blockToDocBook WriterOptions
opts) [Block]
item
inlinesToDocBook :: PandocMonad m => WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
lst = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat ([Doc Text] -> Doc Text)
-> ReaderT DocBookVersion m [Doc Text]
-> ReaderT DocBookVersion m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> ReaderT DocBookVersion m (Doc Text))
-> [Inline] -> ReaderT DocBookVersion m [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (WriterOptions -> Inline -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> DB m (Doc Text)
inlineToDocBook WriterOptions
opts) [Inline]
lst
inlineToDocBook :: PandocMonad m => WriterOptions -> Inline -> DB m (Doc Text)
inlineToDocBook :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> DB m (Doc Text)
inlineToDocBook WriterOptions
_ (Str Text
str) = Doc Text -> ReaderT DocBookVersion m (Doc Text)
forall a. a -> ReaderT DocBookVersion m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> ReaderT DocBookVersion m (Doc Text))
-> Doc Text -> ReaderT DocBookVersion m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
str
inlineToDocBook WriterOptions
opts (Emph [Inline]
lst) =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"emphasis" (Doc Text -> Doc Text)
-> ReaderT DocBookVersion m (Doc Text)
-> ReaderT DocBookVersion m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
lst
inlineToDocBook WriterOptions
opts (Underline [Inline]
lst) =
Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"emphasis" [(Text
"role", Text
"underline")] (Doc Text -> Doc Text)
-> ReaderT DocBookVersion m (Doc Text)
-> ReaderT DocBookVersion m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
lst
inlineToDocBook WriterOptions
opts (Strong [Inline]
lst) =
Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"emphasis" [(Text
"role", Text
"strong")] (Doc Text -> Doc Text)
-> ReaderT DocBookVersion m (Doc Text)
-> ReaderT DocBookVersion m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
lst
inlineToDocBook WriterOptions
opts (Strikeout [Inline]
lst) =
Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"emphasis" [(Text
"role", Text
"strikethrough")] (Doc Text -> Doc Text)
-> ReaderT DocBookVersion m (Doc Text)
-> ReaderT DocBookVersion m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
WriterOptions -> [Inline] -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
lst
inlineToDocBook WriterOptions
opts (Superscript [Inline]
lst) =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"superscript" (Doc Text -> Doc Text)
-> ReaderT DocBookVersion m (Doc Text)
-> ReaderT DocBookVersion m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
lst
inlineToDocBook WriterOptions
opts (Subscript [Inline]
lst) =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"subscript" (Doc Text -> Doc Text)
-> ReaderT DocBookVersion m (Doc Text)
-> ReaderT DocBookVersion m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
lst
inlineToDocBook WriterOptions
opts (SmallCaps [Inline]
lst) =
Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"emphasis" [(Text
"role", Text
"smallcaps")] (Doc Text -> Doc Text)
-> ReaderT DocBookVersion m (Doc Text)
-> ReaderT DocBookVersion m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
WriterOptions -> [Inline] -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
lst
inlineToDocBook WriterOptions
opts (Quoted QuoteType
_ [Inline]
lst) =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"quote" (Doc Text -> Doc Text)
-> ReaderT DocBookVersion m (Doc Text)
-> ReaderT DocBookVersion m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
lst
inlineToDocBook WriterOptions
opts (Cite [Citation]
_ [Inline]
lst) =
WriterOptions -> [Inline] -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
lst
inlineToDocBook WriterOptions
opts (Span (Text
ident,[Text]
_,[(Text, Text)]
_) [Inline]
ils) = do
version <- ReaderT DocBookVersion m DocBookVersion
forall r (m :: * -> *). MonadReader r m => m r
ask
((if T.null ident
then mempty
else selfClosingTag "anchor" [(idName version, ident)]) <>) <$>
inlinesToDocBook opts ils
inlineToDocBook WriterOptions
_ (Code Attr
_ Text
str) =
Doc Text -> ReaderT DocBookVersion m (Doc Text)
forall a. a -> ReaderT DocBookVersion m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> ReaderT DocBookVersion m (Doc Text))
-> Doc Text -> ReaderT DocBookVersion m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"literal" (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Text
escapeStringForXML Text
str)
inlineToDocBook WriterOptions
opts (Math MathType
t Text
str)
| HTMLMathMethod -> Bool
isMathML (WriterOptions -> HTMLMathMethod
writerHTMLMathMethod WriterOptions
opts) = do
res <- (DisplayType -> [Exp] -> Element)
-> MathType
-> Text
-> ReaderT DocBookVersion m (Either Inline Element)
forall (m :: * -> *) a.
PandocMonad m =>
(DisplayType -> [Exp] -> a)
-> MathType -> Text -> m (Either Inline a)
convertMath DisplayType -> [Exp] -> Element
writeMathML MathType
t Text
str
case res of
Right Element
r -> Doc Text -> ReaderT DocBookVersion m (Doc Text)
forall a. a -> ReaderT DocBookVersion m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> ReaderT DocBookVersion m (Doc Text))
-> Doc Text -> ReaderT DocBookVersion m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
tagtype
(Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ConfigPP -> Element -> String
Xml.ppcElement ConfigPP
conf
(Element -> String) -> Element -> String
forall a b. (a -> b) -> a -> b
$ Element -> Element
fixNS
(Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ Element -> Element
removeAttr Element
r
Left Inline
il -> WriterOptions -> Inline -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> DB m (Doc Text)
inlineToDocBook WriterOptions
opts Inline
il
| Bool
otherwise =
MathType -> Text -> ReaderT DocBookVersion m [Inline]
forall (m :: * -> *).
PandocMonad m =>
MathType -> Text -> m [Inline]
texMathToInlines MathType
t Text
str ReaderT DocBookVersion m [Inline]
-> ([Inline] -> ReaderT DocBookVersion m (Doc Text))
-> ReaderT DocBookVersion m (Doc Text)
forall a b.
ReaderT DocBookVersion m a
-> (a -> ReaderT DocBookVersion m b) -> ReaderT DocBookVersion m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WriterOptions -> [Inline] -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts
where tagtype :: Text
tagtype = case MathType
t of
MathType
InlineMath -> Text
"inlineequation"
MathType
DisplayMath -> Text
"informalequation"
conf :: ConfigPP
conf = (QName -> Bool) -> ConfigPP -> ConfigPP
Xml.useShortEmptyTags (Bool -> QName -> Bool
forall a b. a -> b -> a
const Bool
False) ConfigPP
Xml.defaultConfigPP
removeAttr :: Element -> Element
removeAttr Element
e = Element
e{ Xml.elAttribs = [] }
fixNS' :: QName -> QName
fixNS' QName
qname = QName
qname{ Xml.qPrefix = Just "mml" }
fixNS :: Element -> Element
fixNS = (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere ((QName -> QName) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT QName -> QName
fixNS')
inlineToDocBook WriterOptions
_ il :: Inline
il@(RawInline Format
f Text
x)
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
"html" Bool -> Bool -> Bool
|| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
"docbook" = Doc Text -> ReaderT DocBookVersion m (Doc Text)
forall a. a -> ReaderT DocBookVersion m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> ReaderT DocBookVersion m (Doc Text))
-> Doc Text -> ReaderT DocBookVersion m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
x
| Bool
otherwise = do
LogMessage -> ReaderT DocBookVersion m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> ReaderT DocBookVersion m ())
-> LogMessage -> ReaderT DocBookVersion m ()
forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
il
Doc Text -> ReaderT DocBookVersion m (Doc Text)
forall a. a -> ReaderT DocBookVersion m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
inlineToDocBook WriterOptions
_ Inline
LineBreak = Doc Text -> ReaderT DocBookVersion m (Doc Text)
forall a. a -> ReaderT DocBookVersion m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> ReaderT DocBookVersion m (Doc Text))
-> Doc Text -> ReaderT DocBookVersion m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
"\n"
inlineToDocBook WriterOptions
_ Inline
Space = Doc Text -> ReaderT DocBookVersion m (Doc Text)
forall a. a -> ReaderT DocBookVersion m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
inlineToDocBook WriterOptions
_ Inline
SoftBreak = Doc Text -> ReaderT DocBookVersion m (Doc Text)
forall a. a -> ReaderT DocBookVersion m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
inlineToDocBook WriterOptions
opts (Link Attr
attr [Inline]
txt (Text
src, Text
_))
| Just Text
email <- Text -> Text -> Maybe Text
T.stripPrefix Text
"mailto:" Text
src =
let emailLink :: Doc Text
emailLink = Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"email" (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
Text -> Text
escapeStringForXML Text
email
in case [Inline]
txt of
[Str Text
s] | Text -> Text
escapeURI Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
email -> Doc Text -> ReaderT DocBookVersion m (Doc Text)
forall a. a -> ReaderT DocBookVersion m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
emailLink
[Inline]
_ -> do contents <- WriterOptions -> [Inline] -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
txt
return $ contents <+>
char '(' <> emailLink <> char ')'
| Bool
otherwise = do
version <- ReaderT DocBookVersion m DocBookVersion
forall r (m :: * -> *). MonadReader r m => m r
ask
(if "#" `T.isPrefixOf` src
then let tag = if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
txt then Text
"xref" else Text
"link"
in inTags False tag $
("linkend", writerIdentifierPrefix opts <> T.drop 1 src) :
idAndRole attr
else if version == DocBook5
then inTags False "link" $ ("xlink:href", src) : idAndRole attr
else inTags False "ulink" $ ("url", src) : idAndRole attr )
<$> inlinesToDocBook opts txt
inlineToDocBook WriterOptions
opts (Image Attr
attr [Inline]
ils (Text
src, Text
tit)) = Doc Text -> ReaderT DocBookVersion m (Doc Text)
forall a. a -> ReaderT DocBookVersion m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> ReaderT DocBookVersion m (Doc Text))
-> Doc Text -> ReaderT DocBookVersion m (Doc Text)
forall a b. (a -> b) -> a -> b
$
let titleDoc :: Doc Text
titleDoc = if Text -> Bool
T.null Text
tit
then Doc Text
forall a. Doc a
empty
else Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"objectinfo" (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"title" (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
tit)
alt :: Doc Text
alt = if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
ils
then Doc Text
forall a. Monoid a => a
mempty
else Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"textobject" (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"phrase" (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal ([Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils)
in Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"inlinemediaobject" (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"imageobject"
(Doc Text
titleDoc Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ WriterOptions -> Attr -> Text -> Doc Text
imageToDocBook WriterOptions
opts Attr
attr Text
src)
Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
alt
inlineToDocBook WriterOptions
opts (Note [Block]
contents) =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"footnote" (Doc Text -> Doc Text)
-> ReaderT DocBookVersion m (Doc Text)
-> ReaderT DocBookVersion m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Block] -> ReaderT DocBookVersion m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocBook WriterOptions
opts [Block]
contents
isMathML :: HTMLMathMethod -> Bool
isMathML :: HTMLMathMethod -> Bool
isMathML HTMLMathMethod
MathML = Bool
True
isMathML HTMLMathMethod
_ = Bool
False
idAndRole :: Attr -> [(Text, Text)]
idAndRole :: Attr -> [(Text, Text)]
idAndRole (Text
id',[Text]
cls,[(Text, Text)]
_) = [(Text, Text)]
ident [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
role
where
ident :: [(Text, Text)]
ident = [(Text
"id", Text
id') | Bool -> Bool
not (Text -> Bool
T.null Text
id')]
role :: [(Text, Text)]
role = [(Text
"role", [Text] -> Text
T.unwords [Text]
cls) | Bool -> Bool
not ([Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
cls)]
enrichRole :: [(Text, Text)] -> [Text] -> [(Text, Text)]
enrichRole :: [(Text, Text)] -> [Text] -> [(Text, Text)]
enrichRole [(Text, Text)]
mattrs [Text]
cls = [(Text
"role", [Text] -> Text
T.unwords [Text]
roles) | [Text]
roles [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
/= []] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
nonRole
where
([(Text, Text)]
roleAttr, [(Text, Text)]
nonRole) = ((Text, Text) -> Bool)
-> [(Text, Text)] -> ([(Text, Text)], [(Text, Text)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\(Text
key, Text
_v) -> Text
key Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"role") [(Text, Text)]
mattrs
roles :: [Text]
roles = [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cand) [Text]
cls [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
forall a b. (a, b) -> b
snd [(Text, Text)]
roleAttr
cand :: [Text]
cand = [Text
"unnumbered"]
isSectionAttr :: DocBookVersion -> (Text, Text) -> Bool
isSectionAttr :: DocBookVersion -> (Text, Text) -> Bool
isSectionAttr DocBookVersion
_ (Text
"label",Text
_) = Bool
True
isSectionAttr DocBookVersion
_ (Text
"status",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"annotations",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"dir",Text
"ltr") = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"dir",Text
"rtl") = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"dir",Text
"lro") = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"dir",Text
"rlo") = Bool
True
isSectionAttr DocBookVersion
_ (Text
"remap",Text
_) = Bool
True
isSectionAttr DocBookVersion
_ (Text
"revisionflag",Text
"changed") = Bool
True
isSectionAttr DocBookVersion
_ (Text
"revisionflag",Text
"added") = Bool
True
isSectionAttr DocBookVersion
_ (Text
"revisionflag",Text
"deleted") = Bool
True
isSectionAttr DocBookVersion
_ (Text
"revisionflag",Text
"off") = Bool
True
isSectionAttr DocBookVersion
_ (Text
"role",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"version",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"xml:base",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"xml:lang",Text
_) = Bool
True
isSectionAttr DocBookVersion
_ (Text
"xreflabel",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"linkend",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"linkends",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"xlink:actuate",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"xlink:arcrole",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"xlink:from",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"xlink:href",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"xlink:label",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"xlink:role",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"xlink:show",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"xlink:title",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"xlink:to",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook5 (Text
"xlink:type",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook4 (Text
"arch",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook4 (Text
"condition",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook4 (Text
"conformance",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook4 (Text
"lang",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook4 (Text
"os",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook4 (Text
"revision",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook4 (Text
"security",Text
_) = Bool
True
isSectionAttr DocBookVersion
DocBook4 (Text
"vendor",Text
_) = Bool
True
isSectionAttr DocBookVersion
_ (Text
_,Text
_) = Bool
False