{-# LANGUAGE TupleSections #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Readers.JATS
   Copyright   : Copyright (C) 2017-2020 Hamish Mackenzie
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

Conversion of JATS XML to 'Pandoc' document.
-}

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)
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.TeXMath (readMathML, writeTeX)
import Text.Pandoc.XML.Light
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
                          , 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 = Int
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, ToSources a)
         => ReaderOptions
         -> a
         -> m Pandoc
readJATS :: forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readJATS ReaderOptions
_ a
inp = do
  let sources :: Sources
sources = a -> Sources
forall a. ToSources a => a -> Sources
toSources a
inp
  [Content]
tree <- (Text -> m [Content])
-> ([Content] -> m [Content])
-> Either Text [Content]
-> m [Content]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (PandocError -> m [Content]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> m [Content])
-> (Text -> PandocError) -> Text -> m [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> PandocError
PandocXMLError Text
"") [Content] -> m [Content]
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text [Content] -> m [Content])
-> Either Text [Content] -> m [Content]
forall a b. (a -> b) -> a -> b
$
            Text -> Either Text [Content]
parseXMLContents (Text -> Text
TL.fromStrict (Text -> Text) -> (Sources -> Text) -> Sources -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sources -> Text
sourcesToText (Sources -> Text) -> Sources -> Text
forall a b. (a -> b) -> a -> b
$ Sources
sources)
  ([Many Block]
bs, JATSState
st') <- (StateT JATSState m [Many Block]
 -> JATSState -> m ([Many Block], JATSState))
-> JATSState
-> StateT JATSState m [Many Block]
-> m ([Many Block], JATSState)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT JATSState m [Many Block]
-> JATSState -> m ([Many Block], 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 [Many Block] -> m ([Many Block], JATSState))
-> StateT JATSState m [Many Block] -> m ([Many Block], JATSState)
forall a b. (a -> b) -> a -> b
$ (Content -> StateT JATSState m (Many Block))
-> [Content] -> StateT JATSState m [Many Block]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Content -> StateT JATSState m (Many Block)
forall (m :: * -> *).
PandocMonad m =>
Content -> JATS m (Many Block)
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') (Many Block -> [Block]
forall a. Many a -> [a]
toList (Many Block -> [Block])
-> ([Many Block] -> Many Block) -> [Many Block] -> [Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Many Block] -> Many Block
forall a. Monoid a => [a] -> a
mconcat ([Many Block] -> [Block]) -> [Many Block] -> [Block]
forall a b. (a -> b) -> a -> b
$ [Many Block]
bs)

-- convenience function to get an attribute value, defaulting to ""
attrValue :: Text -> Element -> Text
attrValue :: Text -> Element -> Text
attrValue Text
attr =
  Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> (Element -> Maybe Text) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Element -> Maybe Text
maybeAttrValue Text
attr

maybeAttrValue :: Text -> Element -> Maybe Text
maybeAttrValue :: Text -> Element -> Maybe Text
maybeAttrValue Text
attr Element
elt =
  (QName -> Bool) -> [Attr] -> Maybe Text
lookupAttrBy (\QName
x -> QName -> Text
qName QName
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
attr) (Element -> [Attr]
elAttribs Element
elt)

-- convenience function
named :: Text -> Element -> Bool
named :: Text -> Element -> Bool
named Text
s Element
e = QName -> Text
qName (Element -> QName
elName Element
e) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
s

--

addMeta :: PandocMonad m => ToMetaValue a => Text -> a -> JATS m ()
addMeta :: forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> JATS m ()
addMeta Text
field a
val = (JATSState -> JATSState) -> StateT JATSState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Text -> a -> JATSState -> JATSState
forall a b. (HasMeta a, ToMetaValue b) => Text -> b -> a -> a
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 = 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 Text
field 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 Element
e) = QName -> Text
qName (Element -> QName
elName Element
e) Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Text
blocktags
  where blocktags :: Set Text
blocktags = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList ([Text]
paragraphLevel [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
lists [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
mathML [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
other) Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
\\ [Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList [Text]
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

-- Trim leading and trailing newline characters
trimNl :: Text -> Text
trimNl :: Text -> Text
trimNl = (Char -> Bool) -> Text -> Text
T.dropAround (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n')

-- function that is used by both graphic (in parseBlock)
-- and inline-graphic (in parseInline)
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:" Text -> Text -> Text
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 (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Text
atVal Text
"role", [])
      imageUrl :: Text
imageUrl = Text -> Text
atVal Text
"href"
  Inlines -> JATS m Inlines
forall (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
capt

getBlocks :: PandocMonad m => Element -> JATS m Blocks
getBlocks :: forall (m :: * -> *).
PandocMonad m =>
Element -> JATS m (Many Block)
getBlocks Element
e =  [Many Block] -> Many Block
forall a. Monoid a => [a] -> a
mconcat ([Many Block] -> Many Block)
-> StateT JATSState m [Many Block]
-> StateT JATSState m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                 (Content -> StateT JATSState m (Many Block))
-> [Content] -> StateT JATSState m [Many Block]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Content -> StateT JATSState m (Many Block)
forall (m :: * -> *).
PandocMonad m =>
Content -> JATS m (Many Block)
parseBlock (Element -> [Content]
elContent Element
e)


parseBlock :: PandocMonad m => Content -> JATS m Blocks
parseBlock :: forall (m :: * -> *).
PandocMonad m =>
Content -> JATS m (Many Block)
parseBlock (Text (CData CDataKind
CDataRaw Text
_ Maybe Line
_)) = Many Block -> StateT JATSState m (Many Block)
forall (m :: * -> *) a. Monad m => a -> m a
return Many Block
forall a. Monoid a => a
mempty -- DOCTYPE
parseBlock (Text (CData CDataKind
_ Text
s Maybe Line
_)) = if (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isSpace Text
s
                                     then Many Block -> StateT JATSState m (Many Block)
forall (m :: * -> *) a. Monad m => a -> m a
return Many Block
forall a. Monoid a => a
mempty
                                     else Many Block -> StateT JATSState m (Many Block)
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Block -> StateT JATSState m (Many Block))
-> Many Block -> StateT JATSState m (Many Block)
forall a b. (a -> b) -> a -> b
$ Inlines -> Many Block
plain (Inlines -> Many Block) -> Inlines -> Many Block
forall a b. (a -> b) -> a -> b
$ Inlines -> Inlines
trimInlines (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text Text
s
parseBlock (CRef Text
x) = Many Block -> StateT JATSState m (Many Block)
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Block -> StateT JATSState m (Many Block))
-> Many Block -> StateT JATSState m (Many Block)
forall a b. (a -> b) -> a -> b
$ Inlines -> Many Block
plain (Inlines -> Many Block) -> Inlines -> Many Block
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toUpper Text
x
parseBlock (Elem Element
e) =
  case QName -> Text
qName (Element -> QName
elName Element
e) of
        Text
"p" -> (Inlines -> Many Block)
-> [Content] -> StateT JATSState m (Many Block)
forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Many Block)
-> [Content] -> StateT JATSState m (Many Block)
parseMixed Inlines -> Many Block
para (Element -> [Content]
elContent Element
e)
        Text
"code" -> StateT JATSState m (Many Block)
codeBlockWithLang
        Text
"preformat" -> StateT JATSState m (Many Block)
codeBlockWithLang
        Text
"disp-quote" -> StateT JATSState m (Many Block)
parseBlockquote
        Text
"list" -> case Text -> Element -> Text
attrValue Text
"list-type" Element
e of
                    Text
"bullet" -> [Many Block] -> Many Block
bulletList ([Many Block] -> Many Block)
-> StateT JATSState m [Many Block]
-> StateT JATSState m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT JATSState m [Many Block]
listitems
                    Text
listType -> do
                      let start :: Int
start = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$
                                  ((Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named Text
"list-item") Element
e
                                               Maybe Element -> (Element -> Maybe Element) -> Maybe Element
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named Text
"label"))
                                   Maybe Element -> (Element -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Int
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (Text -> Maybe Int) -> (Element -> Text) -> Element -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
textContent
                      ListAttributes -> [Many Block] -> Many Block
orderedListWith (Int
start, Text -> ListNumberStyle
forall {a}. (Eq a, IsString a) => a -> ListNumberStyle
parseListStyleType Text
listType, ListNumberDelim
DefaultDelim)
                        ([Many Block] -> Many Block)
-> StateT JATSState m [Many Block]
-> StateT JATSState m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT JATSState m [Many Block]
listitems
        Text
"def-list" -> [(Inlines, [Many Block])] -> Many Block
definitionList ([(Inlines, [Many Block])] -> Many Block)
-> StateT JATSState m [(Inlines, [Many Block])]
-> StateT JATSState m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT JATSState m [(Inlines, [Many Block])]
deflistitems
        Text
"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 -> StateT JATSState m (Many Block))
-> StateT JATSState m (Many Block)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> StateT JATSState m (Many Block)
forall {m :: * -> *}.
PandocMonad m =>
Int -> StateT JATSState m (Many Block)
sect (Int -> StateT JATSState m (Many Block))
-> (Int -> Int) -> Int -> StateT JATSState m (Many Block)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
        Text
"graphic" -> Inlines -> Many Block
para (Inlines -> Many Block)
-> StateT JATSState m Inlines -> StateT JATSState m (Many Block)
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
        Text
"journal-meta" -> Element -> StateT JATSState m (Many Block)
forall (m :: * -> *).
PandocMonad m =>
Element -> JATS m (Many Block)
parseMetadata Element
e
        Text
"article-meta" -> Element -> StateT JATSState m (Many Block)
forall (m :: * -> *).
PandocMonad m =>
Element -> JATS m (Many Block)
parseMetadata Element
e
        Text
"custom-meta" -> Element -> StateT JATSState m (Many Block)
forall (m :: * -> *).
PandocMonad m =>
Element -> JATS m (Many Block)
parseMetadata Element
e
        Text
"title" -> Many Block -> StateT JATSState m (Many Block)
forall (m :: * -> *) a. Monad m => a -> m a
return Many Block
forall a. Monoid a => a
mempty -- processed by header
        Text
"label" -> Many Block -> StateT JATSState m (Many Block)
forall (m :: * -> *) a. Monad m => a -> m a
return Many Block
forall a. Monoid a => a
mempty -- processed by header
        Text
"table" -> StateT JATSState m (Many Block)
parseTable
        Text
"fig" -> StateT JATSState m (Many Block)
parseFigure
        Text
"fig-group" -> Attr -> Many Block -> Many Block
divWith (Text -> Element -> Text
attrValue Text
"id" Element
e, [Text
"fig-group"], [])
                          (Many Block -> Many Block)
-> StateT JATSState m (Many Block)
-> StateT JATSState m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT JATSState m (Many Block)
forall (m :: * -> *).
PandocMonad m =>
Element -> JATS m (Many Block)
getBlocks Element
e
        Text
"table-wrap" -> Attr -> Many Block -> Many Block
divWith (Text -> Element -> Text
attrValue Text
"id" Element
e, [Text
"table-wrap"], [])
                          (Many Block -> Many Block)
-> StateT JATSState m (Many Block)
-> StateT JATSState m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT JATSState m (Many Block)
forall (m :: * -> *).
PandocMonad m =>
Element -> JATS m (Many Block)
getBlocks Element
e
        Text
"caption" -> Attr -> Many Block -> Many Block
divWith (Text -> Element -> Text
attrValue Text
"id" Element
e, [Text
"caption"], []) (Many Block -> Many Block)
-> StateT JATSState m (Many Block)
-> StateT JATSState m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> StateT JATSState m (Many Block)
forall {m :: * -> *}.
PandocMonad m =>
Int -> StateT JATSState m (Many Block)
sect Int
6
        Text
"ref-list" -> Element -> StateT JATSState m (Many Block)
forall (m :: * -> *).
PandocMonad m =>
Element -> JATS m (Many Block)
parseRefList Element
e
        Text
"?xml"  -> Many Block -> StateT JATSState m (Many Block)
forall (m :: * -> *) a. Monad m => a -> m a
return Many Block
forall a. Monoid a => a
mempty
        Text
_       -> Element -> StateT JATSState m (Many Block)
forall (m :: * -> *).
PandocMonad m =>
Element -> JATS m (Many Block)
getBlocks Element
e
   where parseMixed :: (Inlines -> Many Block)
-> [Content] -> StateT JATSState m (Many Block)
parseMixed Inlines -> Many Block
container [Content]
conts = do
           let ([Content]
ils,[Content]
rest) = (Content -> Bool) -> [Content] -> ([Content], [Content])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Content -> Bool
isBlockElement [Content]
conts
           Inlines
ils' <- Inlines -> Inlines
trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> StateT JATSState m [Inlines] -> StateT JATSState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Content -> StateT JATSState m Inlines)
-> [Content] -> StateT JATSState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Content -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Content -> JATS m Inlines
parseInline [Content]
ils
           let p :: Many Block
p = if Inlines
ils' Inlines -> Inlines -> Bool
forall a. Eq a => a -> a -> Bool
== Inlines
forall a. Monoid a => a
mempty then Many Block
forall a. Monoid a => a
mempty else Inlines -> Many Block
container Inlines
ils'
           case [Content]
rest of
                 []     -> Many Block -> StateT JATSState m (Many Block)
forall (m :: * -> *) a. Monad m => a -> m a
return Many Block
p
                 (Content
r:[Content]
rs) -> do
                    Many Block
b <- Content -> StateT JATSState m (Many Block)
forall (m :: * -> *).
PandocMonad m =>
Content -> JATS m (Many Block)
parseBlock Content
r
                    Many Block
x <- (Inlines -> Many Block)
-> [Content] -> StateT JATSState m (Many Block)
parseMixed Inlines -> Many Block
container [Content]
rs
                    Many Block -> StateT JATSState m (Many Block)
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Block -> StateT JATSState m (Many Block))
-> Many Block -> StateT JATSState m (Many Block)
forall a b. (a -> b) -> a -> b
$ Many Block
p Many Block -> Many Block -> Many Block
forall a. Semigroup a => a -> a -> a
<> Many Block
b Many Block -> Many Block -> Many Block
forall a. Semigroup a => a -> a -> a
<> Many Block
x
         codeBlockWithLang :: StateT JATSState m (Many Block)
codeBlockWithLang = do
           let classes' :: [Text]
classes' = case Text -> Element -> Text
attrValue Text
"language" Element
e of
                                Text
"" -> []
                                Text
x  -> [Text
x]
           Many Block -> StateT JATSState m (Many Block)
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Block -> StateT JATSState m (Many Block))
-> Many Block -> StateT JATSState m (Many Block)
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Many Block
codeBlockWith (Text -> Element -> Text
attrValue Text
"id" Element
e, [Text]
classes', [])
                  (Text -> Many Block) -> Text -> Many Block
forall a b. (a -> b) -> a -> b
$ Text -> Text
trimNl (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContentRecursive Element
e
         parseBlockquote :: StateT JATSState m (Many Block)
parseBlockquote = do
            Many Block
attrib <- case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"attribution") Element
e of
                             Maybe Element
Nothing  -> Many Block -> StateT JATSState m (Many Block)
forall (m :: * -> *) a. Monad m => a -> m a
return Many Block
forall a. Monoid a => a
mempty
                             Just Element
z   -> Inlines -> Many Block
para (Inlines -> Many Block)
-> ([Inlines] -> Inlines) -> [Inlines] -> Many Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Inlines
str Text
"— " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>) (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat
                                         ([Inlines] -> Many Block)
-> StateT JATSState m [Inlines] -> StateT JATSState m (Many Block)
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)
            Many Block
contents <- Element -> StateT JATSState m (Many Block)
forall (m :: * -> *).
PandocMonad m =>
Element -> JATS m (Many Block)
getBlocks Element
e
            Many Block -> StateT JATSState m (Many Block)
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Block -> StateT JATSState m (Many Block))
-> Many Block -> StateT JATSState m (Many Block)
forall a b. (a -> b) -> a -> b
$ Many Block -> Many Block
blockQuote (Many Block
contents Many Block -> Many Block -> Many Block
forall a. Semigroup a => a -> a -> a
<> Many Block
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 [Many Block]
listitems = (Element -> StateT JATSState m (Many Block))
-> [Element] -> StateT JATSState m [Many Block]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> StateT JATSState m (Many Block)
forall (m :: * -> *).
PandocMonad m =>
Element -> JATS m (Many Block)
getBlocks ([Element] -> StateT JATSState m [Many Block])
-> [Element] -> StateT JATSState m [Many Block]
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, [Many Block])]
deflistitems = (Element -> StateT JATSState m (Inlines, [Many Block]))
-> [Element] -> StateT JATSState m [(Inlines, [Many Block])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> StateT JATSState m (Inlines, [Many Block])
forall {m :: * -> *}.
PandocMonad m =>
Element -> StateT JATSState m (Inlines, [Many Block])
parseVarListEntry ([Element] -> StateT JATSState m [(Inlines, [Many Block])])
-> [Element] -> StateT JATSState m [(Inlines, [Many Block])]
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, [Many Block])
parseVarListEntry Element
e' = do
                     let terms :: [Element]
terms = (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"term") Element
e'
                     let items :: [Element]
items = (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"def") Element
e'
                     [Inlines]
terms' <- (Element -> StateT JATSState m Inlines)
-> [Element] -> StateT JATSState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines [Element]
terms
                     [Many Block]
items' <- (Element -> StateT JATSState m (Many Block))
-> [Element] -> StateT JATSState m [Many Block]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> StateT JATSState m (Many Block)
forall (m :: * -> *).
PandocMonad m =>
Element -> JATS m (Many Block)
getBlocks [Element]
items
                     (Inlines, [Many Block])
-> StateT JATSState m (Inlines, [Many Block])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse (Text -> Inlines
str Text
"; ") [Inlines]
terms', [Many Block]
items')
         parseFigure :: StateT JATSState m (Many Block)
parseFigure =
           -- if a simple caption and single graphic, we emit a standard
           -- implicit figure.  otherwise, we emit a div with the contents
           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  -> [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)
                                        Maybe Element
Nothing -> Inlines -> StateT JATSState m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty

                         let figAttributes :: [(Text, Text)]
figAttributes = Maybe (Text, Text) -> [(Text, Text)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
DF.toList (Maybe (Text, Text) -> [(Text, Text)])
-> Maybe (Text, Text) -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$
                              (Text
"alt", ) (Text -> (Text, Text))
-> (Element -> Text) -> Element -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
strContent (Element -> (Text, Text)) -> Maybe Element -> Maybe (Text, Text)
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

                         Many Block -> StateT JATSState m (Many Block)
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Block -> StateT JATSState m (Many Block))
-> Many Block -> StateT JATSState m (Many Block)
forall a b. (a -> b) -> a -> b
$ Attr -> Inlines -> Text -> Text -> Many Block
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 -> Many Block -> Many Block
divWith (Text -> Element -> Text
attrValue Text
"id" Element
e, [Text
"fig"], []) (Many Block -> Many Block)
-> StateT JATSState m (Many Block)
-> StateT JATSState m (Many Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Element -> StateT JATSState m (Many Block)
forall (m :: * -> *).
PandocMonad m =>
Element -> JATS m (Many Block)
getBlocks Element
e

         parseTable :: StateT JATSState m (Many Block)
parseTable = do
                      let isCaption :: Element -> Bool
isCaption Element
x = Text -> Element -> Bool
named Text
"title" Element
x Bool -> Bool -> Bool
|| Text -> Element -> Bool
named Text
"caption" Element
x
                      Inlines
capt <- case (Element -> Bool) -> Element -> Maybe Element
filterChild Element -> Bool
isCaption Element
e of
                                    Just Element
t  -> Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
t
                                    Maybe Element
Nothing -> Inlines -> StateT JATSState m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
                      let e' :: Element
e' = Element -> Maybe Element -> Element
forall a. a -> Maybe a -> a
fromMaybe Element
e (Maybe Element -> Element) -> Maybe Element -> Element
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"tgroup") Element
e
                      let isColspec :: Element -> Bool
isColspec Element
x = Text -> Element -> Bool
named Text
"colspec" Element
x Bool -> Bool -> Bool
|| Text -> Element -> Bool
named Text
"col" Element
x
                      let colspecs :: [Element]
colspecs = case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"colgroup") Element
e' of
                                           Just Element
c -> (Element -> Bool) -> Element -> [Element]
filterChildren Element -> Bool
isColspec Element
c
                                           Maybe Element
_      -> (Element -> Bool) -> Element -> [Element]
filterChildren Element -> Bool
isColspec Element
e'
                      let isRow :: Element -> Bool
