{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Readers.JATS ( readJATS ) where
import Control.Monad.State.Strict ( StateT(runStateT), gets, modify )
import Control.Monad (forM_, when, unless)
import Control.Monad.Except (throwError)
import Text.Pandoc.Error (PandocError(..))
import Data.Char (isDigit, isSpace)
import Data.Default
import Data.Generics
import Data.List (foldl', intersperse)
import qualified Data.Map as Map
import Data.Maybe (maybeToList, fromMaybe, catMaybes)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Text.Pandoc.XML (lookupEntity)
import Text.Pandoc.Builder
import Text.Pandoc.Class.PandocMonad (PandocMonad)
import Text.Pandoc.Options
import Text.Pandoc.Shared (safeRead, extractSpaces)
import Text.Pandoc.Walk (walk)
import Text.Pandoc.XML.Light
import Text.TeXMath (readMathML, writeTeX)
import qualified Data.Set as S (fromList, member)
import Data.Set ((\\))
import Text.Pandoc.Sources (ToSources(..), sourcesToText)
import Safe (headMay)
import Text.Printf (printf)
type JATS m = StateT JATSState m
data JATSState = JATSState{ JATSState -> Int
jatsSectionLevel :: Int
, JATSState -> QuoteType
jatsQuoteType :: QuoteType
, JATSState -> Meta
jatsMeta :: Meta
, JATSState -> Bool
jatsBook :: Bool
, :: Map.Map Text Blocks
, JATSState -> [Content]
jatsContent :: [Content]
, JATSState -> Bool
jatsInFigure :: Bool
} deriving Int -> JATSState -> ShowS
[JATSState] -> ShowS
JATSState -> String
(Int -> JATSState -> ShowS)
-> (JATSState -> String)
-> ([JATSState] -> ShowS)
-> Show JATSState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JATSState -> ShowS
showsPrec :: Int -> JATSState -> ShowS
$cshow :: JATSState -> String
show :: JATSState -> String
$cshowList :: [JATSState] -> ShowS
showList :: [JATSState] -> ShowS
Show
instance Default JATSState where
def :: JATSState
def = JATSState{ jatsSectionLevel :: Int
jatsSectionLevel = Int
0
, jatsQuoteType :: QuoteType
jatsQuoteType = QuoteType
DoubleQuote
, jatsMeta :: Meta
jatsMeta = Meta
forall a. Monoid a => a
mempty
, jatsBook :: Bool
jatsBook = Bool
False
, jatsFootnotes :: Map Text Blocks
jatsFootnotes = Map Text Blocks
forall a. Monoid a => a
mempty
, jatsContent :: [Content]
jatsContent = []
, jatsInFigure :: Bool
jatsInFigure = Bool
False }
readJATS :: (PandocMonad m, ToSources a)
=> ReaderOptions
-> a
-> m Pandoc
readJATS :: forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readJATS ReaderOptions
_ a
inp = do
let sources :: Sources
sources = a -> Sources
forall a. ToSources a => a -> Sources
toSources a
inp
[Content]
tree <- (Text -> m [Content])
-> ([Content] -> m [Content])
-> Either Text [Content]
-> m [Content]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (PandocError -> m [Content]
forall a. PandocError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m [Content])
-> (Text -> PandocError) -> Text -> m [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> PandocError
PandocXMLError Text
"") [Content] -> m [Content]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text [Content] -> m [Content])
-> Either Text [Content] -> m [Content]
forall a b. (a -> b) -> a -> b
$
Text -> Either Text [Content]
parseXMLContents (Text -> Text
TL.fromStrict (Text -> Text) -> (Sources -> Text) -> Sources -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sources -> Text
sourcesToText (Sources -> Text) -> Sources -> Text
forall a b. (a -> b) -> a -> b
$ Sources
sources)
([Blocks]
bs, JATSState
st') <- (StateT JATSState m [Blocks]
-> JATSState -> m ([Blocks], JATSState))
-> JATSState
-> StateT JATSState m [Blocks]
-> m ([Blocks], JATSState)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT JATSState m [Blocks] -> JATSState -> m ([Blocks], JATSState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (JATSState
forall a. Default a => a
def{ jatsContent = tree }) (StateT JATSState m [Blocks] -> m ([Blocks], JATSState))
-> StateT JATSState m [Blocks] -> m ([Blocks], JATSState)
forall a b. (a -> b) -> a -> b
$ (Content -> StateT JATSState m Blocks)
-> [Content] -> StateT JATSState m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Content -> StateT JATSState m Blocks
forall (m :: * -> *). PandocMonad m => Content -> JATS m Blocks
parseBlock [Content]
tree
let footnotes :: Map Text Blocks
footnotes = JATSState -> Map Text Blocks
jatsFootnotes JATSState
st'
let blockList :: [Block]
blockList = Blocks -> [Block]
forall a. Many a -> [a]
toList (Blocks -> [Block]) -> Blocks -> [Block]
forall a b. (a -> b) -> a -> b
$ [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat [Blocks]
bs
let linkToFootnotes :: Inline -> Inline
linkToFootnotes :: Inline -> Inline
linkToFootnotes link' :: Inline
link'@(Link Attr
_attr [Inline]
_txt (Text
href, Text
_title)) =
case Text -> Maybe (Char, Text)
T.uncons Text
href of
Just (Char
'#', Text
rid) -> case Text -> Map Text Blocks -> Maybe Blocks
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
rid Map Text Blocks
footnotes of
Just Blocks
footnote -> [Block] -> Inline
Note (Blocks -> [Block]
forall a. Many a -> [a]
toList Blocks
footnote)
Maybe Blocks
Nothing -> Inline
link'
Maybe (Char, Text)
_ -> Inline
link'
linkToFootnotes Inline
inline = Inline
inline
Pandoc -> m Pandoc
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Pandoc -> m Pandoc) -> Pandoc -> m Pandoc
forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc (JATSState -> Meta
jatsMeta JATSState
st') ((Inline -> Inline) -> [Block] -> [Block]
forall a b. Walkable a b => (a -> a) -> b -> b
walk Inline -> Inline
linkToFootnotes [Block]
blockList)
attrValue :: Text -> Element -> Text
attrValue :: Text -> Element -> Text
attrValue Text
attr =
Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> (Element -> Maybe Text) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Element -> Maybe Text
maybeAttrValue Text
attr
maybeAttrValue :: Text -> Element -> Maybe Text
maybeAttrValue :: Text -> Element -> Maybe Text
maybeAttrValue Text
attr Element
elt =
(QName -> Bool) -> [Attr] -> Maybe Text
lookupAttrBy (\QName
x -> QName -> Text
qName QName
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
attr) (Element -> [Attr]
elAttribs Element
elt)
named :: Text -> Element -> Bool
named :: Text -> Element -> Bool
named Text
s Element
e = QName -> Text
qName (Element -> QName
elName Element
e) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
s
addMeta :: PandocMonad m => ToMetaValue a => Text -> a -> JATS m ()
addMeta :: forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> JATS m ()
addMeta Text
field a
val = (JATSState -> JATSState) -> StateT JATSState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Text -> a -> JATSState -> JATSState
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
forall b. ToMetaValue b => Text -> b -> JATSState -> JATSState
setMeta Text
field a
val)
instance HasMeta JATSState where
setMeta :: forall b. ToMetaValue b => Text -> b -> JATSState -> JATSState
setMeta Text
field b
v JATSState
s = JATSState
s {jatsMeta = setMeta field v (jatsMeta s)}
deleteMeta :: Text -> JATSState -> JATSState
deleteMeta Text
field JATSState
s = JATSState
s {jatsMeta = deleteMeta field (jatsMeta s)}
isBlockElement :: Content -> Bool
isBlockElement :: Content -> Bool
isBlockElement (Elem Element
e) = case QName -> Text
qName (Element -> QName
elName Element
e) of
Text
"disp-formula" -> if Element -> Bool
onlyOneChild Element
e
then if Element -> Bool
hasFormulaChild Element
e
then Bool
False
else case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"alternatives") Element
e of
Just Element
a -> if Element -> Bool
hasFormulaChild Element
a then Bool
False else Bool
True
Maybe Element
Nothing -> Bool
True
else Bool
True
Text
"alternatives" -> if Element -> Bool
hasFormulaChild Element
e then Bool
False else Bool
True
Text
_ -> QName -> Text
qName (Element -> QName
elName Element
e) Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Text
blocktags
where blocktags :: Set Text
blocktags = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList ([Text]
paragraphLevel [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
lists [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
formulae [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
other) Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
\\ [Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList [Text]
canBeInline
paragraphLevel :: [Text]
paragraphLevel = [Text
"address", Text
"answer", Text
"answer-set", Text
"array", Text
"boxed-text", Text
"chem-struct-wrap",
Text
"code", Text
"explanation", Text
"fig", Text
"fig-group", Text
"graphic", Text
"media", Text
"preformat", Text
"question", Text
"question-wrap", Text
"question-wrap-group",
Text
"supplementary-material", Text
"table-wrap", Text
"table-wrap-group",
Text
"alternatives", Text
"disp-formula", Text
"disp-formula-group"]
lists :: [Text]
lists = [Text
"def-list", Text
"list"]
formulae :: [Text]
formulae = [Text
"tex-math", Text
"mml:math"]
other :: [Text]
other = [Text
"p", Text
"related-article", Text
"related-object", Text
"ack", Text
"disp-quote",
Text
"speech", Text
"statement", Text
"verse-group", Text
"x"]
canBeInline :: [Text]
canBeInline = [Text
"tex-math", Text
"mml:math", Text
"related-object", Text
"x"]
onlyOneChild :: Element -> Bool
onlyOneChild Element
x = [Element] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Element -> [Element]
allChildren Element
x) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
allChildren :: Element -> [Element]
allChildren Element
x = (Element -> Bool) -> Element -> [Element]
filterChildren (Bool -> Element -> Bool
forall a b. a -> b -> a
const Bool
True) Element
x
isBlockElement Content
_ = Bool
False
trimNl :: Text -> Text
trimNl :: Text -> Text
trimNl = (Char -> Bool) -> Text -> Text
T.dropAround (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n')
getGraphic :: PandocMonad m => Element -> JATS m Inlines
getGraphic :: forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getGraphic Element
e = do
let atVal :: Text -> Text
atVal Text
a = Text -> Element -> Text
attrValue Text
a Element
e
let altText :: Text
altText = case (Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named Text
"alt-text") Element
e of
Just Element
alt -> Element -> Text
textContent Element
alt
Maybe Element
Nothing -> Text
forall a. Monoid a => a
mempty
(Text
ident, Text
title, Inlines
altText') = (Text -> Text
atVal Text
"id", Text -> Text
atVal Text
"title", Text -> Inlines
text Text
altText)
attr :: (Text, [Text], [a])
attr = (Text
ident, Text -> [Text]
T.words (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Text
atVal Text
"role", [])
imageUrl :: Text
imageUrl = Text -> Text
atVal Text
"href"
Inlines -> JATS m Inlines
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> JATS m Inlines) -> Inlines -> JATS m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
imageWith Attr
forall {a}. (Text, [Text], [a])
attr Text
imageUrl Text
title Inlines
altText'
getBlocks :: PandocMonad m => Element -> JATS m Blocks
getBlocks :: forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
getBlocks Element
e = [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> StateT JATSState m [Blocks] -> StateT JATSState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Content -> StateT JATSState m Blocks)
-> [Content] -> StateT JATSState m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Content -> StateT JATSState m Blocks
forall (m :: * -> *). PandocMonad m => Content -> JATS m Blocks
parseBlock (Element -> [Content]
elContent Element
e)
parseBlock :: PandocMonad m => Content -> JATS m Blocks
parseBlock :: forall (m :: * -> *). PandocMonad m => Content -> JATS m Blocks
parseBlock (Text (CData CDataKind
CDataRaw Text
_ Maybe Line
_)) = Blocks -> StateT JATSState m Blocks
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
parseBlock (Text (CData CDataKind
_ Text
s Maybe Line
_)) = if (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSpace Text
s
then Blocks -> StateT JATSState m Blocks
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
else Blocks -> StateT JATSState m Blocks
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> StateT JATSState m Blocks)
-> Blocks -> StateT JATSState m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
plain (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
trimInlines (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text Text
s
parseBlock (CRef Text
x) = Blocks -> StateT JATSState m Blocks
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> StateT JATSState m Blocks)
-> Blocks -> StateT JATSState m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
plain (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toUpper Text
x
parseBlock (Elem Element
e) = do
Int
sectionLevel <- (JATSState -> Int) -> StateT JATSState m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets JATSState -> Int
jatsSectionLevel
let parseBlockWithHeader :: StateT JATSState m Blocks
parseBlockWithHeader = Int -> StateT JATSState m Blocks -> StateT JATSState m Blocks
forall {m :: * -> *}.
PandocMonad m =>
Int -> StateT JATSState m Blocks -> StateT JATSState m Blocks
wrapWithHeader (Int
sectionLevelInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Element -> StateT JATSState m Blocks
forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
getBlocks Element
e)
case QName -> Text
qName (Element -> QName
elName Element
e) of
Text
"book" -> StateT JATSState m Blocks
parseBook
Text
"book-part-wrapper" -> StateT JATSState m Blocks
parseBook
Text
"p" -> (Inlines -> Blocks) -> [Content] -> StateT JATSState m Blocks
forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Blocks) -> [Content] -> StateT JATSState m Blocks
parseMixed Inlines -> Blocks
para (Element -> [Content]
elContent Element
e)
Text
"code" -> StateT JATSState m Blocks
codeBlockWithLang
Text
"preformat" -> StateT JATSState m Blocks
codeBlockWithLang
Text
"disp-quote" -> Int -> StateT JATSState m Blocks -> StateT JATSState m Blocks
forall {m :: * -> *}.
PandocMonad m =>
Int -> StateT JATSState m Blocks -> StateT JATSState m Blocks
wrapWithHeader (Int
sectionLevelInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) StateT JATSState m Blocks
parseBlockquote
Text
"list" -> Int -> StateT JATSState m Blocks -> StateT JATSState m Blocks
forall {m :: * -> *}.
PandocMonad m =>
Int -> StateT JATSState m Blocks -> StateT JATSState m Blocks
wrapWithHeader (Int
sectionLevelInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) StateT JATSState m Blocks
parseList
Text
"def-list" -> Int -> StateT JATSState m Blocks -> StateT JATSState m Blocks
forall {m :: * -> *}.
PandocMonad m =>
Int -> StateT JATSState m Blocks -> StateT JATSState m Blocks
wrapWithHeader (Int
sectionLevelInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) ([(Inlines, [Blocks])] -> Blocks
definitionList ([(Inlines, [Blocks])] -> Blocks)
-> StateT JATSState m [(Inlines, [Blocks])]
-> StateT JATSState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT JATSState m [(Inlines, [Blocks])]
deflistitems)
Text
"sec" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"abstract" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"ack" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"answer" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"answer-set" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"app" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"app-group" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"author-comment" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"author-notes" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"back" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"bio" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"explanation" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"glossary" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"kwd-group" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"list-item" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"notes" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"option" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"question" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"question-preamble" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"question-wrap-group" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"statement" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"supplement" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"table-wrap-foot" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"trans-abstract" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"verse-group" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"graphic" -> Inlines -> Blocks
para (Inlines -> Blocks)
-> StateT JATSState m Inlines -> StateT JATSState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getGraphic Element
e
Text
"journal-meta" -> Element -> StateT JATSState m Blocks
forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
parseMetadata Element
e
Text
"article-meta" -> Element -> StateT JATSState m Blocks
forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
parseMetadata Element
e
Text
"custom-meta" -> Element -> StateT JATSState m Blocks
forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
parseMetadata Element
e
Text
"processing-meta" -> Blocks -> StateT JATSState m Blocks
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
Text
"book-meta" -> Element -> StateT JATSState m Blocks
forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
parseMetadata Element
e
Text
"title" -> Blocks -> StateT JATSState m Blocks
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
Text
"label" -> Blocks -> StateT JATSState m Blocks
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
Text
"table" -> StateT JATSState m Blocks
parseTable
Text
"fig" -> StateT JATSState m Blocks
parseFigure
Text
"fig-group" -> Attr -> Blocks -> Blocks
divWith (Text -> Element -> Text
attrValue Text
"id" Element
e, [Text
"fig-group"], [])
(Blocks -> Blocks)
-> StateT JATSState m Blocks -> StateT JATSState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT JATSState m Blocks
forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
getBlocks Element
e
Text
"table-wrap" -> Attr -> Blocks -> Blocks
divWith (Text -> Element -> Text
attrValue Text
"id" Element
e, [Text
"table-wrap"], [])
(Blocks -> Blocks)
-> StateT JATSState m Blocks -> StateT JATSState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT JATSState m Blocks
forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
getBlocks Element
e
Text
"caption" -> do
Bool
inFigure <- (JATSState -> Bool) -> StateT JATSState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets JATSState -> Bool
jatsInFigure
if Bool
inFigure
then Blocks -> StateT JATSState m Blocks
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
else Attr -> Blocks -> Blocks
divWith (Text -> Element -> Text
attrValue Text
"id" Element
e, [Text
"caption"], []) (Blocks -> Blocks)
-> StateT JATSState m Blocks -> StateT JATSState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> StateT JATSState m Blocks -> StateT JATSState m Blocks
forall {m :: * -> *}.
PandocMonad m =>
Int -> StateT JATSState m Blocks -> StateT JATSState m Blocks
wrapWithHeader Int
6 (Element -> StateT JATSState m Blocks
forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
getBlocks Element
e)
Text
"fn-group" -> StateT JATSState m Blocks
parseFootnoteGroup
Text
"ref-list" -> Element -> StateT JATSState m Blocks
forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
parseRefList Element
e
Text
"alternatives" -> if Element -> Bool
hasFormulaChild Element
e
then (Text -> Inlines) -> Element -> StateT JATSState m Blocks
forall (m :: * -> *).
PandocMonad m =>
(Text -> Inlines) -> Element -> JATS m Blocks
blockFormula Text -> Inlines
displayMath Element
e
else Element -> StateT JATSState m Blocks
forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
getBlocks Element
e
Text
"disp-formula" -> if Element -> Bool
hasFormulaChild Element
e
then (Text -> Inlines) -> Element -> StateT JATSState m Blocks
forall (m :: * -> *).
PandocMonad m =>
(Text -> Inlines) -> Element -> JATS m Blocks
blockFormula Text -> Inlines
displayMath Element
e
else Attr -> Blocks -> Blocks
divWith (Text -> Element -> Text
attrValue Text
"id" Element
e, [Text
"disp-formula"], [])
(Blocks -> Blocks)
-> StateT JATSState m Blocks -> StateT JATSState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT JATSState m Blocks
forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
getBlocks Element
e
Text
"index" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"index-div" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"index-group" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"index-title-group" -> Blocks -> StateT JATSState m Blocks
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
Text
"toc" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"toc-div" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"toc-entry" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"toc-group" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"toc-title-group" -> Blocks -> StateT JATSState m Blocks
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
Text
"legend" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"dedication" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"foreword" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"preface" -> StateT JATSState m Blocks
parseBlockWithHeader
Text
"?xml" -> Blocks -> StateT JATSState m Blocks
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
Text
_ -> Element -> StateT JATSState m Blocks
forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
getBlocks Element
e
where parseMixed :: (Inlines -> Blocks) -> [Content] -> StateT JATSState m Blocks
parseMixed Inlines -> Blocks
container [Content]
conts = do
let ([Content]
ils,[Content]
rest) = (Content -> Bool) -> [Content] -> ([Content], [Content])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Content -> Bool
isBlockElement [Content]
conts
Inlines
ils' <- Inlines -> Inlines
trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> StateT JATSState m [Inlines] -> StateT JATSState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Content -> StateT JATSState m Inlines)
-> [Content] -> StateT JATSState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Content -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Content -> JATS m Inlines
parseInline [Content]
ils
let p :: Blocks
p = if Inlines
ils' Inlines -> Inlines -> Bool
forall a. Eq a => a -> a -> Bool
== Inlines
forall a. Monoid a => a
mempty then Blocks
forall a. Monoid a => a
mempty else Inlines -> Blocks
container Inlines
ils'
case [Content]
rest of
[] -> Blocks -> StateT JATSState m Blocks
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
p
(Content
r:[Content]
rs) -> do
Blocks
b <- Content -> StateT JATSState m Blocks
forall (m :: * -> *). PandocMonad m => Content -> JATS m Blocks
parseBlock Content
r
Blocks
x <- (Inlines -> Blocks) -> [Content] -> StateT JATSState m Blocks
parseMixed Inlines -> Blocks
container [Content]
rs
Blocks -> StateT JATSState m Blocks
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> StateT JATSState m Blocks)
-> Blocks -> StateT JATSState m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks
p Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
b Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
x
codeBlockWithLang :: StateT JATSState m Blocks
codeBlockWithLang = do
let classes' :: [Text]
classes' = case Text -> Element -> Text
attrValue Text
"language" Element
e of
Text
"" -> []
Text
x -> [Text
x]
Blocks -> StateT JATSState m Blocks
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> StateT JATSState m Blocks)
-> Blocks -> StateT JATSState m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Blocks
codeBlockWith (Text -> Element -> Text
attrValue Text
"id" Element
e, [Text]
classes', [])
(Text -> Blocks) -> Text -> Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Text
trimNl (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContentRecursive Element
e
parseBlockquote :: StateT JATSState m Blocks
parseBlockquote = do
Blocks
attrib <- case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"attrib") Element
e of
Maybe Element
Nothing -> Blocks -> StateT JATSState m Blocks
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
Just Element
z -> Inlines -> Blocks
para (Inlines -> Blocks)
-> ([Inlines] -> Inlines) -> [Inlines] -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Inlines
str Text
"— " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>) (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat
([Inlines] -> Blocks)
-> StateT JATSState m [Inlines] -> StateT JATSState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Content -> StateT JATSState m Inlines)
-> [Content] -> StateT JATSState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Content -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Content -> JATS m Inlines
parseInline (Element -> [Content]
elContent Element
z)
Blocks
contents <- Element -> StateT JATSState m Blocks
forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
getBlocks Element
e
Blocks -> StateT JATSState m Blocks
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> StateT JATSState m Blocks)
-> Blocks -> StateT JATSState m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks -> Blocks
blockQuote (Blocks
contents Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
attrib)
parseList :: StateT JATSState m Blocks
parseList = do
case Text -> Element -> Text
attrValue Text
"list-type" Element
e of
Text
"bullet" -> [Blocks] -> Blocks
bulletList ([Blocks] -> Blocks)
-> StateT JATSState m [Blocks] -> StateT JATSState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT JATSState m [Blocks]
listitems
Text
listType -> do
let start :: Int
start =
Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$
( (Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named Text
"list-item") Element
e
Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named Text
"label")
)
Maybe Element -> (Element -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (Text -> Maybe Int) -> (Element -> Text) -> Element -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
textContent
ListAttributes -> [Blocks] -> Blocks
orderedListWith (Int
start, Text -> ListNumberStyle
forall {a}. (Eq a, IsString a) => a -> ListNumberStyle
parseListStyleType Text
listType, ListNumberDelim
DefaultDelim)
([Blocks] -> Blocks)
-> StateT JATSState m [Blocks] -> StateT JATSState m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT JATSState m [Blocks]
listitems
parseListStyleType :: a -> ListNumberStyle
parseListStyleType a
"roman-lower" = ListNumberStyle
LowerRoman
parseListStyleType a
"roman-upper" = ListNumberStyle
UpperRoman
parseListStyleType a
"alpha-lower" = ListNumberStyle
LowerAlpha
parseListStyleType a
"alpha-upper" = ListNumberStyle
UpperAlpha
parseListStyleType a
_ = ListNumberStyle
DefaultStyle
listitems :: StateT JATSState m [Blocks]
listitems = (Element -> StateT JATSState m Blocks)
-> [Element] -> StateT JATSState m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element -> StateT JATSState m Blocks
forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
getBlocks ([Element] -> StateT JATSState m [Blocks])
-> [Element] -> StateT JATSState m [Blocks]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"list-item") Element
e
deflistitems :: StateT JATSState m [(Inlines, [Blocks])]
deflistitems = (Element -> StateT JATSState m (Inlines, [Blocks]))
-> [Element] -> StateT JATSState m [(Inlines, [Blocks])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element -> StateT JATSState m (Inlines, [Blocks])
forall {m :: * -> *}.
PandocMonad m =>
Element -> StateT JATSState m (Inlines, [Blocks])
parseVarListEntry ([Element] -> StateT JATSState m [(Inlines, [Blocks])])
-> [Element] -> StateT JATSState m [(Inlines, [Blocks])]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren
(Text -> Element -> Bool
named Text
"def-item") Element
e
parseVarListEntry :: Element -> StateT JATSState m (Inlines, [Blocks])
parseVarListEntry Element
e' = do
let terms :: [Element]
terms = (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"term") Element
e'
let items :: [Element]
items = (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"def") Element
e'
[Inlines]
terms' <- (Element -> StateT JATSState m Inlines)
-> [Element] -> StateT JATSState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines [Element]
terms
[Blocks]
items' <- (Element -> StateT JATSState m Blocks)
-> [Element] -> StateT JATSState m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element -> StateT JATSState m Blocks
forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
getBlocks [Element]
items
(Inlines, [Blocks]) -> StateT JATSState m (Inlines, [Blocks])
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse (Text -> Inlines
str Text
"; ") [Inlines]
terms', [Blocks]
items')
parseFigure :: StateT JATSState m Blocks
parseFigure = do
(JATSState -> JATSState) -> StateT JATSState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((JATSState -> JATSState) -> StateT JATSState m ())
-> (JATSState -> JATSState) -> StateT JATSState m ()
forall a b. (a -> b) -> a -> b
$ \JATSState
st -> JATSState
st{ jatsInFigure = True }
Inlines
capt <- case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"caption") Element
e of
Just Element
t -> [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ([Inlines] -> [Inlines]) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse Inlines
linebreak ([Inlines] -> Inlines)
-> StateT JATSState m [Inlines] -> StateT JATSState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Element -> StateT JATSState m Inlines)
-> [Element] -> StateT JATSState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines ((Element -> Bool) -> Element -> [Element]
filterChildren (Bool -> Element -> Bool
forall a b. a -> b -> a
const Bool
True) Element
t)
Maybe Element
Nothing -> Inlines -> StateT JATSState m Inlines
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
Blocks
contents <- Element -> StateT JATSState m Blocks
forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
getBlocks Element
e
(JATSState -> JATSState) -> StateT JATSState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((JATSState -> JATSState) -> StateT JATSState m ())
-> (JATSState -> JATSState) -> StateT JATSState m ()
forall a b. (a -> b) -> a -> b
$ \JATSState
st -> JATSState
st{ jatsInFigure = False }
Blocks -> StateT JATSState m Blocks
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> StateT JATSState m Blocks)
-> Blocks -> StateT JATSState m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Caption -> Blocks -> Blocks
figureWith
(Text -> Element -> Text
attrValue Text
"id" Element
e, [], [])
(Blocks -> Caption
simpleCaption (Blocks -> Caption) -> Blocks -> Caption
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
plain Inlines
capt)
Blocks
contents
parseFootnoteGroup :: StateT JATSState m Blocks
parseFootnoteGroup = do
[Element]
-> (Element -> StateT JATSState m ()) -> StateT JATSState m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ((Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"fn") Element
e) ((Element -> StateT JATSState m ()) -> StateT JATSState m ())
-> (Element -> StateT JATSState m ()) -> StateT JATSState m ()
forall a b. (a -> b) -> a -> b
$ \Element
fn -> do
let id' :: Text
id' = Text -> Element -> Text
attrValue Text
"id" Element
fn
Blocks
contents <- Element -> StateT JATSState m Blocks
forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
getBlocks Element
fn
(JATSState -> JATSState) -> StateT JATSState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((JATSState -> JATSState) -> StateT JATSState m ())
-> (JATSState -> JATSState) -> StateT JATSState m ()
forall a b. (a -> b) -> a -> b
$ \JATSState
st ->
JATSState
st { jatsFootnotes = Map.insert id' contents (jatsFootnotes st) }
Blocks -> StateT JATSState m Blocks
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
parseTable :: StateT JATSState m Blocks
parseTable = do
let isCaption :: Element -> Bool
isCaption Element
x = Text -> Element -> Bool
named Text
"title" Element
x Bool -> Bool -> Bool
|| Text -> Element -> Bool
named Text
"caption" Element
x
Inlines
capt <- case (Element -> Bool) -> Element -> Maybe Element
filterChild Element -> Bool
isCaption Element
e of
Just Element
t -> Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
t
Maybe Element
Nothing -> Inlines -> StateT JATSState m Inlines
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
let e' :: Element
e' = Element -> Maybe Element -> Element
forall a. a -> Maybe a -> a
fromMaybe Element
e (Maybe Element -> Element) -> Maybe Element -> Element
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"tgroup") Element
e
let isColspec :: Element -> Bool
isColspec Element
x = Text -> Element -> Bool
named Text
"colspec" Element
x Bool -> Bool -> Bool
|| Text -> Element -> Bool
named Text
"col" Element
x
let colspecs :: [Element]
colspecs = case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"colgroup") Element
e' of
Just Element
c -> (Element -> Bool) -> Element -> [Element]
filterChildren Element -> Bool
isColspec Element
c
Maybe Element
_ -> (Element -> Bool) -> Element -> [Element]
filterChildren Element -> Bool
isColspec Element
e'
let isRow :: Element -> Bool
isRow Element
x = Text -> Element -> Bool
named Text
"row" Element
x Bool -> Bool -> Bool
|| Text -> Element -> Bool
named Text
"tr" Element
x
let parseRows :: Element -> [[Element]]
parseRows Element
elementWithRows =
(Element -> [Element]) -> [Element] -> [[Element]]
forall a b. (a -> b) -> [a] -> [b]
map Element -> [Element]
parseElement ([Element] -> [[Element]]) -> [Element] -> [[Element]]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren Element -> Bool
isRow Element
elementWithRows
let multipleBodyRowElements :: [[[Element]]]
multipleBodyRowElements =
(Element -> [[Element]]) -> [Element] -> [[[Element]]]
forall a b. (a -> b) -> [a] -> [b]
map Element -> [[Element]]
parseRows ([Element] -> [[[Element]]]) -> [Element] -> [[[Element]]]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"tbody") Element
e'
let headRowElements :: [[Element]]
headRowElements = [[Element]]
-> (Element -> [[Element]]) -> Maybe Element -> [[Element]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Element -> [[Element]]
parseRows ((Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"thead") Element
e')
let footRowElements :: [[Element]]
footRowElements = [[Element]]
-> (Element -> [[Element]]) -> Maybe Element -> [[Element]]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Element -> [[Element]]
parseRows ((Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"tfoot") Element
e')
let toAlignment :: Element -> Alignment
toAlignment Element
c = case QName -> Element -> Maybe Text
findAttr (Text -> QName
unqual Text
"align") Element
c of
Just Text
"left" -> Alignment
AlignLeft
Just Text
"right" -> Alignment
AlignRight
Just Text
"center" -> Alignment
AlignCenter
Maybe Text
_ -> Alignment
AlignDefault
let toColSpan :: Element -> a
toColSpan Element
element = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
1 (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$
QName -> Element -> Maybe Text
findAttr (Text -> QName
unqual Text
"colspan") Element
element Maybe Text -> (Text -> Maybe a) -> Maybe a
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe a
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead
let toRowSpan :: Element -> a
toRowSpan Element
element = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
1 (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$
QName -> Element -> Maybe Text
findAttr (Text -> QName
unqual Text
"rowspan") Element
element Maybe Text -> (Text -> Maybe a) -> Maybe a
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe a
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead
let toWidth :: Element -> Maybe b
toWidth Element
c = do
Text
w <- QName -> Element -> Maybe Text
findAttr (Text -> QName
unqual Text
"colwidth") Element
c
b
n <- Text -> Maybe b
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (Text -> Maybe b) -> Text -> Maybe b
forall a b. (a -> b) -> a -> b
$ Text
"0" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Char -> Bool) -> Text -> Text
T.filter (\Char
x -> Char -> Bool
isDigit Char
x Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') Text
w
if b
n b -> b -> Bool
forall a. Ord a => a -> a -> Bool
> b
0 then b -> Maybe b
forall a. a -> Maybe a
Just b
n else Maybe b
forall a. Maybe a
Nothing
let firstBody :: [[Element]]
firstBody = [[Element]] -> Maybe [[Element]] -> [[Element]]
forall a. a -> Maybe a -> a
fromMaybe [] ([[[Element]]] -> Maybe [[Element]]
forall a. [a] -> Maybe a
headMay [[[Element]]]
multipleBodyRowElements)
let numrows :: Int
numrows = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ([Element] -> Int) -> [[Element]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Element] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Element]]
firstBody
let aligns :: [Alignment]
aligns = case [Element]
colspecs of
[] -> Int -> Alignment -> [Alignment]
forall a. Int -> a -> [a]
replicate Int
numrows Alignment
AlignDefault
[Element]
cs -> (Element -> Alignment) -> [Element] -> [Alignment]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Alignment
toAlignment [Element]
cs
let widths :: [ColWidth]
widths = case [Element]
colspecs of
[] -> Int -> ColWidth -> [ColWidth]
forall a. Int -> a -> [a]
replicate Int
numrows ColWidth
ColWidthDefault
[Element]
cs -> let ws :: [Maybe Double]
ws = (Element -> Maybe Double) -> [Element] -> [Maybe Double]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Maybe Double
forall {b}. (Read b, Ord b, Num b) => Element -> Maybe b
toWidth [Element]
cs
in case [Maybe Double] -> Maybe [Double]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Maybe Double]
ws of
Just [Double]
ws' -> let tot :: Double
tot = [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
ws'
in Double -> ColWidth
ColWidth (Double -> ColWidth) -> (Double -> Double) -> Double -> ColWidth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
tot) (Double -> ColWidth) -> [Double] -> [ColWidth]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double]
ws'
Maybe [Double]
Nothing -> Int -> ColWidth -> [ColWidth]
forall a. Int -> a -> [a]
replicate Int
numrows ColWidth
ColWidthDefault
let parseCell :: Element -> StateT JATSState m Blocks
parseCell = (Inlines -> Blocks) -> [Content] -> StateT JATSState m Blocks
forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Blocks) -> [Content] -> StateT JATSState m Blocks
parseMixed Inlines -> Blocks
plain ([Content] -> StateT JATSState m Blocks)
-> (Element -> [Content]) -> Element -> StateT JATSState m Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Content]
elContent
let elementToCell :: Element -> StateT JATSState m Cell
elementToCell Element
element = Alignment -> RowSpan -> ColSpan -> Blocks -> Cell
cell
(Element -> Alignment
toAlignment Element
element)
(Int -> RowSpan
RowSpan (Int -> RowSpan) -> Int -> RowSpan
forall a b. (a -> b) -> a -> b
$ Element -> Int
forall {a}. (Num a, Read a) => Element -> a
toRowSpan Element
element)
(Int -> ColSpan
ColSpan (Int -> ColSpan) -> Int -> ColSpan
forall a b. (a -> b) -> a -> b
$ Element -> Int
forall {a}. (Num a, Read a) => Element -> a
toColSpan Element
element)
(Blocks -> Cell)
-> StateT JATSState m Blocks -> StateT JATSState m Cell
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> StateT JATSState m Blocks
parseCell Element
element)
let rowElementsToCells :: t Element -> StateT JATSState m (t Cell)
rowElementsToCells t Element
elements = (Element -> StateT JATSState m Cell)
-> t Element -> StateT JATSState m (t Cell)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)
mapM Element -> StateT JATSState m Cell
elementToCell t Element
elements
let toRow :: [Element] -> StateT JATSState m Row
toRow = ([Cell] -> Row)
-> StateT JATSState m [Cell] -> StateT JATSState m Row
forall a b.
(a -> b) -> StateT JATSState m a -> StateT JATSState m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Attr -> [Cell] -> Row
Row Attr
nullAttr) (StateT JATSState m [Cell] -> StateT JATSState m Row)
-> ([Element] -> StateT JATSState m [Cell])
-> [Element]
-> StateT JATSState m Row
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Element] -> StateT JATSState m [Cell]
forall {t :: * -> *}.
Traversable t =>
t Element -> StateT JATSState m (t Cell)
rowElementsToCells
toRows :: t [Element] -> StateT JATSState m (t Row)
toRows t [Element]
elements = ([Element] -> StateT JATSState m Row)
-> t [Element] -> StateT JATSState m (t Row)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)
mapM [Element] -> StateT JATSState m Row
toRow t [Element]
elements
[Row]
headerRows <- [[Element]] -> StateT JATSState m [Row]
forall {t :: * -> *}.
Traversable t =>
t [Element] -> StateT JATSState m (t Row)
toRows [[Element]]
headRowElements
[Row]
footerRows <- [[Element]] -> StateT JATSState m [Row]
forall {t :: * -> *}.
Traversable t =>
t [Element] -> StateT JATSState m (t Row)
toRows [[Element]]
footRowElements
[[Row]]
bodyRows <- ([[Element]] -> StateT JATSState m [Row])
-> [[[Element]]] -> StateT JATSState m [[Row]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [[Element]] -> StateT JATSState m [Row]
forall {t :: * -> *}.
Traversable t =>
t [Element] -> StateT JATSState m (t Row)
toRows [[[Element]]]
multipleBodyRowElements
Blocks -> StateT JATSState m Blocks
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> StateT JATSState m Blocks)
-> Blocks -> StateT JATSState m Blocks
forall a b. (a -> b) -> a -> b
$ Caption
-> [ColSpec] -> TableHead -> [TableBody] -> TableFoot -> Blocks
table (Blocks -> Caption
simpleCaption (Blocks -> Caption) -> Blocks -> Caption
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
plain Inlines
capt)
([Alignment] -> [ColWidth] -> [ColSpec]
forall a b. [a] -> [b] -> [(a, b)]
zip [Alignment]
aligns [ColWidth]
widths)
(Attr -> [Row] -> TableHead
TableHead Attr
nullAttr [Row]
headerRows)
(([Row] -> TableBody) -> [[Row]] -> [TableBody]
forall a b. (a -> b) -> [a] -> [b]
map (Attr -> RowHeadColumns -> [Row] -> [Row] -> TableBody
TableBody Attr
nullAttr RowHeadColumns
0 []) [[Row]]
bodyRows)
(Attr -> [Row] -> TableFoot
TableFoot Attr
nullAttr [Row]
footerRows)
isEntry :: Element -> Bool
isEntry Element
x = Text -> Element -> Bool
named Text
"entry" Element
x Bool -> Bool -> Bool
|| Text -> Element -> Bool
named Text
"td" Element
x Bool -> Bool -> Bool
|| Text -> Element -> Bool
named Text
"th" Element
x
parseElement :: Element -> [Element]
parseElement = (Element -> Bool) -> Element -> [Element]
filterChildren Element -> Bool
isEntry
wrapWithHeader :: Int -> StateT JATSState m Blocks -> StateT JATSState m Blocks
wrapWithHeader Int
n StateT JATSState m Blocks
mBlocks = do
Bool
isBook <- (JATSState -> Bool) -> StateT JATSState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets JATSState -> Bool
jatsBook
let n' :: Int
n' = case ((Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"title") Element
e Maybe Element -> (Element -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Element -> Maybe Text
maybeAttrValue Text
"display-as") of
Just Text
t -> String -> Int
forall a. Read a => String -> a
read (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
t
Maybe Text
Nothing -> if Bool
isBook Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 else Int
n
Inlines
headerText <- case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"title") Element
e of
Just Element
t -> case Text -> Element -> Maybe Text
maybeAttrValue Text
"supress" Element
t of
Just Text
s -> if Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"no"
then Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
t
else Inlines -> StateT JATSState m Inlines
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
Maybe Text
Nothing -> Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
t
Maybe Element
Nothing -> do
let name :: Text
name = QName -> Text
qName (Element -> QName
elName Element
e)
if (Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"dedication" Bool -> Bool -> Bool
|| Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"foreword" Bool -> Bool -> Bool
|| Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"preface")
then Inlines -> StateT JATSState m Inlines
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> StateT JATSState m Inlines)
-> Inlines -> StateT JATSState m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toTitle Text
name
else case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"index-title-group") Element
e Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"title") of
Just Element
i -> Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
i
Maybe Element
Nothing -> case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"toc-title-group") Element
e Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"title") of
Just Element
t -> Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
t
Maybe Element
Nothing -> Inlines -> StateT JATSState m Inlines
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
Int
oldN <- (JATSState -> Int) -> StateT JATSState m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets JATSState -> Int
jatsSectionLevel
(JATSState -> JATSState) -> StateT JATSState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((JATSState -> JATSState) -> StateT JATSState m ())
-> (JATSState -> JATSState) -> StateT JATSState m ()
forall a b. (a -> b) -> a -> b
$ \JATSState
st -> JATSState
st{ jatsSectionLevel = n }
Blocks
blocks <- StateT JATSState m Blocks
mBlocks
let ident :: Text
ident = Text -> Element -> Text
attrValue Text
"id" Element
e
(JATSState -> JATSState) -> StateT JATSState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((JATSState -> JATSState) -> StateT JATSState m ())
-> (JATSState -> JATSState) -> StateT JATSState m ()
forall a b. (a -> b) -> a -> b
$ \JATSState
st -> JATSState
st{ jatsSectionLevel = oldN }
Blocks -> StateT JATSState m Blocks
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> StateT JATSState m Blocks)
-> Blocks -> StateT JATSState m Blocks
forall a b. (a -> b) -> a -> b
$ (if Inlines
headerText Inlines -> Inlines -> Bool
forall a. Eq a => a -> a -> Bool
== Inlines
forall a. Monoid a => a
mempty
then Blocks
forall a. Monoid a => a
mempty
else Attr -> Int -> Inlines -> Blocks
headerWith (Text
ident,[],[]) Int
n' Inlines
headerText) Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
blocks
parseBook :: StateT JATSState m Blocks
parseBook = do
(JATSState -> JATSState) -> StateT JATSState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((JATSState -> JATSState) -> StateT JATSState m ())
-> (JATSState -> JATSState) -> StateT JATSState m ()
forall a b. (a -> b) -> a -> b
$ \JATSState
st -> JATSState
st{ jatsBook = True }
Element -> StateT JATSState m Blocks
forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
getBlocks Element
e
getInlines :: PandocMonad m => Element -> JATS m Inlines
getInlines :: forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
e' = Inlines -> Inlines
trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> StateT JATSState m [Inlines] -> StateT JATSState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Content -> StateT JATSState m Inlines)
-> [Content] -> StateT JATSState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Content -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Content -> JATS m Inlines
parseInline (Element -> [Content]
elContent Element
e')
parseMetadata :: PandocMonad m => Element -> JATS m Blocks
parseMetadata :: forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
parseMetadata Element
e = do
Bool
isBook <- (JATSState -> Bool) -> StateT JATSState m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets JATSState -> Bool
jatsBook
if Bool
isBook then Element -> JATS m ()
forall (m :: * -> *). PandocMonad m => Element -> JATS m ()
getBookTitle Element
e else Element -> JATS m ()
forall (m :: * -> *). PandocMonad m => Element -> JATS m ()
getArticleTitle Element
e
if Bool
isBook then Element -> JATS m ()
forall (m :: * -> *). PandocMonad m => Element -> JATS m ()
getBookAuthors Element
e else Element -> JATS m ()
forall (m :: * -> *). PandocMonad m => Element -> JATS m ()
getArticleAuthors Element
e
Element -> JATS m ()
forall (m :: * -> *). PandocMonad m => Element -> JATS m ()
getAffiliations Element
e
Element -> JATS m ()
forall (m :: * -> *). PandocMonad m => Element -> JATS m ()
getAbstract Element
e
Element -> JATS m ()
forall (m :: * -> *). PandocMonad m => Element -> JATS m ()
getPubDate Element
e
Element -> JATS m ()
forall (m :: * -> *). PandocMonad m => Element -> JATS m ()
getPermissions Element
e
Blocks -> JATS m Blocks
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
getArticleTitle :: PandocMonad m => Element -> JATS m ()
getArticleTitle :: forall (m :: * -> *). PandocMonad m => Element -> JATS m ()
getArticleTitle Element
e = do
Inlines
tit <- case (Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named Text
"article-title") Element
e of
Just Element
s -> Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
s
Maybe Element
Nothing -> Inlines -> StateT JATSState m Inlines
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
Inlines
subtit <- case (Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named Text
"subtitle") Element
e of
Just Element
s -> (Text -> Inlines
text Text
": " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>) (Inlines -> Inlines)
-> StateT JATSState m Inlines -> StateT JATSState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
s
Maybe Element
Nothing -> Inlines -> StateT JATSState m Inlines
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
Bool -> JATS m () -> JATS m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Inlines
tit Inlines -> Inlines -> Bool
forall a. Eq a => a -> a -> Bool
/= Inlines
forall a. Monoid a => a
mempty) (JATS m () -> JATS m ()) -> JATS m () -> JATS m ()
forall a b. (a -> b) -> a -> b
$ Text -> Inlines -> JATS m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> JATS m ()
addMeta Text
"title" Inlines
tit
Bool -> JATS m () -> JATS m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Inlines
subtit Inlines -> Inlines -> Bool
forall a. Eq a => a -> a -> Bool
/= Inlines
forall a. Monoid a => a
mempty) (JATS m () -> JATS m ()) -> JATS m () -> JATS m ()
forall a b. (a -> b) -> a -> b
$ Text -> Inlines -> JATS m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> JATS m ()
addMeta Text
"subtitle" Inlines
subtit
getBookTitle :: PandocMonad m => Element -> JATS m ()
getBookTitle :: forall (m :: * -> *). PandocMonad m => Element -> JATS m ()
getBookTitle Element
e = do
Inlines
tit <- case ((Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named Text
"book-title-group") Element
e Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named Text
"book-title")) of
Just Element
s -> Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
s
Maybe Element
Nothing -> Inlines -> StateT JATSState m Inlines
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
Inlines
subtit <- case ((Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named Text
"book-title-group") Element
e Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named Text
"subtitle")) of
Just Element
s -> (Text -> Inlines
text Text
": " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>) (Inlines -> Inlines)
-> StateT JATSState m Inlines -> StateT JATSState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
s
Maybe Element
Nothing -> Inlines -> StateT JATSState m Inlines
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
Bool -> JATS m () -> JATS m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Inlines
tit Inlines -> Inlines -> Bool
forall a. Eq a => a -> a -> Bool
/= Inlines
forall a. Monoid a => a
mempty) (JATS m () -> JATS m ()) -> JATS m () -> JATS m ()
forall a b. (a -> b) -> a -> b
$ Text -> Inlines -> JATS m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> JATS m ()
addMeta Text
"title" Inlines
tit
Bool -> JATS m () -> JATS m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Inlines
subtit Inlines -> Inlines -> Bool
forall a. Eq a => a -> a -> Bool
/= Inlines
forall a. Monoid a => a
mempty) (JATS m () -> JATS m ()) -> JATS m () -> JATS m ()
forall a b. (a -> b) -> a -> b
$ Text -> Inlines -> JATS m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> JATS m ()
addMeta Text
"subtitle" Inlines
subtit
getArticleAuthors :: PandocMonad m => Element -> JATS m ()
getArticleAuthors :: forall (m :: * -> *). PandocMonad m => Element -> JATS m ()
getArticleAuthors Element
e = do
[Inlines]
authors <- (Element -> StateT JATSState m Inlines)
-> [Element] -> StateT JATSState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getContrib ([Element] -> StateT JATSState m [Inlines])
-> [Element] -> StateT JATSState m [Inlines]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterElements
(\Element
x -> Text -> Element -> Bool
named Text
"contrib" Element
x Bool -> Bool -> Bool
&&
Text -> Element -> Text
attrValue Text
"contrib-type" Element
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"author") Element
e
[Inlines]
authorNotes <- (Element -> StateT JATSState m Inlines)
-> [Element] -> StateT JATSState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines ([Element] -> StateT JATSState m [Inlines])
-> [Element] -> StateT JATSState m [Inlines]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterElements (Text -> Element -> Bool
named Text
"author-notes") Element
e
let authors' :: [Inlines]
authors' = case ([Inlines] -> [Inlines]
forall a. [a] -> [a]
reverse [Inlines]
authors, [Inlines]
authorNotes) of
([], [Inlines]
_) -> []
([Inlines]
_, []) -> [Inlines]
authors
(Inlines
a:[Inlines]
as, [Inlines]
ns) -> [Inlines] -> [Inlines]
forall a. [a] -> [a]
reverse [Inlines]
as [Inlines] -> [Inlines] -> [Inlines]
forall a. [a] -> [a] -> [a]
++ [Inlines
a Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat [Inlines]
ns]
Bool -> JATS m () -> JATS m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Inlines] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inlines]
authors) (JATS m () -> JATS m ()) -> JATS m () -> JATS m ()
forall a b. (a -> b) -> a -> b
$ Text -> [Inlines] -> JATS m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> JATS m ()
addMeta Text
"author" [Inlines]
authors'
getBookAuthors :: PandocMonad m => Element -> JATS m ()
getBookAuthors :: forall (m :: * -> *). PandocMonad m => Element -> JATS m ()
getBookAuthors Element
e = do
[Inlines]
authors <- (Element -> StateT JATSState m Inlines)
-> [Element] -> StateT JATSState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getContrib ([Element] -> StateT JATSState m [Inlines])
-> [Element] -> StateT JATSState m [Inlines]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterElements (\Element
x -> Text -> Element -> Bool
named Text
"contrib-group" Element
x) Element
e
[Element] -> (Element -> [Element]) -> [Element]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Element -> Bool) -> Element -> [Element]
filterElements (\Element
x -> Text -> Element -> Bool
named Text
"contrib" Element
x Bool -> Bool -> Bool
&&
Text -> Element -> Text
attrValue Text
"contrib-type" Element
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"author")
[Inlines]
authorNotes <- (Element -> StateT JATSState m Inlines)
-> [Element] -> StateT JATSState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines ([Element] -> StateT JATSState m [Inlines])
-> [Element] -> StateT JATSState m [Inlines]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterElements (Text -> Element -> Bool
named Text
"author-notes") Element
e
let authors' :: [Inlines]
authors' = case ([Inlines] -> [Inlines]
forall a. [a] -> [a]
reverse [Inlines]
authors, [Inlines]
authorNotes) of
([], [Inlines]
_) -> []
([Inlines]
_, []) -> [Inlines]
authors
(Inlines
a:[Inlines]
as, [Inlines]
ns) -> [Inlines] -> [Inlines]
forall a. [a] -> [a]
reverse [Inlines]
as [Inlines] -> [Inlines] -> [Inlines]
forall a. [a] -> [a] -> [a]
++ [Inlines
a Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat [Inlines]
ns]
Bool -> JATS m () -> JATS m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Inlines] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inlines]
authors) (JATS m () -> JATS m ()) -> JATS m () -> JATS m ()
forall a b. (a -> b) -> a -> b
$ Text -> [Inlines] -> JATS m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> JATS m ()
addMeta Text
"author" [Inlines]
authors'
getAffiliations :: PandocMonad m => Element -> JATS m ()
getAffiliations :: forall (m :: * -> *). PandocMonad m => Element -> JATS m ()
getAffiliations Element
x = do
[Inlines]
affs <- (Element -> StateT JATSState m Inlines)
-> [Element] -> StateT JATSState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines ([Element] -> StateT JATSState m [Inlines])
-> [Element] -> StateT JATSState m [Inlines]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"aff") Element
x
Bool -> JATS m () -> JATS m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Inlines] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inlines]
affs) (JATS m () -> JATS m ()) -> JATS m () -> JATS m ()
forall a b. (a -> b) -> a -> b
$ Text -> [Inlines] -> JATS m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> JATS m ()
addMeta Text
"institute" [Inlines]
affs
getAbstract :: PandocMonad m => Element -> JATS m ()
getAbstract :: forall (m :: * -> *). PandocMonad m => Element -> JATS m ()
getAbstract Element
e =
case (Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named Text
"abstract") Element
e of
Just Element
s -> do
Blocks
blks <- Element -> JATS m Blocks
forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
getBlocks Element
s
Text -> Blocks -> JATS m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> JATS m ()
addMeta Text
"abstract" Blocks
blks
Maybe Element
Nothing -> () -> JATS m ()
forall a. a -> StateT JATSState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
getPubDate :: PandocMonad m => Element -> JATS m ()
getPubDate :: forall (m :: * -> *). PandocMonad m => Element -> JATS m ()
getPubDate Element
e =
case (Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named Text
"pub-date") Element
e of
Just Element
d -> Element -> JATS m Text
forall (m :: * -> *). PandocMonad m => Element -> JATS m Text
getDate Element
d JATS m Text -> (Text -> JATS m ()) -> JATS m ()
forall a b.
StateT JATSState m a
-> (a -> StateT JATSState m b) -> StateT JATSState m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Inlines -> JATS m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> JATS m ()
addMeta Text
"date" (Inlines -> JATS m ()) -> (Text -> Inlines) -> Text -> JATS m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inlines
text
Maybe Element
Nothing -> () -> JATS m ()
forall a. a -> StateT JATSState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
getDate :: PandocMonad m => Element -> JATS m Text
getDate :: forall (m :: * -> *). PandocMonad m => Element -> JATS m Text
getDate Element
e =
case Text -> Element -> Maybe Text
maybeAttrValue Text
"iso-8601-date" Element
e of
Just Text
isod -> Text -> JATS m Text
forall a. a -> StateT JATSState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
isod
Maybe Text
Nothing -> do
let extractDate :: Element -> Maybe Int
extractDate :: Element -> Maybe Int
extractDate = Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (Text -> Maybe Int) -> (Element -> Text) -> Element -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
strContent
let yr :: Maybe Int
yr = (Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named Text
"year") Element
e Maybe Element -> (Element -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Element -> Maybe Int
extractDate
let mon :: Maybe Int
mon = (Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named Text
"month") Element
e Maybe Element -> (Element -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Element -> Maybe Int
extractDate
let day :: Maybe Int
day = (Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named Text
"day") Element
e Maybe Element -> (Element -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Element -> Maybe Int
extractDate
let stringDate :: Maybe Text
stringDate = Element -> Text
strContent (Element -> Text) -> Maybe Element -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named Text
"string-date") Element
e
Text -> JATS m Text
forall a. a -> StateT JATSState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> JATS m Text) -> Text -> JATS m Text
forall a b. (a -> b) -> a -> b
$
case (Maybe Int
yr, Maybe Int
mon, Maybe Int
day) of
(Just Int
y, Just Int
m, Just Int
d) -> String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Int -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%04d-%02d-%02d" Int
y Int
m Int
d
(Just Int
y, Just Int
m, Maybe Int
Nothing) -> String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Int -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%04d-%02d" Int
y Int
m
(Just Int
y, Maybe Int
Nothing, Maybe Int
Nothing) -> String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%04d" Int
y
(Maybe Int, Maybe Int, Maybe Int)
_ -> Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
forall a. Monoid a => a
mempty Maybe Text
stringDate
getPermissions :: PandocMonad m => Element -> JATS m ()
getPermissions :: forall (m :: * -> *). PandocMonad m => Element -> JATS m ()
getPermissions Element
e = do
Map Text MetaValue
copyright <- Element -> JATS m (Map Text MetaValue)
forall (m :: * -> *).
PandocMonad m =>
Element -> JATS m (Map Text MetaValue)
getCopyright Element
e
Map Text MetaValue
license <- case (Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named Text
"license") Element
e of
Just Element
s -> Element -> JATS m (Map Text MetaValue)
forall (m :: * -> *).
PandocMonad m =>
Element -> JATS m (Map Text MetaValue)
getLicense Element
s
Maybe Element
Nothing -> Map Text MetaValue -> JATS m (Map Text MetaValue)
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Map Text MetaValue
forall a. Monoid a => a
mempty
Bool -> JATS m () -> JATS m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Map Text MetaValue
copyright Map Text MetaValue -> Map Text MetaValue -> Bool
forall a. Eq a => a -> a -> Bool
/= Map Text MetaValue
forall a. Monoid a => a
mempty) (JATS m () -> JATS m ()) -> JATS m () -> JATS m ()
forall a b. (a -> b) -> a -> b
$ Text -> Map Text MetaValue -> JATS m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> JATS m ()
addMeta Text
"copyright" Map Text MetaValue
copyright
Bool -> JATS m () -> JATS m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Map Text MetaValue
license Map Text MetaValue -> Map Text MetaValue -> Bool
forall a. Eq a => a -> a -> Bool
/= Map Text MetaValue
forall a. Monoid a => a
mempty) (JATS m () -> JATS m ()) -> JATS m () -> JATS m ()
forall a b. (a -> b) -> a -> b
$ Text -> Map Text MetaValue -> JATS m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> JATS m ()
addMeta Text
"license" Map Text MetaValue
license
getCopyright :: PandocMonad m => Element -> JATS m (Map.Map Text MetaValue)
getCopyright :: forall (m :: * -> *).
PandocMonad m =>
Element -> JATS m (Map Text MetaValue)
getCopyright Element
e = do
let holder :: Maybe (Text, MetaValue)
holder = Element -> Text -> Text -> Maybe (Text, MetaValue)
metaElement Element
e Text
"copyright-holder" Text
"holder"
let statement :: Maybe (Text, MetaValue)
statement = Element -> Text -> Text -> Maybe (Text, MetaValue)
metaElement Element
e Text
"copyright-statement" Text
"statement"
let year :: Maybe (Text, MetaValue)
year = Element -> Text -> Text -> Maybe (Text, MetaValue)
metaElement Element
e Text
"copyright-year" Text
"year"
Map Text MetaValue -> JATS m (Map Text MetaValue)
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text MetaValue -> JATS m (Map Text MetaValue))
-> Map Text MetaValue -> JATS m (Map Text MetaValue)
forall a b. (a -> b) -> a -> b
$ [(Text, MetaValue)] -> Map Text MetaValue
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([Maybe (Text, MetaValue)] -> [(Text, MetaValue)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Text, MetaValue)] -> [(Text, MetaValue)])
-> [Maybe (Text, MetaValue)] -> [(Text, MetaValue)]
forall a b. (a -> b) -> a -> b
$ [Maybe (Text, MetaValue)
holder, Maybe (Text, MetaValue)
statement, Maybe (Text, MetaValue)
year])
getLicense :: PandocMonad m => Element -> JATS m (Map.Map Text MetaValue)
getLicense :: forall (m :: * -> *).
PandocMonad m =>
Element -> JATS m (Map Text MetaValue)
getLicense Element
e = do
let licenseType :: Maybe (Text, MetaValue)
licenseType = Element -> Text -> Text -> Maybe (Text, MetaValue)
metaAttribute Element
e Text
"license-type" Text
"type"
let licenseLink :: Maybe (Text, MetaValue)
licenseLink = Element -> Text -> Maybe (Text, MetaValue)
metaElementAliRef Element
e Text
"link"
let licenseText :: Maybe (Text, MetaValue)
licenseText = Element -> Text -> Text -> Maybe (Text, MetaValue)
metaElement Element
e Text
"license-p" Text
"text"
Map Text MetaValue -> JATS m (Map Text MetaValue)
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text MetaValue -> JATS m (Map Text MetaValue))
-> Map Text MetaValue -> JATS m (Map Text MetaValue)
forall a b. (a -> b) -> a -> b
$ [(Text, MetaValue)] -> Map Text MetaValue
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([Maybe (Text, MetaValue)] -> [(Text, MetaValue)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Text, MetaValue)] -> [(Text, MetaValue)])
-> [Maybe (Text, MetaValue)] -> [(Text, MetaValue)]
forall a b. (a -> b) -> a -> b
$ [Maybe (Text, MetaValue)
licenseType, Maybe (Text, MetaValue)
licenseLink, Maybe (Text, MetaValue)
licenseText])
metaElement :: Element -> Text -> Text -> Maybe (Text, MetaValue)
metaElement :: Element -> Text -> Text -> Maybe (Text, MetaValue)
metaElement Element
e Text
child Text
key =
case (Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named Text
child) Element
e of
Just Element
content -> (Text, MetaValue) -> Maybe (Text, MetaValue)
forall a. a -> Maybe a
Just (Text
key, Text -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue (Text -> MetaValue) -> Text -> MetaValue
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
content)
Maybe Element
Nothing -> Maybe (Text, MetaValue)
forall a. Maybe a
Nothing
metaElementAliRef :: Element -> Text -> Maybe (Text, MetaValue)
metaElementAliRef :: Element -> Text -> Maybe (Text, MetaValue)
metaElementAliRef Element
e Text
key =
case (Element -> Bool) -> Element -> Maybe Element
filterElement Element -> Bool
isAliLicenseRef Element
e of
Just Element
content -> (Text, MetaValue) -> Maybe (Text, MetaValue)
forall a. a -> Maybe a
Just (Text
key, Text -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue (Text -> MetaValue) -> Text -> MetaValue
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
content)
Maybe Element
Nothing -> Maybe (Text, MetaValue)
forall a. Maybe a
Nothing
metaAttribute :: Element -> Text -> Text -> Maybe (Text, MetaValue)
metaAttribute :: Element -> Text -> Text -> Maybe (Text, MetaValue)
metaAttribute Element
e Text
attr Text
key =
case Text -> Element -> Maybe Text
maybeAttrValue Text
attr Element
e of
Just Text
content -> (Text, MetaValue) -> Maybe (Text, MetaValue)
forall a. a -> Maybe a
Just (Text
key, Text -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue Text
content)
Maybe Text
Nothing -> Maybe (Text, MetaValue)
forall a. Maybe a
Nothing
getContrib :: PandocMonad m => Element -> JATS m Inlines
getContrib :: forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getContrib Element
x = do
Inlines
given <- JATS m Inlines
-> (Element -> JATS m Inlines) -> Maybe Element -> JATS m Inlines
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Inlines -> JATS m Inlines
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty) Element -> JATS m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines
(Maybe Element -> JATS m Inlines)
-> Maybe Element -> JATS m Inlines
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named Text
"given-names") Element
x
Inlines
family <- JATS m Inlines
-> (Element -> JATS m Inlines) -> Maybe Element -> JATS m Inlines
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Inlines -> JATS m Inlines
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty) Element -> JATS m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines
(Maybe Element -> JATS m Inlines)
-> Maybe Element -> JATS m Inlines
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named Text
"surname") Element
x
if Inlines
given Inlines -> Inlines -> Bool
forall a. Eq a => a -> a -> Bool
== Inlines
forall a. Monoid a => a
mempty Bool -> Bool -> Bool
&& Inlines
family Inlines -> Inlines -> Bool
forall a. Eq a => a -> a -> Bool
== Inlines
forall a. Monoid a => a
mempty
then Inlines -> JATS m Inlines
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
else if Inlines
given Inlines -> Inlines -> Bool
forall a. Eq a => a -> a -> Bool
== Inlines
forall a. Monoid a => a
mempty Bool -> Bool -> Bool
|| Inlines
family Inlines -> Inlines -> Bool
forall a. Eq a => a -> a -> Bool
== Inlines
forall a. Monoid a => a
mempty
then Inlines -> JATS m Inlines
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> JATS m Inlines) -> Inlines -> JATS m Inlines
forall a b. (a -> b) -> a -> b
$ Inlines
given Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
family
else Inlines -> JATS m Inlines
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> JATS m Inlines) -> Inlines -> JATS m Inlines
forall a b. (a -> b) -> a -> b
$ Inlines
given Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
space Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
family
parseRefList :: PandocMonad m => Element -> JATS m Blocks
parseRefList :: forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
parseRefList Element
e = do
[Map Text MetaValue]
refs <- (Element -> StateT JATSState m (Map Text MetaValue))
-> [Element] -> StateT JATSState m [Map Text MetaValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element -> StateT JATSState m (Map Text MetaValue)
forall (m :: * -> *).
PandocMonad m =>
Element -> JATS m (Map Text MetaValue)
parseRef ([Element] -> StateT JATSState m [Map Text MetaValue])
-> [Element] -> StateT JATSState m [Map Text MetaValue]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"ref") Element
e
let mbtitle :: Maybe Element
mbtitle = (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"title") Element
e
Blocks
title <- case Maybe Element
mbtitle of
Maybe Element
Nothing -> Blocks -> JATS m Blocks
forall a. a -> StateT JATSState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Blocks
forall a. Monoid a => a
mempty
Just Element
te -> Int -> Inlines -> Blocks
header Int
1 (Inlines -> Blocks) -> StateT JATSState m Inlines -> JATS m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Content -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Content -> JATS m Inlines
parseInline (Element -> Content
Elem Element
te)
Text -> [Map Text MetaValue] -> JATS m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> JATS m ()
addMeta Text
"references" [Map Text MetaValue]
refs
Blocks -> JATS m Blocks
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> JATS m Blocks) -> Blocks -> JATS m Blocks
forall a b. (a -> b) -> a -> b
$ Blocks
title Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Attr -> Blocks -> Blocks
divWith (Text
"refs",[],[]) Blocks
forall a. Monoid a => a
mempty
parseRef :: PandocMonad m
=> Element -> JATS m (Map.Map Text MetaValue)
parseRef :: forall (m :: * -> *).
PandocMonad m =>
Element -> JATS m (Map Text MetaValue)
parseRef Element
e = do
let combineWithDash :: Inlines -> Inlines -> Inlines
combineWithDash Inlines
x Inlines
y = Inlines
x Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
text Text
"-" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
y
let getName :: Element -> StateT JATSState m MetaValue
getName Element
nm = do
Inlines
given <- StateT JATSState m Inlines
-> (Element -> StateT JATSState m Inlines)
-> Maybe Element
-> StateT JATSState m Inlines
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Inlines -> StateT JATSState m Inlines
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty) Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines
(Maybe Element -> StateT JATSState m Inlines)
-> Maybe Element -> StateT JATSState m Inlines
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"given-names") Element
nm
Inlines
family <- StateT JATSState m Inlines
-> (Element -> StateT JATSState m Inlines)
-> Maybe Element
-> StateT JATSState m Inlines
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Inlines -> StateT JATSState m Inlines
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty) Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines
(Maybe Element -> StateT JATSState m Inlines)
-> Maybe Element -> StateT JATSState m Inlines
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"surname") Element
nm
MetaValue -> StateT JATSState m MetaValue
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (MetaValue -> StateT JATSState m MetaValue)
-> MetaValue -> StateT JATSState m MetaValue
forall a b. (a -> b) -> a -> b
$ Map Text Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue (Map Text Inlines -> MetaValue) -> Map Text Inlines -> MetaValue
forall a b. (a -> b) -> a -> b
$ [(Text, Inlines)] -> Map Text Inlines
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [
(Text
"given" :: Text, Inlines
given)
, (Text
"family", Inlines
family)
]
let refElement :: PandocMonad m
=> Element -> Element -> JATS m (Maybe (Text, MetaValue))
refElement :: forall (m :: * -> *).
PandocMonad m =>
Element -> Element -> JATS m (Maybe (Text, MetaValue))
refElement Element
c Element
el =
case QName -> Text
qName (Element -> QName
elName Element
el) of
Text
"article-title" -> (Text, MetaValue) -> Maybe (Text, MetaValue)
forall a. a -> Maybe a
Just ((Text, MetaValue) -> Maybe (Text, MetaValue))
-> (Inlines -> (Text, MetaValue))
-> Inlines
-> Maybe (Text, MetaValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"title",) (MetaValue -> (Text, MetaValue))
-> (Inlines -> MetaValue) -> Inlines -> (Text, MetaValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue (Inlines -> Maybe (Text, MetaValue))
-> StateT JATSState m Inlines -> JATS m (Maybe (Text, MetaValue))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
el
Text
"source" ->
case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"article-title") Element
c of
Just Element
_ -> (Text, MetaValue) -> Maybe (Text, MetaValue)
forall a. a -> Maybe a
Just ((Text, MetaValue) -> Maybe (Text, MetaValue))
-> (Inlines -> (Text, MetaValue))
-> Inlines
-> Maybe (Text, MetaValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"container-title",) (MetaValue -> (Text, MetaValue))
-> (Inlines -> MetaValue) -> Inlines -> (Text, MetaValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue (Inlines -> Maybe (Text, MetaValue))
-> StateT JATSState m Inlines -> JATS m (Maybe (Text, MetaValue))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
el
Maybe Element
Nothing -> (Text, MetaValue) -> Maybe (Text, MetaValue)
forall a. a -> Maybe a
Just ((Text, MetaValue) -> Maybe (Text, MetaValue))
-> (Inlines -> (Text, MetaValue))
-> Inlines
-> Maybe (Text, MetaValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"title",) (MetaValue -> (Text, MetaValue))
-> (Inlines -> MetaValue) -> Inlines -> (Text, MetaValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue (Inlines -> Maybe (Text, MetaValue))
-> StateT JATSState m Inlines -> JATS m (Maybe (Text, MetaValue))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
el
Text
"label" -> (Text, MetaValue) -> Maybe (Text, MetaValue)
forall a. a -> Maybe a
Just ((Text, MetaValue) -> Maybe (Text, MetaValue))
-> (Inlines -> (Text, MetaValue))
-> Inlines
-> Maybe (Text, MetaValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"citation-label",) (MetaValue -> (Text, MetaValue))
-> (Inlines -> MetaValue) -> Inlines -> (Text, MetaValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue (Inlines -> Maybe (Text, MetaValue))
-> StateT JATSState m Inlines -> JATS m (Maybe (Text, MetaValue))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
el
Text
"year" -> case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"month") Element
c of
Just Element
m -> (Text, MetaValue) -> Maybe (Text, MetaValue)
forall a. a -> Maybe a
Just ((Text, MetaValue) -> Maybe (Text, MetaValue))
-> (Inlines -> (Text, MetaValue))
-> Inlines
-> Maybe (Text, MetaValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"issued",) (MetaValue -> (Text, MetaValue))
-> (Inlines -> MetaValue) -> Inlines -> (Text, MetaValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue (Inlines -> Maybe (Text, MetaValue))
-> StateT JATSState m Inlines -> JATS m (Maybe (Text, MetaValue))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Inlines -> Inlines -> Inlines
combineWithDash
(Inlines -> Inlines -> Inlines)
-> StateT JATSState m Inlines
-> StateT JATSState m (Inlines -> Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
el StateT JATSState m (Inlines -> Inlines)
-> StateT JATSState m Inlines -> StateT JATSState m Inlines
forall a b.
StateT JATSState m (a -> b)
-> StateT JATSState m a -> StateT JATSState m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
m)
Maybe Element
Nothing -> (Text, MetaValue) -> Maybe (Text, MetaValue)
forall a. a -> Maybe a
Just ((Text, MetaValue) -> Maybe (Text, MetaValue))
-> (Inlines -> (Text, MetaValue))
-> Inlines
-> Maybe (Text, MetaValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"issued",) (MetaValue -> (Text, MetaValue))
-> (Inlines -> MetaValue) -> Inlines -> (Text, MetaValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue (Inlines -> Maybe (Text, MetaValue))
-> StateT JATSState m Inlines -> JATS m (Maybe (Text, MetaValue))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
el
Text
"volume" -> (Text, MetaValue) -> Maybe (Text, MetaValue)
forall a. a -> Maybe a
Just ((Text, MetaValue) -> Maybe (Text, MetaValue))
-> (Inlines -> (Text, MetaValue))
-> Inlines
-> Maybe (Text, MetaValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"volume",) (MetaValue -> (Text, MetaValue))
-> (Inlines -> MetaValue) -> Inlines -> (Text, MetaValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue (Inlines -> Maybe (Text, MetaValue))
-> StateT JATSState m Inlines -> JATS m (Maybe (Text, MetaValue))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
el
Text
"issue" -> (Text, MetaValue) -> Maybe (Text, MetaValue)
forall a. a -> Maybe a
Just ((Text, MetaValue) -> Maybe (Text, MetaValue))
-> (Inlines -> (Text, MetaValue))
-> Inlines
-> Maybe (Text, MetaValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"issue",) (MetaValue -> (Text, MetaValue))
-> (Inlines -> MetaValue) -> Inlines -> (Text, MetaValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue (Inlines -> Maybe (Text, MetaValue))
-> StateT JATSState m Inlines -> JATS m (Maybe (Text, MetaValue))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
el
Text
"isbn" -> (Text, MetaValue) -> Maybe (Text, MetaValue)
forall a. a -> Maybe a
Just ((Text, MetaValue) -> Maybe (Text, MetaValue))
-> (Inlines -> (Text, MetaValue))
-> Inlines
-> Maybe (Text, MetaValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"ISBN",) (MetaValue -> (Text, MetaValue))
-> (Inlines -> MetaValue) -> Inlines -> (Text, MetaValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue (Inlines -> Maybe (Text, MetaValue))
-> StateT JATSState m Inlines -> JATS m (Maybe (Text, MetaValue))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
el
Text
"issn" -> (Text, MetaValue) -> Maybe (Text, MetaValue)
forall a. a -> Maybe a
Just ((Text, MetaValue) -> Maybe (Text, MetaValue))
-> (Inlines -> (Text, MetaValue))
-> Inlines
-> Maybe (Text, MetaValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"ISSN",) (MetaValue -> (Text, MetaValue))
-> (Inlines -> MetaValue) -> Inlines -> (Text, MetaValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue (Inlines -> Maybe (Text, MetaValue))
-> StateT JATSState m Inlines -> JATS m (Maybe (Text, MetaValue))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
el
Text
"uri" -> (Text, MetaValue) -> Maybe (Text, MetaValue)
forall a. a -> Maybe a
Just ((Text, MetaValue) -> Maybe (Text, MetaValue))
-> (Inlines -> (Text, MetaValue))
-> Inlines
-> Maybe (Text, MetaValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"url",) (MetaValue -> (Text, MetaValue))
-> (Inlines -> MetaValue) -> Inlines -> (Text, MetaValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue (Inlines -> Maybe (Text, MetaValue))
-> StateT JATSState m Inlines -> JATS m (Maybe (Text, MetaValue))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
el
Text
"fpage" ->
case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"lpage") Element
c of
Just Element
lp -> (Text, MetaValue) -> Maybe (Text, MetaValue)
forall a. a -> Maybe a
Just ((Text, MetaValue) -> Maybe (Text, MetaValue))
-> (Inlines -> (Text, MetaValue))
-> Inlines
-> Maybe (Text, MetaValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"page",) (MetaValue -> (Text, MetaValue))
-> (Inlines -> MetaValue) -> Inlines -> (Text, MetaValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue (Inlines -> Maybe (Text, MetaValue))
-> StateT JATSState m Inlines -> JATS m (Maybe (Text, MetaValue))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Inlines -> Inlines -> Inlines
combineWithDash (Inlines -> Inlines -> Inlines)
-> StateT JATSState m Inlines
-> StateT JATSState m (Inlines -> Inlines)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
el StateT JATSState m (Inlines -> Inlines)
-> StateT JATSState m Inlines -> StateT JATSState m Inlines
forall a b.
StateT JATSState m (a -> b)
-> StateT JATSState m a -> StateT JATSState m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
lp)
Maybe Element
Nothing -> (Text, MetaValue) -> Maybe (Text, MetaValue)
forall a. a -> Maybe a
Just ((Text, MetaValue) -> Maybe (Text, MetaValue))
-> (Inlines -> (Text, MetaValue))
-> Inlines
-> Maybe (Text, MetaValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"page-first",) (MetaValue -> (Text, MetaValue))
-> (Inlines -> MetaValue) -> Inlines -> (Text, MetaValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue (Inlines -> Maybe (Text, MetaValue))
-> StateT JATSState m Inlines -> JATS m (Maybe (Text, MetaValue))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
el
Text
"publisher-name" -> (Text, MetaValue) -> Maybe (Text, MetaValue)
forall a. a -> Maybe a
Just ((Text, MetaValue) -> Maybe (Text, MetaValue))
-> (Inlines -> (Text, MetaValue))
-> Inlines
-> Maybe (Text, MetaValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"publisher",) (MetaValue -> (Text, MetaValue))
-> (Inlines -> MetaValue) -> Inlines -> (Text, MetaValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue (Inlines -> Maybe (Text, MetaValue))
-> StateT JATSState m Inlines -> JATS m (Maybe (Text, MetaValue))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
el
Text
"publisher-loc" -> (Text, MetaValue) -> Maybe (Text, MetaValue)
forall a. a -> Maybe a
Just ((Text, MetaValue) -> Maybe (Text, MetaValue))
-> (Inlines -> (Text, MetaValue))
-> Inlines
-> Maybe (Text, MetaValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"publisher-place",) (MetaValue -> (Text, MetaValue))
-> (Inlines -> MetaValue) -> Inlines -> (Text, MetaValue)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue
(Inlines -> Maybe (Text, MetaValue))
-> StateT JATSState m Inlines -> JATS m (Maybe (Text, MetaValue))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
el
Text
"edition" -> Maybe (Text, MetaValue) -> JATS m (Maybe (Text, MetaValue))
forall a. a -> StateT JATSState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Text, MetaValue) -> JATS m (Maybe (Text, MetaValue)))
-> Maybe (Text, MetaValue) -> JATS m (Maybe (Text, MetaValue))
forall a b. (a -> b) -> a -> b
$ (Text, MetaValue) -> Maybe (Text, MetaValue)
forall a. a -> Maybe a
Just (Text
"edition",
Text -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue (Text -> MetaValue) -> (Text -> Text) -> Text -> MetaValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.filter Char -> Bool
isDigit (Text -> MetaValue) -> Text -> MetaValue
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
el)
Text
"person-group" -> do [MetaValue]
names <- (Element -> StateT JATSState m MetaValue)
-> [Element] -> StateT JATSState m [MetaValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Element -> StateT JATSState m MetaValue
forall {m :: * -> *}.
PandocMonad m =>
Element -> StateT JATSState m MetaValue
getName
((Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"name") Element
el)
Maybe (Text, MetaValue) -> JATS m (Maybe (Text, MetaValue))
forall a. a -> StateT JATSState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Text, MetaValue) -> JATS m (Maybe (Text, MetaValue)))
-> Maybe (Text, MetaValue) -> JATS m (Maybe (Text, MetaValue))
forall a b. (a -> b) -> a -> b
$ (Text, MetaValue) -> Maybe (Text, MetaValue)
forall a. a -> Maybe a
Just (Text -> Element -> Text
attrValue Text
"person-group-type" Element
el,
[MetaValue] -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue [MetaValue]
names)
Text
"pub-id" -> case Text -> Element -> Text
attrValue Text
"pub-id-type" Element
el of
Text
"doi" -> Maybe (Text, MetaValue) -> JATS m (Maybe (Text, MetaValue))
forall a. a -> StateT JATSState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Text, MetaValue) -> JATS m (Maybe (Text, MetaValue)))
-> Maybe (Text, MetaValue) -> JATS m (Maybe (Text, MetaValue))
forall a b. (a -> b) -> a -> b
$ (Text, MetaValue) -> Maybe (Text, MetaValue)
forall a. a -> Maybe a
Just (Text
"DOI", Text -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue (Text -> MetaValue) -> Text -> MetaValue
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
el)
Text
"pmid" -> Maybe (Text, MetaValue) -> JATS m (Maybe (Text, MetaValue))
forall a. a -> StateT JATSState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Text, MetaValue) -> JATS m (Maybe (Text, MetaValue)))
-> Maybe (Text, MetaValue) -> JATS m (Maybe (Text, MetaValue))
forall a b. (a -> b) -> a -> b
$ (Text, MetaValue) -> Maybe (Text, MetaValue)
forall a. a -> Maybe a
Just (Text
"PMID", Text -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue (Text -> MetaValue) -> Text -> MetaValue
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
el)
Text
_ -> Maybe (Text, MetaValue) -> JATS m (Maybe (Text, MetaValue))
forall a. a -> StateT JATSState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Text, MetaValue)
forall a. Maybe a
Nothing
Text
"object-id" -> case Text -> Element -> Text
attrValue Text
"pub-id-type" Element
el of
Text
"doi" -> Maybe (Text, MetaValue) -> JATS m (Maybe (Text, MetaValue))
forall a. a -> StateT JATSState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Text, MetaValue) -> JATS m (Maybe (Text, MetaValue)))
-> Maybe (Text, MetaValue) -> JATS m (Maybe (Text, MetaValue))
forall a b. (a -> b) -> a -> b
$ (Text, MetaValue) -> Maybe (Text, MetaValue)
forall a. a -> Maybe a
Just (Text
"DOI", Text -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue (Text -> MetaValue) -> Text -> MetaValue
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
el)
Text
"pmid" -> Maybe (Text, MetaValue) -> JATS m (Maybe (Text, MetaValue))
forall a. a -> StateT JATSState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Text, MetaValue) -> JATS m (Maybe (Text, MetaValue)))
-> Maybe (Text, MetaValue) -> JATS m (Maybe (Text, MetaValue))
forall a b. (a -> b) -> a -> b
$ (Text, MetaValue) -> Maybe (Text, MetaValue)
forall a. a -> Maybe a
Just (Text
"PMID", Text -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue (Text -> MetaValue) -> Text -> MetaValue
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
el)
Text
_ -> Maybe (Text, MetaValue) -> JATS m (Maybe (Text, MetaValue))
forall a. a -> StateT JATSState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Text, MetaValue)
forall a. Maybe a
Nothing
Text
_ -> Maybe (Text, MetaValue) -> JATS m (Maybe (Text, MetaValue))
forall a. a -> StateT JATSState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Text, MetaValue)
forall a. Maybe a
Nothing
[(Text, MetaValue)]
refVariables <-
case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"element-citation") Element
e of
Just Element
c -> ((Text
"type", Text -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue (Text -> MetaValue) -> Text -> MetaValue
forall a b. (a -> b) -> a -> b
$ case Text -> Element -> Text
attrValue Text
"publication-type" Element
c of
Text
"journal" -> Text
"article-journal"
Text
x -> Text
x) (Text, MetaValue) -> [(Text, MetaValue)] -> [(Text, MetaValue)]
forall a. a -> [a] -> [a]
:) ([(Text, MetaValue)] -> [(Text, MetaValue)])
-> ([Maybe (Text, MetaValue)] -> [(Text, MetaValue)])
-> [Maybe (Text, MetaValue)]
-> [(Text, MetaValue)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Maybe (Text, MetaValue)] -> [(Text, MetaValue)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Text, MetaValue)] -> [(Text, MetaValue)])
-> StateT JATSState m [Maybe (Text, MetaValue)]
-> StateT JATSState m [(Text, MetaValue)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> StateT JATSState m (Maybe (Text, MetaValue)))
-> [Element] -> StateT JATSState m [Maybe (Text, MetaValue)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Element -> Element -> StateT JATSState m (Maybe (Text, MetaValue))
forall (m :: * -> *).
PandocMonad m =>
Element -> Element -> JATS m (Maybe (Text, MetaValue))
refElement Element
c) (Element -> [Element]
elChildren Element
c)
Maybe Element
Nothing -> [(Text, MetaValue)] -> StateT JATSState m [(Text, MetaValue)]
forall a. a -> StateT JATSState m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
let stripPref :: Text -> Text
stripPref Text
t = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
t (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
T.stripPrefix Text
"ref-" Text
t
Map Text MetaValue -> JATS m (Map Text MetaValue)
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Text MetaValue -> JATS m (Map Text MetaValue))
-> Map Text MetaValue -> JATS m (Map Text MetaValue)
forall a b. (a -> b) -> a -> b
$ [(Text, MetaValue)] -> Map Text MetaValue
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ((Text
"id", Text -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue (Text -> MetaValue) -> Text -> MetaValue
forall a b. (a -> b) -> a -> b
$ Text -> Text
stripPref (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Element -> Text
attrValue Text
"id" Element
e)
(Text, MetaValue) -> [(Text, MetaValue)] -> [(Text, MetaValue)]
forall a. a -> [a] -> [a]
: [(Text, MetaValue)]
refVariables)
textContent :: Element -> Text
textContent :: Element -> Text
textContent = Element -> Text
strContent
strContentRecursive :: Element -> Text
strContentRecursive :: Element -> Text
strContentRecursive = Element -> Text
strContent (Element -> Text) -> (Element -> Element) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(\Element
e' -> Element
e'{ elContent = map elementToStr $ elContent e' })
elementToStr :: Content -> Content
elementToStr :: Content -> Content
elementToStr (Elem Element
e') = CData -> Content
Text (CData -> Content) -> CData -> Content
forall a b. (a -> b) -> a -> b
$ CDataKind -> Text -> Maybe Line -> CData
CData CDataKind
CDataText (Element -> Text
strContentRecursive Element
e') Maybe Line
forall a. Maybe a
Nothing
elementToStr Content
x = Content
x
parseInline :: PandocMonad m => Content -> JATS m Inlines
parseInline :: forall (m :: * -> *). PandocMonad m => Content -> JATS m Inlines
parseInline (Text (CData CDataKind
_ Text
s Maybe Line
_)) = Inlines -> StateT JATSState m Inlines
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> StateT JATSState m Inlines)
-> Inlines -> StateT JATSState m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text Text
s
parseInline (CRef Text
ref) = Inlines -> StateT JATSState m Inlines
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> StateT JATSState m Inlines)
-> Inlines -> StateT JATSState m Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> (Text -> Inlines) -> Maybe Text -> Inlines
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Inlines
text (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toUpper Text
ref) Text -> Inlines
text
(Maybe Text -> Inlines) -> Maybe Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
lookupEntity Text
ref
parseInline (Elem Element
e) =
case QName -> Text
qName (Element -> QName
elName Element
e) of
Text
"italic" -> (Inlines -> Inlines) -> StateT JATSState m Inlines
forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines Inlines -> Inlines
emph
Text
"bold" -> (Inlines -> Inlines) -> StateT JATSState m Inlines
forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines Inlines -> Inlines
strong
Text
"strike" -> (Inlines -> Inlines) -> StateT JATSState m Inlines
forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines Inlines -> Inlines
strikeout
Text
"sub" -> (Inlines -> Inlines) -> StateT JATSState m Inlines
forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines Inlines -> Inlines
subscript
Text
"sup" -> (Inlines -> Inlines) -> StateT JATSState m Inlines
forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines Inlines -> Inlines
superscript
Text
"underline" -> (Inlines -> Inlines) -> StateT JATSState m Inlines
forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines Inlines -> Inlines
underline
Text
"break" -> Inlines -> StateT JATSState m Inlines
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
linebreak
Text
"sc" -> (Inlines -> Inlines) -> StateT JATSState m Inlines
forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines Inlines -> Inlines
smallcaps
Text
"code" -> StateT JATSState m Inlines
codeWithLang
Text
"monospace" -> StateT JATSState m Inlines
codeWithLang
Text
"inline-graphic" -> Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getGraphic Element
e
Text
"disp-quote" -> do
QuoteType
qt <- (JATSState -> QuoteType) -> StateT JATSState m QuoteType
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets JATSState -> QuoteType
jatsQuoteType
let qt' :: QuoteType
qt' = if QuoteType
qt QuoteType -> QuoteType -> Bool
forall a. Eq a => a -> a -> Bool
== QuoteType
SingleQuote then QuoteType
DoubleQuote else QuoteType
SingleQuote
(JATSState -> JATSState) -> StateT JATSState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((JATSState -> JATSState) -> StateT JATSState m ())
-> (JATSState -> JATSState) -> StateT JATSState m ()
forall a b. (a -> b) -> a -> b
$ \JATSState
st -> JATSState
st{ jatsQuoteType = qt' }
Inlines
contents <- (Inlines -> Inlines) -> StateT JATSState m Inlines
forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines Inlines -> Inlines
forall a. a -> a
id
(JATSState -> JATSState) -> StateT JATSState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((JATSState -> JATSState) -> StateT JATSState m ())
-> (JATSState -> JATSState) -> StateT JATSState m ()
forall a b. (a -> b) -> a -> b
$ \JATSState
st -> JATSState
st{ jatsQuoteType = qt }
Inlines -> StateT JATSState m Inlines
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> StateT JATSState m Inlines)
-> Inlines -> StateT JATSState m Inlines
forall a b. (a -> b) -> a -> b
$ if QuoteType
qt QuoteType -> QuoteType -> Bool
forall a. Eq a => a -> a -> Bool
== QuoteType
SingleQuote
then Inlines -> Inlines
singleQuoted Inlines
contents
else Inlines -> Inlines
doubleQuoted Inlines
contents
Text
"xref" -> do
Inlines
ils <- (Inlines -> Inlines) -> StateT JATSState m Inlines
forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines Inlines -> Inlines
forall a. a -> a
id
let rid :: Text
rid = Text -> Element -> Text
attrValue Text
"rid" Element
e
let rids :: [Text]
rids = Text -> [Text]
T.words Text
rid
let refType :: Maybe (Text, Text)
refType = (Text
"ref-type",) (Text -> (Text, Text)) -> Maybe Text -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Element -> Maybe Text
maybeAttrValue Text
"ref-type" Element
e
let attr :: (Text, [a], [(Text, Text)])
attr = (Text -> Element -> Text
attrValue Text
"id" Element
e, [], Maybe (Text, Text) -> [(Text, Text)]
forall a. Maybe a -> [a]
maybeToList Maybe (Text, Text)
refType)
Inlines -> StateT JATSState m Inlines
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> StateT JATSState m Inlines)
-> Inlines -> StateT JATSState m Inlines
forall a b. (a -> b) -> a -> b
$ if Maybe (Text, Text)
refType Maybe (Text, Text) -> Maybe (Text, Text) -> Bool
forall a. Eq a => a -> a -> Bool
== (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
"ref-type",Text
"bibr")
then [Citation] -> Inlines -> Inlines
cite
((Text -> Citation) -> [Text] -> [Citation]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
id' ->
let id'' :: Text
id'' = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
id' (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$
Text -> Text -> Maybe Text
T.stripPrefix Text
"ref-" Text
id'
in Citation { citationId :: Text
citationId = Text
id''
, citationPrefix :: [Inline]
citationPrefix = []
, citationSuffix :: [Inline]
citationSuffix = []
, citationMode :: CitationMode
citationMode = CitationMode
NormalCitation
, citationNoteNum :: Int
citationNoteNum = Int
0
, citationHash :: Int
citationHash = Int
0}) [Text]
rids)
Inlines
ils
else Attr -> Text -> Text -> Inlines -> Inlines
linkWith Attr
forall {a}. (Text, [a], [(Text, Text)])
attr (Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rid) Text
"" Inlines
ils
Text
"ext-link" -> do
Inlines
ils <- (Inlines -> Inlines) -> StateT JATSState m Inlines
forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines Inlines -> Inlines
forall a. a -> a
id
let title :: Text
title = 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
$ QName -> Element -> Maybe Text
findAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"title" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"http://www.w3.org/1999/xlink") Maybe Text
forall a. Maybe a
Nothing) Element
e
let href :: Text
href = case QName -> Element -> Maybe Text
findAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"href" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"http://www.w3.org/1999/xlink") Maybe Text
forall a. Maybe a
Nothing) Element
e of
Just Text
h -> Text
h
Maybe Text
_ -> Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Element -> Text
attrValue Text
"rid" Element
e
let ils' :: Inlines
ils' = if Inlines
ils Inlines -> Inlines -> Bool
forall a. Eq a => a -> a -> Bool
== Inlines
forall a. Monoid a => a
mempty then Text -> Inlines
str Text
href else Inlines
ils
let attr :: (Text, [a], [a])
attr = (Text -> Element -> Text
attrValue Text
"id" Element
e, [], [])
Inlines -> StateT JATSState m Inlines
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> StateT JATSState m Inlines)
-> Inlines -> StateT JATSState m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
linkWith Attr
forall {a} {a}. (Text, [a], [a])
attr Text
href Text
title Inlines
ils'
Text
"alternatives" -> if Element -> Bool
hasFormulaChild Element
e
then (Text -> Inlines) -> Element -> StateT JATSState m Inlines
forall (m :: * -> *).
PandocMonad m =>
(Text -> Inlines) -> Element -> JATS m Inlines
inlineFormula Text -> Inlines
math Element
e
else (Inlines -> Inlines) -> StateT JATSState m Inlines
forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines Inlines -> Inlines
forall a. a -> a
id
Text
"disp-formula" -> (Text -> Inlines) -> Element -> StateT JATSState m Inlines
forall (m :: * -> *).
PandocMonad m =>
(Text -> Inlines) -> Element -> JATS m Inlines
inlineFormula Text -> Inlines
displayMath Element
e
Text
"inline-formula" -> (Text -> Inlines) -> Element -> StateT JATSState m Inlines
forall (m :: * -> *).
PandocMonad m =>
(Text -> Inlines) -> Element -> JATS m Inlines
inlineFormula Text -> Inlines
math Element
e
Text
"math" | QName -> Maybe Text
qURI (Element -> QName
elName Element
e) Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"http://www.w3.org/1998/Math/MathML"
-> Inlines -> StateT JATSState m Inlines
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> StateT JATSState m Inlines)
-> (Text -> Inlines) -> Text -> StateT JATSState m Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inlines
math (Text -> StateT JATSState m Inlines)
-> Text -> StateT JATSState m Inlines
forall a b. (a -> b) -> a -> b
$ Element -> Text
mathML Element
e
Text
"tex-math" -> Inlines -> StateT JATSState m Inlines
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> StateT JATSState m Inlines)
-> (Text -> Inlines) -> Text -> StateT JATSState m Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inlines
math (Text -> StateT JATSState m Inlines)
-> Text -> StateT JATSState m Inlines
forall a b. (a -> b) -> a -> b
$ Element -> Text
textContent Element
e
Text
"email" -> Inlines -> StateT JATSState m Inlines
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> StateT JATSState m Inlines)
-> Inlines -> StateT JATSState m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
link (Text
"mailto:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Element -> Text
textContent Element
e) Text
""
(Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Element -> Text
textContent Element
e
Text
"uri" -> Inlines -> StateT JATSState m Inlines
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> StateT JATSState m Inlines)
-> Inlines -> StateT JATSState m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
link (Element -> Text
textContent Element
e) Text
"" (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Element -> Text
textContent Element
e
Text
"fn" -> Blocks -> Inlines
note (Blocks -> Inlines) -> ([Blocks] -> Blocks) -> [Blocks] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Inlines)
-> StateT JATSState m [Blocks] -> StateT JATSState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Content -> StateT JATSState m Blocks)
-> [Content] -> StateT JATSState m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Content -> StateT JATSState m Blocks
forall (m :: * -> *). PandocMonad m => Content -> JATS m Blocks
parseBlock (Element -> [Content]
elContent Element
e)
Text
_ -> (Inlines -> Inlines) -> StateT JATSState m Inlines
forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines Inlines -> Inlines
forall a. a -> a
id
where innerInlines :: (Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines Inlines -> Inlines
f = (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces Inlines -> Inlines
f (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> StateT JATSState m [Inlines] -> StateT JATSState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Content -> StateT JATSState m Inlines)
-> [Content] -> StateT JATSState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Content -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Content -> JATS m Inlines
parseInline (Element -> [Content]
elContent Element
e)
codeWithLang :: StateT JATSState m Inlines
codeWithLang = do
let classes' :: [Text]
classes' = case Text -> Element -> Text
attrValue Text
"language" Element
e of
Text
"" -> []
Text
l -> [Text
l]
Inlines -> StateT JATSState m Inlines
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> StateT JATSState m Inlines)
-> Inlines -> StateT JATSState m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Inlines
codeWith (Text -> Element -> Text
attrValue Text
"id" Element
e,[Text]
classes',[]) (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContentRecursive Element
e
inlineFormula :: PandocMonad m => (Text->Inlines) -> Element -> JATS m Inlines
inlineFormula :: forall (m :: * -> *).
PandocMonad m =>
(Text -> Inlines) -> Element -> JATS m Inlines
inlineFormula Text -> Inlines
constructor Element
e = do
let whereToLook :: Element
whereToLook = Element -> Maybe Element -> Element
forall a. a -> Maybe a -> a
fromMaybe Element
e (Maybe Element -> Element) -> Maybe Element -> Element
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named Text
"alternatives") Element
e
texMaths :: [Text]
texMaths = (Element -> Text) -> [Element] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Text
textContent ([Element] -> [Text]) -> [Element] -> [Text]
forall a b. (a -> b) -> a -> b
$
(Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"tex-math") Element
whereToLook
mathMLs :: [Text]
mathMLs = (Element -> Text) -> [Element] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Text
mathML ([Element] -> [Text]) -> [Element] -> [Text]
forall a b. (a -> b) -> a -> b
$
(Element -> Bool) -> Element -> [Element]
filterChildren Element -> Bool
isMathML Element
whereToLook
Inlines -> JATS m Inlines
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> JATS m Inlines)
-> ([Text] -> Inlines) -> [Text] -> JATS m Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ([Text] -> [Inlines]) -> [Text] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Inlines] -> [Inlines]
forall a. Int -> [a] -> [a]
take Int
1 ([Inlines] -> [Inlines])
-> ([Text] -> [Inlines]) -> [Text] -> [Inlines]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Inlines) -> [Text] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Inlines
constructor ([Text] -> JATS m Inlines) -> [Text] -> JATS m Inlines
forall a b. (a -> b) -> a -> b
$ [Text]
texMaths [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
mathMLs
blockFormula :: PandocMonad m => (Text->Inlines) -> Element -> JATS m Blocks
blockFormula :: forall (m :: * -> *).
PandocMonad m =>
(Text -> Inlines) -> Element -> JATS m Blocks
blockFormula Text -> Inlines
constructor Element
e = do
let whereToLook :: Element
whereToLook = Element -> Maybe Element -> Element
forall a. a -> Maybe a -> a
fromMaybe Element
e (Maybe Element -> Element) -> Maybe Element -> Element
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named Text
"alternatives") Element
e
texMaths :: [Text]
texMaths = (Element -> Text) -> [Element] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Text
textContent ([Element] -> [Text]) -> [Element] -> [Text]
forall a b. (a -> b) -> a -> b
$
(Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"tex-math") Element
whereToLook
mathMLs :: [Text]
mathMLs = (Element -> Text) -> [Element] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Text
mathML ([Element] -> [Text]) -> [Element] -> [Text]
forall a b. (a -> b) -> a -> b
$
(Element -> Bool) -> Element -> [Element]
filterChildren Element -> Bool
isMathML Element
whereToLook
Blocks -> JATS m Blocks
forall a. a -> StateT JATSState m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> JATS m Blocks)
-> ([Text] -> Blocks) -> [Text] -> JATS m Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Blocks
para (Inlines -> Blocks) -> ([Text] -> Inlines) -> [Text] -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. HasCallStack => [a] -> a
head ([Inlines] -> Inlines)
-> ([Text] -> [Inlines]) -> [Text] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Inlines] -> [Inlines]
forall a. Int -> [a] -> [a]
take Int
1 ([Inlines] -> [Inlines])
-> ([Text] -> [Inlines]) -> [Text] -> [Inlines]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Inlines) -> [Text] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Inlines
constructor ([Text] -> JATS m Blocks) -> [Text] -> JATS m Blocks
forall a b. (a -> b) -> a -> b
$ [Text]
texMaths [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
mathMLs
mathML :: Element -> Text
mathML :: Element -> Text
mathML Element
x =
case Text -> Either Text [Exp]
readMathML (Text -> Either Text [Exp])
-> (Element -> Text) -> Element -> Either Text [Exp]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
showElement (Element -> Either Text [Exp]) -> Element -> Either Text [Exp]
forall a b. (a -> b) -> a -> b
$ (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere ((QName -> QName) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT QName -> QName
removePrefix) Element
x of
Left Text
_ -> Text
forall a. Monoid a => a
mempty
Right [Exp]
m -> [Exp] -> Text
writeTeX [Exp]
m
where removePrefix :: QName -> QName
removePrefix QName
elname = QName
elname { qPrefix = Nothing }
isMathML :: Element -> Bool
isMathML :: Element -> Bool
isMathML Element
x = QName -> Text
qName (Element -> QName
elName Element
x) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"math" Bool -> Bool -> Bool
&&
QName -> Maybe Text
qURI (Element -> QName
elName Element
x) Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
==
Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"http://www.w3.org/1998/Math/MathML"
formulaChildren :: Element -> [Element]
formulaChildren :: Element -> [Element]
formulaChildren Element
x = (Element -> Bool) -> Element -> [Element]
filterChildren Element -> Bool
isMathML Element
x [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"tex-math") Element
x
hasFormulaChild :: Element -> Bool
hasFormulaChild :: Element -> Bool
hasFormulaChild Element
x = [Element] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Element -> [Element]
formulaChildren Element
x) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
isAliLicenseRef :: Element -> Bool
isAliLicenseRef :: Element -> Bool
isAliLicenseRef Element
x = QName -> Text
qName (Element -> QName
elName Element
x) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"license_ref" Bool -> Bool -> Bool
&&
QName -> Maybe Text
qURI (Element -> QName
elName Element
x) Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
==
Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"http://www.niso.org/schemas/ali/1.0/"