decker.hs 6.96 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
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
Henrik Tramberend's avatar
Henrik Tramberend committed
21

22 23 24 25 26
globA :: FilePattern -> Action [FilePath]
globA pattern =
  do projectDir <- getProjectDir
     liftIO $ globDir1 (compile pattern) projectDir

27
main :: IO ()
Henrik Tramberend's avatar
Henrik Tramberend committed
28
main = do
29 30
    -- Calculate some directories
    projectDir <- calcProjectDirectory
31
    let publicDir = projectDir </> "public"
Henrik Tramberend's avatar
Henrik Tramberend committed
32
    let cacheDir = projectDir </> "cache"
33
    let supportDir = publicDir </> "support"
34

35 36 37 38 39
    -- 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
Henrik Tramberend's avatar
Henrik Tramberend committed
40 41
    let allMarkdownA = globA "**/*.md"
    let allImagesA = globA "**/*.png" <++> globA "**/*.jpg"
Henrik Tramberend's avatar
Henrik Tramberend committed
42

43
    let metaA = globA "**/*-meta.yaml"
44 45

    -- Calculate targets
46 47 48 49 50 51
    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"
52 53 54

    let indexSource = projectDir </> "index.md"
    let index = publicDir </> "index.html"
55
    let indexA = return [index] :: Action [FilePath]
56

57 58
    let everythingA = decksA <++> handoutsA <++> pagesA
    let everythingPdfA = decksPdfA <++> handoutsPdfA <++> pagesPdfA
59

60 61 62 63
    let cruft = map (combine projectDir) [ "index.md.generated"
                                         , "server.log"
                                         , "//.shake"
                                         ]
64

65
    context <- makeActionContext projectDir publicDir cacheDir supportDir
66
    runShakeInContext context options $ do
Henrik Tramberend's avatar
Henrik Tramberend committed
67 68 69

        want ["html"]

70
        phony "decks" $ do
71
            decksA >>= need
72

Henrik Tramberend's avatar
Henrik Tramberend committed
73
        phony "html" $ do
74
            everythingA <++> indexA >>= need
Henrik Tramberend's avatar
Henrik Tramberend committed
75 76

        phony "pdf" $ do
77
            pagesPdfA <++> handoutsPdfA <++> indexA >>= need
Henrik Tramberend's avatar
Henrik Tramberend committed
78 79

        phony "pdf-decks" $ do
80
            decksPdfA <++> indexA >>= need
Henrik Tramberend's avatar
Henrik Tramberend committed
81 82 83

        phony "watch" $ do
            need ["html"]
Henrik Tramberend's avatar
Henrik Tramberend committed
84
            allMarkdownA <++> metaA <++> allImagesA >>= watchFiles
Henrik Tramberend's avatar
Henrik Tramberend committed
85 86

        phony "server" $ do
Henrik Tramberend's avatar
Henrik Tramberend committed
87
            need ["watch", "support"]
88
            runHttpServer publicDir True
Henrik Tramberend's avatar
Henrik Tramberend committed
89 90 91 92

        phony "example" writeExampleProject

        priority 2 $ "//*-deck.html" %> \out -> do
93
            src <- calcSource "-deck.html" "-deck.md" out
Henrik Tramberend's avatar
Henrik Tramberend committed
94
            markdownToHtmlDeck src out
Henrik Tramberend's avatar
Henrik Tramberend committed
95 96

        priority 2 $ "//*-deck.pdf" %> \out -> do
97
            let src = replaceSuffix "-deck.pdf" "-deck.html" out
98
            need [src]
Henrik Tramberend's avatar
Henrik Tramberend committed
99
            putNormal $ src ++ " -> " ++ out
100
            runHttpServer publicDir False
Henrik Tramberend's avatar
Henrik Tramberend committed
101
            code <- cmd "decktape.sh reveal" ("http://localhost:8888" </> (makeRelative publicDir src)) out
Henrik Tramberend's avatar
Henrik Tramberend committed
102 103
            case code of
              ExitFailure _ -> do
104
                 throw $ DecktapeException "Unknown."
Henrik Tramberend's avatar
Henrik Tramberend committed
105 106 107 108
              ExitSuccess ->
                 return ()

        priority 2 $ "//*-handout.html" %> \out -> do
109
            src <- calcSource "-handout.html" "-deck.md" out
Henrik Tramberend's avatar
Henrik Tramberend committed
110
            markdownToHtmlHandout src out
Henrik Tramberend's avatar
Henrik Tramberend committed
111 112

        priority 2 $ "//*-handout.pdf" %> \out -> do
113
            src <- calcSource "-handout.pdf" "-deck.md" out
Henrik Tramberend's avatar
Henrik Tramberend committed
114
            markdownToPdfHandout src out
