{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module Text.Pandoc.Writers.JATS
( writeJATS
, writeJatsArchiving
, writeJatsPublishing
, writeJatsArticleAuthoring
) where
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)
import Data.Time (toGregorian, Day, parseTimeM, defaultTimeLocale, formatTime)
import qualified Data.Text as T
import Data.Text (Text)
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.Templates (renderTemplate)
import Text.DocTemplates (Context(..), Val(..))
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 :: 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 :: 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 :: WriterOptions -> Pandoc -> m Text
writeJatsArticleAuthoring = JATSTagSet -> WriterOptions -> Pandoc -> m Text
forall (m :: * -> *).
PandocMonad m =>
JATSTagSet -> WriterOptions -> Pandoc -> m Text
writeJats JATSTagSet
TagSetArticleAuthoring
writeJATS :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeJATS :: 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 :: JATSTagSet -> WriterOptions -> Pandoc -> m Text
writeJats JATSTagSet
tagSet WriterOptions
opts Pandoc
d =
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
where initialState :: JATSState
initialState = JATSState :: [(Int, Doc Text)] -> JATSState
JATSState { jatsNotes :: [(Int, Doc Text)]
jatsNotes = [] }
environment :: JATSEnv m
environment = JATSEnv :: forall (m :: * -> *).
JATSTagSet
-> (WriterOptions -> [Inline] -> JATS m (Doc Text))
-> (WriterOptions -> Block -> JATS m (Doc Text))
-> JATSEnv m
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 :: WriterOptions -> Block -> JATS m (Doc Text)
jatsBlockWriter = WriterOptions -> Block -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> JATS m (Doc Text)
blockToJATS
}
docToJATS :: PandocMonad m => WriterOptions -> Pandoc -> JATS m Text
docToJATS :: 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 (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 (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 (Integer
y,Int
m,Int
d) = Day -> (Integer, 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
$ Integer -> String
forall a. Show a => a -> String
show Integer
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
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 -> 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 (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 (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 :: 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 :: (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]
-> JATS m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat (StateT JATSState (ReaderT (JATSEnv m) m) [Doc Text]
-> JATS m (Doc Text))
-> ([Block] -> StateT JATSState (ReaderT (JATSEnv m) m) [Doc Text])
-> [Block]
-> JATS m (Doc Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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)
mapM Block -> JATS 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 (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 :: 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]
-> JATS m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (([Inline], [[Block]]) -> JATS 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)
mapM (([Inline] -> [[Block]] -> JATS m (Doc Text))
-> ([Inline], [[Block]]) -> JATS m (Doc Text)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (WriterOptions -> [Inline] -> [[Block]] -> JATS 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 :: 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 (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 :: 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)
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 :: 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 (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
lbl -> Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"label" (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
lbl)) Maybe Text
mbmarker
Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents
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 (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 (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)
languageFor :: [Text] -> Text
languageFor :: [Text] -> Text
languageFor [Text]
classes =
case [Text]
langs of
(Text
l:[Text]
_) -> Text -> Text
escapeStringForXML Text
l
[] -> Text
""
where isLang :: Text -> Bool
isLang Text
l = Text -> Text
T.toLower Text
l Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
T.toLower [Text]
languages
langsFrom :: Text -> [Text]
langsFrom Text
s = if Text -> Bool
isLang Text
s
then [Text
s]
else Text -> [Text]
languagesByExtension (Text -> [Text]) -> (Text -> Text) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text
s
langs :: [Text]
langs = (Text -> [Text]) -> [Text] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Text -> [Text]
langsFrom [Text]
classes
codeAttr :: Attr -> (Text, [(Text, Text)])
codeAttr :: (Text, [Text], [(Text, Text)]) -> (Text, [(Text, Text)])
codeAttr (Text
ident,[Text]
classes,[(Text, Text)]
kvs) = (Text
lang, [(Text, Text)]
attr)
where
attr :: [(Text, Text)]
attr = [(Text
"id",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 (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 = [Text] -> Text
languageFor [Text]
classes
blockToJATS :: PandocMonad m => WriterOptions -> Block -> JATS m (Doc Text)
blockToJATS :: WriterOptions -> Block -> JATS m (Doc Text)
blockToJATS WriterOptions
_ Block
Null = Doc Text -> JATS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
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
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 (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]
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 (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 -> Text -> Maybe Text
T.stripPrefix Text
"ref-" -> Just Text
_,[Text]
_,[(Text, Text)]
_) [Para [Inline]
lst]) =
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
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 (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 (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
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 (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 (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
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 (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 (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]
title
Doc Text -> JATS m (Doc Text)
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 [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 [Image (Text
ident,[Text]
_,[(Text, Text)]
kvs) [Inline]
txt
(Text
src,Text -> Text -> Maybe Text
T.stripPrefix Text
"fig:" -> Just Text
tit)]) = do
Doc Text
alt <- WriterOptions -> [Inline] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
txt
let (Text
maintype, Text
subtype) = Text -> [(Text, Text)] -> (Text, Text)
imageMimeType Text
src [(Text, Text)]
kvs
let capt :: Doc Text
capt = if [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
txt
then Doc Text
forall a. Doc a
empty
else Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple Text
"caption" (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
"p" Doc Text
alt
let attr :: [(Text, Text)]
attr = [(Text
"id", 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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"fig-type", Text
"orientation",
Text
"position", Text
"specific-use"]]
let graphicattr :: [(Text, Text)]
graphicattr = [(Text
"mimetype",Text
maintype),
(Text
"mime-subtype",Text
subtype),
(Text
"xlink:href",Text
src),
(Text
"xlink:title",Text
tit)]
Doc Text -> JATS m (Doc Text)
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)]
attr (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
Doc Text
capt Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"graphic" [(Text, Text)]
graphicattr
blockToJATS WriterOptions
_ (Para [Image (Text
ident,[Text]
_,[(Text, Text)]
kvs) [Inline]
_ (Text
src, Text
tit)]) = do
let (Text
maintype, Text
subtype) = Text -> [(Text, Text)] -> (Text, Text)
imageMimeType Text
src [(Text, Text)]
kvs
let attr :: [(Text, Text)]
attr = [(Text
"id", 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 (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"]]
Doc Text -> JATS m (Doc Text)
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)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"graphic" [(Text, Text)]
attr
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 blocksToJats' :: WriterOptions -> [Block] -> JATS m (Doc Text)
blocksToJats' = if JATSTagSet
tagSet JATSTagSet -> JATSTagSet -> Bool
forall a. Eq a => a -> a -> Bool
== JATSTagSet
TagSetArticleAuthoring
then (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)
else WriterOptions -> [Block] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> JATS m (Doc Text)
blocksToJATS
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
<$> WriterOptions -> [Block] -> JATS m (Doc Text)
blocksToJats' WriterOptions
opts [Block]
blocks
blockToJATS WriterOptions
_ (CodeBlock (Text, [Text], [(Text, Text)])
a Text
str) = Doc Text -> JATS m (Doc Text)
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) = (Text, [Text], [(Text, Text)]) -> (Text, [(Text, Text)])
codeAttr (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 (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 (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 (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 (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 (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)
inlinesToJATS :: PandocMonad m => WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS :: 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]
-> JATS m (Doc Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Inline -> JATS 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)
mapM (WriterOptions -> Inline -> JATS 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 :: WriterOptions -> Inline -> JATS m (Doc Text)
inlineToJATS WriterOptions
_ (Str Text
str) = Doc Text -> JATS m (Doc Text)
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 -> 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) -> 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
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) -> 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
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) -> 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
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) -> 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
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) -> 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
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) -> 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
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) -> 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
inlineToJATS WriterOptions
opts (Quoted QuoteType
SingleQuote [Inline]
lst) = do
Doc Text
contents <- WriterOptions -> [Inline] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
lst
Doc Text -> JATS m (Doc Text)
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
$ 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] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
lst
Doc Text -> JATS m (Doc Text)
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
$ 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
_ (Code (Text, [Text], [(Text, Text)])
a Text
str) =
Doc Text -> JATS m (Doc Text)
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) -> 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) = (Text, [Text], [(Text, Text)]) -> (Text, [(Text, Text)])
codeAttr (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 -> JATS m (Doc Text)
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
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 -> JATS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
inlineToJATS WriterOptions
_ Inline
LineBreak = Doc Text -> JATS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
cr
inlineToJATS WriterOptions
_ Inline
Space = Doc Text -> JATS m (Doc Text)
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 -> JATS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
cr
| Bool
otherwise = Doc Text -> JATS m (Doc Text)
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) -> 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 (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) -> 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 (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 -> JATS m (Doc Text)
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
"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] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
lst
inlineToJATS WriterOptions
opts (Span (Text
"",[Text]
_,[]) [Inline]
ils) = WriterOptions -> [Inline] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
ils
inlineToJATS WriterOptions
opts (Span (Text
ident,[Text]
_,[(Text, Text)]
kvs) [Inline]
ils) = do
Doc Text
contents <- WriterOptions -> [Inline] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
ils
let attr :: [(Text, Text)]
attr = [(Text
"id",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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"content-type", Text
"rationale",
Text
"rid", Text
"specific-use"]]
Doc Text -> JATS m (Doc Text)
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)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"milestone-start" [(Text, Text)]
attr 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
<>
Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"milestone-end" []
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 -> JATS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> JATS m (Doc Text))
-> (Doc Text -> Doc Text) -> Doc Text -> JATS 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 -> JATS m (Doc Text)) -> Doc Text -> JATS 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 -> JATS m (Doc Text)
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
"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
"id", Text
ident) | Bool -> Bool
not (Text -> Bool
T.null Text
ident)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[(Text
"alt", [Inline] -> Text
forall a. Walkable Inline a => a -> Text
stringify [Inline]
txt) | Bool -> Bool
not ([Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
txt)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[(Text
"rid", Text
src)] [(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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"ref-type", Text
"specific-use"]]
if [Inline] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inline]
txt
then Doc Text -> JATS m (Doc Text)
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)] -> 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] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
txt
Doc Text -> JATS m (Doc Text)
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
"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
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 (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] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
txt
Doc Text -> JATS m (Doc Text)
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
"ext-link" [(Text, Text)]
attr Doc Text
contents
inlineToJATS WriterOptions
_ (Image (Text
ident,[Text]
_,[(Text, Text)]
kvs) [Inline]
_ (Text
src, Text
tit)) = do
let mbMT :: Maybe Text
mbMT = String -> Maybe Text
getMimeType (Text -> String
T.unpack Text
src)
let 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 (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)
let 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 (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)
let attr :: [(Text, Text)]
attr = [(Text
"id", 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 (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"]]
Doc Text -> JATS m (Doc Text)
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)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag Text
"inline-graphic" [(Text, Text)]
attr
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
fs -> String -> String -> Maybe Day
parsetimeWith String
fs (String -> Maybe Day) -> String -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
s) [String]
formats) :: Maybe Day
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"]