Skip to content
Snippets Groups Projects
Commit 82989249 authored by Henrik Tramberend's avatar Henrik Tramberend
Browse files

Include is now more robust

parent 1384cfff
No related branches found
No related tags found
No related merge requests found
......@@ -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
......
......@@ -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
......
## This is a Level 2 Include
# This is a Level 2 Include
Transitive is cool.
Transitive is so very traditional.
Course is {{course}}
## Level 2 Header
# Level 1 Header
*Here be DRAGONS.*
......
......@@ -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 ++ ")"
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment