@@ -11,17 +11,28 @@ import Control.Applicative ((<$>))
1111type DB = State DBState
1212
1313data DBState = DBState{ dbSectionLevel :: Int
14+ , dbDocTitle :: Inlines
15+ , dbDocAuthors :: [Inlines]
16+ , dbDocDate :: Inlines
1417 } deriving Show
1518
1619readDocBook :: ParserState -> String -> Pandoc
17−readDocBook st inp = Pandoc (Meta [] [] []) $ toList blocks
18− where blocks = mconcat $ evalState (mapM parseBlock $ parseXML inp)
19− DBState{ dbSectionLevel = 0 }
20+readDocBook st inp = setTitle (dbDocTitle st')
21+ $ setAuthors (dbDocAuthors st')
22+ $ setDate (dbDocDate st')
23+ $ doc $ mconcat bs
24+ where (bs, st') = runState (mapM parseBlock $ parseXML inp)
25+ DBState{ dbSectionLevel = 0
26+ , dbDocTitle = mempty
27+ , dbDocAuthors = []
28+ , dbDocDate = mempty
29+ }
2030
2131parseBlock :: Content -> DB Blocks
32+parseBlock (Text (CData CDataRaw _ _)) = return mempty -- DOCTYPE
2233parseBlock (Text (CData _ s _)) = if all isSpace s
23− then return mempty
24− else return $ plain $ text s
34+ then return mempty
35+ else return $ plain $ text s
2536parseBlock (Elem e) =
2637 case qName (elName e) of
2738 "para" -> para <$> getInlines e
@@ -33,7 +44,9 @@ parseBlock (Elem e) =
3344 "sect5" -> sect 5
3445 "sect6" -> sect 6
3546 "section" -> gets dbSectionLevel >>= sect . (+1)
36− "title" -> return $ mempty -- processed by sect
47+ "articleinfo" -> getTitle >> getAuthors >> getDate >> return mempty
48+ "title" -> return mempty -- processed by sect
49+ "?xml" -> return mempty
3750 _ -> innerBlocks
3851 where innerBlocks = mconcat <$> (mapM parseBlock $ elContent e)
3952 getInlines e' = (trimInlines . mconcat) <$>
@@ -42,6 +55,20 @@ parseBlock (Elem e) =
4255 skipWhite (Text (CData _ s _):xs) | all isSpace s = skipWhite xs
4356 | otherwise = xs
4457 skipWhite xs = xs
58+ getTitle = case findChild (unqual "title") e of
59+ Just t -> do
60+ tit <- getInlines t
61+ modify $ \st -> st{dbDocTitle = tit}
62+ Nothing -> return ()
63+ getAuthors = do
64+ auths <- mapM getInlines
65+ $ findChildren (unqual "author") e
66+ modify $ \st -> st{dbDocAuthors = auths}
67+ getDate = case findChild (unqual "date") e of
68+ Just t -> do
69+ dat <- getInlines t
70+ modify $ \st -> st{dbDocDate = dat}
71+ Nothing -> return ()
4572 sect n = case skipWhite (elContent e) of
4673 ((Elem t):body)
4774 | isTitle t -> do