{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Readers.JATS ( readJATS ) where
import Control.Monad.State.Strict
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.HTML.TagSoup.Entity (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 qualified Data.Foldable as DF
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]
} deriving Int -> JATSState -> ShowS
[JATSState] -> ShowS
JATSState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JATSState] -> ShowS
$cshowList :: [JATSState] -> ShowS
show :: JATSState -> String
$cshow :: JATSState -> String
showsPrec :: Int -> JATSState -> ShowS
$cshowsPrec :: Int -> JATSState -> ShowS
Show
instance Default JATSState where
def :: JATSState
def = JATSState{ jatsSectionLevel :: Int
jatsSectionLevel = Int
0
, jatsQuoteType :: QuoteType
jatsQuoteType = QuoteType
DoubleQuote
, jatsMeta :: Meta
jatsMeta = forall a. Monoid a => a
mempty
, jatsBook :: Bool
jatsBook = Bool
False
, jatsFootnotes :: Map Text Blocks
jatsFootnotes = forall a. Monoid a => a
mempty
, jatsContent :: [Content]
jatsContent = [] }
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 = forall a. ToSources a => a -> Sources
toSources a
inp
[Content]
tree <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> PandocError
PandocXMLError Text
"") forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
Text -> Either Text [Content]
parseXMLContents (Text -> Text
TL.fromStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sources -> Text
sourcesToText forall a b. (a -> b) -> a -> b
$ Sources
sources)
([Blocks]
bs, JATSState
st') <- forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (forall a. Default a => a
def{ jatsContent :: [Content]
jatsContent = [Content]
tree }) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM 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 = forall a. Many a -> [a]
toList forall a b. (a -> b) -> a -> b
$ 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 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 (forall a. Many a -> [a]
toList Blocks
footnote)
Maybe Blocks
Nothing -> Inline
link'
Maybe (Char, Text)
_ -> Inline
link'
linkToFootnotes Inline
inline = Inline
inline
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Meta -> [Block] -> Pandoc
Pandoc (JATSState -> Meta
jatsMeta JATSState
st') (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 =
forall a. a -> Maybe a -> a
fromMaybe 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 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) 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 = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
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 :: Meta
jatsMeta = forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
setMeta Text
field b
v (JATSState -> Meta
jatsMeta JATSState
s)}
deleteMeta :: Text -> JATSState -> JATSState
deleteMeta Text
field JATSState
s = JATSState
s {jatsMeta :: Meta
jatsMeta = forall a. HasMeta a => Text -> a -> a
deleteMeta Text
field (JATSState -> Meta
jatsMeta JATSState
s)}
isBlockElement :: Content -> Bool
isBlockElement :: Content -> Bool
isBlockElement (Elem Element
e) = QName -> Text
qName (Element -> QName
elName Element
e) forall a. Ord a => a -> Set a -> Bool
`S.member` Set Text
blocktags
where blocktags :: Set Text
blocktags = forall a. Ord a => [a] -> Set a
S.fromList ([Text]
paragraphLevel forall a. [a] -> [a] -> [a]
++ [Text]
lists forall a. [a] -> [a] -> [a]
++ [Text]
mathML forall a. [a] -> [a] -> [a]
++ [Text]
other) forall a. Ord a => Set a -> Set a -> Set a
\\ forall a. Ord a => [a] -> Set a
S.fromList [Text]
inlinetags
paragraphLevel :: [Text]
paragraphLevel = [Text
"address", Text
"array", Text
"boxed-text", Text
"chem-struct-wrap",
Text
"code", Text
"fig", Text
"fig-group", Text
"graphic", Text
"media", Text
"preformat",
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"]
mathML :: [Text]
mathML = [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"]
inlinetags :: [Text]
inlinetags = [Text
"email", Text
"ext-link", Text
"uri", Text
"inline-supplementary-material",
Text
"related-article", Text
"related-object", Text
"hr", Text
"bold", Text
"fixed-case",
Text
"italic", Text
"monospace", Text
"overline", Text
"overline-start", Text
"overline-end",
Text
"roman", Text
"sans-serif", Text
"sc", Text
"strike", Text
"underline", Text
"underline-start",
Text
"underline-end", Text
"ruby", Text
"alternatives", Text
"inline-graphic", Text
"private-char",
Text
"chem-struct", Text
"inline-formula", Text
"tex-math", Text
"mml:math", Text
"abbrev",
Text
"milestone-end", Text
"milestone-start", Text
"named-content", Text
"styled-content",
Text
"fn", Text
"target", Text
"xref", Text
"sub", Text
"sup", Text
"x", Text
"address", Text
"array",
Text
"boxed-text", Text
"chem-struct-wrap", Text
"code", Text
"fig", Text
"fig-group", Text
"graphic",
Text
"media", Text
"preformat", Text
"supplementary-material", Text
"table-wrap",
Text
"table-wrap-group", Text
"disp-formula", Text
"disp-formula-group",
Text
"citation-alternatives", Text
"element-citation", Text
"mixed-citation",
Text
"nlm-citation", Text
"award-id", Text
"funding-source", Text
"open-access",
Text
"def-list", Text
"list", Text
"ack", Text
"disp-quote", Text
"speech", Text
"statement",
Text
"verse-group"]
isBlockElement Content
_ = Bool
False
trimNl :: Text -> Text
trimNl :: Text -> Text
trimNl = (Char -> Bool) -> Text -> Text
T.dropAround (forall a. Eq a => a -> a -> Bool
== Char
'\n')
getGraphic :: PandocMonad m
=> Maybe (Inlines, Text) -> Element -> JATS m Inlines
getGraphic :: forall (m :: * -> *).
PandocMonad m =>
Maybe (Inlines, Text) -> Element -> JATS m Inlines
getGraphic Maybe (Inlines, Text)
mbfigdata Element
e = do
let atVal :: Text -> Text
atVal Text
a = Text -> Element -> Text
attrValue Text
a Element
e
(Text
ident, Text
title, Inlines
capt) =
case Maybe (Inlines, Text)
mbfigdata of
Just (Inlines
capt', Text
i) -> (Text
i, Text
"fig:" forall a. Semigroup a => a -> a -> a
<> Text -> Text
atVal Text
"title", Inlines
capt')
Maybe (Inlines, Text)
Nothing -> (Text -> Text
atVal Text
"id", Text -> Text
atVal Text
"title",
Text -> Inlines
text (Text -> Text
atVal Text
"alt-text"))
attr :: (Text, [Text], [a])
attr = (Text
ident, Text -> [Text]
T.words forall a b. (a -> b) -> a -> b
$ Text -> Text
atVal Text
"role", [])
imageUrl :: Text
imageUrl = Text -> Text
atVal Text
"href"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
imageWith forall {a}. (Text, [Text], [a])
attr Text
imageUrl Text
title Inlines
capt
getBlocks :: PandocMonad m => Element -> JATS m Blocks
getBlocks :: forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
getBlocks Element
e = forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM 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
_)) = forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
plain forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
trimInlines forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text Text
s
parseBlock (CRef Text
x) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
plain forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toUpper Text
x
parseBlock (Elem Element
e) =
case QName -> Text
qName (Element -> QName
elName Element
e) of
Text
"p" -> 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" -> StateT JATSState m Blocks
parseBlockquote
Text
"list" -> case Text -> Element -> Text
attrValue Text
"list-type" Element
e of
Text
"bullet" -> [Blocks] -> Blocks
bulletList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT JATSState m [Blocks]
listitems
Text
listType -> do
let start :: Int
start = forall a. a -> Maybe a -> a
fromMaybe Int
1 forall a b. (a -> b) -> a -> b
$
((Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named Text
"list-item") Element
e
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"))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
textContent
ListAttributes -> [Blocks] -> Blocks
orderedListWith (Int
start, forall {a}. (Eq a, IsString a) => a -> ListNumberStyle
parseListStyleType Text
listType, ListNumberDelim
DefaultDelim)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT JATSState m [Blocks]
listitems
Text
"def-list" -> [(Inlines, [Blocks])] -> Blocks
definitionList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT JATSState m [(Inlines, [Blocks])]
deflistitems
Text
"sec" -> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets JATSState -> Int
jatsSectionLevel forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {m :: * -> *}.
PandocMonad m =>
Int -> StateT JATSState m Blocks
sect forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
+Int
1)
Text
"graphic" -> Inlines -> Blocks
para forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
PandocMonad m =>
Maybe (Inlines, Text) -> Element -> JATS m Inlines
getGraphic forall a. Maybe a
Nothing Element
e
Text
"journal-meta" -> forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
parseMetadata Element
e
Text
"article-meta" -> forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
parseMetadata Element
e
Text
"custom-meta" -> forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
parseMetadata Element
e
Text
"title" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
Text
"label" -> forall (m :: * -> *) a. Monad m => a -> m a
return 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"], [])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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"], [])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
getBlocks Element
e
Text
"caption" -> Attr -> Blocks -> Blocks
divWith (Text -> Element -> Text
attrValue Text
"id" Element
e, [Text
"caption"], []) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {m :: * -> *}.
PandocMonad m =>
Int -> StateT JATSState m Blocks
sect Int
6
Text
"fn-group" -> StateT JATSState m Blocks
parseFootnoteGroup
Text
"ref-list" -> forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
parseRefList Element
e
Text
"?xml" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
Text
_ -> 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) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break Content -> Bool
isBlockElement [Content]
conts
Inlines
ils' <- Inlines -> Inlines
trimInlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => Content -> JATS m Inlines
parseInline [Content]
ils
let p :: Blocks
p = if Inlines
ils' forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty then forall a. Monoid a => a
mempty else Inlines -> Blocks
container Inlines
ils'
case [Content]
rest of
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
p
(Content
r:[Content]
rs) -> do
Blocks
b <- 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
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Blocks
p forall a. Semigroup a => a -> a -> a
<> Blocks
b 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]
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Blocks
codeBlockWith (Text -> Element -> Text
attrValue Text
"id" Element
e, [Text]
classes', [])
forall a b. (a -> b) -> a -> b
$ Text -> Text
trimNl 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
"attribution") Element
e of
Maybe Element
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
Just Element
z -> Inlines -> Blocks
para forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Inlines
str Text
"— " forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => Content -> JATS m Inlines
parseInline (Element -> [Content]
elContent Element
z)
Blocks
contents <- forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
getBlocks Element
e
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Blocks -> Blocks
blockQuote (Blocks
contents forall a. Semigroup a => a -> a -> a
<> Blocks
attrib)
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 = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
getBlocks 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 = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {m :: * -> *}.
PandocMonad m =>
Element -> StateT JATSState m (Inlines, [Blocks])
parseVarListEntry 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' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines [Element]
terms
[Blocks]
items' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
getBlocks [Element]
items
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a. a -> [a] -> [a]
intersperse (Text -> Inlines
str Text
"; ") [Inlines]
terms', [Blocks]
items')
parseFigure :: StateT JATSState m Blocks
parseFigure =
case (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"graphic") Element
e of
[Element
g] -> do
Inlines
capt <- case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"caption") Element
e of
Just Element
t -> forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. a -> [a] -> [a]
intersperse Inlines
linebreak forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines
((Element -> Bool) -> Element -> [Element]
filterChildren (forall a b. a -> b -> a
const Bool
True) Element
t)
Maybe Element
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
let figAttributes :: [(Text, Text)]
figAttributes = forall (t :: * -> *) a. Foldable t => t a -> [a]
DF.toList forall a b. (a -> b) -> a -> b
$
(Text
"alt", ) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
strContent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"alt-text") Element
e
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Text -> Text -> Blocks
simpleFigureWith
(Text -> Element -> Text
attrValue Text
"id" Element
e, [], [(Text, Text)]
figAttributes)
Inlines
capt
(Text -> Element -> Text
attrValue Text
"href" Element
g)
(Text -> Element -> Text
attrValue Text
"title" Element
g)
[Element]
_ -> Attr -> Blocks -> Blocks
divWith (Text -> Element -> Text
attrValue Text
"id" Element
e, [Text
"fig"], []) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
getBlocks Element
e
parseFootnoteGroup :: StateT JATSState m Blocks
parseFootnoteGroup = do
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) forall a b. (a -> b) -> a -> b
$ \Element
fn -> do
let id' :: Text
id' = Text -> Element -> Text
attrValue Text
"id" Element
fn
Blocks
contents <- forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
getBlocks Element
fn
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \JATSState
st ->
JATSState
st { jatsFootnotes :: Map Text Blocks
jatsFootnotes = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
id' Blocks
contents (JATSState -> Map Text Blocks
jatsFootnotes JATSState
st) }
forall (m :: * -> *) a. Monad m => a -> m a
return 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 -> forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
t
Maybe Element
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
let e' :: Element
e' = forall a. a -> Maybe a -> a
fromMaybe Element
e 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
[Blocks]
headrows <- case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"thead") Element
e' of
Just Element
h -> case (Element -> Bool) -> Element -> Maybe Element
filterChild Element -> Bool
isRow Element
h of
Just Element
x -> Element -> StateT JATSState m [Blocks]
parseRow Element
x
Maybe Element
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []
Maybe Element
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []
[[Blocks]]
bodyrows <- case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"tbody") Element
e' of
Just Element
b -> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> StateT JATSState m [Blocks]
parseRow
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren Element -> Bool
isRow Element
b
Maybe Element
Nothing -> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> StateT JATSState m [Blocks]
parseRow
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren Element -> Bool
isRow 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 toWidth :: Element -> Maybe b
toWidth Element
c = do
Text
w <- QName -> Element -> Maybe Text
findAttr (Text -> QName
unqual Text
"colwidth") Element
c
b
n <- forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead forall a b. (a -> b) -> a -> b
$ Text
"0" 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 forall a. Eq a => a -> a -> Bool
== Char
'.') Text
w
if b
n forall a. Ord a => a -> a -> Bool
> b
0 then forall a. a -> Maybe a
Just b
n else forall a. Maybe a
Nothing
let numrows :: Int
numrows = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Blocks]]
bodyrows
let aligns :: [Alignment]
aligns = case [Element]
colspecs of
[] -> forall a. Int -> a -> [a]
replicate Int
numrows Alignment
AlignDefault
[Element]
cs -> forall a b. (a -> b) -> [a] -> [b]
map Element -> Alignment
toAlignment [Element]
cs
let widths :: [ColWidth]
widths = case [Element]
colspecs of
[] -> forall a. Int -> a -> [a]
replicate Int
numrows ColWidth
ColWidthDefault
[Element]
cs -> let ws :: [Maybe Double]
ws = forall a b. (a -> b) -> [a] -> [b]
map forall {b}. (Read b, Ord b, Num b) => Element -> Maybe b
toWidth [Element]
cs
in case forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Maybe Double]
ws of
Just [Double]
ws' -> let tot :: Double
tot = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
ws'
in Double -> ColWidth
ColWidth forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Fractional a => a -> a -> a
/ Double
tot) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double]
ws'
Maybe [Double]
Nothing -> forall a. Int -> a -> [a]
replicate Int
numrows ColWidth
ColWidthDefault
let toRow :: [Blocks] -> Row
toRow = Attr -> [Cell] -> Row
Row Attr
nullAttr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Blocks -> Cell
simpleCell
toHeaderRow :: [Blocks] -> [Row]
toHeaderRow [Blocks]
l = [[Blocks] -> Row
toRow [Blocks]
l | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Blocks]
l)]
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Caption
-> [ColSpec] -> TableHead -> [TableBody] -> TableFoot -> Blocks
table (Blocks -> Caption
simpleCaption forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
plain Inlines
capt)
(forall a b. [a] -> [b] -> [(a, b)]
zip [Alignment]
aligns [ColWidth]
widths)
(Attr -> [Row] -> TableHead
TableHead Attr
nullAttr forall a b. (a -> b) -> a -> b
$ [Blocks] -> [Row]
toHeaderRow [Blocks]
headrows)
[Attr -> RowHeadColumns -> [Row] -> [Row] -> TableBody
TableBody Attr
nullAttr RowHeadColumns
0 [] forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map [Blocks] -> Row
toRow [[Blocks]]
bodyrows]
(Attr -> [Row] -> TableFoot
TableFoot Attr
nullAttr [])
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
parseRow :: Element -> StateT JATSState m [Blocks]
parseRow = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Blocks) -> [Content] -> StateT JATSState m Blocks
parseMixed Inlines -> Blocks
plain forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Content]
elContent) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> Bool) -> Element -> [Element]
filterChildren Element -> Bool
isEntry
sect :: Int -> StateT JATSState m Blocks
sect Int
n = do Bool
isbook <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets JATSState -> Bool
jatsBook
let n' :: Int
n' = if Bool
isbook Bool -> Bool -> Bool
|| Int
n forall a. Eq a => a -> a -> Bool
== Int
0 then Int
n forall a. Num a => a -> a -> a
+ Int
1 else Int
n
Inlines
labelText <- case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"label") Element
e of
Just Element
t -> (forall a. Semigroup a => a -> a -> a
<> (Inlines
"." forall a. Semigroup a => a -> a -> a
<> Inlines
space)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
t
Maybe Element
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
Inlines
headerText <- case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"title") Element
e forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
((Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"info") Element
e 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 -> (Inlines
labelText forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
t
Maybe Element
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
Int
oldN <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets JATSState -> Int
jatsSectionLevel
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \JATSState
st -> JATSState
st{ jatsSectionLevel :: Int
jatsSectionLevel = Int
n }
Blocks
b <- forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
getBlocks Element
e
let ident :: Text
ident = Text -> Element -> Text
attrValue Text
"id" Element
e
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \JATSState
st -> JATSState
st{ jatsSectionLevel :: Int
jatsSectionLevel = Int
oldN }
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Int -> Inlines -> Blocks
headerWith (Text
ident,[],[]) Int
n' Inlines
headerText forall a. Semigroup a => a -> a -> a
<> Blocks
b
getInlines :: PandocMonad m => Element -> JATS m Inlines
getInlines :: forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
e' = Inlines -> Inlines
trimInlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM 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
forall (m :: * -> *). PandocMonad m => Element -> JATS m ()
getTitle Element
e
forall (m :: * -> *). PandocMonad m => Element -> JATS m ()
getAuthors Element
e
forall (m :: * -> *). PandocMonad m => Element -> JATS m ()
getAffiliations Element
e
forall (m :: * -> *). PandocMonad m => Element -> JATS m ()
getAbstract Element
e
forall (m :: * -> *). PandocMonad m => Element -> JATS m ()
getPubDate Element
e
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
getTitle :: PandocMonad m => Element -> JATS m ()
getTitle :: forall (m :: * -> *). PandocMonad m => Element -> JATS m ()
getTitle 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 -> forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
s
Maybe Element
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return 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
": " forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
s
Maybe Element
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Inlines
tit forall a. Eq a => a -> a -> Bool
/= forall a. Monoid a => a
mempty) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> JATS m ()
addMeta Text
"title" Inlines
tit
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Inlines
subtit forall a. Eq a => a -> a -> Bool
/= forall a. Monoid a => a
mempty) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> JATS m ()
addMeta Text
"subtitle" Inlines
subtit
getAuthors :: PandocMonad m => Element -> JATS m ()
getAuthors :: forall (m :: * -> *). PandocMonad m => Element -> JATS m ()
getAuthors Element
e = do
[Inlines]
authors <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getContrib 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 forall a. Eq a => a -> a -> Bool
== Text
"author") Element
e
[Inlines]
authorNotes <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines 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 (forall a. [a] -> [a]
reverse [Inlines]
authors, [Inlines]
authorNotes) of
([], [Inlines]
_) -> []
([Inlines]
_, []) -> [Inlines]
authors
(Inlines
a:[Inlines]
as, [Inlines]
ns) -> forall a. [a] -> [a]
reverse [Inlines]
as forall a. [a] -> [a] -> [a]
++ [Inlines
a forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat [Inlines]
ns]
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inlines]
authors) forall a b. (a -> b) -> a -> b
$ 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 <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"aff") Element
x
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inlines]
affs) forall a b. (a -> b) -> a -> b
$ 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 <- forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
getBlocks Element
s
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> JATS m ()
addMeta Text
"abstract" Blocks
blks
Maybe Element
Nothing -> 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 -> do
case Text -> Element -> Maybe Text
maybeAttrValue Text
"iso-8601-date" Element
d of
Just Text
isod -> forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> JATS m ()
addMeta Text
"date" (Text -> Inlines
text Text
isod)
Maybe Text
Nothing -> do
let yr :: Maybe Text
yr = Element -> Text
strContent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named Text
"year") Element
d
let mon :: Maybe Text
mon = Element -> Text
strContent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named Text
"month") Element
d
let day :: Maybe Text
day = Element -> Text
strContent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named Text
"day") Element
d
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> JATS m ()
addMeta Text
"date" forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"-" forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [Maybe Text
yr, Maybe Text
mon, Maybe Text
day]
Maybe Element
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
getContrib :: PandocMonad m => Element -> JATS m Inlines
getContrib :: forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getContrib Element
x = do
Inlines
given <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty) forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named Text
"given-names") Element
x
Inlines
family <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty) forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named Text
"surname") Element
x
if Inlines
given forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty Bool -> Bool -> Bool
&& Inlines
family forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
else if Inlines
given forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty Bool -> Bool -> Bool
|| Inlines
family forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Inlines
given forall a. Semigroup a => a -> a -> a
<> Inlines
family
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Inlines
given forall a. Semigroup a => a -> a -> a
<> Inlines
space 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 <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *).
PandocMonad m =>
Element -> JATS m (Map Text MetaValue)
parseRef forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"ref") Element
e
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> JATS m ()
addMeta Text
"references" [Map Text MetaValue]
refs
forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
text Text
"-" forall a. Semigroup a => a -> a -> a
<> Inlines
y
let getName :: Element -> StateT JATSState m MetaValue
getName Element
nm = do
Inlines
given <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty) forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"given-names") Element
nm
Inlines
family <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty) forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"surname") Element
nm
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. ToMetaValue a => a -> MetaValue
toMetaValue forall a b. (a -> b) -> a -> b
$ 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" -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"title",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToMetaValue a => a -> MetaValue
toMetaValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
_ -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"container-title",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToMetaValue a => a -> MetaValue
toMetaValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
el
Maybe Element
Nothing -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"title",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToMetaValue a => a -> MetaValue
toMetaValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
el
Text
"label" -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"citation-label",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToMetaValue a => a -> MetaValue
toMetaValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"issued",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToMetaValue a => a -> MetaValue
toMetaValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Inlines -> Inlines -> Inlines
combineWithDash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
el forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
m)
Maybe Element
Nothing -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"issued",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToMetaValue a => a -> MetaValue
toMetaValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
el
Text
"volume" -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"volume",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToMetaValue a => a -> MetaValue
toMetaValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
el
Text
"issue" -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"issue",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToMetaValue a => a -> MetaValue
toMetaValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
el
Text
"isbn" -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"ISBN",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToMetaValue a => a -> MetaValue
toMetaValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
el
Text
"issn" -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"ISSN",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToMetaValue a => a -> MetaValue
toMetaValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"page",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToMetaValue a => a -> MetaValue
toMetaValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Inlines -> Inlines -> Inlines
combineWithDash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
el forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
lp)
Maybe Element
Nothing -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"page-first",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToMetaValue a => a -> MetaValue
toMetaValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
el
Text
"publisher-name" -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"publisher",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToMetaValue a => a -> MetaValue
toMetaValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
el
Text
"publisher-loc" -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"publisher-place",) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToMetaValue a => a -> MetaValue
toMetaValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
el
Text
"edition" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Text
"edition",
forall a. ToMetaValue a => a -> MetaValue
toMetaValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.filter Char -> Bool
isDigit forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
el)
Text
"person-group" -> do [MetaValue]
names <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {m :: * -> *}.
PandocMonad m =>
Element -> StateT JATSState m MetaValue
getName
((Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"name") Element
el)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Text -> Element -> Text
attrValue Text
"person-group-type" Element
el,
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" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Text
"DOI", forall a. ToMetaValue a => a -> MetaValue
toMetaValue forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
el)
Text
"pmid" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Text
"PMID", forall a. ToMetaValue a => a -> MetaValue
toMetaValue forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
el)
Text
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Text
"object-id" -> case Text -> Element -> Text
attrValue Text
"pub-id-type" Element
el of
Text
"doi" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Text
"DOI", forall a. ToMetaValue a => a -> MetaValue
toMetaValue forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
el)
Text
"pmid" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Text
"PMID", forall a. ToMetaValue a => a -> MetaValue
toMetaValue forall a b. (a -> b) -> a -> b
$ Element -> Text
strContent Element
el)
Text
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Text
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure 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", forall a. ToMetaValue a => a -> MetaValue
toMetaValue 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) forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *).
PandocMonad m =>
Element -> Element -> JATS m (Maybe (Text, MetaValue))
refElement Element
c) (Element -> [Element]
elChildren Element
c)
Maybe Element
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
let stripPref :: Text -> Text
stripPref Text
t = forall a. a -> Maybe a -> a
fromMaybe Text
t forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
T.stripPrefix Text
"ref-" Text
t
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ((Text
"id", forall a. ToMetaValue a => a -> MetaValue
toMetaValue forall a b. (a -> b) -> a -> b
$ Text -> Text
stripPref forall a b. (a -> b) -> a -> b
$ Text -> Element -> Text
attrValue Text
"id" Element
e)
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 forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(\Element
e' -> Element
e'{ elContent :: [Content]
elContent = forall a b. (a -> b) -> [a] -> [b]
map Content -> Content
elementToStr forall a b. (a -> b) -> a -> b
$ Element -> [Content]
elContent Element
e' })
elementToStr :: Content -> Content
elementToStr :: Content -> Content
elementToStr (Elem Element
e') = CData -> Content
Text forall a b. (a -> b) -> a -> b
$ CDataKind -> Text -> Maybe Line -> CData
CData CDataKind
CDataText (Element -> Text
strContentRecursive Element
e') 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
_)) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text Text
s
parseInline (CRef Text
ref) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Inlines
text forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toUpper Text
ref) (Text -> Inlines
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
lookupEntity (Text -> String
T.unpack Text
ref)
parseInline (Elem Element
e) =
case QName -> Text
qName (Element -> QName
elName Element
e) of
Text
"italic" -> forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines Inlines -> Inlines
emph
Text
"bold" -> forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines Inlines -> Inlines
strong
Text
"strike" -> forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines Inlines -> Inlines
strikeout
Text
"sub" -> forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines Inlines -> Inlines
subscript
Text
"sup" -> forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines Inlines -> Inlines
superscript
Text
"underline" -> forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines Inlines -> Inlines
underline
Text
"break" -> forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
linebreak
Text
"sc" -> 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" -> forall (m :: * -> *).
PandocMonad m =>
Maybe (Inlines, Text) -> Element -> JATS m Inlines
getGraphic forall a. Maybe a
Nothing Element
e
Text
"disp-quote" -> do
QuoteType
qt <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets JATSState -> QuoteType
jatsQuoteType
let qt' :: QuoteType
qt' = if QuoteType
qt forall a. Eq a => a -> a -> Bool
== QuoteType
SingleQuote then QuoteType
DoubleQuote else QuoteType
SingleQuote
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \JATSState
st -> JATSState
st{ jatsQuoteType :: QuoteType
jatsQuoteType = QuoteType
qt' }
Inlines
contents <- forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines forall a. a -> a
id
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \JATSState
st -> JATSState
st{ jatsQuoteType :: QuoteType
jatsQuoteType = QuoteType
qt }
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if QuoteType
qt 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 <- forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines 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",) 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, [], forall a. Maybe a -> [a]
maybeToList Maybe (Text, Text)
refType)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Maybe (Text, Text)
refType forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just (Text
"ref-type",Text
"bibr")
then [Citation] -> Inlines -> Inlines
cite
(forall a b. (a -> b) -> [a] -> [b]
map (\Text
id' ->
let id'' :: Text
id'' = forall a. a -> Maybe a -> a
fromMaybe Text
id' 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 forall {a}. (Text, [a], [(Text, Text)])
attr (Text
"#" forall a. Semigroup a => a -> a -> a
<> Text
rid) Text
"" Inlines
ils
Text
"ext-link" -> do
Inlines
ils <- forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines forall a. a -> a
id
let title :: Text
title = forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe Text
findAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"title" (forall a. a -> Maybe a
Just Text
"http://www.w3.org/1999/xlink") 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" (forall a. a -> Maybe a
Just Text
"http://www.w3.org/1999/xlink") forall a. Maybe a
Nothing) Element
e of
Just Text
h -> Text
h
Maybe Text
_ -> Text
"#" forall a. Semigroup a => a -> a -> a
<> Text -> Element -> Text
attrValue Text
"rid" Element
e
let ils' :: Inlines
ils' = if Inlines
ils forall a. Eq a => a -> a -> Bool
== 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, [], [])
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
linkWith forall {a} {a}. (Text, [a], [a])
attr Text
href Text
title Inlines
ils'
Text
"disp-formula" -> forall {m :: * -> *} {b}. (Monad m, Monoid b) => (Text -> b) -> m b
formula Text -> Inlines
displayMath
Text
"inline-formula" -> forall {m :: * -> *} {b}. (Monad m, Monoid b) => (Text -> b) -> m b
formula Text -> Inlines
math
Text
"math" | QName -> Maybe Text
qURI (Element -> QName
elName Element
e) forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Text
"http://www.w3.org/1998/Math/MathML"
-> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inlines
math forall a b. (a -> b) -> a -> b
$ Element -> Text
mathML Element
e
Text
"tex-math" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inlines
math forall a b. (a -> b) -> a -> b
$ Element -> Text
textContent Element
e
Text
"email" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
link (Text
"mailto:" forall a. Semigroup a => a -> a -> a
<> Element -> Text
textContent Element
e) Text
""
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str forall a b. (a -> b) -> a -> b
$ Element -> Text
textContent Element
e
Text
"uri" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
link (Element -> Text
textContent Element
e) Text
"" forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str forall a b. (a -> b) -> a -> b
$ Element -> Text
textContent Element
e
Text
"fn" -> Blocks -> Inlines
note forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => Content -> JATS m Blocks
parseBlock (Element -> [Content]
elContent Element
e)
Text
_ -> forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *). PandocMonad m => Content -> JATS m Inlines
parseInline (Element -> [Content]
elContent Element
e)
mathML :: Element -> Text
mathML Element
x =
case Text -> Either Text [Exp]
readMathML forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
showElement forall a b. (a -> b) -> a -> b
$ (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere (forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT QName -> QName
removePrefix) Element
x of
Left Text
_ -> forall a. Monoid a => a
mempty
Right [Exp]
m -> [Exp] -> Text
writeTeX [Exp]
m
formula :: (Text -> b) -> m b
formula Text -> b
constructor = do
let whereToLook :: Element
whereToLook = forall a. a -> Maybe a -> a
fromMaybe Element
e forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named Text
"alternatives") Element
e
texMaths :: [Text]
texMaths = forall a b. (a -> b) -> [a] -> [b]
map Element -> Text
textContent forall a b. (a -> b) -> a -> b
$
(Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"tex-math") Element
whereToLook
mathMLs :: [Text]
mathMLs = forall a b. (a -> b) -> [a] -> [b]
map Element -> Text
mathML forall a b. (a -> b) -> a -> b
$
(Element -> Bool) -> Element -> [Element]
filterChildren Element -> Bool
isMathML Element
whereToLook
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Text -> b
constructor forall a b. (a -> b) -> a -> b
$ [Text]
texMaths forall a. [a] -> [a] -> [a]
++ [Text]
mathMLs
isMathML :: Element -> Bool
isMathML Element
x = QName -> Text
qName (Element -> QName
elName Element
x) forall a. Eq a => a -> a -> Bool
== Text
"math" Bool -> Bool -> Bool
&&
QName -> Maybe Text
qURI (Element -> QName
elName Element
x) forall a. Eq a => a -> a -> Bool
==
forall a. a -> Maybe a
Just Text
"http://www.w3.org/1998/Math/MathML"
removePrefix :: QName -> QName
removePrefix QName
elname = QName
elname { qPrefix :: Maybe Text
qPrefix = forall a. Maybe a
Nothing }
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]
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Inlines
codeWith (Text -> Element -> Text
attrValue Text
"id" Element
e,[Text]
classes',[]) forall a b. (a -> b) -> a -> b
$ Element -> Text
strContentRecursive Element
e