@@ -499,24 +499,19 @@ type DB = State DBState
499499
500500data DBState = DBState{ dbSectionLevel :: Int
501501 , dbQuoteType :: QuoteType
502− , dbDocTitle :: Inlines
503− , dbDocAuthors :: [Inlines]
504− , dbDocDate :: Inlines
502+ , dbMeta :: Meta
503+ , dbAcceptsMeta :: Bool
505504 , dbBook :: Bool
506505 , dbFigureTitle :: Inlines
507506 } deriving Show
508507
509508readDocBook :: ReaderOptions -> String -> Pandoc
510−readDocBook _ inp = setTitle (dbDocTitle st')
511− $ setAuthors (dbDocAuthors st')
512− $ setDate (dbDocDate st')
513− $ doc $ mconcat bs
509+readDocBook _ inp = Pandoc (dbMeta st') (toList $ mconcat bs)
514510 where (bs, st') = runState (mapM parseBlock $ normalizeTree $ parseXML inp)
515511 DBState{ dbSectionLevel = 0
516512 , dbQuoteType = DoubleQuote
517− , dbDocTitle = mempty
518− , dbDocAuthors = []
519− , dbDocDate = mempty
513+ , dbMeta = mempty
514+ , dbAcceptsMeta = False
520515 , dbBook = False
521516 , dbFigureTitle = mempty
522517 }
@@ -560,6 +555,29 @@ attrValue attr elt =
560555named :: String -> Element -> Bool
561556named s e = qName (elName e) == s
562557
558+--
559+
560+acceptingMetadata :: DB a -> DB a
561+acceptingMetadata p = do
562+ modify (\s -> s { dbAcceptsMeta = True } )
563+ res <- p
564+ modify (\s -> s { dbAcceptsMeta = False })
565+ return res
566+
567+checkInMeta :: Monoid a => DB a -> DB a
568+checkInMeta p = do
569+ accepts <- dbAcceptsMeta <$> get
570+ if accepts then p else return mempty
571+
572+
573+
574+addMeta :: ToMetaValue a => String -> a -> DB ()
575+addMeta field val = modify (setMeta field val)
576+
577+instance HasMeta DBState where
578+ setMeta str v s = s {dbMeta = setMeta str v (dbMeta s)}
579+
580+
563581isBlockElement :: Content -> Bool
564582isBlockElement (Elem e) = qName (elName e) `elem` blocktags
565583 where blocktags = ["toc","index","para","formalpara","simpara",
@@ -606,6 +624,7 @@ getImage e = do
606624getBlocks :: Element -> DB Blocks
607625getBlocks e = mconcat <$> (mapM parseBlock $ elContent e)
608626
627+
609628parseBlock :: Content -> DB Blocks
610629parseBlock (Text (CData CDataRaw _ _)) = return mempty -- DOCTYPE
611630parseBlock (Text (CData _ s _)) = if all isSpace s
@@ -630,7 +649,9 @@ parseBlock (Elem e) =
630649 "attribution" -> return mempty
631650 "titleabbrev" -> return mempty
632651 "authorinitials" -> return mempty
633− "title" -> return mempty -- handled by getTitle or sect or figure
652+ "title" -> checkInMeta getTitle >> return mempty -- handled by getTitle or sect or figure
653+ "author" -> checkInMeta getAuthor >> return mempty
654+ "date" -> checkInMeta getDate >> return mempty
634655 "bibliography" -> sect 0
635656 "bibliodiv" -> sect 1
636657 "biblioentry" -> parseMixed para (elContent e)
@@ -693,8 +714,8 @@ parseBlock (Elem e) =
693714 "figure" -> getFigure e
694715 "mediaobject" -> para <$> getImage e
695716 "caption" -> return mempty
696− "info" -> getTitle >> getAuthors >> getDate >> return mempty
697− "articleinfo" -> getTitle >> getAuthors >> getDate >> return mempty
717+ "info" -> metaBlock
718+ "articleinfo" -> metaBlock
698719 "sectioninfo" -> return mempty -- keywords & other metadata
699720 "refsectioninfo" -> return mempty -- keywords & other metadata
700721 "refsect1info" -> return mempty -- keywords & other metadata
@@ -708,10 +729,10 @@ parseBlock (Elem e) =
708729 "chapterinfo" -> return mempty -- keywords & other metadata
709730 "glossaryinfo" -> return mempty -- keywords & other metadata
710731 "appendixinfo" -> return mempty -- keywords & other metadata
711− "bookinfo" -> getTitle >> getAuthors >> getDate >> return mempty
732+ "bookinfo" -> metaBlock
712733 "article" -> modify (\st -> st{ dbBook = False }) >>
713− getTitle >> getBlocks e
714− "book" -> modify (\st -> st{ dbBook = True }) >> getTitle >> getBlocks e
734+ getBlocks e
735+ "book" -> modify (\st -> st{ dbBook = True }) >> getBlocks e
715736 "table" -> parseTable
716737 "informaltable" -> parseTable
717738 "literallayout" -> codeBlockWithLang
@@ -757,24 +778,16 @@ parseBlock (Elem e) =
757778 terms' <- mapM getInlines terms
758779 items' <- mapM getBlocks items
759780 return (mconcat $ intersperse (str "; ") terms', items')
760− getTitle = case filterChild (named "title") e of
761− Just t -> do
762− tit <- getInlines t
763− subtit <- case filterChild (named "subtitle") e of
764− Just s -> (text ": " <>) <$>
765− getInlines s
766− Nothing -> return mempty
767− modify $ \st -> st{dbDocTitle = tit <> subtit}
768− Nothing -> return ()
769− getAuthors = do
770− auths <- mapM getInlines
771− $ filterChildren (named "author") e
772− modify $ \st -> st{dbDocAuthors = auths}
773− getDate = case filterChild (named "date") e of
774− Just t -> do
775− dat <- getInlines t
776− modify $ \st -> st{dbDocDate = dat}
777− Nothing -> return ()
781+ getTitle = do
782+ tit <- getInlines e
783+ subtit <- case filterChild (named "subtitle") e of
784+ Just s -> (text ": " <>) <$>
785+ getInlines s
786+ Nothing -> return mempty
787+ addMeta "title" (tit <> subtit)
788+
789+ getAuthor = getInlines e >>= addMeta "author"
790+ getDate = getInlines e >>= addMeta "date"
778791 parseTable = do
779792 let isCaption x = named "title" x || named "caption" x
780793 caption <- case filterChild isCaption e of
@@ -836,6 +849,7 @@ parseBlock (Elem e) =
836849 b <- getBlocks e
837850 modify $ \st -> st{ dbSectionLevel = n - 1 }
838851 return $ header n' headerText <> b
852+ metaBlock = acceptingMetadata (getBlocks e)
839853
840854getInlines :: Element -> DB Inlines
841855getInlines e' = (trimInlines . mconcat) <$> (mapM parseInline $ elContent e')