Skip to content
GitLab
Menu
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
decker
decker
Commits
10e5e168
Commit
10e5e168
authored
Sep 12, 2016
by
Henrik Tramberend
Browse files
Better path handling and cleanup
parent
e8781e10
Changes
17
Hide whitespace changes
Inline
Side-by-side
app/.shake/.shake.database
deleted
100644 → 0
View file @
e8781e10
File deleted
app/.shake/.shake.lock
deleted
100644 → 0
View file @
e8781e10
app/decker.hs
View file @
10e5e168
...
...
@@ -17,80 +17,82 @@ import Text.Mustache.Types (mFromJSON)
import
Text.Pandoc
import
Text.Printf
import
Utilities
import
Context
-- | All observable source files that are considered. These are specified in
-- the Action monad, such that they are revealuated on each iteration of the *watch* target.
getDeckSources
=
globRelative
"**/*-deck.md"
getPageSources
=
globRelative
"**/*-page.md"
getAllSources
=
globRelative
"**/*.md"
-- | Calculates all plain markdown files ending just in `*.md`.
getPlainSources
=
do
all
<-
getAllSources
decks
<-
getDeckSources
pages
<-
getPageSources
return
$
all
\\
(
decks
++
pages
)
-- | Returns all YAML files.
getMeta
=
globRelative
"**/*.yaml"
-- | Actions that generate lists of target files from the source list actions
getDecks
=
getDeckSources
>>=
replaceSuffixWith
".md"
".html"
getDecksPdf
=
getDeckSources
>>=
replaceSuffixWith
".md"
".pdf"
getHandouts
=
getDeckSources
>>=
replaceSuffixWith
"-deck.md"
"-handout.html"
getHandoutsPdf
=
getDeckSources
>>=
replaceSuffixWith
"-deck.md"
"-handout.pdf"
getPages
=
getPageSources
>>=
replaceSuffixWith
".md"
".html"
getPagesPdf
=
getPageSources
>>=
replaceSuffixWith
".md"
".pdf"
getPlain
=
getPlainSources
>>=
replaceSuffixWith
".md"
".html"
getPlainPdf
=
getPlainSources
>>=
replaceSuffixWith
".md"
".pdf"
getEverything
=
getDecks
<++>
getHandouts
<++>
getPages
<++>
getPlain
getEverythingPdf
=
getDecksPdf
<++>
getHandoutsPdf
<++>
getPagesPdf
<++>
getPlain
-- | Stuff that will be deleted by the clean target
getCruft
=
return
[
"index.md.generated"
,
"index.html"
,
"server.log"
]
main
::
IO
()
main
=
do
contextRef
<-
newIORef
defaultContext
runShakeInContext
contextRef
options
$
do
-- Calculate some directories
projectDir
<-
calcProjectDirectory
let
publicDir
=
projectDir
</>
publicDirName
let
cacheDir
=
publicDir
</>
"cache"
-- Find sources
deckSources
<-
glob
"**/*-deck.md"
pageSources
<-
glob
"**/*-page.md"
allSources
<-
glob
"**/*.md"
meta
<-
glob
"**/*.yaml"
let
plainSources
=
allSources
\\
(
deckSources
++
pageSources
)
-- Calculate targets
let
decks
=
targetPathes
deckSources
projectDir
".md"
".html"
let
decksPdf
=
targetPathes
deckSources
projectDir
".md"
".pdf"
let
handouts
=
targetPathes
deckSources
projectDir
"-deck.md"
"-handout.html"
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
indexSource
=
projectDir
</>
"index.md"
let
index
=
publicDir
</>
"index.html"
let
everything
=
decks
++
handouts
++
pages
++
plain
++
[
index
]
let
everythingPdf
=
decksPdf
++
handoutsPdf
++
pagesPdf
++
plainPdf
let
cruft
=
[
"index.md.generated"
,
"server.log"
,
"//.shake"
]
context
<-
makeActionContext
projectDir
publicDir
cacheDir
runShakeInContext
context
options
$
do
want
[
"html"
]
phony
"decks"
$
do
need
decks
phony
"html"
$
do
need
[
"index.html"
]
getDecks
<++>
getHandouts
<++>
getPages
<++>
getPlain
>>=
need
need
$
everything
++
[
index
]
--
getDecks <++> getHandouts <++> getPages <++> getPlain >>= need
phony
"pdf"
$
do
need
[
"index.html"
]
getPagesPdf
<++>
getHandoutsPdf
<++>
getPlainPdf
>>=
need
need
$
pagesPdf
++
handoutsPdf
++
plainPdf
++
[
index
]
--
getPagesPdf <++> getHandoutsPdf <++> getPlainPdf >>= need
phony
"pdf-decks"
$
do
need
[
"index.html"
]
getDecksPdf
>>=
need
need
$
decksPdf
++
[
index
]
--
getDecksPdf >>= need
phony
"watch"
$
do
need
[
"html"
]
getDecks
<++>
getHandouts
<++>
getPages
<++>
getPlain
>>=
markNeeded
sources
<-
getAllSources
meta
<-
getMeta
watchFiles
(
sources
++
meta
)
contextRef
watchFiles
$
allSources
++
meta
phony
"server"
$
do
need
[
"watch"
]
runHttpServer
contextRef
True
runHttpServer
True
phony
"example"
writeExampleProject
priority
2
$
"//*-deck.html"
%>
\
out
->
do
let
src
=
out
-<.>
"md"
meta
<-
getMeta
let
src
=
sourcePath
out
projectDir
".html"
".md"
markdownToHtmlDeck
src
meta
out
priority
2
$
"//*-deck.pdf"
%>
\
out
->
do
let
src
=
out
-<.>
"html"
let
src
=
sourcePath
out
projectDir
".pdf"
"
.
html"
need
[
src
]
runHttpServer
contextRef
False
runHttpServer
False
code
<-
cmd
"decktape.sh reveal"
(
"http://localhost:8888/"
++
src
)
out
case
code
of
ExitFailure
_
->
do
...
...
@@ -100,71 +102,60 @@ main = do
return
()
priority
2
$
"//*-handout.html"
%>
\
out
->
do
let
src
=
dropSuffix
"-handout.html"
out
++
"-deck.md"
meta
<-
getMeta
let
src
=
sourcePath
out
projectDir
"-handout.html"
"-deck.md"
markdownToHtmlHandout
src
meta
out
priority
2
$
"//*-handout.pdf"
%>
\
out
->
do
let
src
=
dropSuffix
"-handout.pdf"
out
++
"-deck.md"
meta
<-
getMeta
let
src
=
sourcePath
out
projectDir
"-handout.pdf"
"-deck.md"
markdownToPdfHandout
src
meta
out
priority
2
$
"//*-page.html"
%>
\
out
->
do
let
src
=
dropSuffix
"-page.html"
out
++
"-page.md"
meta
<-
getMeta
let
src
=
sourcePath
out
projectDir
"-page.html"
"-page.md"
markdownToHtmlPage
src
meta
out
priority
2
$
"//*-page.pdf"
%>
\
out
->
do
let
src
=
dropSuffix
"-page.pdf"
out
++
"-page.md"
meta
<-
getMeta
let
src
=
sourcePath
out
projectDir
"-page.pdf"
"-page.md"
markdownToPdfPage
src
meta
out
priority
2
$
"index.html"
%>
\
out
->
do
exists
<-
Development
.
Shake
.
doesFileExist
"index.md"
let
src
=
if
exists
then
"index.md"
else
"index.md.generated"
meta
<-
getMeta
priority
2
$
index
%>
\
out
->
do
exists
<-
Development
.
Shake
.
doesFileExist
indexSource
let
src
=
if
exists
then
indexSource
else
indexSource
<.>
"generated"
markdownToHtmlPage
src
meta
out
"index.md.generated"
%>
\
out
->
do
decks
<-
getDecks
handouts
<-
getHandouts
pages
<-
getPages
plain
<-
getPlain
indexSource
<.>
"generated"
%>
\
out
->
do
need
$
decks
++
handouts
++
pages
++
plain
writeIndex
out
decks
handouts
pages
plain
writeIndex
out
(
takeDirectory
index
)
decks
handouts
pages
plain
"//*.html"
%>
\
out
->
do
let
src
=
out
-<.>
"md"
meta
<-
getMeta
markdownToHtmlPage
src
meta
out
"//*.pdf"
%>
\
out
->
do
let
src
=
out
-<.>
"md"
meta
<-
getMeta
markdownToPdfPage
src
meta
out
phony
"clean"
$
getEverything
<++>
getEverythingPdf
<++>
getCruft
>>=
removeFilesAfter
"."
phony
"clean"
$
do
removeFilesAfter
publicDir
[
"//"
]
removeFilesAfter
projectDir
cruft
phony
"help"
$
liftIO
$
B
.
putStr
helpText
phony
"source"
$
do
source
<-
getAllSources
meta
<-
getMeta
liftIO
$
mapM_
putStrLn
$
source
++
meta
phony
"plan"
$
do
putNormal
$
"project directory: "
++
projectDir
putNormal
"sources:"
mapM_
putNormal
$
allSources
++
meta
putNormal
"targets:"
mapM_
putNormal
$
everything
++
everythingPdf
phony
"meta"
$
do
meta
<-
getMeta
value
<-
readMetaData
meta
liftIO
$
B
.
putStr
$
encodePretty
defConfig
value
phony
"publish"
$
do
everything
<-
getEverything
need
everything
need
$
everything
++
[
"index.html"
]
hasResource
<-
Development
.
Shake
.
doesDirectoryExist
resourceDir
let
source
=
if
hasResource
then
resourceDir
:
everything
else
everything
meta
<-
getMeta
metaData
<-
readMetaData
meta
let
host
=
metaValueAsString
"rsync-destination.host"
metaData
let
path
=
metaValueAsString
"rsync-destination.path"
metaData
...
...
@@ -174,16 +165,42 @@ main = do
cmd
"rsync -a"
source
$
intercalate
":"
[
fromJust
host
,
fromJust
path
]
::
Action
()
else
throw
RsyncUrlException
phony
"cache"
$
getAllSources
>>=
mapM_
cacheImages
phony
"cache"
$
cacheRemoteImages
cacheDir
meta
allSources
phony
"clean-cache"
$
do
need
[
"clean"
]
removeFilesAfter
"."
[
"**/cached"
]
phony
"self-test"
$
do
ctx
<-
getActionContext
putNormal
$
show
ctx
-- | Glob for pathes below and relative to the current directory.
globRelative
::
String
->
Action
[
FilePath
]
globRelative
pat
=
liftIO
$
glob
pat
>>=
mapM
makeRelativeToCurrentDirectory
-- | Glob for pathes below and relative to the current directory.
globRelativeIO
::
String
->
IO
[
FilePath
]
globRelativeIO
pat
=
glob
pat
>>=
mapM
makeRelativeToCurrentDirectory
-- | Some constants that might need tweaking
resourceDir
=
"img"
options
=
shakeOptions
{
shakeFiles
=
".shake"
}
publicDirName
::
String
publicDirName
=
"public"
targetPath
::
FilePath
->
FilePath
->
String
->
String
->
FilePath
targetPath
source
projectDir
srcSuffix
targetSuffix
=
let
target
=
projectDir
</>
publicDirName
</>
(
makeRelative
projectDir
source
)
in
dropSuffix
srcSuffix
target
++
targetSuffix
targetPathes
::
[
FilePath
]
->
FilePath
->
String
->
String
->
[
FilePath
]
targetPathes
sources
projectDir
srcSuffix
targetSuffix
=
[
targetPath
s
projectDir
srcSuffix
targetSuffix
|
s
<-
sources
]
sourcePath
::
FilePath
->
FilePath
->
String
->
String
->
FilePath
sourcePath
out
projectDir
targetSuffix
srcSuffix
=
let
source
=
projectDir
</>
(
makeRelative
(
projectDir
</>
publicDirName
)
out
)
in
dropSuffix
targetSuffix
source
++
srcSuffix
resource/.shake/.shake.database
deleted
100644 → 0
View file @
e8781e10
File deleted
resource/.shake/.shake.lock
deleted
100644 → 0
View file @
e8781e10
resource/example/.shake/.shake.database
deleted
100644 → 0
View file @
e8781e10
File deleted
resource/example/.shake/.shake.lock
deleted
100644 → 0
View file @
e8781e10
resource/example/example-deck.md
View file @
10e5e168
...
...
@@ -52,13 +52,13 @@ subtitle: Tutorial and Examples
## The author


