decker.hs 7.06 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
main :: IO ()
Henrik Tramberend's avatar
Henrik Tramberend committed
23
main = do
24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48
  projectDir <- calcProjectDirectory
  let publicDir = projectDir </> "public"
  let cacheDir = projectDir </> "cache"
  let supportDir = publicDir </> "support"
  -- 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"
  let indexSource = projectDir </> "index.md"
  let index = publicDir </> "index.html"
  let indexA = return [index] :: Action [FilePath]
  let everythingA = decksA <++> handoutsA <++> pagesA
  let everythingPdfA = decksPdfA <++> handoutsPdfA <++> pagesPdfA
  let cruft =
49 50 51
        map
          (combine projectDir)
          ["index.md.generated", "server.log", "//.shake"]
52 53 54 55 56 57 58 59 60 61 62 63 64 65 66
  context <- makeActionContext projectDir publicDir cacheDir supportDir
  runShakeInContext context options $
  --
    do want ["html"]
       --
       phony "decks" $ do decksA >>= need
       --
       phony "html" $ do everythingA <++> indexA >>= need
       --
       phony "pdf" $ do pagesPdfA <++> handoutsPdfA <++> indexA >>= need
       --
       phony "pdf-decks" $ do decksPdfA <++> indexA >>= need
       --
       phony "watch" $
         do need ["html"]
Henrik Tramberend's avatar
Henrik Tramberend committed
67
            allMarkdownA <++> metaA <++> allImagesA >>= watchFiles
68 69 70
       --
       phony "server" $
         do need ["watch", "support"]
71
            runHttpServer publicDir True
72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
       --
       phony "example" writeExampleProject
       --
       phony "index" $ need [index]
       --
       priority 2 $
         "//*-deck.html" %>
         \out -> do
           src <- calcSource "-deck.html" "-deck.md" out
           markdownToHtmlDeck src out
       --
       priority 2 $
         "//*-deck.pdf" %>
         \out -> do
           let src = replaceSuffix "-deck.pdf" "-deck.html" out
           need [src]
           putNormal $ src ++ " -> " ++ out
           runHttpServer publicDir False
           code <-
             cmd
               "decktape.sh reveal"
               ("http://localhost:8888" </> (makeRelative publicDir src))
               out
           case code of
             ExitFailure _ -> do
               throw $ DecktapeException "Unknown."
             ExitSuccess -> return ()
       --
       priority 2 $
         "//*-handout.html" %>
         \out -> do
           src <- calcSource "-handout.html" "-deck.md" out
           markdownToHtmlHandout src out
       --
       priority 2 $
         "//*-handout.pdf" %>
         \out -> do
           src <- calcSource "-handout.pdf" "-deck.md" out
           markdownToPdfHandout src out
       --
       priority 2 $
         "//*-page.html" %>
         \out -> do
           src <- calcSource "-page.html" "-page.md" out
           markdownToHtmlPage src out
       --
       priority 2 $
         "//*-page.pdf" %>
         \out -> do
           src <- calcSource "-page.pdf" "-page.md" out
           markdownToPdfPage src out
       --
       priority 2 $
         index %>
         \out -> do
           exists <- Development.Shake.doesFileExist indexSource
           let src =
                 if exists
                   then indexSource
                   else indexSource <.> "generated"
           markdownToHtmlPage src out
       --
       indexSource <.> "generated" %>
         \out -> do
           decks <- decksA
           handouts <- handoutsA
           pages <- pagesA
           need $ decks ++ handouts ++ pages
           writeIndex out (takeDirectory index) decks handouts pages
       --
       phony "clean" $
         do removeFilesAfter publicDir ["//"]
144
            removeFilesAfter projectDir cruft
145 146 147 148 149
       --
       phony "help" $ liftIO $ putStr deckerHelpText
       --
       phony "plan" $
         do putNormal $ "project directory: " ++ projectDir
150 151
            putNormal $ "public directory: " ++ publicDir
            putNormal $ "support directory: " ++ supportDir
Henrik Tramberend's avatar
Henrik Tramberend committed
152
            putNormal "meta:"
153
            metaA >>= mapM_ putNormal
154
            putNormal "sources:"
155
            allSourcesA >>= mapM_ putNormal
156
            putNormal "targets:"
157
            everythingA <++> everythingPdfA >>= mapM_ putNormal
158 159 160
       --
       phony "meta" $
         do metaData <- metaA >>= readMetaData
161
            liftIO $ B.putStr $ encodePretty defConfig metaData
162 163 164
       --
       phony "support" $
         do putNormal $ "# write embedded files for (" ++ supportDir ++ ")"
165
            writeEmbeddedFiles deckerSupportDir supportDir
166 167 168
       --
       phony "publish" $
         do need ["support"]
169
            everythingA <++> indexA >>= need
170
            metaData <- readMetaDataForDir projectDir
Henrik Tramberend's avatar
Henrik Tramberend committed
171 172 173
            let host = metaValueAsString "rsync-destination.host" metaData
            let path = metaValueAsString "rsync-destination.path" metaData
            if isJust host && isJust path
174 175 176 177 178 179 180 181
              then do
                let src = publicDir ++ "/"
                let dst = intercalate ":" [fromJust host, fromJust path]
                cmd "ssh " (fromJust host) "mkdir -p" (fromJust path) :: Action ()
                cmd "rsync -a" src dst :: Action ()
              else throw RsyncUrlException

-- Calculate some directories
Henrik Tramberend's avatar
Henrik Tramberend committed
182
-- | Some constants that might need tweaking
183 184 185 186
options =
  shakeOptions
  { shakeFiles = ".shake"
  }
187

188 189
replaceSuffix srcSuffix targetSuffix filename =
  dropSuffix srcSuffix filename ++ targetSuffix
190 191 192

-- | Calculates the target pathes from a list of source files.
calcTargets :: String -> String -> [FilePath] -> Action [FilePath]
193 194 195 196 197 198 199 200
calcTargets srcSuffix targetSuffix sources = do
  projectDir <- getProjectDir
  publicDir <- getPublicDir
  return $
    map
      (replaceSuffix srcSuffix targetSuffix .
       combine publicDir . makeRelative projectDir)
      sources
201 202 203

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