{-# 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
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
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 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m Inlines
authorToDocBook WriterOptions
opts [Inline]
name' = do
Text
name <- forall a. HasChars a => Maybe Int -> Doc a -> a
render forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
opts
else forall a. Maybe a
Nothing
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines
B.rawInline Text
"docbook" forall a b. (a -> b) -> a -> b
$
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"personname" [] forall a b. (a -> b) -> a -> b
$
if (Char -> Bool) -> Text -> Bool
T.any (forall a. Eq a => a -> a -> Bool
== Char
',') Text
name
then
let (Text
lastname, Text
rest) = (Char -> Bool) -> Text -> (Text, Text)
T.break (forall a. Eq a => a -> a -> Bool
==Char
',') Text
name
firstname :: Text
firstname = Text -> Text
triml Text
rest in
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"firstname" (forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
firstname) forall a. Semigroup a => a -> a -> a
<>
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"surname" (forall a. HasChars a => a -> Doc a
literal 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 = 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 (forall a. Int -> [a] -> [a]
take (Int
nforall a. Num a => a -> a -> a
-Int
1) [Text]
namewords), forall a. [a] -> a
last [Text]
namewords)
in forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"firstname" (forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
firstname) forall a. Doc a -> Doc a -> Doc a
$$
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"surname" (forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
lastname)
writeDocBook4 :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeDocBook4 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeDocBook4 WriterOptions
opts Pandoc
d =
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (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 =
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (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 forall a. Eq a => a -> a -> Bool
== WrapOption
WrapAuto
then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ WriterOptions -> Int
writerColumns WriterOptions
opts
else forall a. Maybe a
Nothing
let startLvl :: Int
startLvl = WriterOptions -> Int
getStartLvl WriterOptions
opts
let fromBlocks :: [Block] -> DB m (Doc Text)
fromBlocks = forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocBook WriterOptions
opts forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Bool -> Maybe Int -> [Block] -> [Block]
makeSections Bool
False (forall a. a -> Maybe a
Just Int
startLvl)
[Inlines]
auths' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m Inlines
authorToDocBook WriterOptions
opts) forall a b. (a -> b) -> a -> b
$ Meta -> [[Inline]]
docAuthors Meta
meta
let meta' :: Meta
meta' = forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
B.setMeta Text
"author" [Inlines]
auths' Meta
meta
Context Text
metadata <- 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
(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 = forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Doc Text
main
forall a b. (a -> b) -> a -> b
$ 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
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth forall a b. (a -> b) -> a -> b
$
(if WriterOptions -> Bool
writerPreferAscii WriterOptions
opts then forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
toEntities else forall a. a -> a
id) 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 -> 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [Doc a] -> Doc a
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (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 =
forall a. [Doc a] -> Doc a
vcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (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
Doc Text
term' <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
term
Doc Text
def' <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocBook WriterOptions
opts forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
plainToPara) [[Block]]
defs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"varlistentry" forall a b. (a -> b) -> a -> b
$
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"term" Doc Text
term' forall a. Doc a -> Doc a -> Doc a
$$
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 :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> DB m (Doc Text)
listItemsToDocBook WriterOptions
opts [[Block]]
items = forall a. [Doc a] -> Doc a
vcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (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 =
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"listitem" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocBook WriterOptions
opts (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 = forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"imagedata" forall a b. (a -> b) -> a -> b
$
(Text
"fileref", Text
src) forall a. a -> [a] -> [a]
: Attr -> [(Text, Text)]
idAndRole Attr
attr forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
dims
where
dims :: [(Text, Text)]
dims = forall {a}. Direction -> a -> [(a, Text)]
go Direction
Width Text
"width" forall a. Semigroup a => a -> a -> a
<> 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, 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
DocBookVersion
version <- forall r (m :: * -> *). MonadReader r m => m r
ask
let bs :: [Block]
bs = if 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 forall a. Ord a => a -> a -> Bool
>= Int
1 Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= Int
5 -> if DocBookVersion
version forall a. Eq a => a -> a -> Bool
== DocBookVersion
DocBook5
then Text
"section"
else Text
"sect" forall a. Semigroup a => a -> a -> a
<> 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 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 forall a. Eq a => a -> a -> Bool
== DocBookVersion
DocBook5 Bool -> Bool -> Bool
&& Int
lvl forall a. Eq a => a -> a -> Bool
== WriterOptions -> Int
getStartLvl WriterOptions
opts Bool -> Bool -> 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)]
miscAttr = [(Text, Text)] -> [Text] -> [(Text, Text)]
enrichRole (forall a. (a -> Bool) -> [a] -> [a]
filter (DocBookVersion -> (Text, Text) -> Bool
isSectionAttr DocBookVersion
version) [(Text, Text)]
attrs) [Text]
classes
attribs :: [(Text, Text)]
attribs = [(Text, Text)]
nsAttr forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
idAttr forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
miscAttr
Doc Text
title' <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
ils
Doc Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocBook WriterOptions
opts [Block]
bs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
tag [(Text, Text)]
attribs forall a b. (a -> b) -> a -> b
$ forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"title" Doc Text
title' 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 <- 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
"caution",Text
"danger",Text
"important",Text
"note",Text
"tip",Text
"warning"]
case [Text]
classes of
(Text
l:[Text]
_) | Text
l 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) -> (forall a. a -> Maybe a
Just (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) -> (forall a. a -> Maybe a
Just (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocBook WriterOptions
opts [Block]
ts), [Block]
rest)
[Block]
_ -> (forall a. Maybe a
Nothing, [Block]
bs)
Doc Text
admonitionTitle <- case Maybe (DB m (Doc Text))
mTitleBs of
Maybe (DB m (Doc Text))
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
Just DB m (Doc Text)
titleBs -> forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"title" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DB m (Doc Text)
titleBs
Doc Text
admonitionBody <- forall {m :: * -> *}.
PandocMonad m =>
[(Text, Text)] -> [Block] -> ReaderT DocBookVersion m (Doc Text)
handleDivBody [] [Block]
bodyBs
forall (m :: * -> *) a. Monad m => a -> m a
return (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 forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
admonitionBody))
[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 forall a. Doc a -> Doc a
flush forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => Doc a -> Doc a
nowrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"literallayout" [(Text, Text)]
identAttribs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
lst
else forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"para" [(Text, Text)]
identAttribs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocBook WriterOptions
opts (forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
plainToPara [Block]
bodyBs)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
(if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, Text)]
identAttribs
then forall a. Monoid a => a
mempty
else forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"anchor" [(Text, Text)]
identAttribs) forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents
blockToDocBook WriterOptions
_ h :: Block
h@Header{} = do
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
h
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
blockToDocBook WriterOptions
opts (Plain [Inline]
lst) = 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 = forall a. Doc a -> Doc a
flush forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => Doc a -> Doc a
nowrap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"literallayout"
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
lst
| Bool
otherwise = forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"para" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
lst
blockToDocBook WriterOptions
opts (LineBlock [[Inline]]
lns) =
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> DB m (Doc Text)
blockToDocBook WriterOptions
opts forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Block
linesToPara [[Inline]]
lns
blockToDocBook WriterOptions
opts (BlockQuote [Block]
blocks) =
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"blockquote" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
forall a. HasChars a => a -> Doc a
literal (Text
"<programlisting" forall a. Semigroup a => a -> a -> a
<> Text
lang forall a. Semigroup a => a -> a -> a
<> Text
">") forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<>
forall a. Doc a -> Doc a
flush (forall a. HasChars a => a -> Doc a
literal (Text -> Text
escapeStringForXML Text
str) forall a. Semigroup a => a -> a -> a
<> forall a. Doc a
cr forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => a -> Doc a
literal Text
"</programlisting>")
where lang :: Text
lang = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
langs
then Text
""
else Text
" language=\"" forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeStringForXML (forall a. [a] -> a
head [Text]
langs) 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` 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) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower forall a b. (a -> b) -> a -> b
$ Text
s
langs :: [Text]
langs = 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]
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"itemizedlist" [(Text, Text)]
attribs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> DB m (Doc Text)
listItemsToDocBook WriterOptions
opts [[Block]]
lst
blockToDocBook WriterOptions
_ (OrderedList ListAttributes
_ []) = forall (m :: * -> *) a. Monad m => a -> m a
return 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]
firstforall a. a -> [a] -> [a]
:[[Block]]
rest)]
attribs :: [(Text, Text)]
attribs = [(Text, Text)]
numeration forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
spacing
Doc Text
items <- if Int
start forall a. Eq a => a -> a -> Bool
== Int
1
then forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> DB m (Doc Text)
listItemsToDocBook WriterOptions
opts ([Block]
firstforall a. a -> [a] -> [a]
:[[Block]]
rest)
else do
Doc Text
first' <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocBook WriterOptions
opts (forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
plainToPara [Block]
first)
Doc Text
rest' <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> DB m (Doc Text)
listItemsToDocBook WriterOptions
opts [[Block]]
rest
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"listitem" [(Text
"override",forall a. Show a => a -> Text
tshow Int
start)] Doc Text
first' forall a. Doc a -> Doc a -> Doc a
$$
Doc Text
rest'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd [([Inline], [[Block]])]
lst]
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"variablelist" [(Text, Text)]
attribs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall a. Eq a => a -> a -> Bool
== Format
"docbook" = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
str
| Format
f forall a. Eq a => a -> a -> Bool
== Format
"html" = do
DocBookVersion
version <- forall r (m :: * -> *). MonadReader r m => m r
ask
if DocBookVersion
version forall a. Eq a => a -> a -> Bool
== DocBookVersion
DocBook5
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
str
| Bool
otherwise = do
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
b
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
blockToDocBook WriterOptions
_ Block
HorizontalRule = forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
caption
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
else forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"title" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
caption
let tableType :: Text
tableType = if forall a. Doc a -> Bool
isEmpty Doc Text
captionDoc then Text
"informaltable" else Text
"table"
percent :: a -> Text
percent a
w = forall a. Show a => a -> Text
tshow (forall a b. (RealFrac a, Integral b) => a -> b
truncate (a
100forall a. Num a => a -> a -> a
*a
w) :: Integer) forall a. Semigroup a => a -> a -> a
<> Text
"*"
coltags :: Doc Text
coltags = forall a. [Doc a] -> Doc a
vcat forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Double
w Alignment
al -> forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"colspec"
([(Text
"colwidth", forall {a}. RealFrac a => a -> Text
percent Double
w) | Double
w forall a. Ord a => a -> a -> Bool
> Double
0] forall a. Semigroup a => a -> a -> a
<>
[(Text
"align", Alignment -> Text
alignmentToString Alignment
al)])) [Double]
widths [Alignment]
aligns
Doc Text
head' <- if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
else forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"thead" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> DB m (Doc Text)
tableRowToDocBook WriterOptions
opts [[Block]]
headers
Doc Text
body' <- forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"tbody" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Doc a] -> Doc a
vcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> DB m (Doc Text)
tableRowToDocBook WriterOptions
opts) [[[Block]]]
rows
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
tableType forall a b. (a -> b) -> a -> b
$ Doc Text
captionDoc forall a. Doc a -> Doc a -> Doc a
$$
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"tgroup" [(Text
"cols", forall a. Show a => a -> Text
tshow (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Alignment]
aligns))] (
Doc Text
coltags forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
head' forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. All -> Bool
getAll forall a b. (a -> b) -> a -> b
$ forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Block -> All
isAcceptable [Block]
body
then forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> DB m (Doc Text)
blockToDocBook WriterOptions
opts forall a b. (a -> b) -> a -> b
$ Attr -> Caption -> [Block] -> Block
figureDiv Attr
attr Caption
capt [Block]
body
else do
Doc Text
title <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts ([Block] -> [Inline]
blocksToInlines [Block]
caption)
let toMediaobject :: Block -> DB m (Doc Text)
toMediaobject = \case
Plain [Image Attr
imgAttr [Inline]
inlns (Text
src, Text
_)] -> do
Doc Text
alt <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
inlns
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"mediaobject" (
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"imageobject"
(WriterOptions -> Attr -> Text -> Doc Text
imageToDocBook WriterOptions
opts Attr
imgAttr Text
src) forall a. Doc a -> Doc a -> Doc a
$$
if forall a. Doc a -> Bool
isEmpty Doc Text
alt
then forall a. Doc a
empty
else forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"textobject" (forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"phrase" Doc Text
alt))
Block
_ -> forall r (m :: * -> *). MonadReader r m => m r
ask forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
DocBookVersion
DocBook4 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
DocBookVersion
DocBook5 -> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> DB m (Doc Text)
blocksToDocBook WriterOptions
opts [Block]
body
[Doc Text]
mediaobjects <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Block -> DB m (Doc Text)
toMediaobject [Block]
body
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
if forall a. Doc a -> Bool
isEmpty forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Doc Text]
mediaobjects
then forall a. Monoid a => a
mempty
else forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"figure" forall a b. (a -> b) -> a -> b
$
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"title" Doc Text
title forall a. Doc a -> Doc a -> Doc a
$$
forall a. Monoid a => [a] -> a
mconcat [Doc Text]
mediaobjects
hasLineBreaks :: [Inline] -> Bool
hasLineBreaks :: [Inline] -> Bool
hasLineBreaks = Any -> Bool
getAny forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query Inline -> Any
isLineBreak forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"row" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Doc a] -> Doc a
vcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (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 =
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"entry" [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Doc a] -> Doc a
vcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (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 = forall a. [Doc a] -> Doc a
hcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (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) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
str
inlineToDocBook WriterOptions
opts (Emph [Inline]
lst) =
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"emphasis" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
lst
inlineToDocBook WriterOptions
opts (Underline [Inline]
lst) =
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"emphasis" [(Text
"role", Text
"underline")] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
lst
inlineToDocBook WriterOptions
opts (Strong [Inline]
lst) =
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"emphasis" [(Text
"role", Text
"strong")] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
lst
inlineToDocBook WriterOptions
opts (Strikeout [Inline]
lst) =
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"emphasis" [(Text
"role", Text
"strikethrough")] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
lst
inlineToDocBook WriterOptions
opts (Superscript [Inline]
lst) =
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"superscript" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
lst
inlineToDocBook WriterOptions
opts (Subscript [Inline]
lst) =
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"subscript" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
lst
inlineToDocBook WriterOptions
opts (SmallCaps [Inline]
lst) =
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"emphasis" [(Text
"role", Text
"smallcaps")] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
lst
inlineToDocBook WriterOptions
opts (Quoted QuoteType
_ [Inline]
lst) =
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"quote" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
lst
inlineToDocBook WriterOptions
opts (Cite [Citation]
_ [Inline]
lst) =
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 <- forall r (m :: * -> *). MonadReader r m => m r
ask
((if Text -> Bool
T.null Text
ident
then forall a. Monoid a => a
mempty
else forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"anchor" [(DocBookVersion -> Text
idName DocBookVersion
version, Text
ident)]) forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
ils
inlineToDocBook WriterOptions
_ (Code Attr
_ Text
str) =
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"literal" forall a b. (a -> b) -> a -> b
$ 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 <- 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
tagtype
forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ ConfigPP -> Element -> String
Xml.ppcElement ConfigPP
conf
forall a b. (a -> b) -> a -> b
$ Element -> Element
fixNS
forall a b. (a -> b) -> a -> b
$ Element -> Element
removeAttr Element
r
Left Inline
il -> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> DB m (Doc Text)
inlineToDocBook WriterOptions
opts Inline
il
| Bool
otherwise =
forall (m :: * -> *).
PandocMonad m =>
MathType -> Text -> m [Inline]
texMathToInlines MathType
t Text
str forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 (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 = 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 (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 forall a. Eq a => a -> a -> Bool
== Format
"html" Bool -> Bool -> Bool
|| Format
f forall a. Eq a => a -> a -> Bool
== Format
"docbook" = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
x
| Bool
otherwise = do
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
il
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
empty
inlineToDocBook WriterOptions
_ Inline
LineBreak = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal Text
"\n"
inlineToDocBook WriterOptions
_ Inline
Space = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Doc a
space
inlineToDocBook WriterOptions
_ Inline
SoftBreak = forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"email" forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal 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 forall a. Eq a => a -> a -> Bool
== Text
email -> forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
emailLink
[Inline]
_ -> do Doc Text
contents <- forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
txt
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc Text
contents forall a. Doc a -> Doc a -> Doc a
<+>
forall a. HasChars a => Char -> Doc a
char Char
'(' forall a. Semigroup a => a -> a -> a
<> Doc Text
emailLink forall a. Semigroup a => a -> a -> a
<> forall a. HasChars a => Char -> Doc a
char Char
')'
| Bool
otherwise = do
DocBookVersion
version <- forall r (m :: * -> *). MonadReader r m => m r
ask
(if Text
"#" Text -> Text -> Bool
`T.isPrefixOf` Text
src
then let tag :: Text
tag = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
txt then Text
"xref" else Text
"link"
in forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
tag forall a b. (a -> b) -> a -> b
$
(Text
"linkend", WriterOptions -> Text
writerIdentifierPrefix WriterOptions
opts forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.drop Int
1 Text
src) forall a. a -> [a] -> [a]
:
Attr -> [(Text, Text)]
idAndRole Attr
attr
else if DocBookVersion
version forall a. Eq a => a -> a -> Bool
== DocBookVersion
DocBook5
then forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"link" forall a b. (a -> b) -> a -> b
$ (Text
"xlink:href", Text
src) forall a. a -> [a] -> [a]
: Attr -> [(Text, Text)]
idAndRole Attr
attr
else forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"ulink" forall a b. (a -> b) -> a -> b
$ (Text
"url", Text
src) forall a. a -> [a] -> [a]
: Attr -> [(Text, Text)]
idAndRole Attr
attr )
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> DB m (Doc Text)
inlinesToDocBook WriterOptions
opts [Inline]
txt
inlineToDocBook WriterOptions
opts (Image Attr
attr [Inline]
ils (Text
src, Text
tit)) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
let titleDoc :: Doc Text
titleDoc = if Text -> Bool
T.null Text
tit
then forall a. Doc a
empty
else forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"objectinfo" forall a b. (a -> b) -> a -> b
$
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"title" (forall a. HasChars a => a -> Doc a
literal forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
tit)
alt :: Doc Text
alt = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
ils
then forall a. Monoid a => a
mempty
else forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"textobject" forall a b. (a -> b) -> a -> b
$
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"phrase" forall a b. (a -> b) -> a -> b
$ forall a. HasChars a => a -> Doc a
literal (forall a. Walkable Inline a => a -> Text
stringify [Inline]
ils)
in forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"inlinemediaobject" forall a b. (a -> b) -> a -> b
$
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"imageobject"
(Doc Text
titleDoc forall a. Doc a -> Doc a -> Doc a
$$ WriterOptions -> Attr -> Text -> Doc Text
imageToDocBook WriterOptions
opts Attr
attr Text
src)
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
alt
inlineToDocBook WriterOptions
opts (Note [Block]
contents) =
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"footnote" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 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 (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 forall a. Eq a => a -> a -> Bool
/= []] forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
nonRole
where
([(Text, Text)]
roleAttr, [(Text, Text)]
nonRole) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\(Text
key, Text
_v) -> Text
key forall a. Eq a => a -> a -> Bool
== Text
"role") [(Text, Text)]
mattrs
roles :: [Text]
roles = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
cand) [Text]
cls forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map 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