mad/byg/src/SiteGenerator.hs

module SiteGenerator (generateSite) where

import Types
import DependencyGenerator

import Data.Text (Text)

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

makeImageHTML :: Token (FilePath, FilePath) -> DepGenM' Text
makeImageHTML t = do
  (thumbnail, actual) <- untupleDepGenM t
  appendTexts
    (inject "<p><a href=\"")
    (appendTexts
      (toText actual)
      (appendTexts
        (inject "\"><img src=\"")
        (appendTexts
          (toText 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
  areImageFilenames <- mapDepGenM hasImageExtension
                       $ unzipSndDepGenM $ mapDepGenM fileComponents dirContents
  imageFilenames <- filterDepGenM areImageFilenames dirContents
  imagePaths <- mapDepGenM (joinPaths dir) imageFilenames
  imagePathsOut <- mapDepGenM (joinPaths recipeDirOut) imageFilenames
  mapDepGenM_ copyFile' $ zipDepGenM imagePaths imagePathsOut
  thumbnailImageFilenames <- mapDepGenM thumbnailImageFilename imageFilenames
  thumbnailImagePaths <- mapDepGenM (joinPaths recipeDirOut) thumbnailImageFilenames
  mapDepGenM_
    (\files -> convertImage files $ inject $ ResizeToWidth 800)
    (zipDepGenM imagePaths thumbnailImagePaths)
  htmlBodyBase <- runPandoc $ joinPaths dir $ inject "ret.md"
  htmlBodyImages <- mapDepGenM makeImageHTML $ zipDepGenM thumbnailImageFilenames imageFilenames
  imagesHtml <- concatTexts htmlBodyImages
  htmlBody <- appendTexts 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
  html <- applyTemplate template $ runPandoc $ inject "om.md"
  aboutDir <- joinPaths outputDir $ inject "om"
  makeDir aboutDir
  saveFile html $ joinPaths aboutDir indexName