module SiteGenerator (generateSite) where import Types (Token(..), Date(..), formatDate, formatDateShort) import DependencyGenerator import 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 "

\n" ] ingredienserHeadline <- inject "## Ingredienser" mdTemplate <- makeTemplate (readTextFile (joinPaths dir (inject "ret.md"))) ingredienserHeadline pandoc <- [ inject "

Opskrift fortsætter efter billedet.

\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 "

Offentliggjort " , onToken formatDate date , inject "

" ])) pandoc dirIndex <- onTupleToken elemIndex' name recipeSubDirs prev <- onTupleToken ( \ds i -> if i < length ds - 1 then T.concat [ "Forrige" ] else "") recipeSubDirs dirIndex next <- onTupleToken ( \ds i -> if i > 0 then T.concat [ "Næste" ] else "") recipeSubDirs dirIndex prevnext <- onToken T.concat [ inject "

", pure prev, pure next, inject "

" ] 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