diff --git a/src/Text/Pandoc/Readers/DocBook.hs b/src/Text/Pandoc/Readers/DocBook.hs index b8ff3f1ff462..a570964b6c00 100644 --- a/src/Text/Pandoc/Readers/DocBook.hs +++ b/src/Text/Pandoc/Readers/DocBook.hs @@ -1,5 +1,5 @@ module Text.Pandoc.Readers.DocBook ( readDocBook ) where -import Text.Pandoc.Parsing (ParserState(..), defaultParserState) +import Text.Pandoc.Parsing (ParserState(..)) import Text.Pandoc.Definition import Text.Pandoc.Builder import Text.XML.Light @@ -10,16 +10,13 @@ import Control.Applicative ((<$>)) type DB = State DBState -data DBState = DBState{ dbSectionLevel :: Int } - deriving (Read, Show) - -defaultDBState :: DBState -defaultDBState = DBState { dbSectionLevel = 0 } +data DBState = DBState{ dbSectionLevel :: Int + } deriving Show readDocBook :: ParserState -> String -> Pandoc readDocBook st inp = Pandoc (Meta [] [] []) $ toList blocks where blocks = mconcat $ evalState (mapM parseBlock $ parseXML inp) - defaultDBState + DBState{ dbSectionLevel = 0 } parseBlock :: Content -> DB Blocks parseBlock (Text (CData _ s _)) = if all isSpace s @@ -34,6 +31,7 @@ parseBlock (Elem e) = "sect4" -> sect 4 "sect5" -> sect 5 "sect6" -> sect 6 + "section" -> gets dbSectionLevel >>= sect . (+1) "title" -> return $ mempty _ -> innerBlocks where innerBlocks = mconcat <$> (mapM parseBlock $ elContent e) @@ -47,9 +45,16 @@ parseBlock (Elem e) = ((Elem t):body) | isTitle t -> do h <- header n <$> (getInlines t) + modify $ \st -> st{ dbSectionLevel = n } + b <- mconcat <$> (mapM parseBlock body) + modify $ \st -> st{ dbSectionLevel = n - 1 } + return $ h <> b + body -> do + let h = header n mempty + modify $ \st -> st{ dbSectionLevel = n } b <- mconcat <$> (mapM parseBlock body) + modify $ \st -> st{ dbSectionLevel = n - 1 } return $ h <> b - _ -> (header n mempty <>) <$> innerBlocks parseBlock (CRef _) = return mempty parseInline :: Content -> DB Inlines