4612a9a · typeable/pandoc

24data JATSState = JATSState{ jatsSectionLevel :: Int

25 , jatsQuoteType :: QuoteType

26 , jatsMeta :: Meta

27− , jatsAcceptsMeta :: Bool

28 , jatsBook :: Bool

27 , jatsBook :: Bool

29 , jatsFigureTitle :: Inlines

28 , jatsFigureTitle :: Inlines

30 , jatsContent :: [Content]

29 , jatsContent :: [Content]

34 def = JATSState{ jatsSectionLevel = 0

33 def = JATSState{ jatsSectionLevel = 0

35 , jatsQuoteType = DoubleQuote

34 , jatsQuoteType = DoubleQuote

36 , jatsMeta = mempty

35 , jatsMeta = mempty

37− , jatsAcceptsMeta = False

38 , jatsBook = False

36 , jatsBook = False

39 , jatsFigureTitle = mempty

37 , jatsFigureTitle = mempty

40 , jatsContent = [] }

38 , jatsContent = [] }

80

78

81--

79--

82

80

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−

96addMeta :: PandocMonad m => ToMetaValue a => String -> a -> JATS m ()

81addMeta :: PandocMonad m => ToMetaValue a => String -> a -> JATS m ()

97addMeta field val = modify (setMeta field val)

82addMeta field val = modify (setMeta field val)

98

83

180 <$> listitems

165 <$> listitems

181 "def-list" -> definitionList <$> deflistitems

166 "def-list" -> definitionList <$> deflistitems

182 "sec" -> gets jatsSectionLevel >>= sect . (+1)

167 "sec" -> gets jatsSectionLevel >>= sect . (+1)

183− "title" -> return mempty

184− "title-group" -> checkInMeta getTitle

185− "contrib-group" -> checkInMeta getAuthors

186 "graphic" -> para <$> getGraphic e

168 "graphic" -> para <$> getGraphic e

187− "journal-meta" -> metaBlock

169+ "journal-meta" -> parseMetadata e

188− "article-meta" -> metaBlock

170+ "article-meta" -> parseMetadata e

189− "custom-meta" -> metaBlock

171+ "custom-meta" -> parseMetadata e

172+ "title" -> return mempty -- processed by header

190 "table" -> parseTable

173 "table" -> parseTable

191 "fig" -> divWith (attrValue "id" e, ["fig"], []) <$> getBlocks e

174 "fig" -> divWith (attrValue "id" e, ["fig"], []) <$> getBlocks e

192 "table-wrap" -> divWith (attrValue "id" e, ["table-wrap"], []) <$> getBlocks e

175 "table-wrap" -> divWith (attrValue "id" e, ["table-wrap"], []) <$> getBlocks e

232 terms' <- mapM getInlines terms

215 terms' <- mapM getInlines terms

233 items' <- mapM getBlocks items

216 items' <- mapM getBlocks items

234 return (mconcat $ intersperse (str "; ") terms', items')

217 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−

272 parseTable = do

218 parseTable = do

273 let isCaption x = named "title" x || named "caption" x

219 let isCaption x = named "title" x || named "caption" x

274 caption <- case filterChild isCaption e of

220 caption <- case filterChild isCaption e of

333 let ident = attrValue "id" e

279 let ident = attrValue "id" e

334 modify $ \st -> st{ jatsSectionLevel = oldN }

280 modify $ \st -> st{ jatsSectionLevel = oldN }

335 return $ headerWith (ident,[],[]) n' headerText <> b

281 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

341

282

342getInlines :: PandocMonad m => Element -> JATS m Inlines

283getInlines :: PandocMonad m => Element -> JATS m Inlines

343getInlines e' = (trimInlines . mconcat) <$>

284getInlines e' = (trimInlines . mconcat) <$>

344 mapM parseInline (elContent e')

285 mapM parseInline (elContent e')

345

286

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+

346parseRefList :: PandocMonad m => Element -> JATS m Blocks

331parseRefList :: PandocMonad m => Element -> JATS m Blocks

347parseRefList e = do

332parseRefList e = do

348 refs <- mapM parseRef $ filterChildren (named "ref") e

333 refs <- mapM parseRef $ filterChildren (named "ref") e