decker.hs 6.89 KB
Newer Older
1
{-- Author: Henrik Tramberend <henrik@tramberend.de> --}
2
import Action
3
import Common
4
import Context
5
6
7
8
9
10
11
12
import Control.Exception
import Control.Monad ()
import Data.IORef ()
import Data.List
import Data.Maybe
import Data.String ()
import Development.Shake
import Development.Shake.FilePath
13
import GHC.Conc (numCapabilities)
14
import Project
15
import Resources
16
17
18
19
20
21
import System.Exit
import System.FilePath ()
import qualified Text.Mustache as M ()
import Text.Pandoc ()
import Text.Printf ()
import Utilities
Henrik Tramberend's avatar
Henrik Tramberend committed
22

23
main :: IO ()
Henrik Tramberend's avatar
Henrik Tramberend committed
24
main = do
25
  extractResources
26
  dirs <- projectDirectories
27
  --
Henrik Tramberend's avatar
Henrik Tramberend committed
28
29
30
  let projectDir = project dirs
  let publicDir = public dirs
  let supportDir = support dirs
31
  let appDataDir = appData dirs
Henrik Tramberend's avatar
Henrik Tramberend committed
32
  let serverPort = 8888
33
  let serverUrl = "http://localhost:" ++ (show serverPort)
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
  -- Find sources. These are formulated as actions in the Action mondad, such
  -- that each new iteration rescans all possible source files.
  let deckSourcesA = globA "**/*-deck.md"
  let pageSourcesA = globA "**/*-page.md"
  let allSourcesA = deckSourcesA <++> pageSourcesA
  let allMarkdownA = globA "**/*.md"
  let allImagesA = globA "**/*.png" <++> globA "**/*.jpg"
  let metaA = globA "**/*-meta.yaml"
  -- Calculate targets
  let decksA = deckSourcesA >>= calcTargets ".md" ".html"
  let decksPdfA = deckSourcesA >>= calcTargets ".md" ".pdf"
  let handoutsA = deckSourcesA >>= calcTargets "-deck.md" "-handout.html"
  let handoutsPdfA = deckSourcesA >>= calcTargets "-deck.md" "-handout.pdf"
  let pagesA = pageSourcesA >>= calcTargets ".md" ".html"
  let pagesPdfA = pageSourcesA >>= calcTargets ".md" ".pdf"
Henrik Tramberend's avatar
Henrik Tramberend committed
49
  let indexSource = project dirs </> "index.md"
50
51
52
53
  let index = publicDir </> "index.html"
  let indexA = return [index] :: Action [FilePath]
  let everythingA = decksA <++> handoutsA <++> pagesA
  let everythingPdfA = decksPdfA <++> handoutsPdfA <++> pagesPdfA
54
  let cruft = ["index.md.generated", "log", "//.shake", "generated"]
55
  context <- makeActionContext dirs
56
57
  runShakeInContext context options $
  --
58
59
   do
    want ["html"]
60
61
62
    --
    phony "version" $ putNormal $ "decker version " ++ deckerVersion
    --
63
64
65
    phony "decks" $ do
      decksA >>= need
      need ["support"]
66
    --
67
68
69
    phony "html" $ do
      everythingA <++> indexA >>= need
      need ["support"]
70
    --
Henrik Tramberend's avatar
Henrik Tramberend committed
71
    phony "pdf" $ pagesPdfA <++> handoutsPdfA <++> indexA >>= need
72
    --
Henrik Tramberend's avatar
Henrik Tramberend committed
73
    phony "pdf-decks" $ decksPdfA <++> indexA >>= need
74
    --
75
76
77
    phony "watch" $ do
      need ["html"]
      allMarkdownA <++> metaA <++> allImagesA >>= watchFiles
78
    --
79
80
    phony "open" $ do
      need ["html"]
81
      openBrowser index
82
    --
83
    phony "server" $ do
84
      need ["watch"]
85
      runHttpServer serverPort dirs Nothing
86
    --
87
    phony "example" writeExampleProject
88
    --
89
    phony "index" $ need [index, "support"]
90
    --
91
92
93
94
    priority 2 $
      "//*-deck.html" %> \out -> do
        src <- calcSource "-deck.html" "-deck.md" out
        markdownToHtmlDeck src out
95
    --
96
97
98
99
100
    priority 2 $
      "//*-deck.pdf" %> \out -> do
        let src = replaceSuffix "-deck.pdf" "-deck.html" out
        need [src]
        putNormal $ src ++ " -> " ++ out
Henrik Tramberend's avatar
Henrik Tramberend committed
101
        runHttpServer serverPort dirs Nothing
102
103
        code <-
          cmd
Henrik Tramberend's avatar
Henrik Tramberend committed
104
            "decktape.sh reveal"
Henrik Tramberend's avatar
Henrik Tramberend committed
105
            (serverUrl </> makeRelative publicDir src)
