{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Readers.JATS ( readJATS ) where
import Prelude
import Control.Monad.State.Strict
import Data.Char (isDigit, isSpace, toUpper)
import Data.Default
import Data.Generics
import Data.List (foldl', intersperse)
import qualified Data.Map as Map
import Data.Maybe (maybeToList, fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Text.HTML.TagSoup.Entity (lookupEntity)
import Text.Pandoc.Builder
import Text.Pandoc.Class (PandocMonad)
import Text.Pandoc.Options
import Text.Pandoc.Shared (underlineSpan, crFilter, safeRead)
import Text.TeXMath (readMathML, writeTeX)
import Text.XML.Light
import qualified Data.Set as S (fromList, member)
import Data.Set ((\\))
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
, JATSState -> [Content]
jatsContent :: [Content]
} 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
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 :: Int -> QuoteType -> Meta -> Bool -> [Content] -> JATSState
JATSState{ jatsSectionLevel :: Int
jatsSectionLevel = 0
, jatsQuoteType :: QuoteType
jatsQuoteType = QuoteType
DoubleQuote
, jatsMeta :: Meta
jatsMeta = Meta
forall a. Monoid a => a
mempty
, jatsBook :: Bool
jatsBook = Bool
False
, jatsContent :: [Content]
jatsContent = [] }
readJATS :: PandocMonad m => ReaderOptions -> Text -> m Pandoc
readJATS :: ReaderOptions -> Text -> m Pandoc
readJATS _ inp :: Text
inp = do
let tree :: [Content]
tree = [Content] -> [Content]
normalizeTree ([Content] -> [Content])
-> (String -> [Content]) -> String -> [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Content]
forall s. XmlSource s => s -> [Content]
parseXML
(String -> [Content]) -> String -> [Content]
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text
crFilter Text
inp
(bs :: [Blocks]
bs, st' :: 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 :: [Content]
jatsContent = [Content]
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)
mapM Content -> StateT JATSState m Blocks
forall (m :: * -> *). PandocMonad m => Content -> JATS m Blocks
parseBlock [Content]
tree
Pandoc -> m Pandoc
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') (Blocks -> [Block]
forall a. Many a -> [a]
toList (Blocks -> [Block]) -> ([Blocks] -> Blocks) -> [Blocks] -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> [Block]) -> [Blocks] -> [Block]
forall a b. (a -> b) -> a -> b
$ [Blocks]
bs)
normalizeTree :: [Content] -> [Content]
normalizeTree :: [Content] -> [Content]
normalizeTree = (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere (([Content] -> [Content]) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT [Content] -> [Content]
go)
where go :: [Content] -> [Content]
go :: [Content] -> [Content]
go (Text (CData CDataRaw _ _):xs :: [Content]
xs) = [Content]
xs
go (Text (CData CDataText s1 :: String
s1 z :: Maybe Line
z):Text (CData CDataText s2 :: String
s2 _):xs :: [Content]
xs) =
CData -> Content
Text (CDataKind -> String -> Maybe Line -> CData
CData CDataKind
CDataText (String
s1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s2) Maybe Line
z)Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
:[Content]
xs
go (Text (CData CDataText s1 :: String
s1 z :: Maybe Line
z):CRef r :: String
r:xs :: [Content]
xs) =
CData -> Content
Text (CDataKind -> String -> Maybe Line -> CData
CData CDataKind
CDataText (String
s1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
convertEntity String
r) Maybe Line
z)Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
:[Content]
xs
go (CRef r :: String
r:Text (CData CDataText s1 :: String
s1 z :: Maybe Line
z):xs :: [Content]
xs) =
CData -> Content
Text (CDataKind -> String -> Maybe Line -> CData
CData CDataKind
CDataText (ShowS
convertEntity String
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s1) Maybe Line
z)Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
:[Content]
xs
go (CRef r1 :: String
r1:CRef r2 :: String
r2:xs :: [Content]
xs) =
CData -> Content
Text (CDataKind -> String -> Maybe Line -> CData
CData CDataKind
CDataText (ShowS
convertEntity String
r1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
convertEntity String
r2) Maybe Line
forall a. Maybe a
Nothing)Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
:[Content]
xs
go xs :: [Content]
xs = [Content]
xs
convertEntity :: String -> String
convertEntity :: ShowS
convertEntity e :: String
e = String -> Maybe String -> String
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper String
e) (String -> Maybe String
lookupEntity String
e)
attrValue :: String -> Element -> Text
attrValue :: String -> Element -> Text
attrValue attr :: String
attr =
Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "" (Maybe Text -> Text) -> (Element -> Maybe Text) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Element -> Maybe Text
maybeAttrValue String
attr
maybeAttrValue :: String -> Element -> Maybe Text
maybeAttrValue :: String -> Element -> Maybe Text
maybeAttrValue attr :: String
attr elt :: Element
elt =
String -> Text
T.pack (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> Bool) -> [Attr] -> Maybe String
lookupAttrBy (\x :: QName
x -> QName -> String
qName QName
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
attr) (Element -> [Attr]
elAttribs Element
elt)
named :: String -> Element -> Bool
named :: String -> Element -> Bool
named s :: String
s e :: Element
e = QName -> String
qName (Element -> QName
elName Element
e) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
s
addMeta :: PandocMonad m => ToMetaValue a => Text -> a -> JATS m ()
addMeta :: Text -> a -> JATS m ()
addMeta field :: Text
field val :: a
val = (JATSState -> JATSState) -> JATS 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
setMeta Text
field a
val)
instance HasMeta JATSState where
setMeta :: Text -> b -> JATSState -> JATSState
setMeta field :: Text
field v :: b
v s :: JATSState
s = JATSState
s {jatsMeta :: Meta
jatsMeta = Text -> b -> Meta -> Meta
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 field :: Text
field s :: JATSState
s = JATSState
s {jatsMeta :: Meta
jatsMeta = Text -> Meta -> Meta
forall a. HasMeta a => Text -> a -> a
deleteMeta Text
field (JATSState -> Meta
jatsMeta JATSState
s)}
isBlockElement :: Content -> Bool
isBlockElement :: Content -> Bool
isBlockElement (Elem e :: Element
e) = QName -> String
qName (Element -> QName
elName Element
e) String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set String
blocktags
where blocktags :: Set String
blocktags = [String] -> Set String
forall a. Ord a => [a] -> Set a
S.fromList ([String]
paragraphLevel [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
lists [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
mathML [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
other) Set String -> Set String -> Set String
forall a. Ord a => Set a -> Set a -> Set a
\\ [String] -> Set String
forall a. Ord a => [a] -> Set a
S.fromList [String]
inlinetags
paragraphLevel :: [String]
paragraphLevel = ["address", "array", "boxed-text", "chem-struct-wrap",
"code", "fig", "fig-group", "graphic", "media", "preformat",
"supplementary-material", "table-wrap", "table-wrap-group",
"alternatives", "disp-formula", "disp-formula-group"]
lists :: [String]
lists = ["def-list", "list"]
mathML :: [String]
mathML = ["tex-math", "mml:math"]
other :: [String]
other = ["p", "related-article", "related-object", "ack", "disp-quote",
"speech", "statement", "verse-group", "x"]
inlinetags :: [String]
inlinetags = ["email", "ext-link", "uri", "inline-supplementary-material",
"related-article", "related-object", "hr", "bold", "fixed-case",
"italic", "monospace", "overline", "overline-start", "overline-end",
"roman", "sans-serif", "sc", "strike", "underline", "underline-start",
"underline-end", "ruby", "alternatives", "inline-graphic", "private-char",
"chem-struct", "inline-formula", "tex-math", "mml:math", "abbrev",
"milestone-end", "milestone-start", "named-content", "styled-content",
"fn", "target", "xref", "sub", "sup", "x", "address", "array",
"boxed-text", "chem-struct-wrap", "code", "fig", "fig-group", "graphic",
"media", "preformat", "supplementary-material", "table-wrap",
"table-wrap-group", "disp-formula", "disp-formula-group",
"citation-alternatives", "element-citation", "mixed-citation",
"nlm-citation", "award-id", "funding-source", "open-access",
"def-list", "list", "ack", "disp-quote", "speech", "statement",
"verse-group"]
isBlockElement _ = 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
== '\n')
getGraphic :: PandocMonad m
=> Maybe (Inlines, Text) -> Element -> JATS m Inlines
getGraphic :: Maybe (Inlines, Text) -> Element -> JATS m Inlines
getGraphic mbfigdata :: Maybe (Inlines, Text)
mbfigdata e :: Element
e = do
let atVal :: String -> Text
atVal a :: String
a = String -> Element -> Text
attrValue String
a Element
e
(ident :: Text
ident, title :: Text
title, caption :: Inlines
caption) =
case Maybe (Inlines, Text)
mbfigdata of
Just (capt :: Inlines
capt, i :: Text
i) -> (Text
i, "fig:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
atVal "title", Inlines
capt)
Nothing -> (String -> Text
atVal "id", String -> Text
atVal "title",
Text -> Inlines
text (String -> Text
atVal "alt-text"))
attr :: (Text, [Text], [a])
attr = (Text
ident, Text -> [Text]
T.words (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> Text
atVal "role", [])
imageUrl :: Text
imageUrl = String -> Text
atVal "href"
Inlines -> JATS m Inlines
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
caption
getBlocks :: PandocMonad m => Element -> JATS m Blocks
getBlocks :: Element -> JATS m Blocks
getBlocks e :: Element
e = [Blocks] -> Blocks
forall a. Monoid a => [a] -> a
mconcat ([Blocks] -> Blocks)
-> StateT JATSState m [Blocks] -> JATS m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Content -> JATS m Blocks)
-> [Content] -> StateT JATSState m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Content -> JATS m Blocks
forall (m :: * -> *). PandocMonad m => Content -> JATS m Blocks
parseBlock (Element -> [Content]
elContent Element
e)
parseBlock :: PandocMonad m => Content -> JATS m Blocks
parseBlock :: Content -> JATS m Blocks
parseBlock (Text (CData CDataRaw _ _)) = Blocks -> JATS m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
parseBlock (Text (CData _ s :: String
s _)) = if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace String
s
then Blocks -> JATS m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
else Blocks -> JATS m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> JATS m Blocks) -> Blocks -> JATS 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 -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
parseBlock (CRef x :: String
x) = Blocks -> JATS m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> JATS m Blocks) -> Blocks -> JATS 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 -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
x
parseBlock (Elem e :: Element
e) =
case QName -> String
qName (Element -> QName
elName Element
e) of
"p" -> (Inlines -> Blocks) -> [Content] -> JATS m Blocks
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Blocks) -> [Content] -> StateT JATSState m Blocks
parseMixed Inlines -> Blocks
para (Element -> [Content]
elContent Element
e)
"code" -> JATS m Blocks
codeBlockWithLang
"preformat" -> JATS m Blocks
codeBlockWithLang
"disp-quote" -> JATS m Blocks
parseBlockquote
"list" -> case String -> Element -> Text
attrValue "list-type" Element
e of
"bullet" -> [Blocks] -> Blocks
bulletList ([Blocks] -> Blocks)
-> StateT JATSState m [Blocks] -> JATS m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT JATSState m [Blocks]
listitems
listType :: Text
listType -> do
let start :: Int
start = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 1 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$
(Element -> Text
textContent (Element -> Text) -> Maybe Element -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Element -> Bool) -> Element -> Maybe Element
filterElement (String -> Element -> Bool
named "list-item") Element
e
Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Element -> Bool) -> Element -> Maybe Element
filterElement (String -> Element -> Bool
named "label")))
Maybe Text -> (Text -> Maybe Int) -> Maybe Int
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
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] -> JATS m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT JATSState m [Blocks]
listitems
"def-list" -> [(Inlines, [Blocks])] -> Blocks
definitionList ([(Inlines, [Blocks])] -> Blocks)
-> StateT JATSState m [(Inlines, [Blocks])] -> JATS m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT JATSState m [(Inlines, [Blocks])]
deflistitems
"sec" -> (JATSState -> Int) -> StateT JATSState m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets JATSState -> Int
jatsSectionLevel StateT JATSState m Int -> (Int -> JATS m Blocks) -> JATS m Blocks
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> JATS m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT JATSState m Blocks
sect (Int -> JATS m Blocks) -> (Int -> Int) -> Int -> JATS m Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+1)
"graphic" -> Inlines -> Blocks
para (Inlines -> Blocks) -> StateT JATSState m Inlines -> JATS m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Inlines, Text) -> Element -> StateT JATSState m Inlines
forall (m :: * -> *).
PandocMonad m =>
Maybe (Inlines, Text) -> Element -> JATS m Inlines
getGraphic Maybe (Inlines, Text)
forall a. Maybe a
Nothing Element
e
"journal-meta" -> Element -> JATS m Blocks
forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
parseMetadata Element
e
"article-meta" -> Element -> JATS m Blocks
forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
parseMetadata Element
e
"custom-meta" -> Element -> JATS m Blocks
forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
parseMetadata Element
e
"title" -> Blocks -> JATS m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
"table" -> JATS m Blocks
parseTable
"fig" -> JATS m Blocks
parseFigure
"fig-group" -> Attr -> Blocks -> Blocks
divWith (String -> Element -> Text
attrValue "id" Element
e, ["fig-group"], [])
(Blocks -> Blocks) -> JATS m Blocks -> JATS m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> JATS m Blocks
forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
getBlocks Element
e
"table-wrap" -> Attr -> Blocks -> Blocks
divWith (String -> Element -> Text
attrValue "id" Element
e, ["table-wrap"], [])
(Blocks -> Blocks) -> JATS m Blocks -> JATS m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> JATS m Blocks
forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
getBlocks Element
e
"caption" -> Attr -> Blocks -> Blocks
divWith (String -> Element -> Text
attrValue "id" Element
e, ["caption"], []) (Blocks -> Blocks) -> JATS m Blocks -> JATS m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> JATS m Blocks
forall (m :: * -> *).
PandocMonad m =>
Int -> StateT JATSState m Blocks
sect 6
"ref-list" -> Element -> JATS m Blocks
forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
parseRefList Element
e
"?xml" -> Blocks -> JATS m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
_ -> Element -> JATS m Blocks
forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
getBlocks Element
e
where parseMixed :: (Inlines -> Blocks) -> [Content] -> StateT JATSState m Blocks
parseMixed container :: Inlines -> Blocks
container conts :: [Content]
conts = do
let (ils :: [Content]
ils,rest :: [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)
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 (m :: * -> *) a. Monad m => a -> m a
return Blocks
p
(r :: Content
r:rs :: [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 (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 :: JATS m Blocks
codeBlockWithLang = do
let classes' :: [Text]
classes' = case String -> Element -> Text
attrValue "language" Element
e of
"" -> []
x :: Text
x -> [Text
x]
Blocks -> JATS m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> JATS m Blocks) -> Blocks -> JATS m Blocks
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Blocks
codeBlockWith (String -> Element -> Text
attrValue "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
textContentRecursive Element
e
parseBlockquote :: JATS m Blocks
parseBlockquote = do
Blocks
attrib <- case (Element -> Bool) -> Element -> Maybe Element
filterChild (String -> Element -> Bool
named "attribution") Element
e of
Nothing -> Blocks -> JATS m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
Just z :: Element
z -> (Inlines -> Blocks
para (Inlines -> Blocks)
-> ([Inlines] -> Inlines) -> [Inlines] -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Inlines
str "— " 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] -> JATS 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)
mapM Content -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Content -> JATS m Inlines
parseInline (Element -> [Content]
elContent Element
z)
Blocks
contents <- Element -> JATS m Blocks
forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
getBlocks Element
e
Blocks -> JATS m Blocks
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 -> Blocks
blockQuote (Blocks
contents Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
attrib)
parseListStyleType :: a -> ListNumberStyle
parseListStyleType "roman-lower" = ListNumberStyle
LowerRoman
parseListStyleType "roman-upper" = ListNumberStyle
UpperRoman
parseListStyleType "alpha-lower" = ListNumberStyle
LowerAlpha
parseListStyleType "alpha-upper" = ListNumberStyle
UpperAlpha
parseListStyleType _ = ListNumberStyle
DefaultStyle
listitems :: StateT JATSState m [Blocks]
listitems = (Element -> JATS m Blocks)
-> [Element] -> StateT JATSState m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> JATS 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 (String -> Element -> Bool
named "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)
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
(String -> Element -> Bool
named "def-item") Element
e
parseVarListEntry :: Element -> StateT JATSState m (Inlines, [Blocks])
parseVarListEntry e' :: Element
e' = do
let terms :: [Element]
terms = (Element -> Bool) -> Element -> [Element]
filterChildren (String -> Element -> Bool
named "term") Element
e'
let items :: [Element]
items = (Element -> Bool) -> Element -> [Element]
filterChildren (String -> Element -> Bool
named "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)
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)
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 (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 "; ") [Inlines]
terms', [Blocks]
items')
parseFigure :: JATS m Blocks
parseFigure = do
case (Element -> Bool) -> Element -> [Element]
filterChildren (String -> Element -> Bool
named "graphic") Element
e of
[g :: Element
g] -> do
Inlines
caption <- case (Element -> Bool) -> Element -> Maybe Element
filterChild (String -> Element -> Bool
named "caption") Element
e of
Just t :: 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)
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)
Nothing -> Inlines -> StateT JATSState m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
Inlines
img <- Maybe (Inlines, Text) -> Element -> StateT JATSState m Inlines
forall (m :: * -> *).
PandocMonad m =>
Maybe (Inlines, Text) -> Element -> JATS m Inlines
getGraphic ((Inlines, Text) -> Maybe (Inlines, Text)
forall a. a -> Maybe a
Just (Inlines
caption, String -> Element -> Text
attrValue "id" Element
e)) Element
g
Blocks -> JATS m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> JATS m Blocks) -> Blocks -> JATS m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines -> Blocks
para (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
img
_ -> Attr -> Blocks -> Blocks
divWith (String -> Element -> Text
attrValue "id" Element
e, ["fig"], []) (Blocks -> Blocks) -> JATS m Blocks -> JATS m Blocks
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> JATS m Blocks
forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
getBlocks Element
e
parseTable :: JATS m Blocks
parseTable = do
let isCaption :: Element -> Bool
isCaption x :: Element
x = String -> Element -> Bool
named "title" Element
x Bool -> Bool -> Bool
|| String -> Element -> Bool
named "caption" Element
x
Inlines
caption <- case (Element -> Bool) -> Element -> Maybe Element
filterChild Element -> Bool
isCaption Element
e of
Just t :: Element
t -> Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
t
Nothing -> Inlines -> StateT JATSState m Inlines
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 (String -> Element -> Bool
named "tgroup") Element
e
let isColspec :: Element -> Bool
isColspec x :: Element
x = String -> Element -> Bool
named "colspec" Element
x Bool -> Bool -> Bool
|| String -> Element -> Bool
named "col" Element
x
let colspecs :: [Element]
colspecs = case (Element -> Bool) -> Element -> Maybe Element
filterChild (String -> Element -> Bool
named "colgroup") Element
e' of
Just c :: Element
c -> (Element -> Bool) -> Element -> [Element]
filterChildren Element -> Bool
isColspec Element
c
_ -> (Element -> Bool) -> Element -> [Element]
filterChildren Element -> Bool
isColspec Element
e'
let isRow :: Element -> Bool
isRow x :: Element
x = String -> Element -> Bool
named "row" Element
x Bool -> Bool -> Bool
|| String -> Element -> Bool
named "tr" Element
x
[Blocks]
headrows <- case (Element -> Bool) -> Element -> Maybe Element
filterChild (String -> Element -> Bool
named "thead") Element
e' of
Just h :: Element
h -> case (Element -> Bool) -> Element -> Maybe Element
filterChild Element -> Bool
isRow Element
h of
Just x :: Element
x -> Element -> StateT JATSState m [Blocks]
parseRow Element
x
Nothing -> [Blocks] -> StateT JATSState m [Blocks]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Nothing -> [Blocks] -> StateT JATSState m [Blocks]
forall (m :: * -> *) a. Monad m => a -> m a
return []
[[Blocks]]
bodyrows <- case (Element -> Bool) -> Element -> Maybe Element
filterChild (String -> Element -> Bool
named "tbody") Element
e' of
Just b :: Element
b -> (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)
mapM Element -> StateT JATSState m [Blocks]
parseRow
([Element] -> StateT JATSState m [[Blocks]])
-> [Element] -> StateT JATSState m [[Blocks]]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren Element -> Bool
isRow Element
b
Nothing -> (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)
mapM Element -> StateT JATSState m [Blocks]
parseRow
([Element] -> StateT JATSState m [[Blocks]])
-> [Element] -> StateT JATSState m [[Blocks]]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren Element -> Bool
isRow Element
e'
let toAlignment :: Element -> Alignment
toAlignment c :: Element
c = case QName -> Element -> Maybe String
findAttr (String -> QName
unqual "align") Element
c of
Just "left" -> Alignment
AlignLeft
Just "right" -> Alignment
AlignRight
Just "center" -> Alignment
AlignCenter
_ -> Alignment
AlignDefault
let toWidth :: Element -> Double
toWidth c :: Element
c = case QName -> Element -> Maybe Text
findAttrText (String -> QName
unqual "colwidth") Element
c of
Just w :: Text
w -> Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe 0
(Maybe Double -> Double) -> Maybe Double -> Double
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Double
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (Text -> Maybe Double) -> Text -> Maybe Double
forall a b. (a -> b) -> a -> b
$ "0" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Char -> Bool) -> Text -> Text
T.filter (\x :: Char
x ->
Char -> Bool
isDigit Char
x Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '.') Text
w
Nothing -> 0 :: Double
let numrows :: Int
numrows = (Int -> Int -> Int) -> Int -> [Int] -> Int
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 0 ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ([Blocks] -> Int) -> [[Blocks]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Blocks] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Blocks]]
bodyrows
let aligns :: [Alignment]
aligns = case [Element]
colspecs of
[] -> Int -> Alignment -> [Alignment]
forall a. Int -> a -> [a]
replicate Int
numrows Alignment
AlignDefault
cs :: [Element]
cs -> (Element -> Alignment) -> [Element] -> [Alignment]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Alignment
toAlignment [Element]
cs
let widths :: [Double]
widths = case [Element]
colspecs of
[] -> Int -> Double -> [Double]
forall a. Int -> a -> [a]
replicate Int
numrows 0
cs :: [Element]
cs -> let ws :: [Double]
ws = (Element -> Double) -> [Element] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Double
toWidth [Element]
cs
tot :: Double
tot = [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
ws
in if (Double -> Bool) -> [Double] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> 0) [Double]
ws
then (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
tot) [Double]
ws
else Int -> Double -> [Double]
forall a. Int -> a -> [a]
replicate Int
numrows 0
let headrows' :: [Blocks]
headrows' = if [Blocks] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Blocks]
headrows
then Int -> Blocks -> [Blocks]
forall a. Int -> a -> [a]
replicate Int
numrows Blocks
forall a. Monoid a => a
mempty
else [Blocks]
headrows
Blocks -> JATS m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return (Blocks -> JATS m Blocks) -> Blocks -> JATS m Blocks
forall a b. (a -> b) -> a -> b
$ Inlines
-> [(Alignment, Double)] -> [Blocks] -> [[Blocks]] -> Blocks
table Inlines
caption ([Alignment] -> [Double] -> [(Alignment, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Alignment]
aligns [Double]
widths)
[Blocks]
headrows' [[Blocks]]
bodyrows
isEntry :: Element -> Bool
isEntry x :: Element
x = String -> Element -> Bool
named "entry" Element
x Bool -> Bool -> Bool
|| String -> Element -> Bool
named "td" Element
x Bool -> Bool -> Bool
|| String -> Element -> Bool
named "th" Element
x
parseRow :: Element -> StateT JATSState m [Blocks]
parseRow = (Element -> JATS m Blocks)
-> [Element] -> StateT JATSState m [Blocks]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Inlines -> Blocks) -> [Content] -> JATS m Blocks
forall (m :: * -> *).
PandocMonad m =>
(Inlines -> Blocks) -> [Content] -> StateT JATSState m Blocks
parseMixed Inlines -> Blocks
plain ([Content] -> JATS m Blocks)
-> (Element -> [Content]) -> Element -> JATS m Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Content]
elContent) ([Element] -> StateT JATSState m [Blocks])
-> (Element -> [Element]) -> Element -> StateT JATSState m [Blocks]
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 n :: Int
n = 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' = if Bool
isbook Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1 else Int
n
Inlines
headerText <- case (Element -> Bool) -> Element -> Maybe Element
filterChild (String -> Element -> Bool
named "title") Element
e Maybe Element -> Maybe Element -> Maybe Element
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
((Element -> Bool) -> Element -> Maybe Element
filterChild (String -> Element -> Bool
named "info") Element
e Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
(Element -> Bool) -> Element -> Maybe Element
filterChild (String -> Element -> Bool
named "title")) of
Just t :: Element
t -> Element -> JATS m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
t
Nothing -> Inlines -> JATS m Inlines
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
$ \st :: JATSState
st -> JATSState
st{ jatsSectionLevel :: Int
jatsSectionLevel = Int
n }
Blocks
b <- Element -> StateT JATSState m Blocks
forall (m :: * -> *). PandocMonad m => Element -> JATS m Blocks
getBlocks Element
e
let ident :: Text
ident = String -> Element -> Text
attrValue "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
$ \st :: JATSState
st -> JATSState
st{ jatsSectionLevel :: Int
jatsSectionLevel = Int
oldN }
Blocks -> StateT JATSState m Blocks
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 -> Int -> Inlines -> Blocks
headerWith (Text
ident,[],[]) Int
n' Inlines
headerText Blocks -> Blocks -> Blocks
forall a. Semigroup a => a -> a -> a
<> Blocks
b
getInlines :: PandocMonad m => Element -> JATS m Inlines
getInlines :: Element -> JATS m Inlines
getInlines e' :: 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] -> JATS m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Content -> JATS m Inlines)
-> [Content] -> StateT JATSState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Content -> JATS m Inlines
forall (m :: * -> *). PandocMonad m => Content -> JATS m Inlines
parseInline (Element -> [Content]
elContent Element
e')
parseMetadata :: PandocMonad m => Element -> JATS m Blocks
parseMetadata :: Element -> JATS m Blocks
parseMetadata e :: Element
e = do
Element -> JATS m ()
forall (m :: * -> *). PandocMonad m => Element -> JATS m ()
getTitle Element
e
Element -> JATS m ()
forall (m :: * -> *). PandocMonad m => Element -> JATS m ()
getAuthors Element
e
Element -> JATS m ()
forall (m :: * -> *). PandocMonad m => Element -> JATS m ()
getAffiliations Element
e
Blocks -> JATS m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
getTitle :: PandocMonad m => Element -> JATS m ()
getTitle :: Element -> JATS m ()
getTitle e :: Element
e = do
Inlines
tit <- case (Element -> Bool) -> Element -> Maybe Element
filterElement (String -> Element -> Bool
named "article-title") Element
e of
Just s :: Element
s -> Element -> JATS m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
s
Nothing -> Inlines -> JATS m Inlines
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 (String -> Element -> Bool
named "subtitle") Element
e of
Just s :: Element
s -> (Text -> Inlines
text ": " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>) (Inlines -> Inlines) -> JATS m Inlines -> JATS m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Element -> JATS m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
s
Nothing -> Inlines -> JATS m Inlines
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 "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 "subtitle" Inlines
subtit
getAuthors :: PandocMonad m => Element -> JATS m ()
getAuthors :: Element -> JATS m ()
getAuthors e :: 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)
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
(\x :: Element
x -> String -> Element -> Bool
named "contrib" Element
x Bool -> Bool -> Bool
&&
String -> Element -> Text
attrValue "contrib-type" Element
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "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)
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 (String -> Element -> Bool
named "author-notes") Element
e
let authors' :: [Inlines]
authors' = case ([Inlines] -> [Inlines]
forall a. [a] -> [a]
reverse [Inlines]
authors, [Inlines]
authorNotes) of
([], _) -> []
(_, []) -> [Inlines]
authors
(a :: Inlines
a:as :: [Inlines]
as, ns :: [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 (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 "author" [Inlines]
authors'
getAffiliations :: PandocMonad m => Element -> JATS m ()
getAffiliations :: Element -> JATS m ()
getAffiliations x :: 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)
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 (String -> Element -> Bool
named "aff") Element
x
Bool -> JATS m () -> JATS m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Inlines] -> 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 "institute" [Inlines]
affs
getContrib :: PandocMonad m => Element -> JATS m Inlines
getContrib :: Element -> JATS m Inlines
getContrib x :: 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 (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 (String -> Element -> Bool
named "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 (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 (String -> Element -> Bool
named "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 (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 (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 (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 :: Element -> JATS m Blocks
parseRefList e :: 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)
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 (String -> Element -> Bool
named "ref") Element
e
Text -> [Map Text MetaValue] -> JATS m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> JATS m ()
addMeta "references" [Map Text MetaValue]
refs
Blocks -> JATS m Blocks
forall (m :: * -> *) a. Monad m => a -> m a
return Blocks
forall a. Monoid a => a
mempty
parseRef :: PandocMonad m
=> Element -> JATS m (Map.Map Text MetaValue)
parseRef :: Element -> JATS m (Map Text MetaValue)
parseRef e :: Element
e = do
let refId :: Inlines
refId = Text -> Inlines
text (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> Element -> Text
attrValue "id" Element
e
let getInlineText :: String -> Element -> StateT JATSState m Inlines
getInlineText n :: String
n = 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 (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)
-> (Element -> Maybe Element)
-> Element
-> StateT JATSState m Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> Bool) -> Element -> Maybe Element
filterChild (String -> Element -> Bool
named String
n)
case (Element -> Bool) -> Element -> Maybe Element
filterChild (String -> Element -> Bool
named "element-citation") Element
e of
Just c :: Element
c -> do
let refType :: Inlines
refType = Text -> Inlines
text (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$
case String -> Element -> Text
attrValue "publication-type" Element
c of
"journal" -> "article-journal"
x :: Text
x -> Text
x
(refTitle :: Inlines
refTitle, refContainerTitle :: Inlines
refContainerTitle) <- do
Inlines
t <- String -> Element -> StateT JATSState m Inlines
forall (m :: * -> *).
PandocMonad m =>
String -> Element -> StateT JATSState m Inlines
getInlineText "article-title" Element
c
Inlines
ct <- String -> Element -> StateT JATSState m Inlines
forall (m :: * -> *).
PandocMonad m =>
String -> Element -> StateT JATSState m Inlines
getInlineText "source" Element
c
if Inlines
t Inlines -> Inlines -> Bool
forall a. Eq a => a -> a -> Bool
== Inlines
forall a. Monoid a => a
mempty
then (Inlines, Inlines) -> StateT JATSState m (Inlines, Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines
ct, Inlines
forall a. Monoid a => a
mempty)
else (Inlines, Inlines) -> StateT JATSState m (Inlines, Inlines)
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines
t, Inlines
ct)
Inlines
refLabel <- String -> Element -> StateT JATSState m Inlines
forall (m :: * -> *).
PandocMonad m =>
String -> Element -> StateT JATSState m Inlines
getInlineText "label" Element
c
Inlines
refYear <- String -> Element -> StateT JATSState m Inlines
forall (m :: * -> *).
PandocMonad m =>
String -> Element -> StateT JATSState m Inlines
getInlineText "year" Element
c
Inlines
refVolume <- String -> Element -> StateT JATSState m Inlines
forall (m :: * -> *).
PandocMonad m =>
String -> Element -> StateT JATSState m Inlines
getInlineText "volume" Element
c
Inlines
refFirstPage <- String -> Element -> StateT JATSState m Inlines
forall (m :: * -> *).
PandocMonad m =>
String -> Element -> StateT JATSState m Inlines
getInlineText "fpage" Element
c
Inlines
refLastPage <- String -> Element -> StateT JATSState m Inlines
forall (m :: * -> *).
PandocMonad m =>
String -> Element -> StateT JATSState m Inlines
getInlineText "lpage" Element
c
Inlines
refPublisher <- String -> Element -> StateT JATSState m Inlines
forall (m :: * -> *).
PandocMonad m =>
String -> Element -> StateT JATSState m Inlines
getInlineText "publisher-name" Element
c
Inlines
refPublisherPlace <- String -> Element -> StateT JATSState m Inlines
forall (m :: * -> *).
PandocMonad m =>
String -> Element -> StateT JATSState m Inlines
getInlineText "publisher-loc" Element
c
let refPages :: Inlines
refPages = Inlines
refFirstPage Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> (if Inlines
refLastPage Inlines -> Inlines -> Bool
forall a. Eq a => a -> a -> Bool
== Inlines
forall a. Monoid a => a
mempty
then Inlines
forall a. Monoid a => a
mempty
else Text -> Inlines
text "\x2013" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
refLastPage)
let personGroups' :: [Element]
personGroups' = (Element -> Bool) -> Element -> [Element]
filterChildren (String -> Element -> Bool
named "person-group") Element
c
let getName :: Element -> StateT JATSState m MetaValue
getName nm :: 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 (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 (String -> Element -> Bool
named "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 (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 (String -> Element -> Bool
named "surname") Element
nm
MetaValue -> StateT JATSState m MetaValue
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 [
("given" :: Text, Inlines
given)
, ("family", Inlines
family)
]
[(Text, MetaValue)]
personGroups <- (Element -> StateT JATSState m (Text, MetaValue))
-> [Element] -> StateT JATSState m [(Text, MetaValue)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\pg :: Element
pg ->
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)
mapM Element -> StateT JATSState m MetaValue
forall (m :: * -> *).
PandocMonad m =>
Element -> StateT JATSState m MetaValue
getName
((Element -> Bool) -> Element -> [Element]
filterChildren (String -> Element -> Bool
named "name") Element
pg)
(Text, MetaValue) -> StateT JATSState m (Text, MetaValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Element -> Text
attrValue "person-group-type" Element
pg,
[MetaValue] -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue [MetaValue]
names))
[Element]
personGroups'
Map Text MetaValue -> JATS m (Map Text MetaValue)
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, MetaValue)] -> Map Text MetaValue)
-> [(Text, MetaValue)] -> Map Text MetaValue
forall a b. (a -> b) -> a -> b
$
[ ("id" :: Text, Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue Inlines
refId)
, ("type", Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue Inlines
refType)
, ("title", Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue Inlines
refTitle)
, ("container-title", Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue Inlines
refContainerTitle)
, ("publisher", Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue Inlines
refPublisher)
, ("publisher-place", Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue Inlines
refPublisherPlace)
, ("title", Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue Inlines
refTitle)
, ("issued", 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 [
("year" :: Text, Inlines
refYear)
])
, ("volume", Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue Inlines
refVolume)
, ("page", Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue Inlines
refPages)
, ("citation-label", Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue Inlines
refLabel)
] [(Text, MetaValue)] -> [(Text, MetaValue)] -> [(Text, MetaValue)]
forall a. [a] -> [a] -> [a]
++ [(Text, MetaValue)]
personGroups
Nothing -> Map Text MetaValue -> JATS m (Map Text MetaValue)
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 -> Map Text MetaValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert "id" (Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue Inlines
refId) Map Text MetaValue
forall a. Monoid a => a
mempty
findAttrText :: QName -> Element -> Maybe Text
findAttrText :: QName -> Element -> Maybe Text
findAttrText x :: QName
x = (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack (Maybe String -> Maybe Text)
-> (Element -> Maybe String) -> Element -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> Element -> Maybe String
findAttr QName
x
textContent :: Element -> Text
textContent :: Element -> Text
textContent = String -> Text
T.pack (String -> Text) -> (Element -> String) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> String
strContent
textContentRecursive :: Element -> Text
textContentRecursive :: Element -> Text
textContentRecursive = String -> Text
T.pack (String -> Text) -> (Element -> String) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> String
strContentRecursive
strContentRecursive :: Element -> String
strContentRecursive :: Element -> String
strContentRecursive = Element -> String
strContent (Element -> String) -> (Element -> Element) -> Element -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(\e' :: Element
e' -> Element
e'{ elContent :: [Content]
elContent = (Content -> Content) -> [Content] -> [Content]
forall a b. (a -> b) -> [a] -> [b]
map Content -> Content
elementToStr ([Content] -> [Content]) -> [Content] -> [Content]
forall a b. (a -> b) -> a -> b
$ Element -> [Content]
elContent Element
e' })
elementToStr :: Content -> Content
elementToStr :: Content -> Content
elementToStr (Elem e' :: Element
e') = CData -> Content
Text (CData -> Content) -> CData -> Content
forall a b. (a -> b) -> a -> b
$ CDataKind -> String -> Maybe Line -> CData
CData CDataKind
CDataText (Element -> String
strContentRecursive Element
e') Maybe Line
forall a. Maybe a
Nothing
elementToStr x :: Content
x = Content
x
parseInline :: PandocMonad m => Content -> JATS m Inlines
parseInline :: Content -> JATS m Inlines
parseInline (Text (CData _ s :: String
s _)) = Inlines -> JATS m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> JATS m Inlines) -> Inlines -> JATS m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
s
parseInline (CRef ref :: String
ref) =
Inlines -> JATS m Inlines
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 -> (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 -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
ref) Text -> Inlines
text (Maybe Text -> Inlines) -> Maybe Text -> Inlines
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> Maybe String -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe String
lookupEntity String
ref
parseInline (Elem e :: Element
e) =
case QName -> String
qName (Element -> QName
elName Element
e) of
"italic" -> Inlines -> Inlines
emph (Inlines -> Inlines) -> JATS m Inlines -> JATS m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JATS m Inlines
innerInlines
"bold" -> Inlines -> Inlines
strong (Inlines -> Inlines) -> JATS m Inlines -> JATS m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JATS m Inlines
innerInlines
"strike" -> Inlines -> Inlines
strikeout (Inlines -> Inlines) -> JATS m Inlines -> JATS m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JATS m Inlines
innerInlines
"sub" -> Inlines -> Inlines
subscript (Inlines -> Inlines) -> JATS m Inlines -> JATS m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JATS m Inlines
innerInlines
"sup" -> Inlines -> Inlines
superscript (Inlines -> Inlines) -> JATS m Inlines -> JATS m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JATS m Inlines
innerInlines
"underline" -> Inlines -> Inlines
underlineSpan (Inlines -> Inlines) -> JATS m Inlines -> JATS m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JATS m Inlines
innerInlines
"break" -> Inlines -> JATS m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
linebreak
"sc" -> Inlines -> Inlines
smallcaps (Inlines -> Inlines) -> JATS m Inlines -> JATS m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JATS m Inlines
innerInlines
"code" -> JATS m Inlines
codeWithLang
"monospace" -> JATS m Inlines
codeWithLang
"inline-graphic" -> Maybe (Inlines, Text) -> Element -> JATS m Inlines
forall (m :: * -> *).
PandocMonad m =>
Maybe (Inlines, Text) -> Element -> JATS m Inlines
getGraphic Maybe (Inlines, Text)
forall a. Maybe a
Nothing Element
e
"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
$ \st :: JATSState
st -> JATSState
st{ jatsQuoteType :: QuoteType
jatsQuoteType = QuoteType
qt' }
Inlines
contents <- JATS m Inlines
innerInlines
(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
$ \st :: JATSState
st -> JATSState
st{ jatsQuoteType :: QuoteType
jatsQuoteType = QuoteType
qt }
Inlines -> JATS m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> JATS m Inlines) -> Inlines -> JATS 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
"xref" -> do
Inlines
ils <- JATS m Inlines
innerInlines
let rid :: Text
rid = String -> Element -> Text
attrValue "rid" Element
e
let rids :: [Text]
rids = Text -> [Text]
T.words Text
rid
let refType :: Maybe (Text, Text)
refType = ("ref-type",) (Text -> (Text, Text)) -> Maybe Text -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Element -> Maybe Text
maybeAttrValue "ref-type" Element
e
let attr :: (Text, [a], [(Text, Text)])
attr = (String -> Element -> Text
attrValue "id" Element
e, [], Maybe (Text, Text) -> [(Text, Text)]
forall a. Maybe a -> [a]
maybeToList Maybe (Text, Text)
refType)
Inlines -> JATS m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> JATS m Inlines) -> Inlines -> JATS 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 ("ref-type","bibr")
then [Citation] -> Inlines -> Inlines
cite
((Text -> Citation) -> [Text] -> [Citation]
forall a b. (a -> b) -> [a] -> [b]
map (\id' :: Text
id' ->
Citation :: Text
-> [Inline] -> [Inline] -> CitationMode -> Int -> Int -> Citation
Citation{ citationId :: Text
citationId = Text
id'
, citationPrefix :: [Inline]
citationPrefix = []
, citationSuffix :: [Inline]
citationSuffix = []
, citationMode :: CitationMode
citationMode = CitationMode
NormalCitation
, citationNoteNum :: Int
citationNoteNum = 0
, citationHash :: Int
citationHash = 0}) [Text]
rids)
Inlines
ils
else Attr -> Text -> Text -> Inlines -> Inlines
linkWith Attr
forall a. (Text, [a], [(Text, Text)])
attr ("#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rid) "" Inlines
ils
"ext-link" -> do
Inlines
ils <- JATS m Inlines
innerInlines
let title :: Text
title = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe "" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe Text
findAttrText (String -> Maybe String -> Maybe String -> QName
QName "title" (String -> Maybe String
forall a. a -> Maybe a
Just "http://www.w3.org/1999/xlink") Maybe String
forall a. Maybe a
Nothing) Element
e
let href :: Text
href = case QName -> Element -> Maybe String
findAttr (String -> Maybe String -> Maybe String -> QName
QName "href" (String -> Maybe String
forall a. a -> Maybe a
Just "http://www.w3.org/1999/xlink") Maybe String
forall a. Maybe a
Nothing) Element
e of
Just h :: String
h -> String -> Text
T.pack String
h
_ -> "#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Element -> Text
attrValue "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 = (String -> Element -> Text
attrValue "id" Element
e, [], [])
Inlines -> JATS m Inlines
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
linkWith Attr
forall a a. (Text, [a], [a])
attr Text
href Text
title Inlines
ils'
"disp-formula" -> (Text -> Inlines) -> JATS m Inlines
forall (m :: * -> *) a. (Monad m, Monoid a) => (Text -> a) -> m a
formula Text -> Inlines
displayMath
"inline-formula" -> (Text -> Inlines) -> JATS m Inlines
forall (m :: * -> *) a. (Monad m, Monoid a) => (Text -> a) -> m a
formula Text -> Inlines
math
"math" | QName -> Maybe String
qPrefix (Element -> QName
elName Element
e) Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just "mml" -> Inlines -> JATS m Inlines
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
. Text -> Inlines
math (Text -> JATS m Inlines) -> Text -> JATS m Inlines
forall a b. (a -> b) -> a -> b
$ Element -> Text
mathML Element
e
"tex-math" -> Inlines -> JATS m Inlines
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
. Text -> Inlines
math (Text -> JATS m Inlines) -> Text -> JATS m Inlines
forall a b. (a -> b) -> a -> b
$ Element -> Text
textContent Element
e
"email" -> Inlines -> JATS m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> JATS m Inlines) -> Inlines -> JATS m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
link ("mailto:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Element -> Text
textContent Element
e) ""
(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
"uri" -> Inlines -> JATS m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> JATS m Inlines) -> Inlines -> JATS m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
link (Element -> Text
textContent Element
e) "" (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
"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] -> JATS 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)
mapM Content -> StateT JATSState m Blocks
forall (m :: * -> *). PandocMonad m => Content -> JATS m Blocks
parseBlock (Element -> [Content]
elContent Element
e)
_ -> JATS m Inlines
innerInlines
where innerInlines :: JATS m Inlines
innerInlines = (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] -> JATS m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Content -> JATS m Inlines)
-> [Content] -> StateT JATSState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Content -> JATS m Inlines
forall (m :: * -> *). PandocMonad m => Content -> JATS m Inlines
parseInline (Element -> [Content]
elContent Element
e)
mathML :: Element -> Text
mathML x :: 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
. String -> Text
T.pack (String -> Text) -> (Element -> String) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> String
showElement (Element -> Either Text [Exp]) -> Element -> Either Text [Exp]
forall a b. (a -> b) -> a -> b
$ (forall a. Data a => a -> a) -> Element -> Element
(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
forall a. Monoid a => a
mempty
Right m :: [Exp]
m -> [Exp] -> Text
writeTeX [Exp]
m
formula :: (Text -> a) -> m a
formula constructor :: Text -> a
constructor = 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 (String -> Element -> Bool
named "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 (String -> Element -> Bool
named "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
a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> ([Text] -> a) -> [Text] -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> a
forall a. Monoid a => [a] -> a
mconcat ([a] -> a) -> ([Text] -> [a]) -> [Text] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take 1 ([a] -> [a]) -> ([Text] -> [a]) -> [Text] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> a) -> [Text] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Text -> a
constructor ([Text] -> m a) -> [Text] -> m a
forall a b. (a -> b) -> a -> b
$ [Text]
texMaths [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
mathMLs
isMathML :: Element -> Bool
isMathML x :: Element
x = QName -> String
qName (Element -> QName
elName Element
x) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "math" Bool -> Bool -> Bool
&&
QName -> Maybe String
qPrefix (Element -> QName
elName Element
x) Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just "mml"
removePrefix :: QName -> QName
removePrefix elname :: QName
elname = QName
elname { qPrefix :: Maybe String
qPrefix = Maybe String
forall a. Maybe a
Nothing }
codeWithLang :: JATS m Inlines
codeWithLang = do
let classes' :: [Text]
classes' = case String -> Element -> Text
attrValue "language" Element
e of
"" -> []
l :: Text
l -> [Text
l]
Inlines -> JATS m Inlines
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 -> Inlines
codeWith (String -> Element -> Text
attrValue "id" Element
e,[Text]
classes',[]) (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Element -> Text
textContentRecursive Element
e