@@ -32,15 +32,16 @@ module Text.Pandoc.Slides ( ) where
3232import Text.Pandoc.Definition
3333import Text.ParserCombinators.Parsec
3434import Text.Parsec.Pos (initialPos)
35+import Control.Monad
3536
36−data SlideElement = Outside Block
37− | Slide [Inline] [Inline] [Block] -- title - subtitle - contents
37+data SlideElement = SectionSlide Int [Inline]
38+ | ContentSlide [Inline] [Inline] [Block] -- title - subtitle - contents
3839 deriving (Read, Show)
3940
4041toSlideElements :: [Block] -> [SlideElement]
4142toSlideElements bs =
4243 case parse (pElements $ getSlideLevel bs) "blocks" bs of
43− Left err -> map Outside bs
44+ Left err -> error $ show err
4445 Right res -> res
4546
4647anyTok :: GenParser Block () Block
@@ -52,16 +53,30 @@ satisfies f = token show (const $ initialPos "blocks")
5253
5354pElements :: Int -> GenParser Block () [SlideElement]
5455pElements slideLevel = do
55− res <- many (pSlide slideLevel <|> pOutside)
56+ res <- many (pSectionSlide slideLevel <|> pContentSlide slideLevel)
5657 eof
5758 return res
5859
59−pSlide :: Int -> GenParser Block () SlideElement
60−pSlide slideLevel = try $ do
61−
60+pContentSlide :: Int -> GenParser Block () SlideElement
61+pContentSlide slideLevel = try $ do
62+ hrs <- many $ satisfies (== HorizontalRule)
63+ Header _ tit <- option (Header 1 []) $ satisfies (isHeader (== slideLevel))
64+ Header _ subtit <- option (Header 1 []) $ satisfies (isHeader (== slideLevel + 1))
65+ guard $ not (null hrs && null tit && null subtit)
66+ xs <- many $ try $ notFollowedBy (satisfies (== HorizontalRule)) >>
67+ notFollowedBy (satisfies (isHeader (<= slideLevel))) >>
68+ anyTok
69+ return $ ContentSlide tit subtit xs
6270
63−pOutside :: GenParser Block () SlideElement
64−pOutside = Outside `fmap` anyTok
71+pSectionSlide :: Int -> GenParser Block () SlideElement
72+pSectionSlide slideLevel = try $ do
73+ skipMany $ satisfies (== HorizontalRule)
74+ Header lvl txt <- satisfies (isHeader (< slideLevel))
75+ return $ SectionSlide lvl txt
76+
77+isHeader :: (Int -> Bool) -> Block -> Bool
78+isHeader f (Header n _) = f n
79+isHeader _ _ = False
6580
6681-- | Find level of header that starts slides (defined as the least header
6782-- level that occurs before a non-header/non-hrule in the blocks).