59 lines
2.6 KiB
Haskell
59 lines
2.6 KiB
Haskell
module SiteGenerator (generateSite) where
|
|
|
|
import Types
|
|
import DependencyGenerator
|
|
|
|
thumbnailImageFilename :: Token FilePath -> DepGenM' FilePath
|
|
thumbnailImageFilename filename = do
|
|
(base, ext) <- untupleDepGenM (fileComponents filename)
|
|
appendStrings (appendStrings (base, inject "-thumbnail."), ext)
|
|
|
|
makeImageHTML :: Token (FilePath, FilePath) -> DepGenM' String
|
|
makeImageHTML t = do
|
|
(thumbnail, actual) <- untupleDepGenM t
|
|
appendStrings (inject "<p><a href=\"",
|
|
appendStrings (actual,
|
|
appendStrings (inject "\"><img src=\"",
|
|
appendStrings (thumbnail,
|
|
inject "\"></a></p>"))))
|
|
|
|
handleRecipeDir :: Token FilePath -> Token Template -> Token FilePath -> Token FilePath -> DepGenM ()
|
|
handleRecipeDir outputDir template indexName dir = do
|
|
recipeDirOut <- joinPaths (outputDir, dir)
|
|
makeDir recipeDirOut
|
|
dirContents <- listDirectory dir
|
|
exts <- unzipSndDepGenM (mapDepGenM fileComponents dirContents)
|
|
areImageFilenames <- mapDepGenM isImageExtension exts
|
|
imageFilenames <- filterDepGenM areImageFilenames dirContents
|
|
imagePaths <- mapDepGenM (curry joinPaths dir) imageFilenames
|
|
imagePathsOut <- mapDepGenM (curry joinPaths recipeDirOut) imageFilenames
|
|
mapDepGenM_ copyFile' (ZipToken (imagePaths, imagePathsOut))
|
|
thumbnailImageFilenames <- mapDepGenM thumbnailImageFilename imageFilenames
|
|
thumbnailImagePaths <- mapDepGenM (curry joinPaths recipeDirOut) thumbnailImageFilenames
|
|
mapDepGenM_
|
|
(\files -> convertImage (files, inject $ ResizeToWidth 800))
|
|
(ZipToken (imagePaths, thumbnailImagePaths))
|
|
htmlBodyBase <- runPandoc (joinPaths (dir, inject "ret.md"))
|
|
htmlBodyImages <- mapDepGenM makeImageHTML (ZipToken (thumbnailImageFilenames, imageFilenames))
|
|
imagesHtml <- concatStrings htmlBodyImages
|
|
htmlBody <- appendStrings (htmlBodyBase, imagesHtml)
|
|
html <- applyTemplate (template, htmlBody)
|
|
saveFile (html, joinPaths (recipeDirOut, indexName))
|
|
|
|
generateSite :: DepGenM ()
|
|
generateSite = do
|
|
outputDir <- inject "site"
|
|
makeDir outputDir
|
|
recipesDir <- inject "retter"
|
|
outputRecipesDir <- joinPaths (outputDir, recipesDir)
|
|
makeDir outputRecipesDir
|
|
template <- readTemplate (inject "template.html")
|
|
indexName <- inject "index.html"
|
|
dirContents <- listDirectory recipesDir
|
|
mapDepGenM_ (handleRecipeDir outputRecipesDir template indexName) dirContents
|
|
htmlBody <- runPandoc (inject "om.md")
|
|
html <- applyTemplate (template, htmlBody)
|
|
aboutDir <- joinPaths (outputDir, inject "om")
|
|
makeDir aboutDir
|
|
saveFile (html, joinPaths (aboutDir, indexName))
|