Commit 3e7cf8f6 authored by Henrik Tramberend's avatar Henrik Tramberend
Browse files

Includes, images and macros finally work together

parent 9a292255
......@@ -106,7 +106,7 @@ renderCatalog projectDir templates questions out =
Left err -> throw $ PandocException (show err)
Right pandoc -> walk (adjustImageUrls base) pandoc
adjustImageUrls base (Image attr inlines (url,title)) =
(Image attr inlines (absoluteIncludePath projectDir base url,title))
(Image attr inlines (adjustLocalUrl projectDir base url,title))
adjustImageUrls _ inline = inline
renderMarkdown question =
T.unpack $
......
......@@ -55,7 +55,7 @@ transition: linear
The following text ist included from file `/resource/realtive.md`:
![#include](/resource/relative.md)
[#include](/resource/relative.md)
# Multicolumn slides
......@@ -115,14 +115,14 @@ $$
``` {.markdown}
## Video
![:youtube](Wji-BZ0oCwg)
[:youtube](Wji-BZ0oCwg)
```
###
## Video
![:youtube](Wji-BZ0oCwg)
[:youtube](Wji-BZ0oCwg)
# Compile Time Templating
......
......@@ -28,7 +28,7 @@ $for(css)$
<link rel="stylesheet" href="$css$">
$endfor$
$else$
<link rel="stylesheet" href="https://bootswatch.com/readable/bootstrap.min.css">
<link rel="stylesheet" href="https://bootswatch.com/sandstone/bootstrap.min.css">
$endif$
<style type="text/css">
.container {
......
......@@ -3,3 +3,7 @@
Transitive is so very traditional.
Course is {{course}}
Module is {{module}}
![Transitively included image](example/img/06-metal.png)
......@@ -28,7 +28,7 @@ $for(css)$
<link rel="stylesheet" href="$css$">
$endfor$
$else$
<link rel="stylesheet" href="https://bootswatch.com/readable/bootstrap.min.css">
<link rel="stylesheet" href="https://bootswatch.com/sandstone/bootstrap.min.css">
$endif$
<style type="text/css">
.container {
......
......@@ -2,4 +2,4 @@
*Here be DRAGONS.*
![#include](level-2.md)
[#include](level-2.md)
This diff is collapsed.
......@@ -124,8 +124,6 @@ onlyStrings = reverse . foldl only []
expand
:: Inline -> Format -> Meta -> Maybe Inline
expand (Image attr text target) format meta =
expand_ attr text target format meta
expand (Link attr text target) format meta =
expand_ attr text target format meta
expand x _ _ = Just x
......
-- | Generally useful functions on pansoc data structures. Some in the IO monad.
module Pandoc
(isCacheableURI, adjustLocalUrl, cacheRemoteFile,
(isCacheableURI, cacheRemoteFile,
Pandoc.cacheRemoteImages, Pandoc.readMetaData)
where
......@@ -29,41 +29,12 @@ import Utilities
import Context
import Debug.Trace
isLocalURI :: String -> Bool
isLocalURI url = isNothing $ parseURI url
isRemoteURI :: String -> Bool
isRemoteURI = not . isLocalURI
isCacheableURI :: String -> Bool
isCacheableURI url =
case parseURI url of
Just uri -> uriScheme uri `elem` ["http:","https:"]
Nothing -> False
-- | Walks over all images in a Pandoc document and transforms image URLs like
-- this: 1. Remote URLs are not transformed. 2. Absolute URLs are intepreted
-- relative to the project root directory. 3. Relative URLs are intepreted
-- relative to the containing document.
adjustImageUrls :: FilePath -> FilePath -> Pandoc -> Pandoc
adjustImageUrls projectDir baseDir pandoc = walk adjust pandoc
where adjust (Image attr inlines (url,title)) =
(Image attr inlines (adjustLocalUrl projectDir baseDir url,title))
adjust other = other
adjustLocalUrl :: FilePath -> FilePath -> FilePath -> FilePath
adjustLocalUrl root base url
| isLocalURI url =
if isAbsolute url
then root </> makeRelative "/" url
else base </> url
adjustLocalUrl _ _ url = url
cacheRemoteImages :: FilePath -> Pandoc -> IO Pandoc
cacheRemoteImages cacheDir pandoc = walkM cacheRemoteImage pandoc
where cacheRemoteImage (Image attr inlines (url,title)) =
do cachedFile <- cacheRemoteFile cacheDir url
return (Image attr inlines (cachedFile,title))
cacheRemoteImage img = return img
cacheRemoteFile :: FilePath -> String -> IO FilePath
cacheRemoteFile cacheDir url
......
......@@ -7,8 +7,8 @@ module Utilities
markdownToHtmlDeck, markdownToHtmlHandout, markdownToPdfHandout,
markdownToHtmlPage, markdownToPdfPage, writeExampleProject,
metaValueAsString, (<++>), markNeeded, replaceSuffixWith,
writeEmbeddedFiles, getRelativeSupportDir, collectIncludes,
pandocMakePdf, absoluteIncludePath, DeckerException(..))
writeEmbeddedFiles, getRelativeSupportDir,
pandocMakePdf, isCacheableURI, adjustLocalUrl, DeckerException(..))
where
import Control.Monad.Loops
......@@ -205,11 +205,12 @@ writeIndex out baseUrl decks handouts pages =
do let decksLinks = map (makeRelative baseUrl) decks
let handoutsLinks = map (makeRelative baseUrl) handouts
let pagesLinks = map (makeRelative baseUrl) pages
projectDir <- getProjectDir
liftIO $
writeFile out $
unlines ["---"
,"title: Generated Index"
, "subtitle: {{course}} ({{semester}})"
,"subtitle: " ++ projectDir
,"---"
,"# Slide decks"
,unlines $ map makeLink $ sort decksLinks
......@@ -300,9 +301,7 @@ getRelativeSupportDir from =
markdownToHtmlDeck
:: FilePath -> FilePath -> Action ()
markdownToHtmlDeck markdownFile out =
do need [markdownFile]
metaData <- readMetaDataFor markdownFile
supportDir <- getRelativeSupportDir out
do supportDir <- getRelativeSupportDir out
let options =
def {writerStandalone = True
,writerTemplate = deckTemplate
......@@ -314,7 +313,7 @@ markdownToHtmlDeck markdownFile out =
,writerVariables =
[("revealjs-url",supportDir </> "reveal.js")]
,writerCiteMethod = Citeproc}
pandoc <- readAndPreprocessMarkdown metaData markdownFile
pandoc <- readAndPreprocessMarkdown markdownFile
processed <- processPandocDeck "revealjs" pandoc
let images = extractLocalImagePathes processed
copyLocalImages images markdownFile out
......@@ -343,23 +342,19 @@ getPandocWriter format =
_ -> 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
-- template variables and calls need.
readAndPreprocessMarkdown :: FilePath -> Action Pandoc
readAndPreprocessMarkdown markdownFile =
do projectDir <- getProjectDir
let baseDir = takeDirectory markdownFile
includes <- collectIncludes markdownFile
pandoc <- readMetaMarkdown markdownFile metaData
need includes
liftIO $ processIncludes projectDir baseDir metaData pandoc
pandoc <- readMetaMarkdown markdownFile
processIncludes projectDir baseDir pandoc
-- | Write a markdown file to a HTML file using the page template.
markdownToHtmlPage
:: FilePath -> FilePath -> Action ()
markdownToHtmlPage markdownFile out =
do need [markdownFile]
supportDir <- getRelativeSupportDir out
do supportDir <- getRelativeSupportDir out
let options =
def {writerHtml5 = True
,writerStandalone = True
......@@ -370,10 +365,9 @@ markdownToHtmlPage markdownFile out =
KaTeX (supportDir </> "katex/katex.min.js")
(supportDir </> "katex/katex.min.css")
,writerVariables =
[("css",supportDir </> "readable/bootstrap.min.css")]
[("css",supportDir </> "sandstone/bootstrap.min.css")]
,writerCiteMethod = Citeproc}
metaData <- readMetaDataFor markdownFile
pandoc <- readAndPreprocessMarkdown metaData markdownFile
pandoc <- readAndPreprocessMarkdown markdownFile
processed <- processPandocPage "html5" pandoc
let images = extractLocalImagePathes processed
copyLocalImages images markdownFile out
......@@ -383,15 +377,13 @@ markdownToHtmlPage markdownFile out =
markdownToPdfPage
:: FilePath -> FilePath -> Action ()
markdownToPdfPage markdownFile out =
do need [markdownFile]
let options =
do let options =
def {writerStandalone = True
,writerTemplate = pageLatexTemplate
,writerHighlight = True
,writerHighlightStyle = pygments
,writerCiteMethod = Citeproc}
metaData <- readMetaDataFor markdownFile
pandoc <- readAndPreprocessMarkdown metaData markdownFile
pandoc <- readAndPreprocessMarkdown markdownFile
processed <- processPandocPage "latex" pandoc
putNormal $ "# pandoc (for " ++ out ++ ")"
pandocMakePdf options processed out
......@@ -406,9 +398,7 @@ pandocMakePdf options processed out =
markdownToHtmlHandout
:: FilePath -> FilePath -> Action ()
markdownToHtmlHandout markdownFile out =
do need [markdownFile]
metaData <- readMetaDataFor markdownFile
pandoc <- readMetaMarkdown markdownFile metaData
do pandoc <- readAndPreprocessMarkdown markdownFile
processed <- processPandocHandout "html" pandoc
supportDir <- getRelativeSupportDir out
let options =
......@@ -421,7 +411,7 @@ markdownToHtmlHandout markdownFile out =
KaTeX (supportDir </> "katex/katex.min.js")
(supportDir </> "katex/katex.min.css")
,writerVariables =
[("css",supportDir </> "readable/bootstrap.min.css")]
[("css",supportDir </> "sandstone/bootstrap.min.css")]
,writerCiteMethod = Citeproc}
writePandocString "html5" options out processed
......@@ -429,9 +419,7 @@ markdownToHtmlHandout markdownFile out =
markdownToPdfHandout
:: FilePath -> FilePath -> Action ()
markdownToPdfHandout markdownFile out =
do need [markdownFile]
metaData <- readMetaDataFor markdownFile
pandoc <- readMetaMarkdown markdownFile metaData
do pandoc <- readAndPreprocessMarkdown markdownFile
processed <- processPandocHandout "latex" pandoc
let options =
def {writerStandalone = True
......@@ -443,8 +431,16 @@ markdownToPdfHandout markdownFile out =
pandocMakePdf options processed out
readMetaMarkdown
:: FilePath -> Y.Value -> Action Pandoc
readMetaMarkdown markdownFile metaData = liftIO $ readMetaMarkdownIO markdownFile metaData
:: FilePath -> Action Pandoc
readMetaMarkdown markdownFile =
do need [markdownFile]
metaData <- readMetaDataFor markdownFile
pandoc <- liftIO $ readMetaMarkdownIO markdownFile metaData
projectDir <- getProjectDir
return $
walk (adjustImageUrls projectDir
(takeDirectory markdownFile))
pandoc
readMetaMarkdownIO
:: FilePath -> Y.Value -> IO Pandoc
......@@ -456,57 +452,59 @@ readMetaMarkdownIO markdownFile metaData =
Right pandoc -> return pandoc
Left err -> throw $ PandocException (show err)
isLocalURI :: String -> Bool
isLocalURI url = isNothing $ parseURI url
isRemoteURI :: String -> Bool
isRemoteURI = not . isLocalURI
isCacheableURI :: String -> Bool
isCacheableURI url =
case parseURI url of
Just uri -> uriScheme uri `elem` ["http:","https:"]
Nothing -> False
-- | Walks over all images in a Pandoc document and transforms image URLs like
-- this: 1. Remote URLs are not transformed. 2. Absolute URLs are intepreted
-- relative to the project root directory. 3. Relative URLs are intepreted
-- relative to the containing document.
adjustImageUrls :: FilePath -> FilePath -> Pandoc -> Pandoc
adjustImageUrls projectDir baseDir pandoc = walk adjust pandoc
where adjust (Image attr inlines (url,title)) =
(Image attr inlines (adjustLocalUrl projectDir baseDir url,title))
adjust other = other
adjustLocalUrl :: FilePath -> FilePath -> FilePath -> FilePath
adjustLocalUrl root base url
| isLocalURI url =
if isAbsolute url
then root </> makeRelative "/" url
else base </> url
adjustLocalUrl _ _ url = url
cacheRemoteImages :: FilePath -> [FilePath] -> [FilePath] -> Action ()
cacheRemoteImages cacheDir metaFiles markdownFiles =
do mapM_ cacheImages markdownFiles
where cacheImages markdownFile =
do metaData <- readMetaData metaFiles
pandoc <- readMetaMarkdown markdownFile metaData
do pandoc <- readMetaMarkdown markdownFile
_ <- liftIO $ walkM (cachePandocImages cacheDir) pandoc
putNormal $ "# pandoc (cached images for " ++ markdownFile ++ ")"
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 _ blocks =
case readMarkdown def markdown of
Right p -> p
Left e -> throw $ PandocException (show e)
let baseDir = takeDirectory markdownFile
let direct = map (absoluteIncludePath rootDir baseDir) (foldl include [] blocks)
transitive <- mapM (collectIncludesIO rootDir) direct
return $ direct ++ concat transitive
where include :: [FilePath] -> Block -> [FilePath]
include result (Para [Image _ [Str "#include"] (url,_)]) = url : result
include result _ = result
-- Transitively splices all include files into the pandoc document.
processIncludes :: FilePath -> FilePath -> Y.Value -> Pandoc -> IO Pandoc
processIncludes rootDir baseDir metaData (Pandoc meta blocks) =
processIncludes :: FilePath -> FilePath -> Pandoc -> Action Pandoc
processIncludes rootDir baseDir (Pandoc meta blocks) =
do included <- processBlocks baseDir blocks
return $ Pandoc meta included
where processBlocks
:: FilePath -> [Block] -> IO [Block]
:: FilePath -> [Block] -> Action [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
:: FilePath -> [[Block]] -> Block -> Action [[Block]]
include base result (Para [Link _ [Str "#include"] (url,_)]) =
do let filePath = adjustLocalUrl rootDir base url
Pandoc _ b <- readMetaMarkdown filePath
included <-
processBlocks (takeDirectory filePath)
b
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment