Commit 1384cfff authored by Henrik Tramberend's avatar Henrik Tramberend
Browse files

Working on transitive include macro

parent f10e17a0
.DS_Store/
.DS_Store
.stack-work/
TAGS
*.swp
......@@ -9,5 +9,5 @@ index.html
*-deck.html
*-handout.html
*-page.html
.shake/
.shake
public/
import Control.Exception
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.IORef
import Data.List
import Data.Maybe
import Data.String
import Data.Yaml.Pretty
import Development.Shake
import Development.Shake.FilePath
import System.Directory
import System.Exit
import System.FilePath
import System.FilePath.Glob
import qualified Text.Mustache as M
import Text.Mustache.Types (mFromJSON)
import Text.Pandoc
import Text.Printf
import Utilities
import Context
import Control.Exception
import Control.Monad ()
import qualified Data.ByteString.Char8 as B
import Data.IORef ()
import Data.List
import Data.Maybe
import Data.String ()
import Data.Yaml.Pretty
import Development.Shake
import Development.Shake.FilePath
import System.Directory
import System.Exit
import System.FilePath ()
import System.FilePath.Glob
import qualified Text.Mustache as M ()
import Text.Pandoc ()
import Text.Printf ()
import Utilities
import Context
import Embed
main :: IO ()
main = do
......@@ -25,6 +25,7 @@ main = do
projectDir <- calcProjectDirectory
let publicDir = projectDir </> publicDirName
let cacheDir = publicDir </> "cache"
let supportDir = publicDir </> "support"
-- Find sources
deckSources <- glob "**/*-deck.md"
......@@ -32,7 +33,7 @@ main = do
allSources <- glob "**/*.md"
meta <- glob "**/*.yaml"
let plainSources = allSources \\ (deckSources ++ pageSources)
-- let plainSources = allSources \\ (deckSources ++ pageSources)
-- Calculate targets
let decks = targetPathes deckSources projectDir ".md" ".html"
......@@ -41,21 +42,21 @@ main = do
let handoutsPdf = targetPathes deckSources projectDir "-deck.md" "-handout.pdf"
let pages = targetPathes pageSources projectDir ".md" ".html"
let pagesPdf = targetPathes pageSources projectDir ".md" ".pdf"
let plain = targetPathes plainSources projectDir ".md" ".html"
let plainPdf = targetPathes pageSources projectDir ".md" ".pdf"
-- let plain = targetPathes plainSources projectDir ".md" ".html"
-- let plainPdf = targetPathes pageSources projectDir ".md" ".pdf"
let indexSource = projectDir </> "index.md"
let index = publicDir </> "index.html"
let everything = decks ++ handouts ++ pages ++ plain ++ [index]
let everythingPdf = decksPdf ++ handoutsPdf ++ pagesPdf ++ plainPdf
let everything = decks ++ handouts ++ pages ++ [index]
let everythingPdf = decksPdf ++ handoutsPdf ++ pagesPdf
let cruft = [ "index.md.generated"
, "server.log"
, "//.shake"
]
context <- makeActionContext projectDir publicDir cacheDir
context <- makeActionContext projectDir publicDir cacheDir supportDir
runShakeInContext context options $ do
want ["html"]
......@@ -65,15 +66,12 @@ main = do
phony "html" $ do
need $ everything ++ [index]
-- getDecks <++> getHandouts <++> getPages <++> getPlain >>= need
phony "pdf" $ do
need $ pagesPdf ++ handoutsPdf ++ plainPdf ++ [index]
-- getPagesPdf <++> getHandoutsPdf <++> getPlainPdf >>= need
need $ pagesPdf ++ handoutsPdf ++ [index]
phony "pdf-decks" $ do
need $ decksPdf ++ [index]
-- getDecksPdf >>= need
phony "watch" $ do
need ["html"]
......@@ -81,27 +79,28 @@ main = do
phony "server" $ do
need ["watch"]
runHttpServer True
runHttpServer publicDir True
phony "example" writeExampleProject
priority 2 $ "//*-deck.html" %> \out -> do
need ["support"]
let src = sourcePath out projectDir ".html" ".md"
markdownToHtmlDeck src meta out
priority 2 $ "//*-deck.pdf" %> \out -> do
let src = sourcePath out projectDir ".pdf" ".html"
need [src]
runHttpServer False
runHttpServer publicDir False
code <- cmd "decktape.sh reveal" ("http://localhost:8888/" ++ src) out
case code of
ExitFailure _ -> do
cdnBase <- getBaseUrl
throw $ DecktapeException cdnBase
throw $ DecktapeException "Unknown."
ExitSuccess ->
return ()
priority 2 $ "//*-handout.html" %> \out -> do
need ["support"]
let src = sourcePath out projectDir "-handout.html" "-deck.md"
markdownToHtmlHandout src meta out
......@@ -110,6 +109,7 @@ 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
......@@ -120,11 +120,14 @@ main = do
priority 2 $ index %> \out -> do
exists <- Development.Shake.doesFileExist indexSource
let src = if exists then indexSource else indexSource <.> "generated"
putNormal out
rel <- getRelativeSupportDir out
putNormal rel
markdownToHtmlPage src meta out
indexSource <.> "generated" %> \out -> do
need $ decks ++ handouts ++ pages ++ plain
writeIndex out (takeDirectory index) decks handouts pages plain
need $ decks ++ handouts ++ pages
writeIndex out (takeDirectory index) decks handouts pages
"//*.html" %> \out -> do
let src = out -<.> "md"
......@@ -139,7 +142,7 @@ main = do
removeFilesAfter projectDir cruft
phony "help" $
liftIO $ B.putStr helpText
liftIO $ putStr deckerHelpText
phony "plan" $ do
putNormal $ "project directory: " ++ projectDir
......@@ -152,6 +155,9 @@ main = do
value <- readMetaData meta
liftIO $ B.putStr $ encodePretty defConfig value
phony "support" $ do
writeEmbeddedFiles deckerSupportDir supportDir
phony "publish" $ do
need $ everything ++ ["index.html"]
hasResource <- Development.Shake.doesDirectoryExist resourceDir
......
---
theme: htr-slides
author: Henrik Tramberend
transition: linear
title: Decker Slide Tool
date: 15.5.2016
date: '15.5.2016'
subtitle: Tutorial and Examples
theme: 'htr-slides'
title: Decker Slide Tool
transition: linear
---
# Overview
......@@ -20,7 +20,8 @@ subtitle: Tutorial and Examples
## Pandoc-Markdown
- Slides are basically [Pandoc-Markdown](http://pandoc.org) formatted text
- Slides are basically [Pandoc-Markdown](http://pandoc.org) formatted
text
- Pandoc provides a Markdown variant with many extensions
## Some Pandoc extensions
......@@ -36,9 +37,9 @@ subtitle: Tutorial and Examples
## Markdown header
- Level 1 header (`#`) starts new slide
- Level 2 header (`##`) starts a block on a slide
- Level 3 header (`###`) starts new column on a slide
- Level 1 header (`#`) starts new slide
- Level 2 header (`##`) starts a block on a slide
- Level 3 header (`###`) starts new column on a slide
``` {.markdown}
# Episode IV: A new Slide
......@@ -52,7 +53,7 @@ subtitle: Tutorial and Examples
## The author
![](https://tramberend.beuth-hochschule.de/img/htr-beuth.jpg)
![](img/htr-beuth.jpg)
###
......@@ -74,6 +75,12 @@ subtitle: Tutorial and Examples
~~~
```
# Local Images
## Relative path
![](img/06-metal.png){width=75%}
# LaTeX Math
## Syntax
......@@ -82,10 +89,9 @@ subtitle: Tutorial and Examples
- Single \$ encloses inline math
- Double \$\$ encloses a display math block
## Example
- To $\infinity$ and beyond!
- To $\infty$ and beyond!
$$
e = mc^2
......@@ -110,7 +116,6 @@ $$
![:youtube](Wji-BZ0oCwg)
# Compile Time Templating
## Mustache templates
......@@ -158,7 +163,7 @@ $$
## Block styles
- Other block styles include `definition` and `equation`
- Other block styles include `definition` and `equation`
## Definition {.definition}
......@@ -172,8 +177,8 @@ $e=mc^2$
## Slide level
- The slide content becomes part of the speaker notes
- Add `notes` class to slide header
- The slide content becomes part of the speaker notes
- Add `notes` class to slide header
``` {.markdown}
# Slide Level {.notes}
......@@ -185,8 +190,8 @@ $e=mc^2$
## Block level
- Block content becomes part of the speaker notes
- Add `notes` class to level two header
- Block content becomes part of the speaker notes
- Add `notes` class to level two header
``` {.markdown}
## Block level {.notes}
......@@ -196,9 +201,9 @@ $e=mc^2$
# These are just notes {.notes}
Slides with headers that are have the `.notes` class attribute are not included
in the presentation. They are only visible in the handout and probably are
available as presenter notes during slide presentation.
Slides with headers that are have the `.notes` class attribute are not
included in the presentation. They are only visible in the handout and
probably are available as presenter notes during slide presentation.
# Cached Images
......@@ -206,8 +211,8 @@ available as presenter notes during slide presentation.
Remote images can be cached locally
Cache directory is named `img/cached` and is located in the directory of the
referencing document
Cache directory is named `img/cached` and is located in the directory of
the referencing document
`decker cache` scans for and downloads all images
......@@ -215,14 +220,15 @@ referencing document
## Cached remote image
![Some piece of scene graph](http://mmi-rtr.dev/slides/02-jet-engine/img/cube-scene-graph.png)
![Some piece of scene
graph](http://mmi-rtr.dev/slides/02-jet-engine/img/cube-scene-graph.png)
# Meta Data
## Mustache template processor
- Markdown source is processed by [mustache]()
- Data is the union of all available YAML files
- Markdown source is processed by [mustache]()
- Data is the union of all available YAML files
# Meta Data Example
......@@ -247,7 +253,6 @@ total:
Your total score is 42.
```
# `decker` Tool {.section}
# `decker` Tool
......@@ -285,8 +290,8 @@ Your total score is 42.
- `*-deck.html` a *reveal.js* based HTML slide deck
- `*-deck.pdf` a PDF version of that deck
- `*-handout.html` a HTML document containing only the speaker notes from the
deck
- `*-handout.html` a HTML document containing only the speaker notes
from the deck
- `*-handout.pdf` a PDF version of that handout
## Generated from `*-page.md`
......@@ -304,7 +309,8 @@ Your total score is 42.
## `decker`
- Recursively scans the current directory for Markdown files ending in `.md`
- Recursively scans the current directory for Markdown files ending in
`.md`
## `decker clean`
......
......@@ -3,11 +3,12 @@ author: Henrik Tramberend
title: Decker Page
subtitle: {{course}} ({{semester}})
date: 15.5.2016
css: https://bootswatch.com/readable/bootstrap.min.css
---
# Introduction
![#include](/resource/relative.md)
This is just a simple run-of-the-mill document. Use it for exercises and
everything else. This document also has access to the meta data in surrounding
YAML files.
......@@ -26,12 +27,11 @@ This page is published via `rsync` to:
{{rsync-destination.host}}:{{rsync-destination.path}}
Syntax highlighting should be supported, even with the new bootstrap based
Syntax highlighting should be supported, even with the new bootstrap based
styling.
``` {.haskell}
-- | Monadic version of list concatenation.
(<++>) :: Monad m => m [a] -> m [a] -> m [a]
(<++>) = liftM2 (++)
(<++>) = liftM2 (++)
```
## This is a Level 2 Include
Transitive is cool.
Course is {{course}}
## Level 2 Header
*Here be DRAGONS.*
![#include](level-2.md)
This diff is collapsed.
......@@ -15,7 +15,7 @@ cabal-version: >=1.10
library
hs-source-dirs: src
exposed-modules: Context, Utilities, Filter
exposed-modules: Embed, Context, Utilities, Filter
build-depends: base
, pandoc-types
, pandoc-citeproc
......
......@@ -3,15 +3,15 @@
module Context
(ActionContext(..), makeActionContext, setActionContext, getFilesToWatch,
setFilesToWatch, getServerHandle, setServerHandle, getProjectDir,
getPublicDir, getCacheDir, actionContextKey, getActionContext)
getPublicDir, getCacheDir, getSupportDir, actionContextKey, getActionContext)
where
import Control.Monad()
import Control.Monad ()
import Development.Shake
import Data.Dynamic
import Data.Maybe
import Data.Maybe ()
import Data.IORef
import Data.Typeable()
import Data.Typeable ()
import qualified Data.HashMap.Lazy as HashMap
import System.Process
import Text.Printf
......@@ -21,34 +21,37 @@ data ActionContext =
,ctxServerHandle :: IORef (Maybe ProcessHandle)
,ctxProjectDir :: FilePath
,ctxPublicDir :: FilePath
,ctxCacheDir :: FilePath}
,ctxCacheDir :: FilePath
,ctxSupportDir :: FilePath}
deriving (Typeable)
instance Show ActionContext where
show ctx =
printf "ActionContext {ctxProjectDir = %s, ctxPublicDir = %s, ctxCacheDir = %s}"
printf "ActionContext {ctxProjectDir = '%s', ctxPublicDir = '%s', ctxCacheDir = '%s', ctxSupportDir = '%s'}"
(ctxProjectDir ctx)
(ctxPublicDir ctx)
(ctxCacheDir ctx)
(ctxSupportDir ctx)
defaultActionContext :: IO ActionContext
defaultActionContext = do
files <- newIORef []
server <- newIORef Nothing
return $ ActionContext files server "" "" ""
return $ ActionContext files server "" "" "" ""
actionContextKey :: IO TypeRep
actionContextKey = do
ctx <- liftIO $ defaultActionContext
return $ typeOf ctx
makeActionContext :: FilePath -> FilePath -> FilePath -> IO ActionContext
makeActionContext projectDir publicDir cacheDir =
makeActionContext :: FilePath -> FilePath -> FilePath -> FilePath-> IO ActionContext
makeActionContext projectDir publicDir cacheDir supportDir =
do ctx <- defaultActionContext
return $
ctx {ctxProjectDir = projectDir
,ctxPublicDir = publicDir
,ctxCacheDir = cacheDir}
,ctxCacheDir = cacheDir
,ctxSupportDir = supportDir}
setActionContext :: ActionContext -> ShakeOptions -> IO ShakeOptions
setActionContext ctx options =
......@@ -102,3 +105,8 @@ getCacheDir :: Action FilePath
getCacheDir =
do ctx <- getActionContext
return $ ctxCacheDir ctx
getSupportDir :: Action FilePath
getSupportDir =
do ctx <- getActionContext
return $ ctxSupportDir ctx
{-# LANGUAGE TemplateHaskell #-}
module Embed
(deckerHelpText, deckerExampleDir, deckerSupportDir, deckTemplate, pageTemplate,
pageLatexTemplate, handoutTemplate, handoutLatexTemplate)
where
import Data.FileEmbed
import qualified Data.ByteString.Char8 as B
deckerExampleDir :: [(FilePath, B.ByteString)]
deckerExampleDir = $(makeRelativeToProject "resource/example" >>= embedDir)
deckerSupportDir :: [(FilePath, B.ByteString)]
deckerSupportDir = $(makeRelativeToProject "resource/support" >>= embedDir)
deckerHelpText :: String
deckerHelpText =
B.unpack $(makeRelativeToProject "resource/help-page.md" >>= embedFile)
deckTemplate :: String
deckTemplate =
B.unpack $(makeRelativeToProject "resource/deck.html" >>= embedFile)
pageTemplate :: String
pageTemplate =
B.unpack $(makeRelativeToProject "resource/page.html" >>= embedFile)
pageLatexTemplate :: String
pageLatexTemplate =
B.unpack $(makeRelativeToProject "resource/page.tex" >>= embedFile)
handoutTemplate :: String
handoutTemplate =
B.unpack $(makeRelativeToProject "resource/handout.html" >>= embedFile)
handoutLatexTemplate :: String
handoutLatexTemplate =
B.unpack $(makeRelativeToProject "resource/handout.tex" >>= embedFile)
{-# LANGUAGE TemplateHaskell #-}
module Utilities
(cacheRemoteImages, calcProjectDirectory, helpText, spawn,
terminate, threadDelay', wantRepeat, waitForModificationIn,
defaultContext, runShakeInContext, watchFiles,
waitForTwitch, dropSuffix, stopServer, startServer, runHttpServer,
writeIndex, readMetaData, readMetaDataIO, substituteMetaData,
markdownToHtmlDeck, markdownToHtmlHandout, markdownToPdfHandout,
markdownToHtmlPage, markdownToPdfPage, getBaseUrl,
writeExampleProject, metaValueAsString, (<++>), markNeeded,
replaceSuffixWith, DeckerException(..))
(cacheRemoteImages, calcProjectDirectory, spawn, terminate,
threadDelay', wantRepeat, waitForModificationIn, defaultContext,
runShakeInContext, watchFiles, waitForTwitch, dropSuffix,
stopServer, startServer, runHttpServer, writeIndex, readMetaData,
readMetaDataIO, substituteMetaData, markdownToHtmlDeck,
markdownToHtmlHandout, markdownToPdfHandout, markdownToHtmlPage,
markdownToPdfPage, writeExampleProject, metaValueAsString, (<++>),
markNeeded, replaceSuffixWith, writeEmbeddedFiles,
getRelativeSupportDir, DeckerException(..))
where
import Control.Monad.Loops
......@@ -21,7 +19,6 @@ import Development.Shake.FilePath
import Data.Dynamic
import Data.List.Extra
import Data.Maybe
import Data.FileEmbed
import Data.IORef
import qualified Data.Text as T
import Data.Time.Clock
......@@ -52,6 +49,7 @@ import Network.HTTP.Simple
import Network.URI
import Text.Highlighting.Kate.Styles
import Context
import Embed
-- Find the project directory and change current directory to there. The project directory is the first upwards directory that contains a .git directory entry.
calcProjectDirectory :: IO FilePath
......@@ -72,19 +70,17 @@ calcProjectDirectory =
spawn :: String -> Action ProcessHandle
spawn = liftIO . spawnCommand
-- Runs liveroladx on the current directory, if it is not already running. If
-- Runs liveroladx on the given directory, if it is not already running. If
-- open is True a browser window is opended.
runHttpServer open =
do baseUrl <- getBaseUrl
process <- getServerHandle
runHttpServer dir open =
do process <- getServerHandle
case process of
Just handle -> return ()
Nothing ->
do putNormal "# livereloadx (on http://localhost:8888, see server.log)"
putNormal ("# DECKER_RESOURCE_BASE_URL=" ++ baseUrl)
handle <-
liftIO $
spawnCommand "livereloadx -s -p 8888 -d 500 2>&1 > server.log"
spawn $
"livereloadx -s -p 8888 -d 500 " ++ dir ++ " 2>&1 > server.log"
setServerHandle $ Just handle
threadDelay' 200000
when open $ cmd "open http://localhost:8888/" :: Action ()
......@@ -202,22 +198,22 @@ calcTargetPath projectDir suffix with pathes =
return [projectDir </> dropSuffix suffix d ++ with | d <- pathes]
-- | Generates an index.md file with links to all generated files of interest.
writeIndex out baseUrl decks handouts pages plain =
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
let plainLinks = map (makeRelative baseUrl) plain
liftIO $
writeFile out $
unlines ["# Index"
,"## Slide decks"
unlines ["---"
,"title: Generated Index"
, "subtitle: {{course}} ({{semester}})"
,"---"
,"# Slide decks"
,unlines $ map makeLink decksLinks
,"## Handouts"
,"# Handouts"
,unlines $ map makeLink handoutsLinks
,"## Supporting Documents"
,unlines $ map makeLink pagesLinks
,"## Everything else"
,unlines $ map makeLink plainLinks]
,"# Supporting Documents"
,unlines $ map makeLink pagesLinks]
where makeLink path = "- [" ++ takeFileName path ++ "](" ++ path ++ ")"
-- | Decodes an array of YAML files and combines the data into one object.
......@@ -244,34 +240,33 @@ readMetaData files = liftIO $ readMetaDataIO files
-- | Substitutes meta data values in the provided file.
substituteMetaData
:: FilePath -> MT.Value -> Action T.Text
:: FilePath -> MT.Value -> IO T.Text
substituteMetaData source metaData =