isRow Element
x = Text -> Element -> Bool
named Text
"row" Element
x Bool -> Bool -> Bool
|| Text -> Element -> Bool
named Text
"tr" Element
x
                      [Many Block]
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 [Many Block]
parseRow Element
x
                                                       Maybe Element
Nothing -> [Many Block] -> StateT JATSState m [Many Block]
forall (m :: * -> *) a. Monad m => a -> m a
return []
                                       Maybe Element
Nothing -> [Many Block] -> StateT JATSState m [Many Block]
forall (m :: * -> *) a. Monad m => a -> m a
return []
                      [[Many Block]]
bodyrows <- case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"tbody") Element
e' of
                                       Just Element
b  -> (Element -> StateT JATSState m [Many Block])
-> [Element] -> StateT JATSState m [[Many Block]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> StateT JATSState m [Many Block]
parseRow
                                                  ([Element] -> StateT JATSState m [[Many Block]])
-> [Element] -> StateT JATSState m [[Many Block]]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren Element -> Bool
isRow Element
b
                                       Maybe Element
Nothing -> (Element -> StateT JATSState m [Many Block])
-> [Element] -> StateT JATSState m [[Many Block]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> StateT JATSState m [Many Block]
parseRow
                                                  ([Element] -> StateT JATSState m [[Many Block]])
-> [Element] -> StateT JATSState m [[Many Block]]
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 <- Text -> Maybe b
forall (m :: * -> *) a. (MonadPlus m, Read a) => Text -> m a
safeRead (Text -> Maybe b) -> Text -> Maybe b
forall a b. (a -> b) -> a -> b
$ Text
"0" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Char -> Bool) -> Text -> Text
T.filter (\Char
x -> Char -> Bool
isDigit Char
x Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') Text
w
                            if b
n b -> b -> Bool
forall a. Ord a => a -> a -> Bool
> b
0 then b -> Maybe b
forall a. a -> Maybe a
Just b
n else Maybe b
forall a. Maybe a
Nothing
                      let 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 Int
0 ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ([Many Block] -> Int) -> [[Many Block]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Many Block] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Many Block]]
bodyrows
                      let aligns :: [Alignment]
aligns = case [Element]
colspecs of
                                     [] -> Int -> Alignment -> [Alignment]
forall a. Int -> a -> [a]
replicate Int
numrows Alignment
AlignDefault
                                     [Element]
cs -> (Element -> Alignment) -> [Element] -> [Alignment]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Alignment
toAlignment [Element]
cs
                      let widths :: [ColWidth]
widths = case [Element]
colspecs of
                                     [] -> Int -> ColWidth -> [ColWidth]
forall a. Int -> a -> [a]
replicate Int
numrows ColWidth
ColWidthDefault
                                     [Element]
cs -> let ws :: [Maybe Double]
ws = (Element -> Maybe Double) -> [Element] -> [Maybe Double]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Maybe Double
forall {b}. (Read b, Ord b, Num b) => Element -> Maybe b
toWidth [Element]
cs
                                           in case [Maybe Double] -> Maybe [Double]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Maybe Double]
ws of
                                                Just [Double]
ws' -> let tot :: Double
tot = [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
ws'
                                                            in  Double -> ColWidth
ColWidth (Double -> ColWidth) -> (Double -> Double) -> Double -> ColWidth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
tot) (Double -> ColWidth) -> [Double] -> [ColWidth]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Double]
ws'
                                                Maybe [Double]
Nothing  -> Int -> ColWidth -> [ColWidth]
forall a. Int -> a -> [a]
replicate Int
numrows ColWidth
ColWidthDefault
                      let toRow :: [Many Block] -> Row
toRow = Attr -> [Cell] -> Row
Row Attr
nullAttr ([Cell] -> Row) -> ([Many Block] -> [Cell]) -> [Many Block] -> Row
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Many Block -> Cell) -> [Many Block] -> [Cell]
forall a b. (a -> b) -> [a] -> [b]
map Many Block -> Cell
simpleCell
                          toHeaderRow :: [Many Block] -> [Row]
toHeaderRow [Many Block]
l = [[Many Block] -> Row
toRow [Many Block]
l | Bool -> Bool
not ([Many Block] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Many Block]
l)]
                      Many Block -> StateT JATSState m (Many Block)
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Block -> StateT JATSState m (Many Block))
-> Many Block -> StateT JATSState m (Many Block)
forall a b. (a -> b) -> a -> b
$ Caption
-> [ColSpec] -> TableHead -> [TableBody] -> TableFoot -> Many Block
table (Many Block -> Caption
simpleCaption (Many Block -> Caption) -> Many Block -> Caption
forall a b. (a -> b) -> a -> b
$ Inlines -> Many Block
plain Inlines
capt)
                                     ([Alignment] -> [ColWidth] -> [ColSpec]
forall a b. [a] -> [b] -> [(a, b)]
zip [Alignment]
aligns [ColWidth]
widths)
                                     (Attr -> [Row] -> TableHead
TableHead Attr
nullAttr ([Row] -> TableHead) -> [Row] -> TableHead
forall a b. (a -> b) -> a -> b
$ [Many Block] -> [Row]
toHeaderRow [Many Block]
headrows)
                                     [Attr -> RowHeadColumns -> [Row] -> [Row] -> TableBody
TableBody Attr
nullAttr RowHeadColumns
0 [] ([Row] -> TableBody) -> [Row] -> TableBody
forall a b. (a -> b) -> a -> b
$ ([Many Block] -> Row) -> [[Many Block]] -> [Row]
forall a b. (a -> b) -> [a] -> [b]
map [Many Block] -> Row
toRow [[Many Block]]
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 [Many Block]
parseRow = (Element -> StateT JATSState m (Many Block))
-> [Element] -> StateT JATSState m [Many Block]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Inlines -> Many Block)
-> [Content] -> StateT JATSState m (Many Block)
forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Many Block)
-> [Content] -> StateT JATSState m (Many Block)
parseMixed Inlines -> Many Block
plain ([Content] -> StateT JATSState m (Many Block))
-> (Element -> [Content])
-> Element
-> StateT JATSState m (Many Block)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Content]
elContent) ([Element] -> StateT JATSState m [Many Block])
-> (Element -> [Element])
-> Element
-> StateT JATSState m [Many Block]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> Bool) -> Element -> [Element]
filterChildren Element -> Bool
isEntry
         sect :: Int -> StateT JATSState m (Many Block)
sect 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
== Int
0 then Int
n Int -> Int -> Int
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 -> (Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> (Inlines
"." Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
space)) (Inlines -> Inlines)
-> StateT JATSState m Inlines -> StateT JATSState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                              Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
t
                                    Maybe Element
Nothing -> Inlines -> StateT JATSState m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
                     Inlines
headerText <- case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"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 (Text -> Element -> Bool
named Text
"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 (Text -> Element -> Bool
named Text
"title")) of
                                      Just Element
t  -> (Inlines
labelText Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>) (Inlines -> Inlines)
-> StateT JATSState m Inlines -> StateT JATSState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                                  Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
t
                                      Maybe Element
