diff options
-rw-r--r-- | src/Text/Pandoc/Slides.hs | 43 |
1 files changed, 43 insertions, 0 deletions
diff --git a/src/Text/Pandoc/Slides.hs b/src/Text/Pandoc/Slides.hs index 42ac946a5..6a740e68f 100644 --- a/src/Text/Pandoc/Slides.hs +++ b/src/Text/Pandoc/Slides.hs @@ -29,6 +29,49 @@ Utility functions for splitting documents into slides for slide show formats (dzslides, s5, slidy, beamer). -} module Text.Pandoc.Slides ( ) where +import Text.Pandoc.Definition +import Text.ParserCombinators.Parsec +import Text.Parsec.Pos (initialPos) +data SlideElement = Outside Block + | Slide [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 + Right res -> res +anyTok :: GenParser Block () Block +anyTok = token show (const $ initialPos "blocks") Just + +satisfies :: (Block -> Bool) -> GenParser Block () Block +satisfies f = token show (const $ initialPos "blocks") + (\x -> if f x then Just x else Nothing) + +pElements :: Int -> GenParser Block () [SlideElement] +pElements slideLevel = do + res <- many (pSlide slideLevel <|> pOutside) + eof + return res + +pSlide :: Int -> GenParser Block () SlideElement +pSlide slideLevel = try $ do + + +pOutside :: GenParser Block () SlideElement +pOutside = Outside `fmap` anyTok + +-- | Find level of header that starts slides (defined as the least header +-- level that occurs before a non-header/non-hrule in the blocks). +getSlideLevel :: [Block] -> Int +getSlideLevel = go 6 + where go least (Header n _ : x : xs) + | n < least && nonHOrHR x = go n xs + | otherwise = go least (x:xs) + go least (x : xs) = go least xs + go least [] = least + nonHOrHR (Header _ _) = False + nonHOrHR (HorizontalRule) = False + nonHOrHR _ = True |