decker.hs 7.63 KB
Newer Older
1
{-- Author: Henrik Tramberend <henrik@tramberend.de> --}
2
import Action
3
import Common
4
import Context
5
import Control.Exception
6
import Control.Monad (when)
7
import Control.Monad.Extra
8 9 10 11
import Data.IORef ()
import Data.List
import Data.Maybe
import Data.String ()
12
import Debug.Trace
13 14
import Development.Shake
import Development.Shake.FilePath
15
import External
16
import GHC.Conc (numCapabilities)
17
import Project
18
import Resources
19
import System.Directory
20 21
       (copyFile, createDirectoryIfMissing, doesDirectoryExist,
        removeFile)
22
import System.FilePath ()
23
import System.Posix.Files
24
import Text.Groom
25 26 27 28
import qualified Text.Mustache as M ()
import Text.Pandoc ()
import Text.Printf ()
import Utilities
Henrik Tramberend's avatar
Henrik Tramberend committed
29

30
main :: IO ()
Henrik Tramberend's avatar
Henrik Tramberend committed
31
main = do
32
  extractResources
33
  dirs <- projectDirectories
34
  --
Henrik Tramberend's avatar
Henrik Tramberend committed
35 36 37
  let projectDir = project dirs
  let publicDir = public dirs
  let supportDir = support dirs
38
  let appDataDir = appData dirs
Henrik Tramberend's avatar
Henrik Tramberend committed
39
  let serverPort = 8888
40
  let serverUrl = "http://localhost:" ++ (show serverPort)
41 42 43 44 45 46 47 48 49 50 51 52 53 54 55
  -- 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
56
  let indexSource = project dirs </> "index.md"
57 58 59 60
  let index = publicDir </> "index.html"
  let indexA = return [index] :: Action [FilePath]
  let everythingA = decksA <++> handoutsA <++> pagesA
  let everythingPdfA = decksPdfA <++> handoutsPdfA <++> pagesPdfA
61
  let cruft = ["index.md.generated", "log", "//.shake", "generated"]
62
  context <- makeActionContext dirs
Henrik Tramberend's avatar
Henrik Tramberend committed
63
  runShakeInContext context (options projectDir) $
64
  --
65 66
   do
    want ["html"]
67 68 69
    --
    phony "version" $ putNormal $ "decker version " ++ deckerVersion
    --
70 71
    phony "decks" $ do
      need ["support"]
72
      decksA >>= need
73
    --
74 75
    phony "html" $ do
      need ["support"]
76
      everythingA <++> indexA >>= need
77
    --
Henrik Tramberend's avatar
Henrik Tramberend committed
78
    -- phony "pdf" $ pagesPdfA <++> handoutsPdfA <++> indexA >>= need
79
    --
Henrik Tramberend's avatar
Henrik Tramberend committed
80
    -- phony "pdf-decks" $ decksPdfA <++> indexA >>= need
81
    --
82 83 84
    phony "watch" $ do
      need ["html"]
      allMarkdownA <++> metaA <++> allImagesA >>= watchFiles
85
    --
86 87
    phony "open" $ do
      need ["html"]
88
      openBrowser index
89
    --
90
    phony "server" $ do
91
      need ["watch"]
92
      runHttpServer serverPort dirs Nothing
93
    --
94
    phony "example" writeExampleProject
95
    --
96
    phony "index" $ need [index, "support"]
97
    --
98 99 100 101
    priority 2 $
      "//*-deck.html" %> \out -> do
        src <- calcSource "-deck.html" "-deck.md" out
        markdownToHtmlDeck src out
102
    --
103 104 105 106 107
    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
108
        runHttpServer serverPort dirs Nothing
109
        decktape [(serverUrl </> makeRelative publicDir src), out]
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
    priority 2 $
      "//*.dot.svg" %> \out -> do
        let src = dropExtension out
        need [src]
151
        dot [("-o" ++ out), src]
152 153 154 155 156
    --
    priority 2 $
      "//*.gnuplot.svg" %> \out -> do
        let src = dropExtension out
        need [src]
157
        gnuplot ["-e", "set output \"" ++ out ++ "\"", src]
158
    --
Henrik Tramberend's avatar
Henrik Tramberend committed
159 160 161 162 163 164
    priority 2 $
      "//*.tex.svg" %> \out -> do
        let src = dropExtension out
        let pdf = src -<.> ".pdf"
        let dir = takeDirectory src
        need [src]
165 166
        pdflatex ["-output-directory", dir, src]
        pdf2svg [pdf, out]
167
        liftIO $ removeFile pdf
168 169 170 171 172 173
    priority 2 $
      "//*.css" %> \out -> do
        let src = out -<.> ".scss"
        exists <- doesFileExist src
        when exists $ do
          need [src]
174
          sassc [src, out]
Henrik Tramberend's avatar
Henrik Tramberend committed
175
    --
176 177 178
    phony "clean" $ do
      removeFilesAfter publicDir ["//"]
      removeFilesAfter projectDir cruft
179
      when isDevelopmentVersion $ removeFilesAfter appDataDir ["//"]
180
    --
181 182 183
    phony "help" $ do
      text <- liftIO $ getResourceString "template/help-page.md"
      liftIO $ putStr text
184
    --
185
    phony "plan" $ do
186
      metaData <- readMetaDataForDir projectDir
Henrik Tramberend's avatar
Henrik Tramberend committed
187
      putNormal $ "\nproject directory: " ++ projectDir
188 189
      putNormal $ "public directory: " ++ publicDir
      putNormal $ "support directory: " ++ supportDir
190
      putNormal $ "application data directory: " ++ appDataDir
Henrik Tramberend's avatar
Henrik Tramberend committed
191
      putNormal "\nmeta:\n"
192
      metaA >>= mapM_ putNormal
Henrik Tramberend's avatar
Henrik Tramberend committed
193
      putNormal "\nsources:\n"
194
      allSourcesA >>= mapM_ putNormal
Henrik Tramberend's avatar
Henrik Tramberend committed
195
      putNormal "\ntargets:\n"
196
      everythingA <++> everythingPdfA >>= mapM_ putNormal
197 198
      putNormal "\ntop level meta data:\n"
      putNormal $ groom metaData
199
    --
200 201 202 203 204 205 206 207 208 209 210 211 212 213
    phony "support" $ do
      metaData <- readMetaDataForDir projectDir
      unlessM (Development.Shake.doesDirectoryExist supportDir) $ do
        liftIO $ createDirectoryIfMissing True publicDir
        case metaValueAsString "provisioning" metaData of
          Just value
            | value == show SymLink ->
              liftIO $ createSymbolicLink (appDataDir </> "support") supportDir
          Just value
            | value == show Copy ->
              rsync [(appDataDir </> "support/"), supportDir]
          Nothing ->
            liftIO $ createSymbolicLink (appDataDir </> "support") supportDir
          _ -> return ()
214
    --
215 216
    phony "check" checkExternalPrograms
    --
217 218 219 220 221 222 223 224 225 226
    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]
227 228
          ssh [(fromJust host), "mkdir -p", (fromJust path)]
          rsync [src, dst]
229
        else throw RsyncUrlException
230

Henrik Tramberend's avatar
Henrik Tramberend committed
231
-- | Some constants that might need tweaking
Henrik Tramberend's avatar
Henrik Tramberend committed
232 233 234 235 236 237 238 239
options :: FilePath -> ShakeOptions
options projectDir =
  shakeOptions
  { shakeFiles = ".shake"
  -- , shakeColor = True -- TODO: needs at least shake-0.16.0
  , shakeThreads = numCapabilities
  , shakeAbbreviations = [(projectDir ++ "/", "")]
  }