diff options
| -rw-r--r-- | src/Text/Pandoc/Slides.hs | 33 |
1 files changed, 24 insertions, 9 deletions
diff --git a/src/Text/Pandoc/Slides.hs b/src/Text/Pandoc/Slides.hs index 6a740e68f..0fd037d0b 100644 --- a/src/Text/Pandoc/Slides.hs +++ b/src/Text/Pandoc/Slides.hs @@ -32,15 +32,16 @@ module Text.Pandoc.Slides ( ) where import Text.Pandoc.Definition import Text.ParserCombinators.Parsec import Text.Parsec.Pos (initialPos) +import Control.Monad -data SlideElement = Outside Block - | Slide [Inline] [Inline] [Block] -- title - subtitle - contents +data SlideElement = SectionSlide Int [Inline] + | ContentSlide [Inline] [Inline] [Block] -- title - subtitle - contents deriving (Read, Show) toSlideElements :: [Block] -> [SlideElement] toSlideElements bs = case parse (pElements $ getSlideLevel bs) "blocks" bs of - Left err -> map Outside bs + Left err -> error $ show err Right res -> res anyTok :: GenParser Block () Block @@ -52,16 +53,30 @@ satisfies f = token show (const $ initialPos "blocks") pElements :: Int -> GenParser Block () [SlideElement] pElements slideLevel = do - res <- many (pSlide slideLevel <|> pOutside) + res <- many (pSectionSlide slideLevel <|> pContentSlide slideLevel) eof return res -pSlide :: Int -> GenParser Block () SlideElement -pSlide slideLevel = try $ do - +pContentSlide :: Int -> GenParser Block () SlideElement +pContentSlide slideLevel = try $ do + hrs <- many $ satisfies (== HorizontalRule) + Header _ tit <- option (Header 1 []) $ satisfies (isHeader (== slideLevel)) + Header _ subtit <- option (Header 1 []) $ satisfies (isHeader (== slideLevel + 1)) + guard $ not (null hrs && null tit && null subtit) + xs <- many $ try $ notFollowedBy (satisfies (== HorizontalRule)) >> + notFollowedBy (satisfies (isHeader (<= slideLevel))) >> + anyTok + return $ ContentSlide tit subtit xs -pOutside :: GenParser Block () SlideElement -pOutside = Outside `fmap` anyTok +pSectionSlide :: Int -> GenParser Block () SlideElement +pSectionSlide slideLevel = try $ do + skipMany $ satisfies (== HorizontalRule) + Header lvl txt <- satisfies (isHeader (< slideLevel)) + return $ SectionSlide lvl txt + +isHeader :: (Int -> Bool) -> Block -> Bool +isHeader f (Header n _) = f n +isHeader _ _ = False -- | Find level of header that starts slides (defined as the least header -- level that occurs before a non-header/non-hrule in the blocks). |