77 lines
3.0 KiB
Haskell
77 lines
3.0 KiB
Haskell
module SiteGenerator (generateSite) where
|
|
|
|
import Types
|
|
import DependencyGenerator
|
|
|
|
import Control.Monad (forM_)
|
|
import Data.Text (Text)
|
|
|
|
thumbnailImageFilename :: Token FilePath -> DepGenM' FilePath
|
|
thumbnailImageFilename filename = do
|
|
(base, ext) <- untupleDepGenM $ fileComponents filename
|
|
appendStrings base
|
|
$ appendStrings (inject "-thumbnail.") ext
|
|
|
|
makeImageHTML :: Token (FilePath, FilePath) -> DepGenM' Text
|
|
makeImageHTML t = do
|
|
(thumbnail, actual) <- untupleDepGenM t
|
|
appendTexts
|
|
(inject "<p><a href=\"")
|
|
(appendTexts
|
|
(toText actual)
|
|
(appendTexts
|
|
(inject "\"><img src=\"")
|
|
(appendTexts
|
|
(toText thumbnail)
|
|
(inject "\"></a></p>"))))
|
|
|
|
handleRecipeDir :: Token FilePath -> Token FilePath -> Token Template -> Token FilePath -> Token FilePath -> DepGenM ()
|
|
handleRecipeDir inputDir outputDir template indexName name = do
|
|
dir <- joinPaths inputDir name
|
|
recipeDirOut <- joinPaths outputDir name
|
|
makeDir recipeDirOut
|
|
dirContents <- listDirectory dir
|
|
areImageFilenames <- mapDepGenM hasImageExtension dirContents
|
|
imageFilenames <- filterDepGenM areImageFilenames dirContents
|
|
imagePaths <- mapDepGenM (joinPaths dir) imageFilenames
|
|
imagePathsOut <- mapDepGenM (joinPaths recipeDirOut) imageFilenames
|
|
mapDepGenM_ copyFile' $ zipDepGenM imagePaths imagePathsOut
|
|
thumbnailImageFilenames <- mapDepGenM thumbnailImageFilename imageFilenames
|
|
thumbnailImagePaths <- mapDepGenM (joinPaths recipeDirOut) thumbnailImageFilenames
|
|
mapDepGenM_
|
|
(\files -> convertImage files $ inject $ ResizeToWidth 800)
|
|
(zipDepGenM imagePaths thumbnailImagePaths)
|
|
htmlBodyBase <- runPandoc $ joinPaths dir $ inject "ret.md"
|
|
htmlBodyImages <- mapDepGenM makeImageHTML $ zipDepGenM thumbnailImageFilenames imageFilenames
|
|
imagesHtml <- concatTexts htmlBodyImages
|
|
htmlBody <- appendTexts 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"
|
|
dirNames <- listDirectory recipesDir
|
|
dirPaths <- mapDepGenM (joinPaths recipesDir) dirNames
|
|
dirPathsAreSubdirs <- mapDepGenM isDirectory dirPaths
|
|
dirNames' <- filterDepGenM dirPathsAreSubdirs dirNames
|
|
mapDepGenM_ (handleRecipeDir recipesDir outputRecipesDir template indexName) dirNames'
|
|
html <- applyTemplate template $ runPandoc $ inject "om.md"
|
|
aboutDir <- joinPaths outputDir $ inject "om"
|
|
makeDir aboutDir
|
|
saveFile html $ joinPaths aboutDir indexName
|
|
styleName <- inject "style.css"
|
|
copyFile styleName (joinPaths outputDir styleName)
|
|
imgName <- inject "img"
|
|
imgPathOut <- joinPaths outputDir imgName
|
|
makeDir imgPathOut
|
|
forM_ ["mad-icon.png", "mad-logo.png"] $ \name -> do
|
|
val <- inject name
|
|
copyFile (joinPaths imgName val) (joinPaths imgPathOut val)
|