Henrik Tramberend's avatar
Henrik Tramberend committed
115 116

        priority 2 $ "//*-page.html" %> \out -> do
117
            src <- calcSource "-page.html" "-page.md" out
Henrik Tramberend's avatar
Henrik Tramberend committed
118
            markdownToHtmlPage src out
Henrik Tramberend's avatar
Henrik Tramberend committed
119 120

        priority 2 $ "//*-page.pdf" %> \out -> do
121
            src <- calcSource "-page.pdf" "-page.md" out
Henrik Tramberend's avatar
Henrik Tramberend committed
122
            markdownToPdfPage src out
Henrik Tramberend's avatar
Henrik Tramberend committed
123

124 125 126
        priority 2 $ index %> \out -> do
            exists <- Development.Shake.doesFileExist indexSource
            let src = if exists then indexSource else indexSource <.> "generated"
Henrik Tramberend's avatar
Henrik Tramberend committed
127
            markdownToHtmlPage src out
Henrik Tramberend's avatar
Henrik Tramberend committed
128

129
        indexSource <.> "generated" %> \out -> do
130 131 132
            decks <- decksA
            handouts <- handoutsA
            pages <- pagesA
133
            writeIndex out (takeDirectory index) decks handouts pages
Henrik Tramberend's avatar
Henrik Tramberend committed
134

135 136 137
        phony "clean" $ do
            removeFilesAfter publicDir ["//"]
            removeFilesAfter projectDir cruft
Henrik Tramberend's avatar
Henrik Tramberend committed
138 139

        phony "help" $
140
            liftIO $ putStr deckerHelpText
Henrik Tramberend's avatar
Henrik Tramberend committed
141

142 143
        phony "plan" $ do
            putNormal $ "project directory: " ++ projectDir
144 145
            putNormal $ "public directory: " ++ publicDir
            putNormal $ "support directory: " ++ supportDir
Henrik Tramberend's avatar
Henrik Tramberend committed
146
            putNormal "meta:"
147
            metaA >>= mapM_ putNormal
148
            putNormal "sources:"
149
            allSourcesA >>= mapM_ putNormal
150
            putNormal "targets:"
151
            everythingA <++> everythingPdfA >>= mapM_ putNormal
Henrik Tramberend's avatar
Henrik Tramberend committed
152 153

        phony "meta" $ do
154 155
            metaData <- metaA >>= readMetaData
            liftIO $ B.putStr $ encodePretty defConfig metaData
Henrik Tramberend's avatar
Henrik Tramberend committed
156

157
        phony "support" $ do
Henrik Tramberend's avatar
Henrik Tramberend committed
158
            putNormal $ "# write embedded files for (" ++ supportDir ++ ")"
159 160
            writeEmbeddedFiles deckerSupportDir supportDir

Henrik Tramberend's avatar
Henrik Tramberend committed
161
        phony "publish" $ do
Henrik Tramberend's avatar
Henrik Tramberend committed
162
            need ["support"]
163
            everythingA <++> indexA >>= need
164
            metaData <- readMetaDataForDir projectDir
Henrik Tramberend's avatar
Henrik Tramberend committed
165 166 167 168
            let host = metaValueAsString "rsync-destination.host" metaData
            let path = metaValueAsString "rsync-destination.path" metaData
            if isJust host && isJust path
               then do
169 170
                   let src = publicDir ++ "/"
                   let dst = intercalate ":" [fromJust host, fromJust path]
Henrik Tramberend's avatar
Henrik Tramberend committed
171
                   cmd "ssh " (fromJust host) "mkdir -p" (fromJust path) :: Action ()
172
                   cmd "rsync -a" src dst :: Action ()
Henrik Tramberend's avatar
Henrik Tramberend committed
173 174 175 176
               else throw RsyncUrlException

-- | Some constants that might need tweaking
options = shakeOptions{shakeFiles=".shake"}
177

178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194
replaceSuffix srcSuffix targetSuffix filename = dropSuffix srcSuffix filename ++ targetSuffix

-- | Calculates the target pathes from a list of source files.
calcTargets :: String -> String -> [FilePath] -> Action [FilePath]
calcTargets srcSuffix targetSuffix sources =
  do projectDir <- getProjectDir
     publicDir <- getPublicDir
     return $ map (replaceSuffix srcSuffix targetSuffix . combine publicDir . makeRelative projectDir) sources

-- | Calculate the source file from the target path. Calls need.
calcSource :: String -> String -> FilePath -> Action FilePath
calcSource targetSuffix srcSuffix target =
  do projectDir <- getProjectDir
     publicDir <- getPublicDir
     let src = (replaceSuffix targetSuffix srcSuffix . combine projectDir .  makeRelative publicDir) target
     need [src]
     return src