aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Text/Pandoc/Slides.hs43
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