Skip to content

Commit

Permalink
Got section and sectN tags working in docbook reader.
Browse files Browse the repository at this point in the history
  • Loading branch information
John MacFarlane committed Apr 15, 2012
1 parent 9ecb9b5 commit d7e8252
Showing 1 changed file with 13 additions and 8 deletions.
21 changes: 13 additions & 8 deletions src/Text/Pandoc/Readers/DocBook.hs
@@ -1,5 +1,5 @@
module Text.Pandoc.Readers.DocBook ( readDocBook ) where 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.Definition
import Text.Pandoc.Builder import Text.Pandoc.Builder
import Text.XML.Light import Text.XML.Light
Expand All @@ -10,16 +10,13 @@ import Control.Applicative ((<$>))


type DB = State DBState type DB = State DBState


data DBState = DBState{ dbSectionLevel :: Int } data DBState = DBState{ dbSectionLevel :: Int
deriving (Read, Show) } deriving Show

defaultDBState :: DBState
defaultDBState = DBState { dbSectionLevel = 0 }


readDocBook :: ParserState -> String -> Pandoc readDocBook :: ParserState -> String -> Pandoc
readDocBook st inp = Pandoc (Meta [] [] []) $ toList blocks readDocBook st inp = Pandoc (Meta [] [] []) $ toList blocks
where blocks = mconcat $ evalState (mapM parseBlock $ parseXML inp) where blocks = mconcat $ evalState (mapM parseBlock $ parseXML inp)
defaultDBState DBState{ dbSectionLevel = 0 }


parseBlock :: Content -> DB Blocks parseBlock :: Content -> DB Blocks
parseBlock (Text (CData _ s _)) = if all isSpace s parseBlock (Text (CData _ s _)) = if all isSpace s
Expand All @@ -34,6 +31,7 @@ parseBlock (Elem e) =
"sect4" -> sect 4 "sect4" -> sect 4
"sect5" -> sect 5 "sect5" -> sect 5
"sect6" -> sect 6 "sect6" -> sect 6
"section" -> gets dbSectionLevel >>= sect . (+1)
"title" -> return $ mempty "title" -> return $ mempty
_ -> innerBlocks _ -> innerBlocks
where innerBlocks = mconcat <$> (mapM parseBlock $ elContent e) where innerBlocks = mconcat <$> (mapM parseBlock $ elContent e)
Expand All @@ -47,9 +45,16 @@ parseBlock (Elem e) =
((Elem t):body) ((Elem t):body)
| isTitle t -> do | isTitle t -> do
h <- header n <$> (getInlines t) 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) b <- mconcat <$> (mapM parseBlock body)
modify $ \st -> st{ dbSectionLevel = n - 1 }
return $ h <> b return $ h <> b
_ -> (header n mempty <>) <$> innerBlocks
parseBlock (CRef _) = return mempty parseBlock (CRef _) = return mempty


parseInline :: Content -> DB Inlines parseInline :: Content -> DB Inlines
Expand Down

0 comments on commit d7e8252

Please sign in to comment.