###
## Slide source
```
{.markdown}
```
{.markdown}
# Multicolumn slides
## The author
...
...
@@ -283,7 +283,7 @@ Your total score is 42.
## Generated from `*-deck.md`
- `*-deck.html` a *reveal.js* based HTML slide deck
- `*-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
...
...
resource/example/example-meta.yaml
View file @
10e5e168
---
rsync-destination
:
rsync-destination
:
host
:
tramberend@tramberend.beuth-hochschule.de
path
:
/var/www/html/internal/lehre/16-ws/bmi-cgg
sometext
:
Some random text.
course
:
Real-Time Rendering
semester
:
Winter
2016
structured
:
structured
:
-
First
-
Second
-
Third
-
Fourth
date
:
14.5.2016
csl
:
chicago-author-date.csl
...
resource/example/index.md.generated
deleted
100644 → 0
View file @
e8781e10
# Index
## Slide decks
- [example-deck.html](example-deck.html)
## Handouts
- [example-handout.html](example-handout.html)
## Supporting Documents
- [example-page.html](example-page.html)
## Everything else
resource/support/reveal.js/plugin/markdown/example.html
deleted
100644 → 0
View file @
e8781e10
<!doctype html>
<html
lang=
"en"
>
<head>
<meta
charset=
"utf-8"
>
<title>
reveal.js - Markdown Demo
</title>
<link
rel=
"stylesheet"
href=
"../../css/reveal.css"
>
<link
rel=
"stylesheet"
href=
"../../css/theme/white.css"
id=
"theme"
>
<link
rel=
"stylesheet"
href=
"../../lib/css/zenburn.css"
>
</head>
<body>
<div
class=
"reveal"
>
<div
class=
"slides"
>
<!-- Use external markdown resource, separate slides by three newlines; vertical slides by two newlines -->
<section
data-markdown=
"example.md"
data-separator=
"^\n\n\n"
data-separator-vertical=
"^\n\n"
></section>
<!-- Slides are separated by three dashes (quick 'n dirty regular expression) -->
<section
data-markdown
data-separator=
"---"
>
<script
type=
"text/template"
>
##
Demo
1
Slide
1
---
##
Demo
1
Slide
2
---
##
Demo
1
Slide
3
</script>
</section>
<!-- Slides are separated by newline + three dashes + newline, vertical slides identical but two dashes -->
<section
data-markdown
data-separator=
"^\n---\n$"
data-separator-vertical=
"^\n--\n$"
>
<script
type=
"text/template"
>
##
Demo
2
Slide
1.1
--
##
Demo
2
Slide
1.2
---
##
Demo
2
Slide
2
</script>
</section>
<!-- No "extra" slides, since there are no separators defined (so they'll become horizontal rulers) -->
<section
data-markdown
>
<script
type=
"text/template"
>
A
---
B
---
C
</script>
</section>
<!-- Slide attributes -->
<section
data-markdown
>
<script
type=
"text/template"
>
<!--
.
slide
:
data
-
background
=
"
#000000
"
-->
##
Slide
attributes
</script>
</section>
<!-- Element attributes -->
<section
data-markdown
>
<script
type=
"text/template"
>
##
Element
attributes
-
Item
1
<!--
.
element
:
class
=
"
fragment
"
data
-
fragment
-
index
=
"
2
"
-->
-
Item
2
<!--
.
element
:
class
=
"
fragment
"
data
-
fragment
-
index
=
"
1
"
-->
</script>
</section>
<!-- Code -->
<section
data-markdown
>
<script
type=
"text/template"
>
```php
public function foo()
{
$foo = array(
'bar' => 'bar'
)
}
```
</script>
</section>
</div>
</div>
<script
src=
"../../lib/js/head.min.js"
></script>
<script
src=
"../../js/reveal.js"
></script>
<script>
Reveal
.
initialize
({
controls
:
true
,
progress
:
true
,
history
:
true
,
center
:
true
,
// Optional libraries used to extend on reveal.js
dependencies
:
[
{
src
:
'
../../lib/js/classList.js
'
,
condition
:
function
()
{
return
!
document
.
body
.
classList
;
}
},
{
src
:
'
marked.js
'
,
condition
:
function
()
{
return
!!
document
.
querySelector
(
'
[data-markdown]
'
);
}
},
{
src
:
'
markdown.js
'
,
condition
:
function
()
{
return
!!
document
.
querySelector
(
'
[data-markdown]
'
);
}
},
{
src
:
'
../highlight/highlight.js
'
,
async
:
true
,
callback
:
function
()
{
hljs
.
initHighlightingOnLoad
();
}
},
{
src
:
'
../notes/notes.js
'
}
]
});
</script>
</body>
</html>
resource/support/reveal.js/plugin/markdown/example.md
deleted
100644 → 0
View file @
e8781e10
# Markdown Demo
## External 1.1
Content 1.1
Note: This will only appear in the speaker notes window.
## External 1.2
Content 1.2
## External 2
Content 2.1
## External 3.1
Content 3.1
## External 3.2
Content 3.2
slides.cabal
View file @
10e5e168
...
...
@@ -15,7 +15,7 @@ cabal-version: >=1.10
library
hs-source-dirs: src
exposed-modules: Utilities, Filter
exposed-modules:
Context,
Utilities, Filter
build-depends: base
, pandoc-types
, pandoc-citeproc
...
...
@@ -61,6 +61,7 @@ executable decker
, pandoc
, yaml
, mustache
, io-memoize
default-language: Haskell2010
executable include-pandoc-filter
...
...
src/context.hs
0 → 100644
View file @
10e5e168
{-# LANGUAGE DeriveDataTypeable #-}
module
Context
(
ActionContext
(
..
),
makeActionContext
,
setActionContext
,
getFilesToWatch
,
setFilesToWatch
,
getServerHandle
,
setServerHandle
,
getProjectDir
,
getPublicDir
,
getCacheDir
,
actionContextKey
,
getActionContext
)
where
import
Control.Monad
()
import
Development.Shake
import
Data.Dynamic
import
Data.Maybe
import
Data.IORef
import
Data.Typeable
()
import
qualified
Data.HashMap.Lazy
as
HashMap
import
System.Process
import
Text.Printf
data
ActionContext
=
ActionContext
{
ctxFilesToWatch
::
IORef
[
FilePath
]
,
ctxServerHandle
::
IORef
(
Maybe
ProcessHandle
)
,
ctxProjectDir
::
FilePath
,
ctxPublicDir
::
FilePath
,
ctxCacheDir
::
FilePath
}
deriving
(
Typeable
)
instance
Show
ActionContext
where
show
ctx
=
printf
"ActionContext {ctxProjectDir = %s, ctxPublicDir = %s, ctxCacheDir = %s}"
(
ctxProjectDir
ctx
)
(
ctxPublicDir
ctx
)
(
ctxCacheDir
ctx
)
defaultActionContext
::
IO
ActionContext
defaultActionContext
=
do
files
<-
newIORef
[]
server
<-
newIORef
Nothing
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
=
do
ctx
<-
defaultActionContext
return
$
ctx
{
ctxProjectDir
=
projectDir
,
ctxPublicDir
=
publicDir
,
ctxCacheDir
=
cacheDir
}
setActionContext
::
ActionContext
->
ShakeOptions
->
IO
ShakeOptions
setActionContext
ctx
options
=
do
key
<-
liftIO
$
actionContextKey
let
extra
=
HashMap
.
insert
key
(
toDyn
ctx
)
$
HashMap
.
empty
return
options
{
shakeExtra
=
extra
}
getActionContext
::
Action
ActionContext
getActionContext
=
do
options
<-
getShakeOptions
key
<-
liftIO
$
actionContextKey
let
extra
=
shakeExtra
options
let
dyn
=
case
HashMap
.
lookup
key
extra
of
Just
d
->
d
Nothing
->
error
"Error looking up action context"
return
$
case
fromDynamic
dyn
of
Just
d
->
d
Nothing
->
error
"Error upcasting action context"
getFilesToWatch
::
Action
[
FilePath
]
getFilesToWatch
=
do
ctx
<-
getActionContext
liftIO
$
readIORef
$
ctxFilesToWatch
ctx
setFilesToWatch
::
[
FilePath
]
->
Action
()
setFilesToWatch
files
=
do
ctx
<-
getActionContext
liftIO
$
writeIORef
(
ctxFilesToWatch
ctx
)
files
getServerHandle
::
Action
(
Maybe
ProcessHandle
)
getServerHandle
=
do
ctx
<-
getActionContext
liftIO
$
readIORef
$
ctxServerHandle
ctx
setServerHandle
::
Maybe
ProcessHandle
->
Action
()
setServerHandle
handle
=
do
ctx
<-
getActionContext
liftIO
$
writeIORef
(
ctxServerHandle
ctx
)
handle
getProjectDir
::
Action
FilePath
getProjectDir
=
do
ctx
<-
getActionContext
return
$
ctxProjectDir
ctx
getPublicDir
::
Action
FilePath
getPublicDir
=
do
ctx
<-
getActionContext
return
$
ctxPublicDir
ctx
getCacheDir
::
Action
FilePath
getCacheDir
=
do
ctx
<-
getActionContext
return
$
ctxCacheDir
ctx
src/filter.hs
View file @
10e5e168
...
...
@@ -2,7 +2,7 @@
module
Filter