106
107
            out
        case code of
Henrik Tramberend's avatar
Henrik Tramberend committed
108
          ExitFailure _ -> throw $ DecktapeException "Unknown."
109
          ExitSuccess -> return ()
110
    --
111
112
113
114
    priority 2 $
      "//*-handout.html" %> \out -> do
        src <- calcSource "-handout.html" "-deck.md" out
        markdownToHtmlHandout src out
115
    --
116
117
118
119
    priority 2 $
      "//*-handout.pdf" %> \out -> do
        src <- calcSource "-handout.pdf" "-deck.md" out
        markdownToPdfHandout src out
120
    --
121
122
123
124
    priority 2 $
      "//*-page.html" %> \out -> do
        src <- calcSource "-page.html" "-page.md" out
        markdownToHtmlPage src out
125
    --
126
127
128
129
    priority 2 $
      "//*-page.pdf" %> \out -> do
        src <- calcSource "-page.pdf" "-page.md" out
        markdownToPdfPage src out
130
    --
131
132
133
134
135
136
137
138
    priority 2 $
      index %> \out -> do
        exists <- Development.Shake.doesFileExist indexSource
        let src =
              if exists
                then indexSource
                else indexSource <.> "generated"
        markdownToHtmlPage src out
139
    --
140
141
142
143
144
145
    indexSource <.> "generated" %> \out -> do
      decks <- decksA
      handouts <- handoutsA
      pages <- pagesA
      need $ decks ++ handouts ++ pages
      writeIndex out (takeDirectory index) decks handouts pages
146
    --
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
    priority 2 $
      "//*.dot.svg" %> \out -> do
        let src = dropExtension out
        need [src]
        cmd "dot -Tsvg" ("-o" ++ out) src
    --
    priority 2 $
      "//*.gnuplot.svg" %> \out -> do
        let src = dropExtension out
        need [src]
        cmd
          "gnuplot -d"
          ["-e", "set terminal svg"]
          ["-e", "set output \"" ++ out ++ "\""]
          src
    --
Henrik Tramberend's avatar
Henrik Tramberend committed
163
164
165
166
167
168
169
170
171
172
173
    priority 2 $
      "//*.tex.svg" %> \out -> do
        let src = dropExtension out
        let pdf = src -<.> ".pdf"
        let dir = takeDirectory src
        need [src]
        () <-
          cmd
            "pdflatex -halt-on-error -interaction batchmode"
            ["-output-directory", dir]
            src
Henrik Tramberend's avatar
Henrik Tramberend committed
174
        () <- cmd "pdf2svg" pdf out
Henrik Tramberend's avatar
Henrik Tramberend committed
175
176
        cmd "rm" pdf
    --
177
178
179
    phony "clean" $ do
      removeFilesAfter publicDir ["//"]
      removeFilesAfter projectDir cruft
180
    --
181
182
183
    phony "help" $ do
      text <- liftIO $ getResourceString "template/help-page.md"
      liftIO $ putStr text
184
    --
185
186
187
188
    phony "plan" $ do
      putNormal $ "project directory: " ++ projectDir
      putNormal $ "public directory: " ++ publicDir
      putNormal $ "support directory: " ++ supportDir
189
      putNormal $ "application data directory: " ++ appDataDir
190
191
192
193
194
195
      putNormal "meta:"
      metaA >>= mapM_ putNormal
      putNormal "sources:"
      allSourcesA >>= mapM_ putNormal
      putNormal "targets:"
      everythingA <++> everythingPdfA >>= mapM_ putNormal
196
    --
197
    -- phony "support" $ writeEmbeddedFiles deckerSupportDir supportDir
198
    phony "support" $ do liftIO $ writeResourceFiles "support" supportDir
199
    --
200
201
202
203
204
205
206
207
208
209
210
    phony "publish" $ do
      need ["support"]
      everythingA <++> indexA >>= need
      metaData <- readMetaDataForDir projectDir
      let host = metaValueAsString "rsync-destination.host" metaData
      let path = metaValueAsString "rsync-destination.path" metaData
      if isJust host && isJust path
        then do
          let src = publicDir ++ "/"
          let dst = intercalate ":" [fromJust host, fromJust path]
          cmd "ssh " (fromJust host) "mkdir -p" (fromJust path) :: Action ()
211
212
213
214
          cmd
            "rsync --recursive --no-xattrs --no-group --perms --chmod=a+r,go-w --no-owner --copy-links"
            src
            dst :: Action ()
215
        else throw RsyncUrlException
216
217

-- Calculate some directories
Henrik Tramberend's avatar
Henrik Tramberend committed
218
-- | Some constants that might need tweaking
219
options :: ShakeOptions
220
options = shakeOptions {shakeFiles = ".shake", shakeThreads = numCapabilities}