mad/byg/src/SiteGenerator.hs

module SiteGenerator (generateSite) where

import Types (Token(..))
import DependencyGenerator
import Functions

import Data.Text (Text)
import qualified Data.Text as T
import Control.Monad (forM_)

handleRecipeDir :: Token FilePath -> Token Template -> Token FilePath -> Token FilePath -> DepGenM (Token (Text, FilePath))
handleRecipeDir outputDir htmlTemplate indexName dir = do
  recipeDirOut <- joinPaths outputDir dir
  makeDir recipeDirOut
  imageFilenames <- filterDepGenM (hasExtension (inject ["jpg"]))
                    $ listDirectory dir
  htmlBodyImages <- forDepGenM imageFilenames $ \name -> do
    path <- joinPaths dir name
    path `copyTo` outputDir
    (base, ext) <- untupleDepGenM $ fileComponents name
    thumbnailName <- onToken concat [ pure base, inject "-thumbnail.", pure ext ]
    imageResized <- convertImage (openImage path) (inject (ResizeToWidth 800))
    saveImage imageResized (joinPaths recipeDirOut thumbnailName)
    onToken T.concat [ inject "<p class=\"image\"><a href=\""
                     , onToken T.pack name
                     , inject "\"><img src=\""
                     , onToken T.pack thumbnailName
                     , inject "\"></a></p>\n"
                     ]
  ingredienserHeadline <- inject "## Ingredienser"
  mdTemplate <- makeTemplate
    (readTextFile (joinPaths dir (inject "ret.md")))
    ingredienserHeadline
  pandoc <- readMarkdown
            $ applyTemplate mdTemplate
            $ onToken T.concat [ inject "<p class=\"imagetext\">Opskrift fortsætter efter billedet.</p>\n"
                               , onToken T.concat htmlBodyImages
                               , inject "\n"
                               , pure ingredienserHeadline
                               ]
  title <- extractTitle pandoc
  html <- applyTemplate htmlTemplate
          $ writeHtml pandoc
  saveTextFile html (joinPaths recipeDirOut indexName)
  pure $ TupleToken title dir

handleFontDir :: Token FilePath -> Token FilePath -> DepGenM ()
handleFontDir outputDir dir = do
  makeDir $ joinPaths outputDir dir
  paths <- filterDepGenM (hasExtension (inject ["woff2", "css"]))
           $ mapDepGenM (joinPaths dir)
           $ listDirectory dir
  mapDepGenM_ (`copyTo` outputDir) paths

generateSite :: DepGenM ()
generateSite = do
  outputDir <- inject "site"
  makeDir outputDir
  htmlTemplate <- makeTemplate (readTextFile (inject "template.html")) (inject "CONTENT")
  indexName <- inject "index.html"

  -- Handle recipes
  recipesDir <- inject "retter"
  outputRecipesDir <- joinPaths outputDir recipesDir
  makeDir $ outputRecipesDir
  recipeSubDirs <- filterDepGenM isDirectory
                   $ mapDepGenM (joinPaths recipesDir)
                   $ listDirectory recipesDir
  infos <- mapDepGenM (handleRecipeDir outputDir htmlTemplate indexName) recipeSubDirs
  allRecipesHtml <- applyTemplate htmlTemplate
                    $ writeHtml
                    $ readMarkdown
                    $ onToken (T.append "# Alle retter\n\n" . T.intercalate "\n" . map (\(t, u) -> T.concat ["- ", "[", t, "](/", T.pack u, ")"])) infos
  saveTextFile allRecipesHtml (joinPaths outputRecipesDir indexName)

  -- Handle about page
  outputAboutDir <- joinPaths outputDir (inject "om")
  makeDir outputAboutDir
  aboutHtml <- applyTemplate htmlTemplate
               $ writeHtml
               $ readMarkdown
               $ readTextFile
               $ inject "om.md"
  saveTextFile aboutHtml (joinPaths outputAboutDir indexName)

  -- Handle style
  inject "style.css" `copyTo` outputDir

  -- Handle images
  imgDir <- inject "img"
  makeDir $ joinPaths outputDir imgDir
  forM_ ["mad-icon.png", "mad-logo.png"] $ \name ->
    joinPaths imgDir (inject name) `copyTo` outputDir

  -- Handle fonts
  fontsDir <- inject "fonts"
  makeDir $ joinPaths outputDir fontsDir
  fontSubDirs <- filterDepGenM isDirectory
                 $ mapDepGenM (joinPaths fontsDir)
                 $ listDirectory fontsDir
  mapDepGenM_ (handleFontDir outputDir) fontSubDirs