mad/byg/src/SiteGenerator.hs

module SiteGenerator (generateSite) where

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

import Data.Ord (comparing)
import Data.List (sortBy)
import Data.Function ((&))
import Data.Text (Text)
import qualified Data.Text as T
import Control.Monad (forM_, (<=<))

handleRecipeDir :: Token FilePath -> Token FilePath
                -> Token Template -> Token FilePath
                -> Token FilePath -> DepGenM (Token ((Text, Date), FilePath))
handleRecipeDir recipesDir outputDir htmlTemplate indexName name = do
  dir <- joinPaths recipesDir name
  recipeDirOut <- joinPaths outputDir dir
  makeDir recipeDirOut
  imageFilenames <-
    listDirectory dir
    & filterDepGenM (hasExtension (inject ["jpg"]))
  htmlBodyImages <- forDepGenM imageFilenames $ \filename -> do
    path <- joinPaths dir filename
    path `copyTo` outputDir
    (base, ext) <- untupleDepGenM $ fileComponents filename
    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 filename
                     , inject "\"><img src=\""
                     , onToken T.pack thumbnailName
                     , inject "\"></a></p>\n"
                     ]
  ingredienserHeadline <- inject "## Ingredienser"
  mdTemplate <- makeTemplate
    (readTextFile (joinPaths dir (inject "ret.md")))
    ingredienserHeadline
  pandoc <-
    [ inject "<p class=\"imagetext\">Opskrift fortsætter efter billedet.</p>\n"
    , onToken T.concat htmlBodyImages
    , inject "\n"
    , pure ingredienserHeadline
    ]
    & onToken T.concat
    & applyTemplate mdTemplate
    & readMarkdown
  title <- extractTitle pandoc
  date <- extractDate name
  pandoc' <- injectAfterTitle (onTupleToken T.append
                               (inject "Offentliggjort ")
                               (onToken formatDate date))
             pandoc
  html <-
    pandoc'
    & writeHtml
    & applyTemplate htmlTemplate
  saveTextFile html (joinPaths recipeDirOut indexName)
  pure $ TupleToken (TupleToken title date) dir

handleFontDir :: Token FilePath -> Token FilePath -> DepGenM ()
handleFontDir outputDir dir = do
  makeDir $ joinPaths outputDir dir
  paths <-
    listDirectory dir
    & mapDepGenM (joinPaths dir)
    & filterDepGenM (hasExtension (inject ["woff2", "css"]))
  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 <-
    listDirectory recipesDir
    & filterDepGenM (isDirectory <=< joinPaths recipesDir)
  infos <- mapDepGenM (handleRecipeDir recipesDir outputDir htmlTemplate indexName) recipeSubDirs
  allRecipesHtml <-
    infos
    & onToken (T.append "# Alle retter\n\n"
               . T.intercalate "\n"
               . map (\((t, d), u) -> T.concat ["- ", "[", t, " *(", formatDateShort d, ")*](/", T.pack u, ")"])
               . sortBy (flip (comparing (\((_, d), _) -> d))))
    & markdownToHtml
    & applyTemplate htmlTemplate
  saveTextFile allRecipesHtml (joinPaths outputRecipesDir indexName)

  -- Handle about page
  outputAboutDir <- joinPaths outputDir (inject "om")
  makeDir outputAboutDir
  aboutHtml <-
    inject "om.md"
    & readTextFile
    & markdownToHtml
    & applyTemplate htmlTemplate
  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 <-
    fontsDir
    & listDirectory
    & mapDepGenM (joinPaths fontsDir)
    & filterDepGenM isDirectory
  mapDepGenM_ (handleFontDir outputDir) fontSubDirs