@@ -5,32 +5,63 @@ import Text.Pandoc.Builder
55import Text.XML.Light
66import Data.Monoid
77import Data.Char (isSpace)
8+import Control.Monad.State
9+import Control.Applicative ((<$>))
10+
11+type DB = State DBState
12+
13+data DBState = DBState{ dbSectionLevel :: Int }
14+ deriving (Read, Show)
15+
16+defaultDBState :: DBState
17+defaultDBState = DBState { dbSectionLevel = 0 }
818
919readDocBook :: ParserState -> String -> Pandoc
1020readDocBook st inp = Pandoc (Meta [] [] []) $ toList blocks
11− where blocks = mconcat $ map (parseBlock st) $ parseXML inp
21+ where blocks = mconcat $ evalState (mapM parseBlock $ parseXML inp)
22+ defaultDBState
1223
13−parseBlock :: ParserState -> Content -> Blocks
14−parseBlock st (Text (CData _ s _)) = if all isSpace s
15− then mempty
16− else plain $ text s
17−parseBlock st (Elem e) =
24+parseBlock :: Content -> DB Blocks
25+parseBlock (Text (CData _ s _)) = if all isSpace s
26+ then return mempty
27+ else return $ plain $ text s
28+parseBlock (Elem e) =
1829 case qName (elName e) of
19− "para" -> para $ trimInlines $ mconcat
20− $ map (parseInline st) $ elContent e
21− _ -> mconcat $ map (parseBlock st) $ elContent e
22−parseBlock st (CRef _) = mempty
30+ "para" -> para <$> getInlines e
31+ "sect1" -> sect 1
32+ "sect2" -> sect 2
33+ "sect3" -> sect 3
34+ "sect4" -> sect 4
35+ "sect5" -> sect 5
36+ "sect6" -> sect 6
37+ "title" -> return $ mempty
38+ _ -> innerBlocks
39+ where innerBlocks = mconcat <$> (mapM parseBlock $ elContent e)
40+ getInlines e' = (trimInlines . mconcat) <$>
41+ (mapM parseInline $ elContent e')
42+ isTitle e' = qName (elName e') == "title"
43+ skipWhite (Text (CData _ s _):xs) | all isSpace s = skipWhite xs
44+ | otherwise = xs
45+ skipWhite xs = xs
46+ sect n = case skipWhite (elContent e) of
47+ ((Elem t):body)
48+ | isTitle t -> do
49+ h <- header n <$> (getInlines t)
50+ b <- mconcat <$> (mapM parseBlock body)
51+ return $ h <> b
52+ _ -> (header n mempty <>) <$> innerBlocks
53+parseBlock (CRef _) = return mempty
2354
24−parseInline :: ParserState -> Content -> Inlines
25−parseInline st (Text (CData _ s _)) = text s
26−parseInline st (Elem e) =
55+parseInline :: Content -> DB Inlines
56+parseInline (Text (CData _ s _)) = return $ text s
57+parseInline (Elem e) =
2758 case qName (elName e) of
2859 "emphasis" -> case lookupAttrBy (\attr -> qName attr == "role")
2960 (elAttribs e) of
30− Just "strong" -> strong innerInlines
31− _ -> emph innerInlines
61+ Just "strong" -> strong <$> innerInlines
62+ _ -> emph <$> innerInlines
3263 _ -> innerInlines
33− where innerInlines = trimInlines . mconcat . map (parseInline st)
34− $ elContent e
35−parseInline st (CRef _) = mempty
64+ where innerInlines = (trimInlines . mconcat) <$>
65+ (mapM parseInline $ elContent e)
66+parseInline (CRef _) = return mempty
3667