Nothing -> Inlines -> StateT JATSState 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
$ \JATSState
st -> JATSState
st{ jatsSectionLevel :: Int
jatsSectionLevel = Int
n }
                     Many Block
b <- Element -> StateT JATSState m (Many Block)
forall (m :: * -> *).
PandocMonad m =>
Element -> JATS m (Many Block)
getBlocks Element
e
                     let ident :: Text
ident = Text -> Element -> Text
attrValue Text
"id" Element
e
                     (JATSState -> JATSState) -> StateT JATSState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((JATSState -> JATSState) -> StateT JATSState m ())
-> (JATSState -> JATSState) -> StateT JATSState m ()
forall a b. (a -> b) -> a -> b
$ \JATSState
st -> JATSState
st{ jatsSectionLevel :: Int
jatsSectionLevel = Int
oldN }
                     Many Block -> StateT JATSState m (Many Block)
forall (m :: * -> *) a. Monad m => a -> m a
return (Many Block -> StateT JATSState m (Many Block))
-> Many Block -> StateT JATSState m (Many Block)
forall a b. (a -> b) -> a -> b
$ Attr -> Int -> Inlines -> Many Block
headerWith (Text
ident,[],[]) Int
n' Inlines
headerText Many Block -> Many Block -> Many Block
forall a. Semigroup a => a -> a -> a
<> Many Block
b

getInlines :: PandocMonad m => Element -> JATS m Inlines
getInlines :: forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
e' = Inlines -> Inlines
trimInlines (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> StateT JATSState m [Inlines] -> StateT JATSState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                 (Content -> StateT JATSState m Inlines)
-> [Content] -> StateT JATSState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Content -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Content -> JATS m Inlines
parseInline (Element -> [Content]
elContent Element
e')

parseMetadata :: PandocMonad m => Element -> JATS m Blocks
parseMetadata :: forall (m :: * -> *).
PandocMonad m =>
Element -> JATS m (Many Block)
parseMetadata 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
  Element -> JATS m ()
forall (m :: * -> *). PandocMonad m => Element -> JATS m ()
getAbstract Element
e
  Many Block -> JATS m (Many Block)
forall (m :: * -> *) a. Monad m => a -> m a
return Many Block
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  -> Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
s
               Maybe Element
Nothing -> Inlines -> StateT JATSState m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
  Inlines
subtit <-  case (Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named Text
"subtitle") Element
e of
               Just Element
s  -> (Text -> Inlines
text Text
": " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<>) (Inlines -> Inlines)
-> StateT JATSState m Inlines -> StateT JATSState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                           Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines Element
s
               Maybe Element
Nothing -> Inlines -> StateT JATSState m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty
  Bool -> JATS m () -> JATS m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Inlines
tit Inlines -> Inlines -> Bool
forall a. Eq a => a -> a -> Bool
/= Inlines
forall a. Monoid a => a
mempty) (JATS m () -> JATS m ()) -> JATS m () -> JATS m ()
forall a b. (a -> b) -> a -> b
$ Text -> Inlines -> JATS m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> JATS m ()
addMeta Text
"title" Inlines
tit
  Bool -> JATS m () -> JATS m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Inlines
subtit Inlines -> Inlines -> Bool
forall a. Eq a => a -> a -> Bool
/= Inlines
forall a. Monoid a => a
mempty) (JATS m () -> JATS m ()) -> JATS m () -> JATS m ()
forall a b. (a -> b) -> a -> b
$ Text -> Inlines -> JATS m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> JATS m ()
addMeta Text
"subtitle" Inlines
subtit

getAuthors :: PandocMonad m => Element -> JATS m ()
getAuthors :: forall (m :: * -> *). PandocMonad m => Element -> JATS m ()
getAuthors 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
              (\Element
x -> Text -> Element -> Bool
named Text
"contrib" Element
x Bool -> Bool -> Bool
&&
                     Text -> Element -> Text
attrValue Text
"contrib-type" Element
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"author") Element
e
  [Inlines]
authorNotes <- (Element -> StateT JATSState m Inlines)
-> [Element] -> StateT JATSState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines ([Element] -> StateT JATSState m [Inlines])
-> [Element] -> StateT JATSState m [Inlines]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterElements (Text -> Element -> Bool
named Text
"author-notes") Element
e
  let authors' :: [Inlines]
authors' = case ([Inlines] -> [Inlines]
forall a. [a] -> [a]
reverse [Inlines]
authors, [Inlines]
authorNotes) of
                   ([], [Inlines]
_)    -> []
                   ([Inlines]
_, [])    -> [Inlines]
authors
                   (Inlines
a:[Inlines]
as, [Inlines]
ns) -> [Inlines] -> [Inlines]
forall a. [a] -> [a]
reverse [Inlines]
as [Inlines] -> [Inlines] -> [Inlines]
forall a. [a] -> [a] -> [a]
++ [Inlines
a Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat [Inlines]
ns]
  Bool -> JATS m () -> JATS m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Inlines] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inlines]
authors) (JATS m () -> JATS m ()) -> JATS m () -> JATS m ()
forall a b. (a -> b) -> a -> b
$ Text -> [Inlines] -> JATS m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> JATS m ()
addMeta Text
"author" [Inlines]
authors'

getAffiliations :: PandocMonad m => Element -> JATS m ()
getAffiliations :: forall (m :: * -> *). PandocMonad m => Element -> JATS m ()
getAffiliations Element
x = do
  [Inlines]
affs <- (Element -> StateT JATSState m Inlines)
-> [Element] -> StateT JATSState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines ([Element] -> StateT JATSState m [Inlines])
-> [Element] -> StateT JATSState m [Inlines]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"aff") Element
x
  Bool -> JATS m () -> JATS m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Inlines] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Inlines]
affs) (JATS m () -> JATS m ()) -> JATS m () -> JATS m ()
forall a b. (a -> b) -> a -> b
$ Text -> [Inlines] -> JATS m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> JATS m ()
addMeta Text
"institute" [Inlines]
affs

getAbstract :: PandocMonad m => Element -> JATS m ()
getAbstract :: forall (m :: * -> *). PandocMonad m => Element -> JATS m ()
getAbstract Element
e =
  case (Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named Text
"abstract") Element
e of
    Just Element
s -> do
      Many Block
blks <- Element -> JATS m (Many Block)
forall (m :: * -> *).
PandocMonad m =>
Element -> JATS m (Many Block)
getBlocks Element
s
      Text -> Many Block -> JATS m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> JATS m ()
addMeta Text
"abstract" Many Block
blks
    Maybe Element
Nothing -> () -> JATS m ()
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 <- 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 (Text -> Element -> Bool
named Text
"given-names") Element
x
  Inlines
family <- JATS m Inlines
-> (Element -> JATS m Inlines) -> Maybe Element -> JATS m Inlines
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Inlines -> JATS m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty) Element -> JATS m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines
            (Maybe Element -> JATS m Inlines)
