Slides: New approach, using hierarchicalize.

This will work better with the HTML slideshows.

2 files changed, 44 insertions, 67 deletions

diff --git a/src/Text/Pandoc/Slides.hs b/src/Text/Pandoc/Slides.hs
index d45af4f1c..ba68bbd67 100644
--- a/src/Text/Pandoc/Slides.hs
+++ b/src/Text/Pandoc/Slides.hs
@@ -28,51 +28,8 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 Utility functions for splitting documents into slides for slide
 show formats (dzslides, s5, slidy, beamer).
 -}
-module Text.Pandoc.Slides ( toSlideElements, SlideElement(..) ) where
+module Text.Pandoc.Slides ( getSlideLevel, prepSlides ) where
 import Text.Pandoc.Definition
-import Text.ParserCombinators.Parsec
-import Text.Parsec.Pos (initialPos)
-import Control.Monad
-
-data SlideElement = SectionSlide Int [Inline]
-                  | ContentSlide [Inline] [Block]  -- title - contents
-                  deriving (Read, Show)
-
-toSlideElements :: [Block] -> [SlideElement]
-toSlideElements bs =
-  case parse (pElements $ getSlideLevel bs) "blocks" bs of
-       Left err   -> error $ "toSlideElements: " ++ show err  -- should never happen
-       Right res  -> res
-
-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 (pSectionSlide slideLevel <|> pContentSlide slideLevel)
-  eof
-  return res
-
-pContentSlide :: Int -> GenParser Block () SlideElement
-pContentSlide slideLevel = try $ do
-  hrs <- many $ satisfies (== HorizontalRule)
-  Header _ tit <- option (Header 1 []) $ satisfies (isHeader (== slideLevel))
-  xs <- many $ try $ notFollowedBy (satisfies (== HorizontalRule)) >>
-                     notFollowedBy (satisfies (isHeader (<= slideLevel))) >>
-                     anyToken
-  guard $ not (null hrs && null tit && null xs)  -- make sure we can't match empty
-  return $ ContentSlide tit xs
-
-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).
@@ -86,3 +43,15 @@ getSlideLevel = go 6
         nonHOrHR (Header _ _) = False
         nonHOrHR (HorizontalRule) = False
         nonHOrHR _ = True
+
+-- | Prepare a block list to be passed to hierarchicalize.
+prepSlides :: Int -> [Block] -> [Block]
+prepSlides slideLevel = ensureStartWithH . splitHrule
+  where splitHrule (HorizontalRule : Header n xs : ys)
+                       | n == slideLevel = Header slideLevel xs : splitHrule ys
+        splitHrule (HorizontalRule : xs) = Header slideLevel [] : splitHrule xs
+        splitHrule (x : xs)              = x : splitHrule xs
+        splitHrule []                    = []
+        ensureStartWithH bs@(Header n _:_)
+                       | n == slideLevel = bs
+        ensureStartWithH bs              = Header slideLevel [] : bs
diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs
index 6291300b0..e4844fde2 100644
--- a/src/Text/Pandoc/Writers/LaTeX.hs
+++ b/src/Text/Pandoc/Writers/LaTeX.hs
@@ -200,29 +200,37 @@ inCmd :: String -> Doc -> Doc
 inCmd cmd contents = char '\\' <> text cmd <> braces contents
 
 toSlides :: [Block] -> State WriterState [Block]
-toSlides bs = concat `fmap` (mapM slideToBeamer $ toSlideElements bs)
-
-slideToBeamer :: SlideElement -> State WriterState [Block]
-slideToBeamer (SectionSlide lvl tit) = return [Header lvl tit]
-slideToBeamer (ContentSlide tit bs)  = do
-  tit' <- inlineListToLaTeX tit
-  -- note: [fragile] is required or verbatim breaks
-  let hasCodeBlock (CodeBlock _ _) = [True]
-      hasCodeBlock _               = []
-  let hasCode (Code _ _) = [True]
-      hasCode _          = []
-  let fragile = if not $ null $ queryWith hasCodeBlock bs ++ queryWith hasCode bs
-                   then "[fragile]"
-                   else ""
-  let slideStart = RawBlock "latex" ("\\begin{frame}" ++ fragile ++
-            "\\frametitle{" ++ render Nothing tit' ++ "}")
-  let slideEnd = RawBlock "latex" "\\end{frame}"
-  -- now carve up slide into blocks if there are sections inside
-  let eltToBlocks (Blk b) = [b]
-      eltToBlocks (Sec _ _ _ lab xs) =
-         Para (RawInline "latex" "\\begin{block}{" : lab ++ [RawInline "latex" "}"])
-         : concatMap eltToBlocks xs ++ [RawBlock "latex" "\\end{block}"]
-  return $ slideStart : concatMap eltToBlocks (hierarchicalize bs) ++ [slideEnd]
+toSlides bs = do
+  let slideLevel = getSlideLevel bs
+  let bs' = prepSlides slideLevel bs
+  concat `fmap` (mapM (elementToBeamer slideLevel) $ hierarchicalize bs')
+
+elementToBeamer :: Int -> Element -> State WriterState [Block]
+elementToBeamer _slideLevel (Blk b) = return [b]
+elementToBeamer slideLevel  (Sec lvl _num _ident tit elts)
+  | lvl >  slideLevel = do
+      bs <- concat `fmap` mapM (elementToBeamer slideLevel) elts
+      return $ Para ( RawInline "latex" "\\begin{block}{"
+                    : tit ++ [RawInline "latex" "}"] )
+             : bs ++ [RawBlock "latex" "\\end{block}"]
+  | lvl <  slideLevel = do
+      bs <- concat `fmap` mapM (elementToBeamer slideLevel) elts
+      return $ (Header lvl tit) : bs
+  | otherwise = do -- lvl == slideLevel
+      -- note: [fragile] is required or verbatim breaks
+      let hasCodeBlock (CodeBlock _ _) = [True]
+          hasCodeBlock _               = []
+      let hasCode (Code _ _) = [True]
+          hasCode _          = []
+      let fragile = if not $ null $ queryWith hasCodeBlock elts ++ queryWith hasCode elts
+                       then "[fragile]"
+                       else ""
+      let slideStart = Para $ RawInline "latex" ("\\begin{frame}" ++ fragile ++
+                "\\frametitle{") : tit ++ [RawInline "latex" "}"]
+      let slideEnd = RawBlock "latex" "\\end{frame}"
+      -- now carve up slide into blocks if there are sections inside
+      bs <- concat `fmap` mapM (elementToBeamer slideLevel) elts
+      return $ slideStart : bs ++ [slideEnd]
 
 isListBlock :: Block -> Bool
 isListBlock (BulletList _)     = True