{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
module Text.Pandoc.Writers.TEI (writeTEI) where
import Data.Text (Text)
import qualified Data.Text as T
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.XML
writeTEI :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeTEI :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeTEI 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 = case WriterOptions -> TopLevelDivision
writerTopLevelDivision WriterOptions
opts of
TopLevelDivision
TopLevelPart -> -Int
1
TopLevelDivision
TopLevelChapter -> Int
0
TopLevelDivision
TopLevelSection -> Int
1
TopLevelDivision
TopLevelDefault -> Int
1
let fromBlocks :: [Block] -> m (Doc Text)
fromBlocks = WriterOptions -> [Block] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> m (Doc Text)
blocksToTEI WriterOptions
opts ([Block] -> m (Doc Text))
-> ([Block] -> [Block]) -> [Block] -> 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)
Context Text
metadata <- WriterOptions
-> ([Block] -> m (Doc Text))
-> ([Inline] -> m (Doc Text))
-> Meta
-> m (Context Text)
forall (m :: * -> *) a.
(Monad m, TemplateTarget a) =>
WriterOptions
-> ([Block] -> m (Doc a))
-> ([Inline] -> m (Doc a))
-> Meta
-> m (Context a)
metaToContext WriterOptions
opts
[Block] -> m (Doc Text)
fromBlocks
((Doc Text -> Doc Text) -> m (Doc Text) -> m (Doc Text)
forall a b. (a -> b) -> m a -> 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
chomp (m (Doc Text) -> m (Doc Text))
-> ([Inline] -> m (Doc Text)) -> [Inline] -> m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions -> [Inline] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> m (Doc Text)
inlinesToTEI WriterOptions
opts)
Meta
meta
Doc Text
main <- [Block] -> m (Doc Text)
fromBlocks [Block]
blocks
let context :: Context Text
context = Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"body" Doc Text
main
(Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Bool -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"mathml" (case WriterOptions -> HTMLMathMethod
writerHTMLMathMethod WriterOptions
opts of
HTMLMathMethod
MathML -> Bool
True
HTMLMathMethod
_ -> Bool
False) Context Text
metadata
Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth (Doc Text -> Text) -> Doc Text -> Text
forall a b. (a -> b) -> a -> b
$
case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
Maybe (Template Text)
Nothing -> Doc Text
main
Just Template Text
tpl -> Template Text -> Context Text -> Doc Text
forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl Context Text
context
blocksToTEI :: PandocMonad m => WriterOptions -> [Block] -> m (Doc Text)
blocksToTEI :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> m (Doc Text)
blocksToTEI WriterOptions
opts [Block]
bs = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text) -> m [Doc Text] -> m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> m (Doc Text)) -> [Block] -> 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 -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> m (Doc Text)
blockToTEI WriterOptions
opts) [Block]
bs
plainToPara :: Block -> Block
plainToPara :: Block -> Block
plainToPara (Plain [Inline]
x) = [Inline] -> Block
Para [Inline]
x
plainToPara Block
x = Block
x
deflistItemsToTEI :: PandocMonad m
=> WriterOptions -> [([Inline],[[Block]])] -> m (Doc Text)
deflistItemsToTEI :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [([Inline], [[Block]])] -> m (Doc Text)
deflistItemsToTEI WriterOptions
opts [([Inline], [[Block]])]
items =
[Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text) -> m [Doc Text] -> m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([Inline], [[Block]]) -> m (Doc Text))
-> [([Inline], [[Block]])] -> 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]] -> m (Doc Text))
-> ([Inline], [[Block]]) -> m (Doc Text)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (WriterOptions -> [Inline] -> [[Block]] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> [[Block]] -> m (Doc Text)
deflistItemToTEI WriterOptions
opts)) [([Inline], [[Block]])]
items
deflistItemToTEI :: PandocMonad m
=> WriterOptions -> [Inline] -> [[Block]] -> m (Doc Text)
deflistItemToTEI :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> [[Block]] -> m (Doc Text)
deflistItemToTEI WriterOptions
opts [Inline]
term [[Block]]
defs = do
Doc Text
term' <- WriterOptions -> [Inline] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> m (Doc Text)
inlinesToTEI WriterOptions
opts [Inline]
term
Doc Text
defs' <- WriterOptions -> [Block] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> m (Doc Text)
blocksToTEI WriterOptions
opts ([Block] -> m (Doc Text)) -> [Block] -> m (Doc Text)
forall a b. (a -> b) -> a -> b
$ ([Block] -> [Block]) -> [[Block]] -> [Block]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Block -> Block) -> [Block] -> [Block]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
plainToPara) [[Block]]
defs
Doc Text -> m (Doc Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> m (Doc Text)) -> Doc Text -> m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"label" Doc Text
term' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"item" Doc Text
defs'
listItemsToTEI :: PandocMonad m => WriterOptions -> [[Block]] -> m (Doc Text)
listItemsToTEI :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> m (Doc Text)
listItemsToTEI WriterOptions
opts [[Block]]
items = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text) -> m [Doc Text] -> m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Block] -> m (Doc Text)) -> [[Block]] -> 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] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> m (Doc Text)
listItemToTEI WriterOptions
opts) [[Block]]
items
listItemToTEI :: PandocMonad m => WriterOptions -> [Block] -> m (Doc Text)
listItemToTEI :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> m (Doc Text)
listItemToTEI WriterOptions
opts [Block]
item =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"item" (Doc Text -> Doc Text) -> m (Doc Text) -> m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Block] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> m (Doc Text)
blocksToTEI WriterOptions
opts ((Block -> Block) -> [Block] -> [Block]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
plainToPara [Block]
item)
imageToTEI :: PandocMonad m => WriterOptions -> Attr -> Text -> m (Doc Text)
imageToTEI :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Text -> m (Doc Text)
imageToTEI WriterOptions
opts Attr
attr Text
src = Doc Text -> m (Doc Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> m (Doc Text)) -> Doc Text -> m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"graphic" ([(Text, Text)] -> Doc Text) -> [(Text, Text)] -> Doc Text
forall a b. (a -> b) -> a -> b
$
(Text
"url", Text
src) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: WriterOptions -> Attr -> [(Text, Text)]
idFromAttr WriterOptions
opts Attr
attr [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall 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. [a] -> [a] -> [a]
++ Direction -> Text -> [(Text, Text)]
forall {a}. Direction -> a -> [(a, Text)]
go Direction
Height Text
"height"
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 -> []
blockToTEI :: PandocMonad m => WriterOptions -> Block -> m (Doc Text)
blockToTEI :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> m (Doc Text)
blockToTEI WriterOptions
opts (Div attr :: Attr
attr@(Text
_,Text
"section":[Text]
_,[(Text, Text)]
_) (Header Int
lvl Attr
_ [Inline]
ils : [Block]
xs)) =
do
let xs' :: [Block]
xs' = 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
divType :: Text
divType = case Int
lvl of
Int
n | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1 -> Text
"part"
| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Text
"chapter"
| 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 -> Text
"level" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
n
| Bool
otherwise -> Text
"section"
Doc Text
titleContents <- WriterOptions -> [Inline] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> m (Doc Text)
inlinesToTEI WriterOptions
opts [Inline]
ils
Doc Text
contents <- WriterOptions -> [Block] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> m (Doc Text)
blocksToTEI WriterOptions
opts [Block]
xs'
Doc Text -> m (Doc Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> m (Doc Text)) -> Doc Text -> m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"div" ((Text
"type", Text
divType) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: WriterOptions -> Attr -> [(Text, Text)]
idFromAttr WriterOptions
opts Attr
attr) (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
"head" Doc Text
titleContents Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents
blockToTEI WriterOptions
opts (Div Attr
attr [Para [Inline]
lst]) = do
let attribs :: [(Text, Text)]
attribs = WriterOptions -> Attr -> [(Text, Text)]
idFromAttr WriterOptions
opts Attr
attr
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
"p" [(Text, Text)]
attribs (Doc Text -> Doc Text) -> m (Doc Text) -> m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> m (Doc Text)
inlinesToTEI WriterOptions
opts [Inline]
lst
blockToTEI WriterOptions
opts (Div Attr
_ [Block]
bs) = WriterOptions -> [Block] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> m (Doc Text)
blocksToTEI WriterOptions
opts ([Block] -> m (Doc Text)) -> [Block] -> m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (Block -> Block) -> [Block] -> [Block]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
plainToPara [Block]
bs
blockToTEI WriterOptions
_ h :: Block
h@Header{} = do
LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
h
Doc Text -> m (Doc Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToTEI WriterOptions
opts (Plain [Inline]
lst) = WriterOptions -> Block -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> m (Doc Text)
blockToTEI WriterOptions
opts (Block -> m (Doc Text)) -> Block -> m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Inline] -> Block
Para [Inline]
lst
blockToTEI WriterOptions
opts (Para [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
"p" [] (Doc Text -> Doc Text) -> m (Doc Text) -> m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> m (Doc Text)
inlinesToTEI WriterOptions
opts [Inline]
lst
blockToTEI WriterOptions
opts (LineBlock [[Inline]]
lns) =
WriterOptions -> Block -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> m (Doc Text)
blockToTEI WriterOptions
opts (Block -> m (Doc Text)) -> Block -> m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Block
linesToPara [[Inline]]
lns
blockToTEI WriterOptions
opts (BlockQuote [Block]
blocks) =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"quote" (Doc Text -> Doc Text) -> m (Doc Text) -> m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Block] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> m (Doc Text)
blocksToTEI WriterOptions
opts [Block]
blocks
blockToTEI WriterOptions
opts (CodeBlock (Text
_,[Text]
classes,[(Text, Text)]
_) Text
str) =
Doc Text -> m (Doc Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> m (Doc Text)) -> Doc Text -> m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text
"<ab type='codeblock " 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
<> String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"</ab>")
where lang :: Text
lang = if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
langs
then Text
""
else Text -> Text
escapeStringForXML ([Text] -> Text
forall a. HasCallStack => [a] -> a
head [Text]
langs)
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
blockToTEI WriterOptions
opts (BulletList [[Block]]
lst) = do
let attribs :: [(Text, Text)]
attribs = [(Text
"type", Text
"unordered")]
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
"list" [(Text, Text)]
attribs (Doc Text -> Doc Text) -> m (Doc Text) -> m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [[Block]] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> m (Doc Text)
listItemsToTEI WriterOptions
opts [[Block]]
lst
blockToTEI WriterOptions
_ (OrderedList ListAttributes
_ []) = Doc Text -> m (Doc Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToTEI WriterOptions
opts (OrderedList (Int
start, ListNumberStyle
numstyle, ListNumberDelim
_) ([Block]
first:[[Block]]
rest)) = do
let attribs :: [(Text, Text)]
attribs = case ListNumberStyle
numstyle of
ListNumberStyle
DefaultStyle -> []
ListNumberStyle
Decimal -> [(Text
"type", Text
"ordered:arabic")]
ListNumberStyle
Example -> [(Text
"type", Text
"ordered:arabic")]
ListNumberStyle
UpperAlpha -> [(Text
"type", Text
"ordered:upperalpha")]
ListNumberStyle
LowerAlpha -> [(Text
"type", Text
"ordered:loweralpha")]
ListNumberStyle
UpperRoman -> [(Text
"type", Text
"ordered:upperroman")]
ListNumberStyle
LowerRoman -> [(Text
"type", Text
"ordered:lowerroman")]
Doc Text
items <- if Int
start Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
then WriterOptions -> [[Block]] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> m (Doc Text)
listItemsToTEI WriterOptions
opts ([Block]
first[Block] -> [[Block]] -> [[Block]]
forall a. a -> [a] -> [a]
:[[Block]]
rest)
else do
Doc Text
fi <- WriterOptions -> [Block] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> m (Doc Text)
blocksToTEI WriterOptions
opts ([Block] -> m (Doc Text)) -> [Block] -> m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (Block -> Block) -> [Block] -> [Block]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
plainToPara [Block]
first
Doc Text
re <- WriterOptions -> [[Block]] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> m (Doc Text)
listItemsToTEI WriterOptions
opts [[Block]]
rest
Doc Text -> m (Doc Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> m (Doc Text)) -> Doc Text -> m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"item" [(Text
"n",Int -> Text
forall a. Show a => a -> Text
tshow Int
start)] Doc Text
fi Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
re
Doc Text -> m (Doc Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> m (Doc Text)) -> Doc Text -> m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"list" [(Text, Text)]
attribs Doc Text
items
blockToTEI WriterOptions
opts (DefinitionList [([Inline], [[Block]])]
lst) = do
let attribs :: [(Text, Text)]
attribs = [(Text
"type", Text
"definition")]
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
"list" [(Text, Text)]
attribs (Doc Text -> Doc Text) -> m (Doc Text) -> m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [([Inline], [[Block]])] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [([Inline], [[Block]])] -> m (Doc Text)
deflistItemsToTEI WriterOptions
opts [([Inline], [[Block]])]
lst
blockToTEI WriterOptions
_ b :: Block
b@(RawBlock Format
f Text
str)
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
"tei" = Doc Text -> m (Doc Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> m (Doc Text)) -> Doc Text -> m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str
| Bool
otherwise = do
LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> m ()) -> LogMessage -> m ()
forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
b
Doc Text -> m (Doc Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToTEI WriterOptions
_ Block
HorizontalRule = Doc Text -> m (Doc Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> m (Doc Text)) -> Doc Text -> m (Doc Text)
forall a b. (a -> b) -> a -> b
$
Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"milestone" [(Text
"unit",Text
"undefined")
,(Text
"type",Text
"separator")
,(Text
"rendition",Text
"line")]
blockToTEI WriterOptions
opts (Figure Attr
attr Caption
capt [Block]
bs) =
WriterOptions -> Block -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> m (Doc Text)
blockToTEI WriterOptions
opts (Attr -> Caption -> [Block] -> Block
figureDiv Attr
attr Caption
capt [Block]
bs)
blockToTEI WriterOptions
opts (Table Attr
_ Caption
blkCapt [ColSpec]
specs TableHead
thead [TableBody]
tbody TableFoot
tfoot) = do
let ([Inline]
_, [Alignment]
_, [Double]
_, [[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
headers' <- if [[Block]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers then Doc Text -> m (Doc Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
forall a. Monoid a => a
mempty else WriterOptions -> [[Block]] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> m (Doc Text)
tableHeadersToTEI WriterOptions
opts [[Block]]
headers
[Doc Text]
rows' <- ([[Block]] -> m (Doc Text)) -> [[[Block]]] -> 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]] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> m (Doc Text)
tableRowToTEI WriterOptions
opts) [[[Block]]]
rows
Doc Text -> m (Doc Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> m (Doc Text)) -> Doc Text -> m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"table" [] (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text
headers' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
rows'
tableRowToTEI :: PandocMonad m
=> WriterOptions
-> [[Block]]
-> m (Doc Text)
tableRowToTEI :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [[Block]] -> m (Doc Text)
tableRowToTEI 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) -> m [Doc Text] -> m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Block] -> m (Doc Text)) -> [[Block]] -> 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] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> m (Doc Text)
tableItemToTEI WriterOptions
opts) [[Block]]
cols
tableHeadersToTEI :: PandocMonad m
=> WriterOptions
-> [[Block]]
-> m (Doc Text)
WriterOptions
opts [[Block]]
cols =
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
"row" [(Text
"role",Text
"label")] (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) -> m [Doc Text] -> m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
([Block] -> m (Doc Text)) -> [[Block]] -> 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] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> m (Doc Text)
tableItemToTEI WriterOptions
opts) [[Block]]
cols
tableItemToTEI :: PandocMonad m
=> WriterOptions
-> [Block]
-> m (Doc Text)
tableItemToTEI :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> m (Doc Text)
tableItemToTEI 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
False Text
"cell" [] (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) -> m [Doc Text] -> m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> m (Doc Text)) -> [Block] -> 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 -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> m (Doc Text)
blockToTEI WriterOptions
opts) [Block]
item
inlinesToTEI :: PandocMonad m => WriterOptions -> [Inline] -> m (Doc Text)
inlinesToTEI :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> m (Doc Text)
inlinesToTEI WriterOptions
opts [Inline]
lst = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat ([Doc Text] -> Doc Text) -> m [Doc Text] -> m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> m (Doc Text)) -> [Inline] -> 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 -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> m (Doc Text)
inlineToTEI WriterOptions
opts) [Inline]
lst
inlineToTEI :: PandocMonad m => WriterOptions -> Inline -> m (Doc Text)
inlineToTEI :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> m (Doc Text)
inlineToTEI WriterOptions
_ (Str Text
str) = Doc Text -> m (Doc Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> m (Doc Text)) -> Doc Text -> 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
inlineToTEI WriterOptions
opts (Emph [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
"hi" [(Text
"rendition",Text
"simple:italic")] (Doc Text -> Doc Text) -> m (Doc Text) -> m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> m (Doc Text)
inlinesToTEI WriterOptions
opts [Inline]
lst
inlineToTEI 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
"hi" [(Text
"rendition",Text
"simple:underline")] (Doc Text -> Doc Text) -> m (Doc Text) -> m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> m (Doc Text)
inlinesToTEI WriterOptions
opts [Inline]
lst
inlineToTEI 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
"hi" [(Text
"rendition", Text
"simple:bold")] (Doc Text -> Doc Text) -> m (Doc Text) -> m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> m (Doc Text)
inlinesToTEI WriterOptions
opts [Inline]
lst
inlineToTEI 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
"hi" [(Text
"rendition", Text
"simple:strikethrough")] (Doc Text -> Doc Text) -> m (Doc Text) -> m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
WriterOptions -> [Inline] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> m (Doc Text)
inlinesToTEI WriterOptions
opts [Inline]
lst
inlineToTEI WriterOptions
opts (Superscript [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
"hi" [(Text
"rendition", Text
"simple:superscript")] (Doc Text -> Doc Text) -> m (Doc Text) -> m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
WriterOptions -> [Inline] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> m (Doc Text)
inlinesToTEI WriterOptions
opts [Inline]
lst
inlineToTEI WriterOptions
opts (Subscript [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
"hi" [(Text
"rendition", Text
"simple:subscript")] (Doc Text -> Doc Text) -> m (Doc Text) -> m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
WriterOptions -> [Inline] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> m (Doc Text)
inlinesToTEI WriterOptions
opts [Inline]
lst
inlineToTEI 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
"hi" [(Text
"rendition", Text
"simple:smallcaps")] (Doc Text -> Doc Text) -> m (Doc Text) -> m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
WriterOptions -> [Inline] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> m (Doc Text)
inlinesToTEI WriterOptions
opts [Inline]
lst
inlineToTEI 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) -> m (Doc Text) -> m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> m (Doc Text)
inlinesToTEI WriterOptions
opts [Inline]
lst
inlineToTEI WriterOptions
opts (Cite [Citation]
_ [Inline]
lst) =
WriterOptions -> [Inline] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> m (Doc Text)
inlinesToTEI WriterOptions
opts [Inline]
lst
inlineToTEI WriterOptions
opts (Span Attr
_ [Inline]
ils) =
WriterOptions -> [Inline] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> m (Doc Text)
inlinesToTEI WriterOptions
opts [Inline]
ils
inlineToTEI WriterOptions
_ (Code Attr
_ Text
str) = Doc Text -> m (Doc Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> m (Doc Text)) -> Doc Text -> m (Doc Text)
forall a b. (a -> b) -> a -> b
$
Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"seg" [(Text
"type",Text
"code")] (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)
inlineToTEI WriterOptions
_ (Math MathType
t Text
str) = Doc Text -> m (Doc Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> m (Doc Text)) -> Doc Text -> m (Doc Text)
forall a b. (a -> b) -> a -> b
$
case MathType
t of
MathType
InlineMath -> 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
"formula" [(Text
"notation",Text
"TeX")] (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
str
MathType
DisplayMath -> 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
"figure" [(Text
"type",Text
"math")] (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"formula" [(Text
"notation",Text
"TeX")] (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
str
inlineToTEI WriterOptions
_ il :: Inline
il@(RawInline Format
f Text
x) | Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
"tei" = Doc Text -> m (Doc Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> m (Doc Text)) -> Doc Text -> 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 = Doc Text
forall a. Doc a
empty Doc Text -> m () -> m (Doc Text)
forall a b. a -> m b -> m a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
LogMessage -> m ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (Inline -> LogMessage
InlineNotRendered Inline
il)
inlineToTEI WriterOptions
_ Inline
LineBreak = Doc Text -> m (Doc Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> m (Doc Text)) -> Doc Text -> m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"lb" []
inlineToTEI WriterOptions
_ Inline
Space =
Doc Text -> m (Doc Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
inlineToTEI WriterOptions
_ Inline
SoftBreak =
Doc Text -> m (Doc Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
inlineToTEI WriterOptions
opts (Link Attr
attr [Inline]
txt (Text
src, Text
_))
| Just Text
email <- Text -> Text -> Maybe Text
T.stripPrefix Text
"mailto:" Text
src = do
let emailLink :: Doc Text
emailLink = 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
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 -> m (Doc Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
emailLink
[Inline]
_ -> do
Doc Text
linktext <- WriterOptions -> [Inline] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> m (Doc Text)
inlinesToTEI WriterOptions
opts [Inline]
txt
Doc Text -> m (Doc Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> m (Doc Text)) -> Doc Text -> m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Doc Text
linktext Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
<+> Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char Char
'(' Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
emailLink Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Char -> Doc Text
forall a. HasChars a => Char -> Doc a
char Char
')'
| Bool
otherwise =
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
"ref" ((Text
"target", Text
src) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: WriterOptions -> Attr -> [(Text, Text)]
idFromAttr WriterOptions
opts Attr
attr)
(Doc Text -> Doc Text) -> m (Doc Text) -> m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> m (Doc Text)
inlinesToTEI WriterOptions
opts [Inline]
txt
inlineToTEI WriterOptions
opts (Image Attr
attr [Inline]
description (Text
src, Text
tit)) = do
let titleDoc :: Doc Text
titleDoc = if Text -> Bool
T.null Text
tit
then Doc Text
forall a. Doc a
empty
else Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"figDesc" []
(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)
Doc Text
imageDesc <- if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
description
then Doc Text -> m (Doc Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
else Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False Text
"head" []
(Doc Text -> Doc Text) -> m (Doc Text) -> m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> m (Doc Text)
inlinesToTEI WriterOptions
opts [Inline]
description
Doc Text
img <- WriterOptions -> Attr -> Text -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Attr -> Text -> m (Doc Text)
imageToTEI WriterOptions
opts Attr
attr Text
src
Doc Text -> m (Doc Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> m (Doc Text)) -> Doc Text -> m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"figure" (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text
imageDesc Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
img Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
titleDoc
inlineToTEI WriterOptions
opts (Note [Block]
contents) =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"note" (Doc Text -> Doc Text) -> m (Doc Text) -> m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Block] -> m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> m (Doc Text)
blocksToTEI WriterOptions
opts [Block]
contents
idFromAttr :: WriterOptions -> Attr -> [(Text, Text)]
idFromAttr :: WriterOptions -> Attr -> [(Text, Text)]
idFromAttr WriterOptions
opts (Text
id',[Text]
_,[(Text, Text)]
_) =
[(Text
"xml:id", 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')]