-> Maybe Element -> JATS m Inlines
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> Maybe Element
filterElement (Text -> Element -> Bool
named Text
"surname") Element
x
  if Inlines
given Inlines -> Inlines -> Bool
forall a. Eq a => a -> a -> Bool
== Inlines
forall a. Monoid a => a
mempty Bool -> Bool -> Bool
&& Inlines
family Inlines -> Inlines -> Bool
forall a. Eq a => a -> a -> Bool
== Inlines
forall a. Monoid a => a
mempty
     then Inlines -> JATS m Inlines
forall (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 :: forall (m :: * -> *).
PandocMonad m =>
Element -> JATS m (Many Block)
parseRefList Element
e = do
  [Map Text MetaValue]
refs <- (Element -> StateT JATSState m (Map Text MetaValue))
-> [Element] -> StateT JATSState m [Map Text MetaValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Element -> StateT JATSState m (Map Text MetaValue)
forall (m :: * -> *).
PandocMonad m =>
Element -> JATS m (Map Text MetaValue)
parseRef ([Element] -> StateT JATSState m [Map Text MetaValue])
-> [Element] -> StateT JATSState m [Map Text MetaValue]
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"ref") Element
e
  Text -> [Map Text MetaValue] -> JATS m ()
forall (m :: * -> *) a.
(PandocMonad m, ToMetaValue a) =>
Text -> a -> JATS m ()
addMeta Text
"references" [Map Text MetaValue]
refs
  Many Block -> JATS m (Many Block)
forall (m :: * -> *) a. Monad m => a -> m a
return Many Block
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 refId :: Inlines
refId = Text -> Inlines
text (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Element -> Text
attrValue Text
"id" Element
e
  let getInlineText :: Text -> Element -> StateT JATSState m Inlines
getInlineText Text
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 (Text -> Element -> Bool
named Text
n)
  case (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"element-citation") Element
e of
       Just Element
c  -> do
         let refType :: Inlines
refType = Text -> Inlines
text (Text -> Inlines) -> Text -> Inlines
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
         (Inlines
refTitle, Inlines
refContainerTitle) <- do
           Inlines
t <- Text -> Element -> StateT JATSState m Inlines
forall {m :: * -> *}.
PandocMonad m =>
Text -> Element -> StateT JATSState m Inlines
getInlineText Text
"article-title" Element
c
           Inlines
ct <- Text -> Element -> StateT JATSState m Inlines
forall {m :: * -> *}.
PandocMonad m =>
Text -> Element -> StateT JATSState m Inlines
getInlineText Text
"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 <- Text -> Element -> StateT JATSState m Inlines
forall {m :: * -> *}.
PandocMonad m =>
Text -> Element -> StateT JATSState m Inlines
getInlineText Text
"label" Element
c
         Inlines
refYear <- Text -> Element -> StateT JATSState m Inlines
forall {m :: * -> *}.
PandocMonad m =>
Text -> Element -> StateT JATSState m Inlines
getInlineText Text
"year" Element
c
         Inlines
refVolume <- Text -> Element -> StateT JATSState m Inlines
forall {m :: * -> *}.
PandocMonad m =>
Text -> Element -> StateT JATSState m Inlines
getInlineText Text
"volume" Element
c
         Inlines
refFirstPage <- Text -> Element -> StateT JATSState m Inlines
forall {m :: * -> *}.
PandocMonad m =>
Text -> Element -> StateT JATSState m Inlines
getInlineText Text
"fpage" Element
c
         Inlines
refLastPage <- Text -> Element -> StateT JATSState m Inlines
forall {m :: * -> *}.
PandocMonad m =>
Text -> Element -> StateT JATSState m Inlines
getInlineText Text
"lpage" Element
c
         Inlines
refPublisher <- Text -> Element -> StateT JATSState m Inlines
forall {m :: * -> *}.
PandocMonad m =>
Text -> Element -> StateT JATSState m Inlines
getInlineText Text
"publisher-name" Element
c
         Inlines
refPublisherPlace <- Text -> Element -> StateT JATSState m Inlines
forall {m :: * -> *}.
PandocMonad m =>
Text -> Element -> StateT JATSState m Inlines
getInlineText Text
"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 Text
"\x2013" Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Inlines
refLastPage)
         let personGroups' :: [Element]
personGroups' = (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named Text
"person-group") Element
c
         let getName :: Element -> StateT JATSState m MetaValue
getName Element
nm = do
               Inlines
given <- StateT JATSState m Inlines
-> (Element -> StateT JATSState m Inlines)
-> Maybe Element
-> StateT JATSState m Inlines
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Inlines -> StateT JATSState m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty) Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines
                         (Maybe Element -> StateT JATSState m Inlines)
-> Maybe Element -> StateT JATSState m Inlines
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"given-names") Element
nm
               Inlines
family <- StateT JATSState m Inlines
-> (Element -> StateT JATSState m Inlines)
-> Maybe Element
-> StateT JATSState m Inlines
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Inlines -> StateT JATSState m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
forall a. Monoid a => a
mempty) Element -> StateT JATSState m Inlines
forall (m :: * -> *). PandocMonad m => Element -> JATS m Inlines
getInlines
                         (Maybe Element -> StateT JATSState m Inlines)
-> Maybe Element -> StateT JATSState m Inlines
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> Maybe Element
filterChild (Text -> Element -> Bool
named Text
"surname") Element
nm
               MetaValue -> StateT JATSState m MetaValue
