@@ -24,7 +24,6 @@ type JATS m = StateT JATSState m
2424data JATSState = JATSState{ jatsSectionLevel :: Int
2525 , jatsQuoteType :: QuoteType
2626 , jatsMeta :: Meta
27− , jatsAcceptsMeta :: Bool
2827 , jatsBook :: Bool
2928 , jatsFigureTitle :: Inlines
3029 , jatsContent :: [Content]
@@ -34,7 +33,6 @@ instance Default JATSState where
3433 def = JATSState{ jatsSectionLevel = 0
3534 , jatsQuoteType = DoubleQuote
3635 , jatsMeta = mempty
37− , jatsAcceptsMeta = False
3836 , jatsBook = False
3937 , jatsFigureTitle = mempty
4038 , jatsContent = [] }
@@ -80,19 +78,6 @@ named s e = qName (elName e) == s
8078
8179--
8280
83−acceptingMetadata :: PandocMonad m => JATS m a -> JATS m a
84−acceptingMetadata p = do
85− modify (\s -> s { jatsAcceptsMeta = True } )
86− res <- p
87− modify (\s -> s { jatsAcceptsMeta = False })
88− return res
89−
90−checkInMeta :: (PandocMonad m, Monoid a) => JATS m () -> JATS m a
91−checkInMeta p = do
92− accepts <- jatsAcceptsMeta <$> get
93− when accepts p
94− return mempty
95−
9681addMeta :: PandocMonad m => ToMetaValue a => String -> a -> JATS m ()
9782addMeta field val = modify (setMeta field val)
9883
@@ -180,13 +165,11 @@ parseBlock (Elem e) =
180165 <$> listitems
181166 "def-list" -> definitionList <$> deflistitems
182167 "sec" -> gets jatsSectionLevel >>= sect . (+1)
183− "title" -> return mempty
184− "title-group" -> checkInMeta getTitle
185− "contrib-group" -> checkInMeta getAuthors
186168 "graphic" -> para <$> getGraphic e
187− "journal-meta" -> metaBlock
188− "article-meta" -> metaBlock
189− "custom-meta" -> metaBlock
169+ "journal-meta" -> parseMetadata e
170+ "article-meta" -> parseMetadata e
171+ "custom-meta" -> parseMetadata e
172+ "title" -> return mempty -- processed by header
190173 "table" -> parseTable
191174 "fig" -> divWith (attrValue "id" e, ["fig"], []) <$> getBlocks e
192175 "table-wrap" -> divWith (attrValue "id" e, ["table-wrap"], []) <$> getBlocks e
@@ -232,43 +215,6 @@ parseBlock (Elem e) =
232215 terms' <- mapM getInlines terms
233216 items' <- mapM getBlocks items
234217 return (mconcat $ intersperse (str "; ") terms', items')
235− getTitle = do
236− tit <- case filterChild (named "article-title") e of
237− Just s -> getInlines s
238− Nothing -> return mempty
239− subtit <- case filterChild (named "subtitle") e of
240− Just s -> (text ": " <>) <$>
241− getInlines s
242− Nothing -> return mempty
243− when (tit /= mempty) $ addMeta "title" tit
244− when (subtit /= mempty) $ addMeta "subtitle" subtit
245−
246− getAuthors :: PandocMonad m => JATS m ()
247− getAuthors = do
248− authors <- mapM getContrib $ filterChildren
249− (\x -> named "contrib" x &&
250− attrValue "contrib-type" x == "author") e
251− unless (null authors) $
252− addMeta "author" authors
253−
254− getAffiliations :: PandocMonad m => Element -> JATS m ()
255− getAffiliations x = do
256− affs <- mapM getInlines $ filterChildren (named "aff") x
257− unless (null affs) $ addMeta "institute" affs
258−
259− getContrib :: PandocMonad m => Element -> JATS m Inlines
260− getContrib x = do
261− given <- maybe (return mempty) getInlines
262− $ filterElement (named "given-names") x
263− family <- maybe (return mempty) getInlines
264− $ filterElement (named "surname") x
265− if given == mempty && family == mempty
266− then return mempty
267− else if given == mempty || family == mempty
268− then return $ given <> family
269− else return $ given <> space <> family
270− -- TODO institute, etc.
271−
272218 parseTable = do
273219 let isCaption x = named "title" x || named "caption" x
274220 caption <- case filterChild isCaption e of
@@ -333,16 +279,55 @@ parseBlock (Elem e) =
333279 let ident = attrValue "id" e
334280 modify $ \st -> st{ jatsSectionLevel = oldN }
335281 return $ headerWith (ident,[],[]) n' headerText <> b
336−-- lineItems = mapM getInlines $ filterChildren (named "line") e
337− metaBlock = do
338− acceptingMetadata (getBlocks e)
339− getAffiliations e
340− return mempty
341282
342283getInlines :: PandocMonad m => Element -> JATS m Inlines
343284getInlines e' = (trimInlines . mconcat) <$>
344285 mapM parseInline (elContent e')
345286
287+parseMetadata :: PandocMonad m => Element -> JATS m Blocks
288+parseMetadata e = do
289+ getTitle e
290+ getAuthors e
291+ getAffiliations e
292+ return mempty
293+
294+getTitle :: PandocMonad m => Element -> JATS m ()
295+getTitle e = do
296+ tit <- case filterElement (named "article-title") e of
297+ Just s -> getInlines s
298+ Nothing -> return mempty
299+ subtit <- case filterElement (named "subtitle") e of
300+ Just s -> (text ": " <>) <$>
301+ getInlines s
302+ Nothing -> return mempty
303+ when (tit /= mempty) $ addMeta "title" tit
304+ when (subtit /= mempty) $ addMeta "subtitle" subtit
305+
306+getAuthors :: PandocMonad m => Element -> JATS m ()
307+getAuthors e = do
308+ authors <- mapM getContrib $ filterElements
309+ (\x -> named "contrib" x &&
310+ attrValue "contrib-type" x == "author") e
311+ unless (null authors) $
312+ addMeta "author" authors
313+
314+getAffiliations :: PandocMonad m => Element -> JATS m ()
315+getAffiliations x = do
316+ affs <- mapM getInlines $ filterChildren (named "aff") x
317+ unless (null affs) $ addMeta "institute" affs
318+
319+getContrib :: PandocMonad m => Element -> JATS m Inlines
320+getContrib x = do
321+ given <- maybe (return mempty) getInlines
322+ $ filterElement (named "given-names") x
323+ family <- maybe (return mempty) getInlines
324+ $ filterElement (named "surname") x
325+ if given == mempty && family == mempty
326+ then return mempty
327+ else if given == mempty || family == mempty
328+ then return $ given <> family
329+ else return $ given <> space <> family
330+
346331parseRefList :: PandocMonad m => Element -> JATS m Blocks
347332parseRefList e = do
348333 refs <- mapM parseRef $ filterChildren (named "ref") e