100 lines
3.7 KiB
Haskell
100 lines
3.7 KiB
Haskell
module SiteGenerator (generateSite) where
|
|
|
|
import Prelude hiding (String, FilePath)
|
|
|
|
import Types
|
|
import DependencyGenerator
|
|
import Function
|
|
import FunctionIO
|
|
|
|
import Control.Monad (forM_)
|
|
|
|
copyTo :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGenM ()
|
|
copyTo path targetDir = do
|
|
pathToken <- toToken path
|
|
copyFile pathToken =<< joinPaths targetDir pathToken
|
|
|
|
hasExtension :: (TokenableTo [String] a, TokenableTo FilePath b) => a -> b -> DepGenM (Token Bool)
|
|
hasExtension exts filename = do
|
|
ext <- lowerString =<< untupleSndDepGenM =<< fileComponents filename
|
|
ext `elemOf'` exts
|
|
|
|
handleRecipeDir :: Token FilePath -> Token Template -> Token FilePath -> Token FilePath -> DepGenM ()
|
|
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 <- concatStrings [ pure base, inject "-thumbnail.", pure ext ]
|
|
imageResized <- convertImage (openImage path) (inject (ResizeToWidth 800))
|
|
saveImage imageResized (joinPaths recipeDirOut thumbnailName)
|
|
concatTexts [ inject "<p class=\"image\"><a href=\""
|
|
, toText name
|
|
, inject "\"><img src=\""
|
|
, toText thumbnailName
|
|
, inject "\"></a></p>\n"
|
|
]
|
|
ingredienserHeadline <- inject "## Ingredienser"
|
|
mdTemplate <- makeTemplate
|
|
(readTextFile (joinPaths dir (inject "ret.md")))
|
|
ingredienserHeadline
|
|
html <- applyTemplate htmlTemplate
|
|
$ runPandoc
|
|
$ applyTemplate mdTemplate
|
|
$ concatTexts [ inject "<p class=\"imagetext\">Opskrift fortsætter efter billedet.</p>\n"
|
|
, concatTexts htmlBodyImages
|
|
, inject "\n"
|
|
, pure ingredienserHeadline
|
|
]
|
|
saveTextFile html (joinPaths recipeDirOut indexName)
|
|
|
|
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"
|
|
makeDir $ joinPaths outputDir recipesDir
|
|
recipeSubDirs <- filterDepGenM isDirectory
|
|
$ mapDepGenM (joinPaths recipesDir)
|
|
$ listDirectory recipesDir
|
|
mapDepGenM_ (handleRecipeDir outputDir htmlTemplate indexName) recipeSubDirs
|
|
|
|
-- Handle about page
|
|
outputAboutDir <- joinPaths outputDir (inject "om")
|
|
makeDir outputAboutDir
|
|
aboutHtml <- applyTemplate htmlTemplate $ runPandoc $ 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
|