forall (m :: * -> *) a. Monad m => a -> m a
return (MetaValue -> StateT JATSState m MetaValue)
-> MetaValue -> StateT JATSState m MetaValue
forall a b. (a -> b) -> a -> b
$ Map Text Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue (Map Text Inlines -> MetaValue) -> Map Text Inlines -> MetaValue
forall a b. (a -> b) -> a -> b
$ [(Text, Inlines)] -> Map Text Inlines
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [
                   (Text
"given" :: Text, Inlines
given)
                 , (Text
"family", Inlines
family)
                 ]
         [(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 (\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 (Text -> Element -> Bool
named Text
"name") Element
pg)
                                   (Text, MetaValue) -> StateT JATSState m (Text, MetaValue)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Element -> Text
attrValue Text
"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
$
           [ (Text
"id" :: Text, Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue Inlines
refId)
           , (Text
"type", Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue Inlines
refType)
           , (Text
"title", Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue Inlines
refTitle)
           , (Text
"container-title", Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue Inlines
refContainerTitle)
           , (Text
"publisher", Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue Inlines
refPublisher)
           , (Text
"publisher-place", Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue Inlines
refPublisherPlace)
           , (Text
"title", Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue Inlines
refTitle)
           , (Text
"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 [
                            (Text
"year" :: Text, Inlines
refYear)
                          ])
           , (Text
"volume", Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue Inlines
refVolume)
           , (Text
"page", Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue Inlines
refPages)
           , (Text
"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
       Maybe Element
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 Text
"id" (Inlines -> MetaValue
forall a. ToMetaValue a => a -> MetaValue
toMetaValue Inlines
refId) Map Text MetaValue
forall a. Monoid a => a
mempty
       -- TODO handle mixed-citation

textContent :: Element -> Text
textContent :: Element -> Text
textContent = Element -> Text
strContent

strContentRecursive :: Element -> Text
strContentRecursive :: Element -> Text
strContentRecursive = Element -> Text
strContent (Element -> Text) -> (Element -> Element) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (\Element
e' -> Element
e'{ elContent :: [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 Element
e') = CData -> Content
Text (CData -> Content) -> CData -> Content
forall a b. (a -> b) -> a -> b
$ CDataKind -> Text -> Maybe Line -> CData
CData CDataKind
CDataText (Element -> Text
strContentRecursive Element
e') Maybe Line
forall a. Maybe a
Nothing
elementToStr Content
x = Content
x

parseInline :: PandocMonad m => Content -> JATS m Inlines
parseInline :: forall (m :: * -> *). PandocMonad m => Content -> JATS m Inlines
parseInline (Text (CData CDataKind
_ Text
s Maybe Line
_)) = Inlines -> StateT JATSState m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> StateT JATSState m Inlines)
-> Inlines -> StateT JATSState m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text Text
s
parseInline (CRef Text
ref) = Inlines -> StateT JATSState m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> StateT JATSState m Inlines)
-> Inlines -> StateT JATSState m Inlines
forall a b. (a -> b) -> a -> b
$ Inlines -> (String -> Inlines) -> Maybe String -> Inlines
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Inlines
text (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.toUpper Text
ref) (Text -> Inlines
text (Text -> Inlines) -> (String -> Text) -> String -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack)
                                (Maybe String -> Inlines) -> Maybe String -> Inlines
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" -> (Inlines -> Inlines) -> StateT JATSState m Inlines
forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines Inlines -> Inlines
emph
        Text
"bold" -> (Inlines -> Inlines) -> StateT JATSState m Inlines
forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines Inlines -> Inlines
strong
        Text
"strike" -> (Inlines -> Inlines) -> StateT JATSState m Inlines
forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines Inlines -> Inlines
strikeout
        Text
"sub" -> (Inlines -> Inlines) -> StateT JATSState m Inlines
forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines Inlines -> Inlines
subscript
        Text
"sup" -> (Inlines -> Inlines) -> StateT JATSState m Inlines
forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines Inlines -> Inlines
superscript
        Text
"underline" -> (Inlines -> Inlines) -> StateT JATSState m Inlines
forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines Inlines -> Inlines
underline
        Text
"break" -> Inlines -> StateT JATSState m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return Inlines
linebreak
        Text
"sc" -> (Inlines -> Inlines) -> StateT JATSState m Inlines
forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines Inlines -> Inlines
smallcaps

        Text
"code" -> StateT JATSState m Inlines
codeWithLang
        Text
"monospace" -> StateT JATSState m Inlines
codeWithLang

        Text
"inline-graphic" -> 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
        Text
"disp-quote" -> do
            QuoteType
qt <- (JATSState -> QuoteType) -> StateT JATSState m QuoteType
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets JATSState -> QuoteType
jatsQuoteType
            let qt' :: QuoteType
qt' = if QuoteType
qt QuoteType -> QuoteType -> Bool
forall a. Eq a => a -> a -> Bool
== QuoteType
SingleQuote then QuoteType
DoubleQuote else QuoteType
SingleQuote
            (JATSState -> JATSState) -> StateT JATSState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((JATSState -> JATSState) -> StateT JATSState m ())
-> (JATSState -> JATSState) -> StateT JATSState m ()
forall a b. (a -> b) -> a -> b
$ \JATSState
st -> JATSState
st{ jatsQuoteType :: QuoteType
jatsQuoteType = QuoteType
qt' }
            Inlines
contents <- (Inlines -> Inlines) -> StateT JATSState m Inlines
forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines Inlines -> Inlines
forall a. a -> a
id
            (JATSState -> JATSState) -> StateT JATSState m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((JATSState -> JATSState) -> StateT JATSState m ())
-> (JATSState -> JATSState) -> StateT JATSState m ()
forall a b. (a -> b) -> a -> b
$ \JATSState
st -> JATSState
st{ jatsQuoteType :: QuoteType
jatsQuoteType = QuoteType
qt }
            Inlines -> StateT JATSState m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> StateT JATSState m Inlines)
-> Inlines -> StateT JATSState m Inlines
forall a b. (a -> b) -> a -> b
$ if QuoteType
qt QuoteType -> QuoteType -> Bool
forall a. Eq a => a -> a -> Bool
== QuoteType
SingleQuote
                        then Inlines -> Inlines
singleQuoted Inlines
contents
                        else Inlines -> Inlines
doubleQuoted Inlines
contents

        Text
"xref" -> do
            Inlines
ils <- (Inlines -> Inlines) -> StateT JATSState m Inlines
forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines Inlines -> Inlines
forall a. a -> a
id
            let rid :: Text
rid = Text -> Element -> Text
attrValue Text
"rid" Element
e
            let rids :: [Text]
rids = Text -> [Text]
T.words Text
rid
            let refType :: Maybe (Text, Text)
refType = (Text
"ref-type",) (Text -> (Text, Text)) -> Maybe Text -> Maybe (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Element -> Maybe Text
maybeAttrValue Text
"ref-type" Element
e
            let attr :: (Text, [a], [(Text, Text)])
attr = (Text -> Element -> Text
attrValue Text
"id" Element
e, [], Maybe (Text, Text) -> [(Text, Text)]
forall a. Maybe a -> [a]
maybeToList Maybe (Text, Text)
refType)
            Inlines -> StateT JATSState m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> StateT JATSState m Inlines)
-> Inlines -> StateT JATSState m Inlines
forall a b. (a -> b) -> a -> b
$ if Maybe (Text, Text)
refType Maybe (Text, Text) -> Maybe (Text, Text) -> Bool
forall a. Eq a => a -> a -> Bool
== (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
"ref-type",Text
"bibr")
                        then [Citation] -> Inlines -> Inlines
cite
                             ((Text -> Citation) -> [Text] -> [Citation]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
id' ->
                                     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 = Int
0
                                             , citationHash :: Int
citationHash = Int
0}) [Text]
rids)
                             Inlines
ils
                        else Attr -> Text -> Text -> Inlines -> Inlines
linkWith Attr
forall {a}. (Text, [a], [(Text, Text)])
attr (Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rid) Text
"" Inlines
ils
        Text
"ext-link" -> do
             Inlines
ils <- (Inlines -> Inlines) -> StateT JATSState m Inlines
forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines Inlines -> Inlines
forall a. a -> a
id
             let title :: Text
title = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ QName -> Element -> Maybe Text
findAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"title" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"http://www.w3.org/1999/xlink") Maybe Text
forall a. Maybe a
Nothing) Element
e
             let href :: Text
