mad/byg/app/SiteGenerator.hs

module SiteGenerator (generateSite) where

import Byg.Types (Token(..), Date(..), formatDate, formatDateShort)
import Byg.DependencyGenerator
import Byg.Functions

import Data.List (sort, elemIndex)
import Data.Function ((&))
import Data.Text (Text)
import qualified Data.Text as T
import Control.Monad (forM_, (<=<))

elemIndex' :: (Show a, Eq a) => a -> [a] -> Int
elemIndex' x xs = case elemIndex x xs of
  Just i -> i
  Nothing -> error ("unexpected unknown directory index for " ++ show x ++ " in " ++ show xs)

head' :: [a] -> a
head' [] = error "error"
head' (x : _) = x

handleRecipeDir :: Token FilePath -> Token FilePath
                -> Token Template -> Token FilePath
                -> Token [FilePath] -> Token FilePath
                -> DepGenM (Token ((Text, Date), FilePath))
handleRecipeDir recipesDir outputDir htmlTemplate indexName recipeSubDirs 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 (
      (onToken T.concat [ inject "<p class=\"date\">Offentliggjort "
                        , onToken formatDate date
                        , inject "</p>"
                        ]))
             pandoc
  dirIndex <- onTupleToken elemIndex' name recipeSubDirs
  prev <- onTupleToken (
    \ds i -> if i < length ds - 1
             then T.concat [ "<a class=\"prev\" href=\"/retter/"
                           , T.pack (ds !! (i + 1))
                           , "\">Forrige</a>"
                           ]
             else "")
          recipeSubDirs dirIndex
  next <- onTupleToken (
    \ds i -> if i > 0
             then T.concat [ "<a class=\"next\" href=\"/retter/"
                           , T.pack (ds !! (i - 1))
                           , "\">Næste</a>"
                           ]
             else "")
          recipeSubDirs dirIndex
  prevnext <- onToken T.concat [ inject "<p class=\"prevnext\">", pure prev, pure next, inject "</p>" ]
  html <-
    pandoc'
    & writeHtml
    & onTupleToken T.append prevnext
    & onTupleToken (flip T.append) prevnext
    & 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
    & onToken (reverse . sort)
    & filterDepGenM (isDirectory <=< joinPaths recipesDir)
  infos <- mapDepGenM (handleRecipeDir recipesDir outputDir htmlTemplate indexName recipeSubDirs) 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, ")"]))
    & markdownToHtml
    & applyTemplate htmlTemplate
  saveTextFile allRecipesHtml (joinPaths outputRecipesDir indexName)

  newest <- onToken (snd . fst . head') infos
  atomText <- generateAtom newest infos
  saveTextFile atomText (joinPaths outputDir (inject "atom.xml"))

  redirectTemplate <- makeTemplate (readTextFile (inject "redirect.html")) (inject "URL")
  newestSlug <- onToken (T.pack . snd . head') infos
  saveTextFile (applyTemplate redirectTemplate newestSlug) (joinPaths outputDir 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