{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}
module Text.Pandoc.Writers.JATS
( writeJATS
, writeJatsArchiving
, writeJatsPublishing
, writeJatsArticleAuthoring
) where
import Control.Applicative ((<|>))
import Control.Monad
import Control.Monad.Reader
import Control.Monad.State
import Data.Generics (everywhere, mkT)
import Data.List (partition)
import qualified Data.Map as M
import Data.Maybe (fromMaybe, listToMaybe)
import Data.Time (toGregorian, Day, parseTimeM, defaultTimeLocale, formatTime)
import qualified Data.Text as T
import Data.Text (Text)
import Text.Pandoc.Citeproc (getReferences)
import Text.Pandoc.Class.PandocMonad (PandocMonad, report)
import Text.Pandoc.Definition
import Text.Pandoc.Highlighting (languages, languagesByExtension)
import Text.Pandoc.Logging
import Text.Pandoc.MIME (getMimeType)
import Text.Pandoc.Walk (walk)
import Text.Pandoc.Options
import Text.DocLayout
import Text.Pandoc.Shared
import Text.Pandoc.URI
import Text.Pandoc.Templates (renderTemplate)
import Text.DocTemplates (Context(..), Val(..))
import Text.Pandoc.Writers.JATS.References (referencesToJATS)
import Text.Pandoc.Writers.JATS.Table (tableToJATS)
import Text.Pandoc.Writers.JATS.Types
import Text.Pandoc.Writers.Math
import Text.Pandoc.Writers.Shared
import Text.Pandoc.XML
import Text.TeXMath
import qualified Text.Pandoc.Writers.AnnotatedTable as Ann
import qualified Text.XML.Light as Xml
writeJatsArchiving :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeJatsArchiving :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeJatsArchiving = JATSTagSet -> WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
JATSTagSet -> WriterOptions -> Pandoc -> m Text
writeJats JATSTagSet
TagSetArchiving
writeJatsPublishing :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeJatsPublishing :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeJatsPublishing = JATSTagSet -> WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
JATSTagSet -> WriterOptions -> Pandoc -> m Text
writeJats JATSTagSet
TagSetPublishing
writeJatsArticleAuthoring :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeJatsArticleAuthoring :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeJatsArticleAuthoring = JATSTagSet -> WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
JATSTagSet -> WriterOptions -> Pandoc -> m Text
writeJats JATSTagSet
TagSetArticleAuthoring
{-# DEPRECATED writeJATS "Use writeJatsArchiving instead" #-}
writeJATS :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeJATS :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeJATS = WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeJatsArchiving
writeJats :: PandocMonad m => JATSTagSet -> WriterOptions -> Pandoc -> m Text
writeJats :: forall (m :: * -> *).
PandocMonad m =>
JATSTagSet -> WriterOptions -> Pandoc -> m Text
writeJats JATSTagSet
tagSet WriterOptions
opts Pandoc
d = do
[Reference Inlines]
refs <- if Extension -> Extensions -> Bool
extensionEnabled Extension
Ext_element_citations (Extensions -> Bool) -> Extensions -> Bool
forall a b. (a -> b) -> a -> b
$ WriterOptions -> Extensions
writerExtensions WriterOptions
opts
then Maybe Locale -> Pandoc -> m [Reference Inlines]
forall (m :: * -> *).
PandocMonad m =>
Maybe Locale -> Pandoc -> m [Reference Inlines]
getReferences Maybe Locale
forall a. Maybe a
Nothing Pandoc
d
else [Reference Inlines] -> m [Reference Inlines]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
let environment :: JATSEnv m
environment = JATSEnv
{ jatsTagSet :: JATSTagSet
jatsTagSet = JATSTagSet
tagSet
, jatsInlinesWriter :: WriterOptions -> [Inline] -> JATS m (Doc Text)
jatsInlinesWriter = WriterOptions -> [Inline] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS
, jatsBlockWriter :: (Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
jatsBlockWriter = (Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
(Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
wrappedBlocksToJATS
, jatsReferences :: [Reference Inlines]
jatsReferences = [Reference Inlines]
refs
}
let initialState :: JATSState
initialState = JATSState { jatsNotes :: [(Int, Doc Text)]
jatsNotes = [] }
ReaderT (JATSEnv m) m Text -> JATSEnv m -> m Text
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (StateT JATSState (ReaderT (JATSEnv m) m) Text
-> JATSState -> ReaderT (JATSEnv m) m Text
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (WriterOptions
-> Pandoc -> StateT JATSState (ReaderT (JATSEnv m) m) Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> JATS m Text
docToJATS WriterOptions
opts Pandoc
d) JATSState
initialState)
JATSEnv m
environment
docToJATS :: PandocMonad m => WriterOptions -> Pandoc -> JATS m Text
docToJATS :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> JATS m Text
docToJATS WriterOptions
opts (Pandoc Meta
meta [Block]
blocks) = do
let isBackBlock :: Block -> Bool
isBackBlock (Div (Text
"refs",[Text]
_,[(Text, Text)]
_) [Block]
_) = Bool
True
isBackBlock Block
_ = Bool
False
let ([Block]
backblocks, [Block]
bodyblocks) = (Block -> Bool) -> [Block] -> ([Block], [Block])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Block -> Bool
isBackBlock [Block]
blocks
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] -> JATS m (Doc Text)
fromBlocks = WriterOptions -> [Block] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> JATS m (Doc Text)
blocksToJATS WriterOptions
opts ([Block] -> JATS m (Doc Text))
-> ([Block] -> [Block]) -> [Block] -> JATS 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)
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
Context Text
metadata <- WriterOptions
-> ([Block] -> JATS m (Doc Text))
-> ([Inline] -> JATS m (Doc Text))
-> Meta
-> StateT JATSState (ReaderT (JATSEnv m) 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] -> JATS m (Doc Text)
fromBlocks
((Doc Text -> Doc Text) -> JATS m (Doc Text) -> JATS m (Doc Text)
forall a b.
(a -> b)
-> StateT JATSState (ReaderT (JATSEnv m) m) a
-> StateT JATSState (ReaderT (JATSEnv m) 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 (JATS m (Doc Text) -> JATS m (Doc Text))
-> ([Inline] -> JATS m (Doc Text)) -> [Inline] -> JATS m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterOptions -> [Inline] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts)
Meta
meta
Doc Text
main <- [Block] -> JATS m (Doc Text)
fromBlocks [Block]
bodyblocks
[Doc Text]
notes <- (JATSState -> [Doc Text])
-> StateT JATSState (ReaderT (JATSEnv m) m) [Doc Text]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ([Doc Text] -> [Doc Text]
forall a. [a] -> [a]
reverse ([Doc Text] -> [Doc Text])
-> (JATSState -> [Doc Text]) -> JATSState -> [Doc Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Doc Text) -> Doc Text) -> [(Int, Doc Text)] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Doc Text) -> Doc Text
forall a b. (a, b) -> b
snd ([(Int, Doc Text)] -> [Doc Text])
-> (JATSState -> [(Int, Doc Text)]) -> JATSState -> [Doc Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JATSState -> [(Int, Doc Text)]
jatsNotes)
Doc Text
backs <- [Block] -> JATS m (Doc Text)
fromBlocks [Block]
backblocks
JATSTagSet
tagSet <- (JATSEnv m -> JATSTagSet)
-> StateT JATSState (ReaderT (JATSEnv m) m) JATSTagSet
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks JATSEnv m -> JATSTagSet
forall (m :: * -> *). JATSEnv m -> JATSTagSet
jatsTagSet
let fns :: Doc Text
fns = if [Doc Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc Text]
notes Bool -> Bool -> Bool
|| JATSTagSet
tagSet JATSTagSet -> JATSTagSet -> Bool
forall a. Eq a => a -> a -> Bool
== JATSTagSet
TagSetArticleAuthoring
then Doc Text
forall a. Monoid a => a
mempty
else Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"fn-group" (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat [Doc Text]
notes
let back :: Doc Text
back = Doc Text
backs Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
fns
let date :: Val Text
date =
case Text -> Context Text -> Maybe (Val Text)
forall a b. FromContext a b => Text -> Context a -> Maybe b
getField Text
"date" Context Text
metadata of
Maybe (Val Text)
Nothing -> Val Text
forall a. Val a
NullVal
Just (SimpleVal (Doc Text
x :: Doc Text)) ->
case Text -> Maybe Day
parseDate (Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
forall a. Maybe a
Nothing Doc Text
x) of
Maybe Day
Nothing -> Val Text
forall a. Val a
NullVal
Just Day
day ->
let (Year
y,Int
m,Int
d) = Day -> (Year, Int, Int)
toGregorian Day
day
in Context Text -> Val Text
forall a. Context a -> Val a
MapVal (Context Text -> Val Text)
-> (Map Text (Val Text) -> Context Text)
-> Map Text (Val Text)
-> Val Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text (Val Text) -> Context Text
forall a. Map Text (Val a) -> Context a
Context (Map Text (Val Text) -> Val Text)
-> Map Text (Val Text) -> Val Text
forall a b. (a -> b) -> a -> b
$ [(Text, Val Text)] -> Map Text (Val Text)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[(Text
"year" :: Text, Doc Text -> Val Text
forall a. Doc a -> Val a
SimpleVal (Doc Text -> Val Text) -> Doc Text -> Val Text
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String -> Doc Text) -> String -> Doc Text
forall a b. (a -> b) -> a -> b
$ Year -> String
forall a. Show a => a -> String
show Year
y)
,(Text
"month", Doc Text -> Val Text
forall a. Doc a -> Val a
SimpleVal (Doc Text -> Val Text) -> Doc Text -> Val Text
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String -> Doc Text) -> String -> Doc Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
m)
,(Text
"day", Doc Text -> Val Text
forall a. Doc a -> Val a
SimpleVal (Doc Text -> Val Text) -> Doc Text -> Val Text
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String -> Doc Text) -> String -> Doc Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
d)
,(Text
"iso-8601", Doc Text -> Val Text
forall a. Doc a -> Val a
SimpleVal (Doc Text -> Val Text) -> Doc Text -> Val Text
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String -> Doc Text) -> String -> Doc Text
forall a b. (a -> b) -> a -> b
$
TimeLocale -> String -> Day -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%F" Day
day)
]
Just Val Text
x -> Val Text
x
Doc Text
title' <- WriterOptions -> [Inline] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts ([Inline] -> JATS m (Doc Text)) -> [Inline] -> JATS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (Inline -> Inline) -> [Inline] -> [Inline]
forall a b. (a -> b) -> [a] -> [b]
map Inline -> Inline
fixLineBreak
(Text -> Meta -> [Inline]
lookupMetaInlines Text
"title" Meta
meta)
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 -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
defField Text
"back" Doc Text
back
(Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"title" Doc Text
title'
(Context Text -> Context Text) -> Context Text -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Val Text -> Context Text -> Context Text
forall a b. ToContext a b => Text -> b -> Context a -> Context a
resetField Text
"date" Val Text
date
(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 -> JATS m Text
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> JATS m Text) -> Text -> JATS m Text
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Doc Text -> Text
forall a. HasChars a => Maybe Int -> Doc a -> a
render Maybe Int
colwidth (Doc Text -> Text) -> Doc Text -> Text
forall a b. (a -> b) -> a -> b
$
(if WriterOptions -> Bool
writerPreferAscii WriterOptions
opts then (Text -> Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> Doc a -> Doc b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
toEntities else Doc Text -> Doc Text
forall a. a -> a
id) (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
case WriterOptions -> Maybe (Template Text)
writerTemplate WriterOptions
opts of
Maybe (Template Text)
Nothing -> Doc Text
main
Just Template Text
tpl -> Template Text -> Context Text -> Doc Text
forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
tpl Context Text
context
blocksToJATS :: PandocMonad m => WriterOptions -> [Block] -> JATS m (Doc Text)
blocksToJATS :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> JATS m (Doc Text)
blocksToJATS = (Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
(Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
wrappedBlocksToJATS (Bool -> Block -> Bool
forall a b. a -> b -> a
const Bool
False)
wrappedBlocksToJATS :: PandocMonad m
=> (Block -> Bool)
-> WriterOptions
-> [Block]
-> JATS m (Doc Text)
wrappedBlocksToJATS :: forall (m :: * -> *).
PandocMonad m =>
(Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
wrappedBlocksToJATS Block -> Bool
needsWrap WriterOptions
opts =
([Doc Text] -> Doc Text)
-> StateT JATSState (ReaderT (JATSEnv m) m) [Doc Text]
-> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall a b.
(a -> b)
-> StateT JATSState (ReaderT (JATSEnv m) m) a
-> StateT JATSState (ReaderT (JATSEnv m) m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat (StateT JATSState (ReaderT (JATSEnv m) m) [Doc Text]
-> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
-> ([Block] -> StateT JATSState (ReaderT (JATSEnv m) m) [Doc Text])
-> [Block]
-> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
-> [Block] -> StateT JATSState (ReaderT (JATSEnv m) 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 Block -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall {m :: * -> *}.
PandocMonad m =>
Block -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
wrappedBlockToJATS
where
wrappedBlockToJATS :: Block -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
wrappedBlockToJATS Block
b = do
Doc Text
inner <- WriterOptions
-> Block -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> JATS m (Doc Text)
blockToJATS WriterOptions
opts Block
b
Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
-> Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall a b. (a -> b) -> a -> b
$
if Block -> Bool
needsWrap Block
b
then Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"p" [(Text
"specific-use",Text
"wrapper")] Doc Text
inner
else Doc Text
inner
plainToPara :: Block -> Block
plainToPara :: Block -> Block
plainToPara (Plain [Inline]
x) = [Inline] -> Block
Para [Inline]
x
plainToPara Block
x = Block
x
deflistItemsToJATS :: PandocMonad m
=> WriterOptions
-> [([Inline],[[Block]])] -> JATS m (Doc Text)
deflistItemsToJATS :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [([Inline], [[Block]])] -> JATS m (Doc Text)
deflistItemsToJATS WriterOptions
opts [([Inline], [[Block]])]
items =
[Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> StateT JATSState (ReaderT (JATSEnv m) m) [Doc Text]
-> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([Inline], [[Block]])
-> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
-> [([Inline], [[Block]])]
-> StateT JATSState (ReaderT (JATSEnv m) 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]]
-> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
-> ([Inline], [[Block]])
-> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (WriterOptions
-> [Inline]
-> [[Block]]
-> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> [[Block]] -> JATS m (Doc Text)
deflistItemToJATS WriterOptions
opts)) [([Inline], [[Block]])]
items
deflistItemToJATS :: PandocMonad m
=> WriterOptions
-> [Inline] -> [[Block]] -> JATS m (Doc Text)
deflistItemToJATS :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> [[Block]] -> JATS m (Doc Text)
deflistItemToJATS WriterOptions
opts [Inline]
term [[Block]]
defs = do
Doc Text
term' <- WriterOptions -> [Inline] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
term
Doc Text
def' <- (Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
(Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
wrappedBlocksToJATS (Bool -> Bool
not (Bool -> Bool) -> (Block -> Bool) -> Block -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Bool
isPara)
WriterOptions
opts ([Block] -> JATS m (Doc Text)) -> [Block] -> JATS 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. Walkable a b => (a -> a) -> b -> b
walk Block -> Block
demoteHeaderAndRefs ([Block] -> [Block]) -> ([Block] -> [Block]) -> [Block] -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Block -> Block) -> [Block] -> [Block]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Block
plainToPara) [[Block]]
defs
Doc Text -> JATS m (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> JATS m (Doc Text)) -> Doc Text -> JATS 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
"def-item" (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
"term" Doc Text
term' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"def" Doc Text
def'
listItemsToJATS :: PandocMonad m
=> WriterOptions
-> Maybe [Text] -> [[Block]] -> JATS m (Doc Text)
listItemsToJATS :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Maybe [Text] -> [[Block]] -> JATS m (Doc Text)
listItemsToJATS WriterOptions
opts Maybe [Text]
markers [[Block]]
items =
case Maybe [Text]
markers of
Maybe [Text]
Nothing -> [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> StateT JATSState (ReaderT (JATSEnv m) m) [Doc Text]
-> JATS m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Block] -> JATS m (Doc Text))
-> [[Block]] -> StateT JATSState (ReaderT (JATSEnv m) 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 -> Maybe Text -> [Block] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Maybe Text -> [Block] -> JATS m (Doc Text)
listItemToJATS WriterOptions
opts Maybe Text
forall a. Maybe a
Nothing) [[Block]]
items
Just [Text]
ms -> [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> StateT JATSState (ReaderT (JATSEnv m) m) [Doc Text]
-> JATS m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe Text -> [Block] -> JATS m (Doc Text))
-> [Maybe Text]
-> [[Block]]
-> StateT JATSState (ReaderT (JATSEnv m) m) [Doc Text]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (WriterOptions -> Maybe Text -> [Block] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Maybe Text -> [Block] -> JATS m (Doc Text)
listItemToJATS WriterOptions
opts) ((Text -> Maybe Text) -> [Text] -> [Maybe Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Maybe Text
forall a. a -> Maybe a
Just [Text]
ms) [[Block]]
items
listItemToJATS :: PandocMonad m
=> WriterOptions
-> Maybe Text -> [Block] -> JATS m (Doc Text)
listItemToJATS :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Maybe Text -> [Block] -> JATS m (Doc Text)
listItemToJATS WriterOptions
opts Maybe Text
mbmarker [Block]
item = do
Doc Text
contents <- (Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
(Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
wrappedBlocksToJATS (Bool -> Bool
not (Bool -> Bool) -> (Block -> Bool) -> Block -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Bool
isParaOrList) WriterOptions
opts
((Block -> Block) -> [Block] -> [Block]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Block -> Block
demoteHeaderAndRefs [Block]
item)
Doc Text -> JATS m (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> JATS m (Doc Text)) -> Doc Text -> JATS 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
"list-item" (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
Doc Text -> (Text -> Doc Text) -> Maybe Text -> Doc Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc Text
forall a. Doc a
empty (Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"label" (Doc Text -> Doc Text) -> (Text -> Doc Text) -> Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String -> Doc Text) -> (Text -> String) -> Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) Maybe Text
mbmarker
Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents
languageFor :: WriterOptions -> [Text] -> Text
languageFor :: WriterOptions -> [Text] -> Text
languageFor WriterOptions
opts [Text]
classes =
case [Text]
langs of
(Text
l:[Text]
_) -> Text -> Text
escapeStringForXML Text
l
[] -> Text
""
where
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
codeAttr :: WriterOptions -> Attr -> (Text, [(Text, Text)])
codeAttr :: WriterOptions
-> (Text, [Text], [(Text, Text)]) -> (Text, [(Text, Text)])
codeAttr WriterOptions
opts (Text
ident,[Text]
classes,[(Text, Text)]
kvs) = (Text
lang, [(Text, Text)]
attr)
where
attr :: [(Text, Text)]
attr = [(Text
"id", Text -> Text
escapeNCName Text
ident) | Bool -> Bool
not (Text -> Bool
T.null Text
ident)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[(Text
"language",Text
lang) | Bool -> Bool
not (Text -> Bool
T.null Text
lang)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[(Text
k,Text
v) | (Text
k,Text
v) <- [(Text, Text)]
kvs, Text
k Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"code-type",
Text
"code-version", Text
"executable",
Text
"language-version", Text
"orientation",
Text
"platforms", Text
"position", Text
"specific-use"]]
lang :: Text
lang = WriterOptions -> [Text] -> Text
languageFor WriterOptions
opts [Text]
classes
fixLineBreak :: Inline -> Inline
fixLineBreak :: Inline -> Inline
fixLineBreak Inline
LineBreak = Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"jats") Text
"<break/>"
fixLineBreak Inline
x = Inline
x
blockToJATS :: PandocMonad m => WriterOptions -> Block -> JATS m (Doc Text)
blockToJATS :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> JATS m (Doc Text)
blockToJATS WriterOptions
opts (Div (Text
id',Text
"section":[Text]
_,[(Text, Text)]
kvs) (Header Int
_lvl (Text, [Text], [(Text, Text)])
_ [Inline]
ils : [Block]
xs)) = do
let idAttr :: [(Text, Text)]
idAttr = [ (Text
"id", WriterOptions -> Text
writerIdentifierPrefix WriterOptions
opts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeNCName Text
id')
| Bool -> Bool
not (Text -> Bool
T.null Text
id')]
let otherAttrs :: [Text]
otherAttrs = [Text
"sec-type", Text
"specific-use"]
let attribs :: [(Text, Text)]
attribs = [(Text, Text)]
idAttr [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(Text
k,Text
v) | (Text
k,Text
v) <- [(Text, Text)]
kvs, Text
k Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
otherAttrs]
Doc Text
title' <- WriterOptions -> [Inline] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts ((Inline -> Inline) -> [Inline] -> [Inline]
forall a b. (a -> b) -> [a] -> [b]
map Inline -> Inline
fixLineBreak [Inline]
ils)
Doc Text
contents <- WriterOptions -> [Block] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> JATS m (Doc Text)
blocksToJATS WriterOptions
opts [Block]
xs
Doc Text -> JATS m (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> JATS m (Doc Text)) -> Doc Text -> JATS 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
"sec" [(Text, Text)]
attribs (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"title" Doc Text
title' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents
blockToJATS WriterOptions
opts (Div (Text
ident,[Text]
_,[(Text, Text)]
_) [Para [Inline]
lst]) | Text
"ref-" Text -> Text -> Bool
`T.isPrefixOf` Text
ident =
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
"ref" [(Text
"id", Text -> Text
escapeNCName Text
ident)] (Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"mixed-citation" (Doc Text -> Doc Text) -> JATS m (Doc Text) -> JATS m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
WriterOptions -> [Inline] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
lst
blockToJATS WriterOptions
opts (Div (Text
"refs",[Text]
_,[(Text, Text)]
_) [Block]
xs) = do
[Reference Inlines]
refs <- (JATSEnv m -> [Reference Inlines])
-> StateT JATSState (ReaderT (JATSEnv m) m) [Reference Inlines]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks JATSEnv m -> [Reference Inlines]
forall (m :: * -> *). JATSEnv m -> [Reference Inlines]
jatsReferences
Doc Text
contents <- if [Reference Inlines] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Reference Inlines]
refs
then WriterOptions -> [Block] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> JATS m (Doc Text)
blocksToJATS WriterOptions
opts [Block]
xs
else WriterOptions -> [Reference Inlines] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Reference Inlines] -> JATS m (Doc Text)
referencesToJATS WriterOptions
opts [Reference Inlines]
refs
Doc Text -> JATS m (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> JATS m (Doc Text)) -> Doc Text -> JATS 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
"ref-list" Doc Text
contents
blockToJATS WriterOptions
opts (Div (Text
ident,[Text
cls],[(Text, Text)]
kvs) [Block]
bs) | Text
cls Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"fig", Text
"caption", Text
"table-wrap"] = do
Doc Text
contents <- WriterOptions -> [Block] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> JATS m (Doc Text)
blocksToJATS WriterOptions
opts [Block]
bs
let attr :: [(Text, Text)]
attr = [(Text
"id", Text -> Text
escapeNCName Text
ident) | Bool -> Bool
not (Text -> Bool
T.null Text
ident)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[(Text
"xml:lang",Text
l) | (Text
"lang",Text
l) <- [(Text, Text)]
kvs] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[(Text
k,Text
v) | (Text
k,Text
v) <- [(Text, Text)]
kvs, Text
k Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"specific-use",
Text
"content-type", Text
"orientation", Text
"position"]]
Doc Text -> JATS m (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> JATS m (Doc Text)) -> Doc Text -> JATS 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
cls [(Text, Text)]
attr Doc Text
contents
blockToJATS WriterOptions
opts (Div (Text
ident,[Text]
_,[(Text, Text)]
kvs) [Block]
bs) = do
Doc Text
contents <- WriterOptions -> [Block] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> JATS m (Doc Text)
blocksToJATS WriterOptions
opts [Block]
bs
let attr :: [(Text, Text)]
attr = [(Text
"id", Text -> Text
escapeNCName Text
ident) | Bool -> Bool
not (Text -> Bool
T.null Text
ident)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[(Text
"xml:lang",Text
l) | (Text
"lang",Text
l) <- [(Text, Text)]
kvs] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[(Text
k,Text
v) | (Text
k,Text
v) <- [(Text, Text)]
kvs, Text
k Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"specific-use",
Text
"content-type", Text
"orientation", Text
"position"]]
Doc Text -> JATS m (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> JATS m (Doc Text)) -> Doc Text -> JATS 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
"boxed-text" [(Text, Text)]
attr Doc Text
contents
blockToJATS WriterOptions
opts (Header Int
_ (Text, [Text], [(Text, Text)])
_ [Inline]
title) = do
Doc Text
title' <- WriterOptions -> [Inline] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts ((Inline -> Inline) -> [Inline] -> [Inline]
forall a b. (a -> b) -> [a] -> [b]
map Inline -> Inline
fixLineBreak [Inline]
title)
Doc Text -> JATS m (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> JATS m (Doc Text)) -> Doc Text -> JATS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"title" Doc Text
title'
blockToJATS WriterOptions
_opts (Plain [Image (Text, [Text], [(Text, Text)])
attr [Inline]
alt (Text, Text)
tgt]) =
Doc Text -> JATS m (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> JATS m (Doc Text)) -> Doc Text -> JATS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (Text, [Text], [(Text, Text)])
-> [Inline] -> (Text, Text) -> Doc Text
graphic (Text, [Text], [(Text, Text)])
attr [Inline]
alt (Text, Text)
tgt
blockToJATS WriterOptions
_opts (Para [Image (Text, [Text], [(Text, Text)])
attr [Inline]
alt (Text, Text)
tgt]) =
Doc Text -> JATS m (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> JATS m (Doc Text)) -> Doc Text -> JATS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (Text, [Text], [(Text, Text)])
-> [Inline] -> (Text, Text) -> Doc Text
graphic (Text, [Text], [(Text, Text)])
attr [Inline]
alt (Text, Text)
tgt
blockToJATS WriterOptions
opts (Plain [Inline]
lst) = WriterOptions -> Block -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> JATS m (Doc Text)
blockToJATS WriterOptions
opts ([Inline] -> Block
Para [Inline]
lst)
blockToJATS WriterOptions
opts (Para [Inline]
lst) =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"p" (Doc Text -> Doc Text) -> JATS m (Doc Text) -> JATS m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Inline] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
lst
blockToJATS WriterOptions
opts (LineBlock [[Inline]]
lns) =
WriterOptions -> Block -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> JATS m (Doc Text)
blockToJATS WriterOptions
opts (Block -> JATS m (Doc Text)) -> Block -> JATS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ [[Inline]] -> Block
linesToPara [[Inline]]
lns
blockToJATS WriterOptions
opts (BlockQuote [Block]
blocks) = do
JATSTagSet
tagSet <- (JATSEnv m -> JATSTagSet)
-> StateT JATSState (ReaderT (JATSEnv m) m) JATSTagSet
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks JATSEnv m -> JATSTagSet
forall (m :: * -> *). JATSEnv m -> JATSTagSet
jatsTagSet
let needsWrap :: Block -> Bool
needsWrap = if JATSTagSet
tagSet JATSTagSet -> JATSTagSet -> Bool
forall a. Eq a => a -> a -> Bool
== JATSTagSet
TagSetArticleAuthoring
then Bool -> Bool
not (Bool -> Bool) -> (Block -> Bool) -> Block -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Bool
isPara
else \case
Header{} -> Bool
True
Block
HorizontalRule -> Bool
True
Block
_ -> Bool
False
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"disp-quote" (Doc Text -> Doc Text) -> JATS m (Doc Text) -> JATS m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
(Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
wrappedBlocksToJATS Block -> Bool
needsWrap WriterOptions
opts [Block]
blocks
blockToJATS WriterOptions
opts (CodeBlock (Text, [Text], [(Text, Text)])
a Text
str) = Doc Text -> JATS m (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> JATS m (Doc Text)) -> Doc Text -> JATS 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
tag [(Text, Text)]
attr (Doc Text -> Doc Text
forall a. Doc a -> Doc a
flush (String -> Doc Text
forall a. HasChars a => String -> Doc a
text (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
str)))
where (Text
lang, [(Text, Text)]
attr) = WriterOptions
-> (Text, [Text], [(Text, Text)]) -> (Text, [(Text, Text)])
codeAttr WriterOptions
opts (Text, [Text], [(Text, Text)])
a
tag :: Text
tag = if Text -> Bool
T.null Text
lang then Text
"preformat" else Text
"code"
blockToJATS WriterOptions
_ (BulletList []) = Doc Text -> JATS m (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToJATS WriterOptions
opts (BulletList [[Block]]
lst) =
Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"list" [(Text
"list-type", Text
"bullet")] (Doc Text -> Doc Text) -> JATS m (Doc Text) -> JATS m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
WriterOptions -> Maybe [Text] -> [[Block]] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Maybe [Text] -> [[Block]] -> JATS m (Doc Text)
listItemsToJATS WriterOptions
opts Maybe [Text]
forall a. Maybe a
Nothing [[Block]]
lst
blockToJATS WriterOptions
_ (OrderedList ListAttributes
_ []) = Doc Text -> JATS m (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToJATS WriterOptions
opts (OrderedList (Int
start, ListNumberStyle
numstyle, ListNumberDelim
delimstyle) [[Block]]
items) = do
JATSTagSet
tagSet <- (JATSEnv m -> JATSTagSet)
-> StateT JATSState (ReaderT (JATSEnv m) m) JATSTagSet
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks JATSEnv m -> JATSTagSet
forall (m :: * -> *). JATSEnv m -> JATSTagSet
jatsTagSet
let listType :: Text
listType =
if JATSTagSet
tagSet JATSTagSet -> JATSTagSet -> Bool
forall a. Eq a => a -> a -> Bool
== JATSTagSet
TagSetArticleAuthoring
then Text
"order"
else case ListNumberStyle
numstyle of
ListNumberStyle
DefaultStyle -> Text
"order"
ListNumberStyle
Decimal -> Text
"order"
ListNumberStyle
Example -> Text
"order"
ListNumberStyle
UpperAlpha -> Text
"alpha-upper"
ListNumberStyle
LowerAlpha -> Text
"alpha-lower"
ListNumberStyle
UpperRoman -> Text
"roman-upper"
ListNumberStyle
LowerRoman -> Text
"roman-lower"
let simpleList :: Bool
simpleList = Int
start Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& (ListNumberDelim
delimstyle ListNumberDelim -> ListNumberDelim -> Bool
forall a. Eq a => a -> a -> Bool
== ListNumberDelim
DefaultDelim Bool -> Bool -> Bool
||
ListNumberDelim
delimstyle ListNumberDelim -> ListNumberDelim -> Bool
forall a. Eq a => a -> a -> Bool
== ListNumberDelim
Period)
let markers :: Maybe [Text]
markers = if Bool
simpleList
then Maybe [Text]
forall a. Maybe a
Nothing
else [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just ([Text] -> Maybe [Text]) -> [Text] -> Maybe [Text]
forall a b. (a -> b) -> a -> b
$
ListAttributes -> [Text]
orderedListMarkers (Int
start, ListNumberStyle
numstyle, ListNumberDelim
delimstyle)
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
"list-type", Text
listType)] (Doc Text -> Doc Text) -> JATS m (Doc Text) -> JATS m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
WriterOptions -> Maybe [Text] -> [[Block]] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Maybe [Text] -> [[Block]] -> JATS m (Doc Text)
listItemsToJATS WriterOptions
opts Maybe [Text]
markers [[Block]]
items
blockToJATS WriterOptions
opts (DefinitionList [([Inline], [[Block]])]
lst) =
Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
True Text
"def-list" [] (Doc Text -> Doc Text) -> JATS m (Doc Text) -> JATS m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [([Inline], [[Block]])] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [([Inline], [[Block]])] -> JATS m (Doc Text)
deflistItemsToJATS WriterOptions
opts [([Inline], [[Block]])]
lst
blockToJATS WriterOptions
_ b :: Block
b@(RawBlock Format
f Text
str)
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
"jats" = Doc Text -> JATS m (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> JATS m (Doc Text)) -> Doc Text -> JATS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String -> Doc Text) -> String -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
str
| Bool
otherwise = do
LogMessage -> StateT JATSState (ReaderT (JATSEnv m) m) ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT JATSState (ReaderT (JATSEnv m) m) ())
-> LogMessage -> StateT JATSState (ReaderT (JATSEnv m) m) ()
forall a b. (a -> b) -> a -> b
$ Block -> LogMessage
BlockNotRendered Block
b
Doc Text -> JATS m (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToJATS WriterOptions
_ Block
HorizontalRule = Doc Text -> JATS m (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToJATS WriterOptions
opts (Table (Text, [Text], [(Text, Text)])
attr Caption
caption [ColSpec]
colspecs TableHead
thead [TableBody]
tbody TableFoot
tfoot) =
WriterOptions -> Table -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Table -> JATS m (Doc Text)
tableToJATS WriterOptions
opts ((Text, [Text], [(Text, Text)])
-> Caption
-> [ColSpec]
-> TableHead
-> [TableBody]
-> TableFoot
-> Table
Ann.toTable (Text, [Text], [(Text, Text)])
attr Caption
caption [ColSpec]
colspecs TableHead
thead [TableBody]
tbody TableFoot
tfoot)
blockToJATS WriterOptions
opts (Figure (Text
ident, [Text]
_, [(Text, Text)]
kvs) (Caption Maybe [Inline]
_short [Block]
longcapt) [Block]
body) = do
let unsetAltIfDupl :: Inline -> Inline
unsetAltIfDupl = \case
Image (Text, [Text], [(Text, Text)])
attr [Inline]
alt (Text, Text)
tgt
| [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
alt Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== [Block] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Block]
longcapt -> (Text, [Text], [(Text, Text)])
-> [Inline] -> (Text, Text) -> Inline
Image (Text, [Text], [(Text, Text)])
attr [] (Text, Text)
tgt
Inline
inline -> Inline
inline
Doc Text
capt <- if [Block] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Block]
longcapt
then Doc Text -> JATS m (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Doc Text
forall a. Doc a
empty
else Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"caption" (Doc Text -> Doc Text) -> JATS m (Doc Text) -> JATS m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions -> [Block] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> JATS m (Doc Text)
blocksToJATS WriterOptions
opts [Block]
longcapt
Doc Text
figbod <- WriterOptions -> [Block] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> JATS m (Doc Text)
blocksToJATS WriterOptions
opts ([Block] -> JATS m (Doc Text)) -> [Block] -> JATS m (Doc Text)
forall a b. (a -> b) -> a -> b
$ (Inline -> Inline) -> [Block] -> [Block]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
unsetAltIfDupl [Block]
body
let figattr :: [(Text, Text)]
figattr = [(Text
"id", Text -> Text
escapeNCName Text
ident) | Bool -> Bool
not (Text -> Bool
T.null Text
ident)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[(Text
k,Text
v) | (Text
k,Text
v) <- [(Text, Text)]
kvs
, Text
k Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ Text
"fig-type", Text
"orientation"
, Text
"position", Text
"specific-use"]]
Doc Text -> JATS m (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> JATS m (Doc Text)) -> Doc Text -> JATS 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
"fig" [(Text, Text)]
figattr (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text
capt Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
figbod
inlinesToJATS :: PandocMonad m => WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
lst = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat ([Doc Text] -> Doc Text)
-> StateT JATSState (ReaderT (JATSEnv m) m) [Doc Text]
-> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
-> [Inline] -> StateT JATSState (ReaderT (JATSEnv m) 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 -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> JATS m (Doc Text)
inlineToJATS WriterOptions
opts) ([Inline] -> [Inline]
fixCitations [Inline]
lst)
where
fixCitations :: [Inline] -> [Inline]
fixCitations [] = []
fixCitations (Inline
x:[Inline]
xs) | Inline -> Bool
needsFixing Inline
x =
Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: Text -> Inline
Str ([Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
ys) Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
fixCitations [Inline]
zs
where
needsFixing :: Inline -> Bool
needsFixing (RawInline (Format Text
"jats") Text
z) =
Text
"<pub-id pub-id-type=" Text -> Text -> Bool
`T.isPrefixOf` Text
z
needsFixing Inline
_ = Bool
False
isRawInline :: Inline -> Bool
isRawInline RawInline{} = Bool
True
isRawInline Inline
_ = Bool
False
([Inline]
ys,[Inline]
zs) = (Inline -> Bool) -> [Inline] -> ([Inline], [Inline])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Inline -> Bool
isRawInline [Inline]
xs
fixCitations (Inline
x:[Inline]
xs) = Inline
x Inline -> [Inline] -> [Inline]
forall a. a -> [a] -> [a]
: [Inline] -> [Inline]
fixCitations [Inline]
xs
inlineToJATS :: PandocMonad m => WriterOptions -> Inline -> JATS m (Doc Text)
inlineToJATS :: forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Inline -> JATS m (Doc Text)
inlineToJATS WriterOptions
_ (Str Text
str) = Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
-> Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text (String -> Doc Text) -> String -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text
escapeStringForXML Text
str
inlineToJATS WriterOptions
opts (Emph [Inline]
lst) =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"italic" (Doc Text -> Doc Text)
-> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
-> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions
-> [Inline] -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
lst
inlineToJATS WriterOptions
opts (Underline [Inline]
lst) =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"underline" (Doc Text -> Doc Text)
-> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
-> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions
-> [Inline] -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
lst
inlineToJATS WriterOptions
opts (Strong [Inline]
lst) =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"bold" (Doc Text -> Doc Text)
-> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
-> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions
-> [Inline] -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
lst
inlineToJATS WriterOptions
opts (Strikeout [Inline]
lst) =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"strike" (Doc Text -> Doc Text)
-> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
-> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions
-> [Inline] -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
lst
inlineToJATS WriterOptions
opts (Superscript [Inline]
lst) =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"sup" (Doc Text -> Doc Text)
-> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
-> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions
-> [Inline] -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
lst
inlineToJATS WriterOptions
opts (Subscript [Inline]
lst) =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"sub" (Doc Text -> Doc Text)
-> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
-> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions
-> [Inline] -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
lst
inlineToJATS WriterOptions
opts (SmallCaps [Inline]
lst) =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"sc" (Doc Text -> Doc Text)
-> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
-> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterOptions
-> [Inline] -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
lst
inlineToJATS WriterOptions
opts (Quoted QuoteType
SingleQuote [Inline]
lst) = do
Doc Text
contents <- WriterOptions
-> [Inline] -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
lst
Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
-> Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall a b. (a -> b) -> a -> b
$ 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
contents 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
'’'
inlineToJATS WriterOptions
opts (Quoted QuoteType
DoubleQuote [Inline]
lst) = do
Doc Text
contents <- WriterOptions
-> [Inline] -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
lst
Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
-> Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall a b. (a -> b) -> a -> b
$ 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
contents 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
'”'
inlineToJATS WriterOptions
opts (Code (Text, [Text], [(Text, Text)])
a Text
str) =
Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
-> Doc Text -> StateT JATSState (ReaderT (JATSEnv m) 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
tag [(Text, Text)]
attr (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)
where (Text
lang, [(Text, Text)]
attr) = WriterOptions
-> (Text, [Text], [(Text, Text)]) -> (Text, [(Text, Text)])
codeAttr WriterOptions
opts (Text, [Text], [(Text, Text)])
a
tag :: Text
tag = if Text -> Bool
T.null Text
lang then Text
"monospace" else Text
"code"
inlineToJATS WriterOptions
_ il :: Inline
il@(RawInline Format
f Text
x)
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== Format
"jats" = Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
-> Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
x
| Bool
otherwise = do
LogMessage -> StateT JATSState (ReaderT (JATSEnv m) m) ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT JATSState (ReaderT (JATSEnv m) m) ())
-> LogMessage -> StateT JATSState (ReaderT (JATSEnv m) m) ()
forall a b. (a -> b) -> a -> b
$ Inline -> LogMessage
InlineNotRendered Inline
il
Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
inlineToJATS WriterOptions
_ Inline
LineBreak = Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
cr
inlineToJATS WriterOptions
_ Inline
Space = Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
inlineToJATS WriterOptions
opts Inline
SoftBreak
| WriterOptions -> WrapOption
writerWrapText WriterOptions
opts WrapOption -> WrapOption -> Bool
forall a. Eq a => a -> a -> Bool
== WrapOption
WrapPreserve = Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
cr
| Bool
otherwise = Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
inlineToJATS WriterOptions
opts (Note [Block]
contents) = do
JATSTagSet
tagSet <- (JATSEnv m -> JATSTagSet)
-> StateT JATSState (ReaderT (JATSEnv m) m) JATSTagSet
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks JATSEnv m -> JATSTagSet
forall (m :: * -> *). JATSEnv m -> JATSTagSet
jatsTagSet
if JATSTagSet
tagSet JATSTagSet -> JATSTagSet -> Bool
forall a. Eq a => a -> a -> Bool
== JATSTagSet
TagSetArticleAuthoring
then Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented Text
"fn" (Doc Text -> Doc Text)
-> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
-> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> Bool)
-> WriterOptions
-> [Block]
-> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
(Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
wrappedBlocksToJATS (Bool -> Bool
not (Bool -> Bool) -> (Block -> Bool) -> Block -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Bool
isPara) WriterOptions
opts [Block]
contents
else do
[(Int, Doc Text)]
notes <- (JATSState -> [(Int, Doc Text)])
-> StateT JATSState (ReaderT (JATSEnv m) m) [(Int, Doc Text)]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets JATSState -> [(Int, Doc Text)]
jatsNotes
let notenum :: Int
notenum = case [(Int, Doc Text)]
notes of
(Int
n, Doc Text
_):[(Int, Doc Text)]
_ -> Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
[] -> Int
1
Doc Text
thenote <- 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
"fn" [(Text
"id", Text
"fn" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
notenum)]
(Doc Text -> Doc Text)
-> (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"label" (Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Doc Text) -> Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
tshow Int
notenum) Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<>)
(Doc Text -> Doc Text)
-> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
-> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Block -> Bool)
-> WriterOptions
-> [Block]
-> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
(Block -> Bool) -> WriterOptions -> [Block] -> JATS m (Doc Text)
wrappedBlocksToJATS (Bool -> Bool
not (Bool -> Bool) -> (Block -> Bool) -> Block -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> Bool
isPara) WriterOptions
opts
((Block -> Block) -> [Block] -> [Block]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Block -> Block
demoteHeaderAndRefs [Block]
contents)
(JATSState -> JATSState)
-> StateT JATSState (ReaderT (JATSEnv m) m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((JATSState -> JATSState)
-> StateT JATSState (ReaderT (JATSEnv m) m) ())
-> (JATSState -> JATSState)
-> StateT JATSState (ReaderT (JATSEnv m) m) ()
forall a b. (a -> b) -> a -> b
$ \JATSState
st -> JATSState
st{ jatsNotes :: [(Int, Doc Text)]
jatsNotes = (Int
notenum, Doc Text
thenote) (Int, Doc Text) -> [(Int, Doc Text)] -> [(Int, Doc Text)]
forall a. a -> [a] -> [a]
: [(Int, Doc Text)]
notes }
Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
-> Doc Text -> StateT JATSState (ReaderT (JATSEnv m) 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
"xref" [(Text
"ref-type", Text
"fn"),
(Text
"rid", Text
"fn" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
notenum)]
(Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ String -> Doc Text
forall a. HasChars a => String -> Doc a
text (Int -> String
forall a. Show a => a -> String
show Int
notenum)
inlineToJATS WriterOptions
opts (Cite [Citation]
_ [Inline]
lst) =
WriterOptions
-> [Inline] -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
lst
inlineToJATS WriterOptions
opts (Span (Text
ident,[Text]
classes,[(Text, Text)]
kvs) [Inline]
ils) = do
Doc Text
contents <- WriterOptions
-> [Inline] -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
ils
let commonAttr :: [(Text, Text)]
commonAttr = [(Text
"id", Text -> Text
escapeNCName Text
ident) | Bool -> Bool
not (Text -> Bool
T.null Text
ident)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[(Text
"xml:lang",Text
l) | (Text
"lang",Text
l) <- [(Text, Text)]
kvs] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[(Text
k,Text
v) | (Text
k,Text
v) <- [(Text, Text)]
kvs, Text
k Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"alt", Text
"specific-use"]]
let (Text
tag, [(Text, Text)]
specificAttr) =
case Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"content-type" [(Text, Text)]
kvs Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe [Text]
classes of
Just Text
ct -> ( Text
"named-content"
, (Text
"content-type", Text
ct) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:
[(Text
k, Text
v) | (Text
k, Text
v) <- [(Text, Text)]
kvs
, Text
k Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"rid", Text
"vocab", Text
"vocab-identifier",
Text
"vocab-term", Text
"vocab-term-identifier"]])
Maybe Text
Nothing -> (Text
"styled-content"
, [(Text
k, Text
v) | (Text
k,Text
v) <- [(Text, Text)]
kvs
, Text
k Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"style", Text
"style-type", Text
"style-detail",
Text
"toggle"]])
let attr :: [(Text, Text)]
attr = [(Text, Text)]
commonAttr [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++ [(Text, Text)]
specificAttr
Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
-> Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall a b. (a -> b) -> a -> b
$
if [(Text, Text)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, Text)]
attr
then Doc Text
contents
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
tag [(Text, Text)]
attr Doc Text
contents
inlineToJATS WriterOptions
_ (Math MathType
t Text
str) = do
let addPref :: Attr -> Attr
addPref (Xml.Attr QName
q String
v)
| QName -> String
Xml.qName QName
q String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"xmlns" = QName -> String -> Attr
Xml.Attr QName
q{ qName :: String
Xml.qName = String
"xmlns:mml" } String
v
| Bool
otherwise = QName -> String -> Attr
Xml.Attr QName
q String
v
let fixNS' :: Element -> Element
fixNS' Element
e = Element
e{ elName :: QName
Xml.elName =
(Element -> QName
Xml.elName Element
e){ qPrefix :: Maybe String
Xml.qPrefix = String -> Maybe String
forall a. a -> Maybe a
Just String
"mml" } }
let fixNS :: Element -> Element
fixNS = (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere ((Element -> Element) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT Element -> Element
fixNS') (Element -> Element) -> (Element -> Element) -> Element -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(\Element
e -> Element
e{ elAttribs :: [Attr]
Xml.elAttribs = (Attr -> Attr) -> [Attr] -> [Attr]
forall a b. (a -> b) -> [a] -> [b]
map Attr -> Attr
addPref (Element -> [Attr]
Xml.elAttribs Element
e) })
let conf :: ConfigPP
conf = (QName -> Bool) -> ConfigPP -> ConfigPP
Xml.useShortEmptyTags (Bool -> QName -> Bool
forall a b. a -> b -> a
const Bool
False) ConfigPP
Xml.defaultConfigPP
Either Inline Element
res <- (DisplayType -> [Exp] -> Element)
-> MathType
-> Text
-> StateT JATSState (ReaderT (JATSEnv m) m) (Either Inline Element)
forall (m :: * -> *) a.
PandocMonad m =>
(DisplayType -> [Exp] -> a)
-> MathType -> Text -> m (Either Inline a)
convertMath DisplayType -> [Exp] -> Element
writeMathML MathType
t Text
str
let tagtype :: Text
tagtype = case MathType
t of
MathType
DisplayMath -> Text
"disp-formula"
MathType
InlineMath -> Text
"inline-formula"
let rawtex :: Doc Text
rawtex = String -> Doc Text
forall a. HasChars a => String -> Doc a
text String
"<![CDATA[" Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal Text
str 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
"]]>"
let texMath :: Doc Text
texMath = Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"tex-math" Doc Text
rawtex
JATSTagSet
tagSet <- (JATSEnv m -> JATSTagSet)
-> StateT JATSState (ReaderT (JATSEnv m) m) JATSTagSet
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks JATSEnv m -> JATSTagSet
forall (m :: * -> *). JATSEnv m -> JATSTagSet
jatsTagSet
Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
-> (Doc Text -> Doc Text)
-> Doc Text
-> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
tagtype (Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
-> Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall a b. (a -> b) -> a -> b
$
case Either Inline Element
res of
Right Element
r -> let mathMl :: Doc Text
mathMl = String -> Doc Text
forall a. HasChars a => String -> Doc a
text (ConfigPP -> Element -> String
Xml.ppcElement ConfigPP
conf (Element -> String) -> Element -> String
forall a b. (a -> b) -> a -> b
$ Element -> Element
fixNS Element
r)
in if JATSTagSet
tagSet JATSTagSet -> JATSTagSet -> Bool
forall a. Eq a => a -> a -> Bool
== JATSTagSet
TagSetArticleAuthoring
then Doc Text
mathMl
else Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"alternatives" (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
Doc Text
forall a. Doc a
cr Doc Text -> Doc Text -> Doc Text
forall a. Semigroup a => a -> a -> a
<> Doc Text
texMath Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
mathMl
Left Inline
_ -> if JATSTagSet
tagSet JATSTagSet -> JATSTagSet -> Bool
forall a. Eq a => a -> a -> Bool
/= JATSTagSet
TagSetArticleAuthoring
then Doc Text
texMath
else Doc Text
rawtex
inlineToJATS WriterOptions
_ (Link (Text, [Text], [(Text, Text)])
_attr [Str Text
t] (Text -> Text -> Maybe Text
T.stripPrefix Text
"mailto:" -> Just Text
email, Text
_))
| Text -> Text
escapeURI Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
email =
Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
-> Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"email" (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal (Text -> Text
escapeStringForXML Text
email)
inlineToJATS WriterOptions
opts (Link (Text
ident,[Text]
_,[(Text, Text)]
kvs) [Inline]
txt (Text -> Maybe (Char, Text)
T.uncons -> Just (Char
'#', Text
src), Text
_)) = do
let attr :: [(Text, Text)]
attr = [[(Text, Text)]] -> [(Text, Text)]
forall a. Monoid a => [a] -> a
mconcat
[ [(Text
"id", Text -> Text
escapeNCName Text
ident) | Bool -> Bool
not (Text -> Bool
T.null Text
ident)]
, [(Text
"alt", [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
txt) | Bool -> Bool
not ([Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
txt)]
, [(Text
"rid", Text -> Text
escapeNCName Text
src)]
, [(Text
k,Text
v) | (Text
k,Text
v) <- [(Text, Text)]
kvs, Text
k Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"ref-type", Text
"specific-use"]]
, [(Text
"ref-type", Text
"bibr") | Text
"ref-" Text -> Text -> Bool
`T.isPrefixOf` Text
src]
]
if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
txt
then Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
-> Doc Text -> StateT JATSState (ReaderT (JATSEnv m) 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
"xref" [(Text, Text)]
attr
else do
Doc Text
contents <- WriterOptions
-> [Inline] -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
txt
Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
-> Doc Text -> StateT JATSState (ReaderT (JATSEnv m) 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
"xref" [(Text, Text)]
attr Doc Text
contents
inlineToJATS WriterOptions
opts (Link (Text
ident,[Text]
_,[(Text, Text)]
kvs) [Inline]
txt (Text
src, Text
tit)) = do
let attr :: [(Text, Text)]
attr = [(Text
"id", Text -> Text
escapeNCName Text
ident) | Bool -> Bool
not (Text -> Bool
T.null Text
ident)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[(Text
"ext-link-type", Text
"uri"),
(Text
"xlink:href", Text
src)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[(Text
"xlink:title", Text
tit) | Bool -> Bool
not (Text -> Bool
T.null Text
tit)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[(Text
k,Text
v) | (Text
k,Text
v) <- [(Text, Text)]
kvs, Text
k Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"assigning-authority",
Text
"specific-use", Text
"xlink:actuate",
Text
"xlink:role", Text
"xlink:show",
Text
"xlink:type"]]
Doc Text
contents <- WriterOptions
-> [Inline] -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
txt
Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
-> Doc Text -> StateT JATSState (ReaderT (JATSEnv m) 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
"ext-link" [(Text, Text)]
attr Doc Text
contents
inlineToJATS WriterOptions
_ (Image (Text, [Text], [(Text, Text)])
attr [Inline]
alt (Text, Text)
tgt) = do
let elattr :: [(Text, Text)]
elattr = (Text, [Text], [(Text, Text)])
-> [Inline] -> (Text, Text) -> [(Text, Text)]
graphicAttr (Text, [Text], [(Text, Text)])
attr [Inline]
alt (Text, Text)
tgt
Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall a. a -> StateT JATSState (ReaderT (JATSEnv m) m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text))
-> Doc Text -> StateT JATSState (ReaderT (JATSEnv m) m) (Doc Text)
forall a b. (a -> b) -> a -> b
$ case [Inline] -> Maybe (Doc Text)
altToJATS [Inline]
alt of
Maybe (Doc Text)
Nothing -> Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"inline-graphic" [(Text, Text)]
elattr
Just Doc Text
altTag -> 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
"inline-graphic" [(Text, Text)]
elattr Doc Text
altTag
graphic :: Attr -> [Inline] -> Target -> (Doc Text)
graphic :: (Text, [Text], [(Text, Text)])
-> [Inline] -> (Text, Text) -> Doc Text
graphic (Text, [Text], [(Text, Text)])
attr [Inline]
alt (Text, Text)
tgt =
let elattr :: [(Text, Text)]
elattr = (Text, [Text], [(Text, Text)])
-> [Inline] -> (Text, Text) -> [(Text, Text)]
graphicAttr (Text, [Text], [(Text, Text)])
attr [Inline]
alt (Text, Text)
tgt
in case [Inline] -> Maybe (Doc Text)
altToJATS [Inline]
alt of
Maybe (Doc Text)
Nothing -> Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"graphic" [(Text, Text)]
elattr
Just Doc Text
altTag -> 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
"graphic" [(Text, Text)]
elattr Doc Text
altTag
graphicAttr :: Attr -> [Inline] -> Target -> [(Text, Text)]
graphicAttr :: (Text, [Text], [(Text, Text)])
-> [Inline] -> (Text, Text) -> [(Text, Text)]
graphicAttr (Text
ident, [Text]
_, [(Text, Text)]
kvs) [Inline]
_alt (Text
src, Text
tit) =
let (Text
maintype, Text
subtype) = Text -> [(Text, Text)] -> (Text, Text)
imageMimeType Text
src [(Text, Text)]
kvs
in [(Text
"id", Text -> Text
escapeNCName Text
ident) | Bool -> Bool
not (Text -> Bool
T.null Text
ident)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[ (Text
"mimetype", Text
maintype)
, (Text
"mime-subtype", Text
subtype)
, (Text
"xlink:href", Text
src)
] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[(Text
"xlink:title", Text
tit) | Bool -> Bool
not (Text -> Bool
T.null Text
tit)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[(Text
k,Text
v) | (Text
k,Text
v) <- [(Text, Text)]
kvs
, Text
k Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ Text
"baseline-shift", Text
"content-type", Text
"specific-use"
, Text
"xlink:actuate", Text
"xlink:href", Text
"xlink:role"
, Text
"xlink:show", Text
"xlink:type"]
]
altToJATS :: [Inline] -> Maybe (Doc Text)
altToJATS :: [Inline] -> Maybe (Doc Text)
altToJATS [Inline]
alt =
if [Inline] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
alt
then Maybe (Doc Text)
forall a. Maybe a
Nothing
else Doc Text -> Maybe (Doc Text)
forall a. a -> Maybe a
Just (Doc Text -> Maybe (Doc Text))
-> (Text -> Doc Text) -> Text -> Maybe (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"alt-text" (Doc Text -> Doc Text) -> (Text -> Doc Text) -> Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hsep ([Doc Text] -> Doc Text)
-> (Text -> [Doc Text]) -> Text -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Doc Text) -> [Text] -> [Doc Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Doc Text
forall a. HasChars a => a -> Doc a
literal ([Text] -> [Doc Text]) -> (Text -> [Text]) -> Text -> [Doc Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words (Text -> Maybe (Doc Text)) -> Text -> Maybe (Doc Text)
forall a b. (a -> b) -> a -> b
$ [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
alt
imageMimeType :: Text -> [(Text, Text)] -> (Text, Text)
imageMimeType :: Text -> [(Text, Text)] -> (Text, Text)
imageMimeType Text
src [(Text, Text)]
kvs =
let mbMT :: Maybe Text
mbMT = String -> Maybe Text
getMimeType (Text -> String
T.unpack Text
src)
maintype :: Text
maintype = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"image" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$
Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"mimetype" [(Text, Text)]
kvs Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
((Char -> Bool) -> Text -> Text
T.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'/') (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
mbMT)
subtype :: Text
subtype = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$
Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"mime-subtype" [(Text, Text)]
kvs Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
(Int -> Text -> Text
T.drop Int
1 (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'/') (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
mbMT)
in (Text
maintype, Text
subtype)
isParaOrList :: Block -> Bool
isParaOrList :: Block -> Bool
isParaOrList Para{} = Bool
True
isParaOrList Plain{} = Bool
True
isParaOrList BulletList{} = Bool
True
isParaOrList OrderedList{} = Bool
True
isParaOrList DefinitionList{} = Bool
True
isParaOrList Block
_ = Bool
False
isPara :: Block -> Bool
isPara :: Block -> Bool
isPara Para{} = Bool
True
isPara Plain{} = Bool
True
isPara Block
_ = Bool
False
demoteHeaderAndRefs :: Block -> Block
demoteHeaderAndRefs :: Block -> Block
demoteHeaderAndRefs (Header Int
_ (Text, [Text], [(Text, Text)])
_ [Inline]
ils) = [Inline] -> Block
Para [Inline]
ils
demoteHeaderAndRefs (Div (Text
"refs",[Text]
cls,[(Text, Text)]
kvs) [Block]
bs) =
(Text, [Text], [(Text, Text)]) -> [Block] -> Block
Div (Text
"",[Text]
cls,[(Text, Text)]
kvs) [Block]
bs
demoteHeaderAndRefs Block
x = Block
x
parseDate :: Text -> Maybe Day
parseDate :: Text -> Maybe Day
parseDate Text
s = [Maybe Day] -> Maybe Day
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum ((String -> Maybe Day) -> [String] -> [Maybe Day]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> Maybe Day
`parsetimeWith` Text -> String
T.unpack Text
s) [String]
formats)
where parsetimeWith :: String -> String -> Maybe Day
parsetimeWith = Bool -> TimeLocale -> String -> String -> Maybe Day
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale
formats :: [String]
formats = [String
"%x",String
"%m/%d/%Y", String
"%D",String
"%F", String
"%d %b %Y",
String
"%e %B %Y", String
"%b. %e, %Y", String
"%B %e, %Y",
String
"%Y%m%d", String
"%Y%m", String
"%Y"]