href = case QName -> Element -> Maybe Text
findAttr (Text -> Maybe Text -> Maybe Text -> QName
QName Text
"href" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"http://www.w3.org/1999/xlink") Maybe Text
forall a. Maybe a
Nothing) Element
e of
                               Just Text
h -> Text
h
                               Maybe Text
_      -> Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Element -> Text
attrValue Text
"rid" Element
e
             let ils' :: Inlines
ils' = if Inlines
ils Inlines -> Inlines -> Bool
forall a. Eq a => a -> a -> Bool
== Inlines
forall a. Monoid a => a
mempty then Text -> Inlines
str Text
href else Inlines
ils
             let attr :: (Text, [a], [a])
attr = (Text -> Element -> Text
attrValue Text
"id" Element
e, [], [])
             Inlines -> StateT JATSState m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> StateT JATSState m Inlines)
-> Inlines -> StateT JATSState m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Text -> Inlines -> Inlines
linkWith Attr
forall {a} {a}. (Text, [a], [a])
attr Text
href Text
title Inlines
ils'

        Text
"disp-formula" -> (Text -> Inlines) -> StateT JATSState m Inlines
forall {m :: * -> *} {b}. (Monad m, Monoid b) => (Text -> b) -> m b
formula Text -> Inlines
displayMath
        Text
"inline-formula" -> (Text -> Inlines) -> StateT JATSState m Inlines
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) Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"http://www.w3.org/1998/Math/MathML"
                   -> Inlines -> StateT JATSState m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> StateT JATSState m Inlines)
-> (Text -> Inlines) -> Text -> StateT JATSState m Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inlines
math (Text -> StateT JATSState m Inlines)
-> Text -> StateT JATSState m Inlines
forall a b. (a -> b) -> a -> b
$ Element -> Text
mathML Element
e
        Text
"tex-math" -> Inlines -> StateT JATSState m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> StateT JATSState m Inlines)
-> (Text -> Inlines) -> Text -> StateT JATSState m Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inlines
math (Text -> StateT JATSState m Inlines)
-> Text -> StateT JATSState m Inlines
forall a b. (a -> b) -> a -> b
$ Element -> Text
textContent Element
e

        Text
"email" -> Inlines -> StateT JATSState m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> StateT JATSState m Inlines)
-> Inlines -> StateT JATSState m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
link (Text
"mailto:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Element -> Text
textContent Element
e) Text
""
                          (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Element -> Text
textContent Element
e
        Text
"uri" -> Inlines -> StateT JATSState m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> StateT JATSState m Inlines)
-> Inlines -> StateT JATSState m Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Inlines -> Inlines
link (Element -> Text
textContent Element
e) Text
"" (Inlines -> Inlines) -> Inlines -> Inlines
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
str (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Element -> Text
textContent Element
e
        Text
"fn" -> Many Block -> Inlines
note (Many Block -> Inlines)
-> ([Many Block] -> Many Block) -> [Many Block] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Many Block] -> Many Block
forall a. Monoid a => [a] -> a
mconcat ([Many Block] -> Inlines)
-> StateT JATSState m [Many Block] -> StateT JATSState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                         (Content -> StateT JATSState m (Many Block))
-> [Content] -> StateT JATSState m [Many Block]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Content -> StateT JATSState m (Many Block)
forall (m :: * -> *).
PandocMonad m =>
Content -> JATS m (Many Block)
parseBlock (Element -> [Content]
elContent Element
e)
        Text
_          -> (Inlines -> Inlines) -> StateT JATSState m Inlines
forall {m :: * -> *}.
PandocMonad m =>
(Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines Inlines -> Inlines
forall a. a -> a
id
   where innerInlines :: (Inlines -> Inlines) -> StateT JATSState m Inlines
innerInlines Inlines -> Inlines
f = (Inlines -> Inlines) -> Inlines -> Inlines
extractSpaces Inlines -> Inlines
f (Inlines -> Inlines)
-> ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> StateT JATSState m [Inlines] -> StateT JATSState m Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                          (Content -> StateT JATSState m Inlines)
-> [Content] -> StateT JATSState m [Inlines]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Content -> StateT JATSState m Inlines
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 (Text -> Either Text [Exp])
-> (Element -> Text) -> Element -> Either Text [Exp]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
showElement (Element -> Either Text [Exp]) -> Element -> Either Text [Exp]
forall a b. (a -> b) -> a -> b
$ (forall a. Data a => a -> a) -> forall a. Data a => a -> a
everywhere ((QName -> QName) -> a -> a
forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
mkT QName -> QName
removePrefix) Element
x of
                Left Text
_ -> Text
forall a. Monoid a => a
mempty
                Right [Exp]
m -> [Exp] -> Text
writeTeX [Exp]
m
         formula :: (Text -> b) -> m b
formula Text -> b
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 (Text -> Element -> Bool
named Text
"alternatives") Element
e
                texMaths :: [Text]
texMaths = (Element -> Text) -> [Element] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Text
textContent ([Element] -> [Text]) -> [Element] -> [Text]
forall a b. (a -> b) -> a -> b
$
                            (Element -> Bool) -> Element -> [Element]
filterChildren (Text -> Element -> Bool
named  Text
"tex-math") Element
whereToLook
                mathMLs :: [Text]
mathMLs = (Element -> Text) -> [Element] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Text
mathML ([Element] -> [Text]) -> [Element] -> [Text]
forall a b. (a -> b) -> a -> b
$
                            (Element -> Bool) -> Element -> [Element]
filterChildren Element -> Bool
isMathML Element
whereToLook
            b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> ([Text] -> b) -> [Text] -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [b] -> b
forall a. Monoid a => [a] -> a
mconcat ([b] -> b) -> ([Text] -> [b]) -> [Text] -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [b] -> [b]
forall a. Int -> [a] -> [a]
take Int
1 ([b] -> [b]) -> ([Text] -> [b]) -> [Text] -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> b) -> [Text] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map Text -> b
constructor ([Text] -> m b) -> [Text] -> m b
forall a b. (a -> b) -> a -> b
$ [Text]
texMaths [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
mathMLs

         isMathML :: Element -> Bool
isMathML Element
x = QName -> Text
qName (Element -> QName
elName Element
x) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"math" Bool -> Bool -> Bool
&&
                      QName -> Maybe Text
qURI  (Element -> QName
elName Element
x) Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
==
                                      Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"http://www.w3.org/1998/Math/MathML"
         removePrefix :: QName -> QName
removePrefix QName
elname = QName
elname { qPrefix :: Maybe Text
qPrefix = Maybe Text
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]
           Inlines -> StateT JATSState m Inlines
forall (m :: * -> *) a. Monad m => a -> m a
return (Inlines -> StateT JATSState m Inlines)
-> Inlines -> StateT JATSState m Inlines
forall a b. (a -> b) -> a -> b
$ Attr -> Text -> Inlines
codeWith (Text -> Element -> Text
attrValue Text
"id" Element
e,[Text]
classes',[]) (Text -> Inlines) -> Text -> Inlines
forall a b. (a -> b) -> a -> b
$ Element -> Text
strContentRecursive Element
e