{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module Text.Pandoc.Writers.JATS ( writeJATS ) where
import Prelude
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, 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.Math
import Text.Pandoc.Writers.Shared
import Text.Pandoc.XML
import Text.TeXMath
import qualified Text.XML.Light as Xml
data JATSVersion = JATS1_1
deriving (JATSVersion -> JATSVersion -> Bool
(JATSVersion -> JATSVersion -> Bool)
-> (JATSVersion -> JATSVersion -> Bool) -> Eq JATSVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JATSVersion -> JATSVersion -> Bool
$c/= :: JATSVersion -> JATSVersion -> Bool
== :: JATSVersion -> JATSVersion -> Bool
$c== :: JATSVersion -> JATSVersion -> Bool
Eq, Int -> JATSVersion -> ShowS
[JATSVersion] -> ShowS
JATSVersion -> String
(Int -> JATSVersion -> ShowS)
-> (JATSVersion -> String)
-> ([JATSVersion] -> ShowS)
-> Show JATSVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JATSVersion] -> ShowS
$cshowList :: [JATSVersion] -> ShowS
show :: JATSVersion -> String
$cshow :: JATSVersion -> String
showsPrec :: Int -> JATSVersion -> ShowS
$cshowsPrec :: Int -> JATSVersion -> ShowS
Show)
data JATSState = JATSState
{ JATSState -> [(Int, Doc Text)]
jatsNotes :: [(Int, Doc Text)] }
type JATS a = StateT JATSState (ReaderT JATSVersion a)
writeJATS :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeJATS :: WriterOptions -> Pandoc -> m Text
writeJATS opts :: WriterOptions
opts d :: Pandoc
d =
ReaderT JATSVersion m Text -> JATSVersion -> m Text
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (StateT JATSState (ReaderT JATSVersion m) Text
-> JATSState -> ReaderT JATSVersion m Text
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (WriterOptions
-> Pandoc -> StateT JATSState (ReaderT JATSVersion m) Text
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> JATS m Text
docToJATS WriterOptions
opts Pandoc
d)
(JATSState :: [(Int, Doc Text)] -> JATSState
JATSState{ jatsNotes :: [(Int, Doc Text)]
jatsNotes = [] }))
JATSVersion
JATS1_1
docToJATS :: PandocMonad m => WriterOptions -> Pandoc -> JATS m Text
docToJATS :: WriterOptions -> Pandoc -> JATS m Text
docToJATS opts :: WriterOptions
opts (Pandoc meta :: Meta
meta blocks :: [Block]
blocks) = do
let isBackBlock :: Block -> Bool
isBackBlock (Div ("refs",_,_) _) = Bool
True
isBackBlock _ = Bool
False
let (backblocks :: [Block]
backblocks, bodyblocks :: [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
TopLevelPart -> -1
TopLevelChapter -> 0
TopLevelSection -> 1
TopLevelDefault -> 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 JATSVersion 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 <- [Doc Text] -> [Doc Text]
forall a. [a] -> [a]
reverse ([Doc Text] -> [Doc Text])
-> ([(Int, Doc Text)] -> [Doc Text])
-> [(Int, Doc Text)]
-> [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])
-> StateT JATSState (ReaderT JATSVersion m) [(Int, Doc Text)]
-> StateT JATSState (ReaderT JATSVersion m) [Doc Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (JATSState -> [(Int, Doc Text)])
-> StateT JATSState (ReaderT JATSVersion m) [(Int, Doc Text)]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets JATSState -> [(Int, Doc Text)]
jatsNotes
Doc Text
backs <- [Block] -> JATS m (Doc Text)
fromBlocks [Block]
backblocks
let fns :: Doc Text
fns = if [Doc Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Doc Text]
notes
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 "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 "date" Context Text
metadata of
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
Nothing -> Val Text
forall a. Val a
NullVal
Just day :: Day
day ->
let (y :: Integer
y,m :: Int
m,d :: 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) -> Context Text -> Val Text
forall a b. (a -> b) -> a -> b
$ Map Text (Val Text) -> Context Text
forall a. Map Text (Val a) -> Context a
Context
(Map Text (Val Text) -> Context Text)
-> Map Text (Val Text) -> Context Text
forall a b. (a -> b) -> a -> b
$ Text -> Val Text -> Map Text (Val Text) -> Map Text (Val Text)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert ("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)
(Map Text (Val Text) -> Map Text (Val Text))
-> Map Text (Val Text) -> Map Text (Val Text)
forall a b. (a -> b) -> a -> b
$ Text -> Val Text -> Map Text (Val Text) -> Map Text (Val Text)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert "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)
(Map Text (Val Text) -> Map Text (Val Text))
-> Map Text (Val Text) -> Map Text (Val Text)
forall a b. (a -> b) -> a -> b
$ Text -> Val Text -> Map Text (Val Text) -> Map Text (Val Text)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert "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)
(Map Text (Val Text) -> Map Text (Val Text))
-> Map Text (Val Text) -> Map Text (Val Text)
forall a b. (a -> b) -> a -> b
$ Text -> Val Text -> Map Text (Val Text) -> Map Text (Val Text)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert "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 "%F" Day
day)
(Map Text (Val Text) -> Map Text (Val Text))
-> Map Text (Val Text) -> Map Text (Val Text)
forall a b. (a -> b) -> a -> b
$ Map Text (Val Text)
forall a. Monoid a => a
mempty
Just x :: 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 "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 "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 "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 "mathml" (case WriterOptions -> HTMLMathMethod
writerHTMLMathMethod WriterOptions
opts of
MathML -> Bool
True
_ -> 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
Nothing -> Doc Text
main
Just tpl :: 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 needsWrap :: Block -> Bool
needsWrap opts :: WriterOptions
opts =
([Doc Text] -> Doc Text)
-> StateT JATSState (ReaderT JATSVersion 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 JATSVersion m) [Doc Text]
-> JATS m (Doc Text))
-> ([Block] -> StateT JATSState (ReaderT JATSVersion 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 JATSVersion 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 JATSVersion m) (Doc Text)
wrappedBlockToJATS
where
wrappedBlockToJATS :: Block -> StateT JATSState (ReaderT JATSVersion m) (Doc Text)
wrappedBlockToJATS b :: Block
b = do
Doc Text
inner <- WriterOptions
-> Block -> StateT JATSState (ReaderT JATSVersion m) (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> JATS m (Doc Text)
blockToJATS WriterOptions
opts Block
b
Doc Text -> StateT JATSState (ReaderT JATSVersion m) (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc Text -> StateT JATSState (ReaderT JATSVersion m) (Doc Text))
-> Doc Text -> StateT JATSState (ReaderT JATSVersion 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 "p" [("specific-use","wrapper")] Doc Text
inner
else Doc Text
inner
plainToPara :: Block -> Block
plainToPara :: Block -> Block
plainToPara (Plain x :: [Inline]
x) = [Inline] -> Block
Para [Inline]
x
plainToPara x :: Block
x = Block
x
deflistItemsToJATS :: PandocMonad m
=> WriterOptions -> [([Inline],[[Block]])] -> JATS m (Doc Text)
deflistItemsToJATS :: WriterOptions -> [([Inline], [[Block]])] -> JATS m (Doc Text)
deflistItemsToJATS opts :: WriterOptions
opts items :: [([Inline], [[Block]])]
items =
[Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> StateT JATSState (ReaderT JATSVersion 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 JATSVersion 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 opts :: WriterOptions
opts term :: [Inline]
term defs :: [[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 "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 "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 "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 opts :: WriterOptions
opts markers :: Maybe [Text]
markers items :: [[Block]]
items =
case Maybe [Text]
markers of
Nothing -> [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> StateT JATSState (ReaderT JATSVersion 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 JATSVersion 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 ms :: [Text]
ms -> [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text)
-> StateT JATSState (ReaderT JATSVersion 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 JATSVersion 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 opts :: WriterOptions
opts mbmarker :: Maybe Text
mbmarker item :: [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 "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 (\lbl :: Text
lbl -> Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple "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 src :: Text
src kvs :: [(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 "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 "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
/='/') (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 "" (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 "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 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
/='/')) (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 classes :: [Text]
classes =
case [Text]
langs of
(l :: Text
l:_) -> Text -> Text
escapeStringForXML Text
l
[] -> ""
where isLang :: Text -> Bool
isLang l :: 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 s :: 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 :: Attr -> (Text, [(Text, Text)])
codeAttr (ident :: Text
ident,classes :: [Text]
classes,kvs :: [(Text, Text)]
kvs) = (Text
lang, [(Text, Text)]
attr)
where
attr :: [(Text, Text)]
attr = [("id",Text
ident) | Bool -> Bool
not (Text -> Bool
T.null Text
ident)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[("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) | (k :: Text
k,v :: Text
v) <- [(Text, Text)]
kvs, Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["code-type",
"code-version", "executable",
"language-version", "orientation",
"platforms", "position", "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 _ Null = Doc Text -> JATS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToJATS opts :: WriterOptions
opts (Div (id' :: Text
id',"section":_,kvs :: [(Text, Text)]
kvs) (Header _lvl :: Int
_lvl _ ils :: [Inline]
ils : xs :: [Block]
xs)) = do
let idAttr :: [(Text, Text)]
idAttr = [("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 = ["sec-type", "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) | (k :: Text
k,v :: 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 "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 "title" Doc Text
title' Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
contents
blockToJATS opts :: WriterOptions
opts (Div (Text -> Text -> Maybe Text
T.stripPrefix "ref-" -> Just _,_,_) [Para lst :: [Inline]
lst]) =
WriterOptions -> [Inline] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
lst
blockToJATS opts :: WriterOptions
opts (Div ("refs",_,_) xs :: [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 "ref-list" Doc Text
contents
blockToJATS opts :: WriterOptions
opts (Div (ident :: Text
ident,[cls :: Text
cls],kvs :: [(Text, Text)]
kvs) bs :: [Block]
bs) | Text
cls Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["fig", "caption", "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 = [("id", Text
ident) | Bool -> Bool
not (Text -> Bool
T.null Text
ident)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[("xml:lang",Text
l) | ("lang",l :: Text
l) <- [(Text, Text)]
kvs] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[(Text
k,Text
v) | (k :: Text
k,v :: Text
v) <- [(Text, Text)]
kvs, Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["specific-use",
"content-type", "orientation", "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 opts :: WriterOptions
opts (Div (ident :: Text
ident,_,kvs :: [(Text, Text)]
kvs) bs :: [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 = [("id", Text
ident) | Bool -> Bool
not (Text -> Bool
T.null Text
ident)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[("xml:lang",Text
l) | ("lang",l :: Text
l) <- [(Text, Text)]
kvs] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[(Text
k,Text
v) | (k :: Text
k,v :: Text
v) <- [(Text, Text)]
kvs, Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["specific-use",
"content-type", "orientation", "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 "boxed-text" [(Text, Text)]
attr Doc Text
contents
blockToJATS opts :: WriterOptions
opts (Header _ _ title :: [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 "title" Doc Text
title'
blockToJATS opts :: WriterOptions
opts (Plain lst :: [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 opts :: WriterOptions
opts (Para [Image (ident :: Text
ident,_,kvs :: [(Text, Text)]
kvs) txt :: [Inline]
txt
(src :: Text
src,Text -> Text -> Maybe Text
T.stripPrefix "fig:" -> Just tit :: 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 (maintype :: Text
maintype, subtype :: 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 "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 "p" Doc Text
alt
let attr :: [(Text, Text)]
attr = [("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) | (k :: Text
k,v :: Text
v) <- [(Text, Text)]
kvs, Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["fig-type", "orientation",
"position", "specific-use"]]
let graphicattr :: [(Text, Text)]
graphicattr = [("mimetype",Text
maintype),
("mime-subtype",Text
subtype),
("xlink:href",Text
src),
("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 "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 "graphic" [(Text, Text)]
graphicattr
blockToJATS _ (Para [Image (ident :: Text
ident,_,kvs :: [(Text, Text)]
kvs) _ (src :: Text
src, tit :: Text
tit)]) = do
let (maintype :: Text
maintype, subtype :: Text
subtype) = Text -> [(Text, Text)] -> (Text, Text)
imageMimeType Text
src [(Text, Text)]
kvs
let attr :: [(Text, Text)]
attr = [("id", Text
ident) | Bool -> Bool
not (Text -> Bool
T.null Text
ident)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[("mimetype", Text
maintype),
("mime-subtype", Text
subtype),
("xlink:href", Text
src)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[("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) | (k :: Text
k,v :: Text
v) <- [(Text, Text)]
kvs, Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["baseline-shift",
"content-type", "specific-use", "xlink:actuate",
"xlink:href", "xlink:role", "xlink:show",
"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 "graphic" [(Text, Text)]
attr
blockToJATS opts :: WriterOptions
opts (Para lst :: [Inline]
lst) =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple "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 opts :: WriterOptions
opts (LineBlock lns :: [[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 opts :: WriterOptions
opts (BlockQuote blocks :: [Block]
blocks) =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented "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)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Block] -> JATS m (Doc Text)
blocksToJATS WriterOptions
opts [Block]
blocks
blockToJATS _ (CodeBlock a :: Attr
a 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
$
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 (lang :: Text
lang, attr :: [(Text, Text)]
attr) = Attr -> (Text, [(Text, Text)])
codeAttr Attr
a
tag :: Text
tag = if Text -> Bool
T.null Text
lang then "preformat" else "code"
blockToJATS _ (BulletList []) = Doc Text -> JATS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToJATS opts :: WriterOptions
opts (BulletList lst :: [[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 "list" [("list-type", "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 _ (OrderedList _ []) = Doc Text -> JATS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToJATS opts :: WriterOptions
opts (OrderedList (start :: Int
start, numstyle :: ListNumberStyle
numstyle, delimstyle :: ListNumberDelim
delimstyle) items :: [[Block]]
items) = do
let listType :: Text
listType = case ListNumberStyle
numstyle of
DefaultStyle -> "order"
Decimal -> "order"
Example -> "order"
UpperAlpha -> "alpha-upper"
LowerAlpha -> "alpha-lower"
UpperRoman -> "roman-upper"
LowerRoman -> "roman-lower"
let simpleList :: Bool
simpleList = Int
start Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 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
$
(Int, ListNumberStyle, ListNumberDelim) -> [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 "list" [("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 opts :: WriterOptions
opts (DefinitionList lst :: [([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 "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 _ b :: Block
b@(RawBlock f :: Format
f str :: Text
str)
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== "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 JATSVersion m) ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT JATSState (ReaderT JATSVersion m) ())
-> LogMessage -> StateT JATSState (ReaderT JATSVersion 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 _ HorizontalRule = Doc Text -> JATS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
blockToJATS opts :: WriterOptions
opts (Table [] aligns :: [Alignment]
aligns widths :: [Double]
widths headers :: [[Block]]
headers rows :: [[[Block]]]
rows) = do
let percent :: a -> Text
percent w :: a
w = Integer -> Text
forall a. Show a => a -> Text
tshow (a -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate (100a -> a -> a
forall a. Num a => a -> a -> a
*a
w) :: Integer) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "*"
let coltags :: Doc Text
coltags = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall a b. (a -> b) -> a -> b
$ (Double -> Alignment -> Doc Text)
-> [Double] -> [Alignment] -> [Doc Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\w :: Double
w al :: Alignment
al -> Text -> [(Text, Text)] -> Doc Text
forall a.
(HasChars a, IsString a) =>
Text -> [(Text, Text)] -> Doc a
selfClosingTag "col"
([("width", Double -> Text
forall a. RealFrac a => a -> Text
percent Double
w) | Double
w Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> 0] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[("align", Alignment -> Text
alignmentToText Alignment
al)])) [Double]
widths [Alignment]
aligns
Doc Text
thead <- if ([Block] -> Bool) -> [[Block]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Block]]
headers
then Doc Text -> JATS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
empty
else Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented "thead" (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 -> Bool -> [[Block]] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Bool -> [[Block]] -> JATS m (Doc Text)
tableRowToJATS WriterOptions
opts Bool
True [[Block]]
headers
Doc Text
tbody <- (Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented "tbody" (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat) ([Doc Text] -> Doc Text)
-> StateT JATSState (ReaderT JATSVersion 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 JATSVersion m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> Bool -> [[Block]] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Bool -> [[Block]] -> JATS m (Doc Text)
tableRowToJATS WriterOptions
opts Bool
False) [[[Block]]]
rows
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 "table" [] (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text
coltags Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
thead Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
tbody
blockToJATS opts :: WriterOptions
opts (Table caption :: [Inline]
caption aligns :: [Alignment]
aligns widths :: [Double]
widths headers :: [[Block]]
headers rows :: [[[Block]]]
rows) = do
Doc Text
captionDoc <- Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented "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)
blockToJATS WriterOptions
opts ([Inline] -> Block
Para [Inline]
caption)
Doc Text
tbl <- WriterOptions -> Block -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> JATS m (Doc Text)
blockToJATS WriterOptions
opts ([Inline]
-> [Alignment] -> [Double] -> [[Block]] -> [[[Block]]] -> Block
Table [] [Alignment]
aligns [Double]
widths [[Block]]
headers [[[Block]]]
rows)
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 "table-wrap" [] (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$ Doc Text
captionDoc Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$ Doc Text
tbl
alignmentToText :: Alignment -> Text
alignmentToText :: Alignment -> Text
alignmentToText alignment :: Alignment
alignment = case Alignment
alignment of
AlignLeft -> "left"
AlignRight -> "right"
AlignCenter -> "center"
AlignDefault -> "left"
tableRowToJATS :: PandocMonad m
=> WriterOptions
-> Bool
-> [[Block]]
-> JATS m (Doc Text)
tableRowToJATS :: WriterOptions -> Bool -> [[Block]] -> JATS m (Doc Text)
tableRowToJATS opts :: WriterOptions
opts isHeader :: Bool
isHeader cols :: [[Block]]
cols =
(Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsIndented "tr" (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat) ([Doc Text] -> Doc Text)
-> StateT JATSState (ReaderT JATSVersion 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 JATSVersion m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> Bool -> [Block] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Bool -> [Block] -> JATS m (Doc Text)
tableItemToJATS WriterOptions
opts Bool
isHeader) [[Block]]
cols
tableItemToJATS :: PandocMonad m
=> WriterOptions
-> Bool
-> [Block]
-> JATS m (Doc Text)
tableItemToJATS :: WriterOptions -> Bool -> [Block] -> JATS m (Doc Text)
tableItemToJATS opts :: WriterOptions
opts isHeader :: Bool
isHeader [Plain item :: [Inline]
item] =
Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False (if Bool
isHeader then "th" else "td") [] (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]
item
tableItemToJATS opts :: WriterOptions
opts isHeader :: Bool
isHeader item :: [Block]
item =
(Bool -> Text -> [(Text, Text)] -> Doc Text -> Doc Text
forall a.
(HasChars a, IsString a) =>
Bool -> Text -> [(Text, Text)] -> Doc a -> Doc a
inTags Bool
False (if Bool
isHeader then "th" else "td") [] (Doc Text -> Doc Text)
-> ([Doc Text] -> Doc Text) -> [Doc Text] -> Doc Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
vcat) ([Doc Text] -> Doc Text)
-> StateT JATSState (ReaderT JATSVersion 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 JATSVersion m) [Doc Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (WriterOptions -> Block -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Block -> JATS m (Doc Text)
blockToJATS WriterOptions
opts) [Block]
item
inlinesToJATS :: PandocMonad m => WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS :: WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS opts :: WriterOptions
opts lst :: [Inline]
lst = [Doc Text] -> Doc Text
forall a. [Doc a] -> Doc a
hcat ([Doc Text] -> Doc Text)
-> StateT JATSState (ReaderT JATSVersion 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 JATSVersion 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 (x :: Inline
x:xs :: [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 "jats") z :: Text
z) =
"<pub-id pub-id-type=" Text -> Text -> Bool
`T.isPrefixOf` Text
z
needsFixing _ = Bool
False
isRawInline :: Inline -> Bool
isRawInline (RawInline{}) = Bool
True
isRawInline _ = Bool
False
(ys :: [Inline]
ys,zs :: [Inline]
zs) = (Inline -> Bool) -> [Inline] -> ([Inline], [Inline])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Inline -> Bool
isRawInline [Inline]
xs
fixCitations (x :: Inline
x:xs :: [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 _ (Str 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 opts :: WriterOptions
opts (Emph lst :: [Inline]
lst) =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple "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 opts :: WriterOptions
opts (Strong lst :: [Inline]
lst) =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple "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 opts :: WriterOptions
opts (Strikeout lst :: [Inline]
lst) =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple "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 opts :: WriterOptions
opts (Superscript lst :: [Inline]
lst) =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple "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 opts :: WriterOptions
opts (Subscript lst :: [Inline]
lst) =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple "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 opts :: WriterOptions
opts (SmallCaps lst :: [Inline]
lst) =
Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple "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 opts :: WriterOptions
opts (Quoted SingleQuote lst :: [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 '‘' 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 '’'
inlineToJATS opts :: WriterOptions
opts (Quoted DoubleQuote lst :: [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 '“' 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 '”'
inlineToJATS _ (Code a :: Attr
a 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
$ 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 (lang :: Text
lang, attr :: [(Text, Text)]
attr) = Attr -> (Text, [(Text, Text)])
codeAttr Attr
a
tag :: Text
tag = if Text -> Bool
T.null Text
lang then "monospace" else "code"
inlineToJATS _ il :: Inline
il@(RawInline f :: Format
f x :: Text
x)
| Format
f Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
== "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 JATSVersion m) ()
forall (m :: * -> *). PandocMonad m => LogMessage -> m ()
report (LogMessage -> StateT JATSState (ReaderT JATSVersion m) ())
-> LogMessage -> StateT JATSState (ReaderT JATSVersion 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 _ LineBreak = Doc Text -> JATS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
cr
inlineToJATS _ Space = Doc Text -> JATS m (Doc Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Doc Text
forall a. Doc a
space
inlineToJATS opts :: WriterOptions
opts 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 opts :: WriterOptions
opts (Note contents :: [Block]
contents) = do
[(Int, Doc Text)]
notes <- (JATSState -> [(Int, Doc Text)])
-> StateT JATSState (ReaderT JATSVersion 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
(n :: Int
n, _):_ -> Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
[] -> 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 "fn" [("id","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 JATSVersion m) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((JATSState -> JATSState)
-> StateT JATSState (ReaderT JATSVersion m) ())
-> (JATSState -> JATSState)
-> StateT JATSState (ReaderT JATSVersion m) ()
forall a b. (a -> b) -> a -> b
$ \st :: 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 "xref" [("ref-type", "fn"),
("rid", "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 opts :: WriterOptions
opts (Cite _ lst :: [Inline]
lst) =
WriterOptions -> [Inline] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
lst
inlineToJATS opts :: WriterOptions
opts (Span ("",_,[]) ils :: [Inline]
ils) = WriterOptions -> [Inline] -> JATS m (Doc Text)
forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> [Inline] -> JATS m (Doc Text)
inlinesToJATS WriterOptions
opts [Inline]
ils
inlineToJATS opts :: WriterOptions
opts (Span (ident :: Text
ident,_,kvs :: [(Text, Text)]
kvs) ils :: [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 = [("id",Text
ident) | Bool -> Bool
not (Text -> Bool
T.null Text
ident)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[("xml:lang",Text
l) | ("lang",l :: Text
l) <- [(Text, Text)]
kvs] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[(Text
k,Text
v) | (k :: Text
k,v :: Text
v) <- [(Text, Text)]
kvs
, Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["content-type", "rationale",
"rid", "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 "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 "milestone-end" []
inlineToJATS _ (Math t :: MathType
t str :: Text
str) = do
let addPref :: Attr -> Attr
addPref (Xml.Attr q :: QName
q v :: String
v)
| QName -> String
Xml.qName QName
q String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "xmlns" = QName -> String -> Attr
Xml.Attr QName
q{ qName :: String
Xml.qName = "xmlns:mml" } String
v
| Bool
otherwise = QName -> String -> Attr
Xml.Attr QName
q String
v
let fixNS' :: Element -> Element
fixNS' e :: 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 "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
.
(\e :: 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 JATSVersion 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
DisplayMath -> "disp-formula"
InlineMath -> "inline-formula"
let rawtex :: Doc Text
rawtex = Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple "tex-math"
(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 "<![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 "]]>"
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
tagtype (Doc Text -> Doc Text) -> Doc Text -> Doc Text
forall a b. (a -> b) -> a -> b
$
case Either Inline Element
res of
Right r :: Element
r -> Text -> Doc Text -> Doc Text
forall a. (HasChars a, IsString a) => Text -> Doc a -> Doc a
inTagsSimple "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
rawtex Doc Text -> Doc Text -> Doc Text
forall a. Doc a -> Doc a -> Doc a
$$
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)
Left _ -> Doc Text
rawtex
inlineToJATS _ (Link _attr :: Attr
_attr [Str t :: Text
t] (Text -> Text -> Maybe Text
T.stripPrefix "mailto:" -> Just email :: Text
email, _))
| 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 "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 opts :: WriterOptions
opts (Link (ident :: Text
ident,_,kvs :: [(Text, Text)]
kvs) txt :: [Inline]
txt (Text -> Maybe (Char, Text)
T.uncons -> Just ('#', src :: Text
src), _)) = do
let attr :: [(Text, Text)]
attr = [("id", Text
ident) | Bool -> Bool
not (Text -> Bool
T.null Text
ident)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[("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]
++
[("rid", Text
src)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[(Text
k,Text
v) | (k :: Text
k,v :: Text
v) <- [(Text, Text)]
kvs, Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["ref-type", "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 "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 "xref" [(Text, Text)]
attr Doc Text
contents
inlineToJATS opts :: WriterOptions
opts (Link (ident :: Text
ident,_,kvs :: [(Text, Text)]
kvs) txt :: [Inline]
txt (src :: Text
src, tit :: Text
tit)) = do
let attr :: [(Text, Text)]
attr = [("id", Text
ident) | Bool -> Bool
not (Text -> Bool
T.null Text
ident)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[("ext-link-type", "uri"),
("xlink:href", Text
src)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[("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) | (k :: Text
k,v :: Text
v) <- [(Text, Text)]
kvs, Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["assigning-authority",
"specific-use", "xlink:actuate",
"xlink:role", "xlink:show",
"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 "ext-link" [(Text, Text)]
attr Doc Text
contents
inlineToJATS _ (Image (ident :: Text
ident,_,kvs :: [(Text, Text)]
kvs) _ (src :: Text
src, tit :: 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 "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 "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
/='/') (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 "" (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 "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 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
/='/')) (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 = [("id", Text
ident) | Bool -> Bool
not (Text -> Bool
T.null Text
ident)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[("mimetype", Text
maintype),
("mime-subtype", Text
subtype),
("xlink:href", Text
src)] [(Text, Text)] -> [(Text, Text)] -> [(Text, Text)]
forall a. [a] -> [a] -> [a]
++
[("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) | (k :: Text
k,v :: Text
v) <- [(Text, Text)]
kvs, Text
k Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["baseline-shift",
"content-type", "specific-use", "xlink:actuate",
"xlink:href", "xlink:role", "xlink:show",
"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 "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 _ = Bool
False
isPara :: Block -> Bool
isPara :: Block -> Bool
isPara Para{} = Bool
True
isPara Plain{} = Bool
True
isPara _ = Bool
False
demoteHeaderAndRefs :: Block -> Block
demoteHeaderAndRefs :: Block -> Block
demoteHeaderAndRefs (Header _ _ ils :: [Inline]
ils) = [Inline] -> Block
Para [Inline]
ils
demoteHeaderAndRefs (Div ("refs",cls :: [Text]
cls,kvs :: [(Text, Text)]
kvs) bs :: [Block]
bs) =
Attr -> [Block] -> Block
Div ("",[Text]
cls,[(Text, Text)]
kvs) [Block]
bs
demoteHeaderAndRefs x :: Block
x = Block
x
parseDate :: Text -> Maybe Day
parseDate :: Text -> Maybe Day
parseDate s :: 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 (\fs :: 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 = ["%x","%m/%d/%Y", "%D","%F", "%d %b %Y",
"%e %B %Y", "%b. %e, %Y", "%B %e, %Y",
"%Y%m%d", "%Y%m", "%Y"]