Include is now more robust

app/decker.hs

@@ -33,6 +33,9 @@ main = do
     allSources <- glob "**/*.md"
     meta <- glob "**/*.yaml"
 
+    -- Read meta data.
+    metaData <- readMetaDataIO meta
+
     -- let plainSources = allSources \\ (deckSources ++ pageSources)
 
     -- Calculate targets
@@ -86,7 +89,7 @@ main = do
         priority 2 $ "//*-deck.html" %> \out -> do
             need ["support"]
             let src = sourcePath out projectDir ".html" ".md"
-            markdownToHtmlDeck src meta out
+            markdownToHtmlDeck src metaData out
 
         priority 2 $ "//*-deck.pdf" %> \out -> do
             let src = sourcePath out projectDir ".pdf" ".html"
@@ -109,13 +112,14 @@ main = do
             markdownToPdfHandout src meta out
 
         priority 2 $ "//*-page.html" %> \out -> do
-            need ["support"]
             let src = sourcePath out projectDir "-page.html" "-page.md"
-            markdownToHtmlPage src meta out
+            need $ [src, "support"] ++ meta
+            markdownToHtmlPage src metaData out
 
         priority 2 $ "//*-page.pdf" %> \out -> do
             let src = sourcePath out projectDir "-page.pdf" "-page.md"
-            markdownToPdfPage src meta out
+            need $ [src, "support", "cache"] ++ meta
+            markdownToPdfPage src metaData out
 
         priority 2 $ index %> \out -> do
             exists <- Development.Shake.doesFileExist indexSource
@@ -123,20 +127,12 @@ main = do
             putNormal out
             rel <- getRelativeSupportDir out
             putNormal rel
-            markdownToHtmlPage src meta out
+            markdownToHtmlPage src metaData out
 
         indexSource <.> "generated" %> \out -> do
             need $ decks ++ handouts ++ pages
             writeIndex out (takeDirectory index) decks handouts pages
 
-        "//*.html" %> \out -> do
-            let src = out -<.> "md"
-            markdownToHtmlPage src meta out
-
-        "//*.pdf" %> \out -> do
-            let src = out -<.> "md"
-            markdownToPdfPage src meta out
-
         phony "clean" $ do
             removeFilesAfter publicDir ["//"]
             removeFilesAfter projectDir cruft

resource/example/example-deck.md

