mad/byg/src/SiteGenerator.hs

{-# LANGUAGE OverloadedStrings #-}
module SiteGenerator (generateSite) where

import Types
import DependencyGenerator

thumbnailImageFilename :: Token FilePath -> DepGenM' FilePath
thumbnailImageFilename filename = do
  (base, ext) <- untupleDepGenM (fileComponents filename)
  appendStrings (appendStrings (base, inject "-thumbnail."), ext)

makeImageHTML :: Token (FilePath, FilePath) -> DepGenM' String
makeImageHTML t = do
  (thumbnail, actual) <- untupleDepGenM t
  appendStrings (inject "<p><a href=\"",
                 appendStrings (actual,
                                appendStrings (inject "\"><img src=\"",
                                               appendStrings (thumbnail,
                                                              inject "\"></a></p>"))))

handleRecipeDir :: Token FilePath -> Token Template -> Token FilePath -> Token FilePath -> DepGenM ()
handleRecipeDir outputDir template indexName dir = do
  recipeDirOut <- joinPaths (outputDir, dir)
  makeDir recipeDirOut
  dirContents <- listDirectory dir
  exts <- unzipSndDepGenM (mapDepGenM fileComponents dirContents)
  areImageFilenames <- mapDepGenM isImageExtension exts
  imageFilenames <- filterDepGenM areImageFilenames dirContents
  imagePaths <- mapDepGenM (curry joinPaths dir) imageFilenames
  imagePathsOut <- mapDepGenM (curry joinPaths recipeDirOut) imageFilenames
  mapDepGenM_ copyFile' (ZipToken (imagePaths, imagePathsOut))
  thumbnailImageFilenames <- mapDepGenM thumbnailImageFilename imageFilenames
  thumbnailImagePaths <- mapDepGenM (curry joinPaths recipeDirOut) thumbnailImageFilenames
  mapDepGenM_
    (\files -> convertImage (files, inject $ ResizeToWidth 800))
    (ZipToken (imagePaths, thumbnailImagePaths))
  htmlBodyBase <- runPandoc (joinPaths (dir, inject "ret.md"))
  htmlBodyImages <- mapDepGenM makeImageHTML (ZipToken (thumbnailImageFilenames, imageFilenames))
  imagesHtml <- concatStrings htmlBodyImages
  htmlBody <- appendStrings (htmlBodyBase, imagesHtml)
  html <- applyTemplate (template, htmlBody)
  saveFile (html, joinPaths (recipeDirOut, indexName))

generateSite :: DepGenM ()
generateSite = do
  outputDir <- inject "site"
  makeDir outputDir
  recipesDir <- inject "retter"
  outputRecipesDir <- joinPaths (outputDir, recipesDir)
  makeDir outputRecipesDir
  template <- readTemplate (inject "template.html")
  indexName <- inject "index.html"
  dirContents <- listDirectory recipesDir
  mapDepGenM_ (handleRecipeDir outputRecipesDir template indexName) dirContents
  htmlBody <- runPandoc (inject "om.md")
  html <- applyTemplate (template, htmlBody)
  aboutDir <- joinPaths (outputDir, inject "om")
  makeDir aboutDir
  saveFile (html, joinPaths (aboutDir, indexName))