aboutsummaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Pandoc/Readers/DocBook.hs21
1 files changed, 13 insertions, 8 deletions
diff --git a/src/Text/Pandoc/Readers/DocBook.hs b/src/Text/Pandoc/Readers/DocBook.hs
index b8ff3f1ff..a570964b6 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