@@ -49,6 +49,14 @@ transition: linear
 ... in a galaxy far, far away.
 ```
 
+# Includes
+
+## Include markdown files
+
+The following text ist included from file `/resource/realtive.md`:
+
+![#include](/resource/relative.md)
+
 # Multicolumn slides
 
 ## The author

resource/level-2.md

-## This is a Level 2 Include
+# This is a Level 2 Include
 
-Transitive is cool.
+Transitive is so very traditional.
 
 Course is {{course}}

resource/relative.md

-## Level 2 Header
+# Level 1 Header
 
 *Here be DRAGONS.*
 

src/utilities.hs

@@ -7,7 +7,7 @@ module Utilities
         markdownToHtmlHandout, markdownToPdfHandout, markdownToHtmlPage,
         markdownToPdfPage, writeExampleProject, metaValueAsString, (<++>),
         markNeeded, replaceSuffixWith, writeEmbeddedFiles,
-        getRelativeSupportDir, DeckerException(..))
+        getRelativeSupportDir, collectIncludes, DeckerException(..))
        where
 
 import Control.Monad.Loops
@@ -260,18 +260,12 @@ getRelativeSupportDir from =
 
 -- | Write a markdown file to a HTML file using the page template.
 markdownToHtmlDeck
-  :: FilePath -> [FilePath] -> FilePath -> Action ()
-markdownToHtmlDeck markdownFile metaFiles out =
-  do need $ markdownFile : metaFiles
-     metaData <- readMetaData metaFiles
-     pandoc <- readMetaMarkdown markdownFile metaData
-     processed <- processPandocDeck "revealjs" pandoc
-     supportDir <- getRelativeSupportDir out
+  :: FilePath -> MetaData -> FilePath -> Action ()
+markdownToHtmlDeck markdownFile metaData out =
+  do supportDir <- getRelativeSupportDir out
      let options =
-           def {writerHtml5 = True
-               ,writerStandalone = True
+           def {writerStandalone = True
                ,writerTemplate = deckTemplate
-               ,writerSlideVariant = RevealJsSlides
                ,writerHighlight = True
                ,writerHighlightStyle = pygments
                ,writerHTMLMathMethod =
@@ -280,9 +274,11 @@ markdownToHtmlDeck markdownFile metaFiles out =
                ,writerVariables =
                   [("revealjs-url",supportDir </> "reveal.js")]
                ,writerCiteMethod = Citeproc}
-     writePandocString writeHtmlString options out processed
+     pandoc <- readAndPreprocessMarkdown metaData markdownFile
+     processed <- processPandocDeck "revealjs" pandoc
      let images = extractLocalImagePathes processed
      copyLocalImages images markdownFile out
+     writePandocString "revealjs" options out processed
 
 copyLocalImages :: [FilePath] -> FilePath  -> FilePath -> Action ()
 copyLocalImages imageFiles inFile outFile =
@@ -295,15 +291,34 @@ copyLocalImages imageFiles inFile outFile =
              liftIO $ createDirectoryIfMissing True (takeDirectory to)
              copyFileChanged from to
 
+type MetaData = Y.Value
+
+-- | Selects a matching pandoc string writer for the format string, or throws an
+-- exception.
+getPandocWriter :: String -> StringWriter
+getPandocWriter format =
+  case getWriter format of
+    Right (PureStringWriter w) -> w
+    Left e -> throw $ PandocException e
+    _ -> throw $ PandocException $ "No writer for format: " ++ format
+
+-- | Reads a markdownfile, expands the included files, and substitutes mustache
+-- template variables.
+readAndPreprocessMarkdown :: MetaData -> FilePath -> Action Pandoc
+readAndPreprocessMarkdown metaData markdownFile =
+  do -- let writer = getPandocWriter format
+     projectDir <- getProjectDir
+     let baseDir = takeDirectory markdownFile
+     includes <- collectIncludes markdownFile
+     pandoc <- readMetaMarkdown markdownFile metaData
+     need (markdownFile : includes)
+     liftIO $ processIncludes projectDir baseDir metaData pandoc
+
 -- | Write a markdown file to a HTML file using the page template.
 markdownToHtmlPage
-  :: FilePath -> [FilePath] -> FilePath -> Action ()
-markdownToHtmlPage markdownFile metaFiles out =
+  :: FilePath -> MetaData -> FilePath -> Action ()
+markdownToHtmlPage markdownFile metaData out =
   do supportDir <- getRelativeSupportDir out
-     projectDir <- getProjectDir
-     need $ markdownFile : metaFiles
-     metaData <- readMetaData metaFiles
-     pandoc <- readMetaMarkdown markdownFile metaData
      let options =
            def {writerHtml5 = True
                ,writerStandalone = True
@@ -316,32 +331,24 @@ markdownToHtmlPage markdownFile metaFiles out =
                ,writerVariables =
                   [("css",supportDir </> "readable/bootstrap.min.css")]
                ,writerCiteMethod = Citeproc}
-     included <-
-       liftIO $
-       processIncludes writeHtmlString
-                       options
-                       projectDir
-                       (takeDirectory markdownFile)
-                       metaData
-                       pandoc
-     processed <- processPandocPage "html" included
-     writePandocString writeHtmlString options out processed
+     pandoc <- readAndPreprocessMarkdown metaData markdownFile
+     processed <- processPandocPage "html5" pandoc
+     let images = extractLocalImagePathes processed
+     copyLocalImages images markdownFile out
+     writePandocString "html5" options out processed
 
 -- | Write a markdown file to a PDF file using the handout template.
 markdownToPdfPage
-  :: FilePath -> [FilePath] -> FilePath -> Action ()
-markdownToPdfPage markdownFile metaFiles out =
-  do need $ markdownFile : metaFiles
-     metaData <- readMetaData metaFiles
-     pandoc <- readMetaMarkdown markdownFile metaData
-     processed <- processPandocPage "latex" pandoc
-     supportDir <- getRelativeSupportDir out
-     let options =
+  :: FilePath -> MetaData -> FilePath -> Action ()
+markdownToPdfPage markdownFile metaData out =
+  do let options =
            def {writerStandalone = True
                ,writerTemplate = pageLatexTemplate
                ,writerHighlight = True
                ,writerHighlightStyle = pygments
                ,writerCiteMethod = Citeproc}
+     pandoc <- readAndPreprocessMarkdown metaData markdownFile
+     processed <- processPandocPage "latex" pandoc
      putNormal $ "# pandoc (for " ++ out ++ ")"
      pandocMakePdf options processed out
 
@@ -372,7 +379,7 @@ markdownToHtmlHandout markdownFile metaFiles out =
                ,writerVariables =
                   [("css",supportDir </> "readable/bootstrap.min.css")]
                ,writerCiteMethod = Citeproc}
-     writePandocString writeHtmlString options out processed
+     writePandocString "html5" options out processed
 
 -- | Write a markdown file to a PDF file using the handout template.
 markdownToPdfHandout
@@ -411,29 +418,56 @@ cacheRemoteImages cacheDir metaFiles markdownFiles =
   where cacheImages markdownFile =
           do metaData <- readMetaData metaFiles
              pandoc <- readMetaMarkdown markdownFile metaData
-             liftIO $ walkM (cachePandocImages cacheDir) pandoc
+             _ <- liftIO $ walkM (cachePandocImages cacheDir) pandoc
              putNormal $ "# pandoc (cached images for " ++ markdownFile ++ ")"
 
-processIncludes :: StringWriter -> WriterOptions -> FilePath -> FilePath -> Y.Value -> Pandoc -> IO Pandoc
-processIncludes writer options rootDir baseDir metaData pandoc =
-  liftIO $ walkM (include baseDir) pandoc
-  where include :: FilePath -> Block -> IO Block
-        include base (Para [Image _ [Str "#include"] (url,_)]) =
-          do let filePath =
-                   if isAbsolute url
-                      then rootDir </> makeRelative "/" url
-                      else base </> url
-             includedPandoc <- readMetaMarkdownIO filePath metaData
+absoluteIncludePath root base path =
+  if isAbsolute path
+     then root </> makeRelative "/" path
+     else base </> path
+
+-- Transitively collects all include files for the given markdown file. The returned pathes
+-- are absolute an can be passed directly to `need`.
+collectIncludes ::  FilePath -> Action [FilePath]
+collectIncludes markdownFile =
+  do projectDir <- getProjectDir
+     liftIO $ collectIncludesIO projectDir markdownFile
+
+collectIncludesIO :: FilePath -> FilePath -> IO [FilePath]
+collectIncludesIO rootDir markdownFile =
+  do markdown <- readFile markdownFile
+     let pandoc =
+           case readMarkdown def markdown of
+             Right p -> p
+             Left e -> throw $ PandocException (show e)
+     let baseDir = takeDirectory markdownFile
+     let direct = map (absoluteIncludePath rootDir baseDir) (Text.Pandoc.Walk.query include pandoc)
+     transitive <- mapM (collectIncludesIO rootDir) direct
+     return $ direct ++ concat transitive
+  where include :: Block -> [FilePath]
+        include (Para [Image _ [Str "#include"] (url,_)]) = [url]
+        include _ = []
+
+-- Transitively splices all include files into the pandoc document.
+processIncludes :: FilePath -> FilePath -> Y.Value -> Pandoc -> IO Pandoc
+processIncludes rootDir baseDir metaData (Pandoc meta blocks) =
+  do included <- processBlocks baseDir blocks
+     return $ Pandoc meta included
+  where processBlocks
+          :: FilePath -> [Block] -> IO [Block]
+        processBlocks base blcks =
+          do spliced <- foldM (include base) [] blcks
+             return $ concat $ reverse spliced
+        include
+          :: FilePath -> [[Block]] -> Block -> IO [[Block]]
+        include base result (Para [Image _ [Str "#include"] (url,_)]) =
+          do let filePath = absoluteIncludePath rootDir base url
+             Pandoc _ b <- readMetaMarkdownIO filePath metaData
              included <-
-               processIncludes writer
-                               options
-                               rootDir
-                               (takeDirectory filePath)
-                               metaData
-                               includedPandoc
-             let rendered = writer options {writerStandalone = False} included
-             return $ RawBlock (Format "html") rendered
-        include _ block = return block
+               processBlocks (takeDirectory filePath)
+                             b
+             return $ included : result
+        include _ result block = return $ [block] : result
 
 processPandocPage
   :: String -> Pandoc -> Action Pandoc
@@ -464,13 +498,14 @@ processPandocHandout format pandoc =
 
 type StringWriter = WriterOptions -> Pandoc -> String
 
-writePandocString :: StringWriter
+writePandocString :: String
                   -> WriterOptions
                   -> FilePath
                   -> Pandoc
                   -> Action ()
-writePandocString writer options out pandoc =
-  do writeFile' out
+writePandocString format options out pandoc =
+  do let writer = getPandocWriter format
+     writeFile' out
                 (writer options pandoc)
      putNormal $ "# pandoc for (" ++ out ++ ")"