module SiteGenerator (generateSite) where import Prelude hiding (String, FilePath) 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 "
")))) hasExtension :: (TokenableTo [String] a, TokenableTo FilePath b) => a -> b -> DepGenM' Bool hasExtension exts filename = do ext <- lowerString $ untupleSndDepGenM $ fileComponents filename ext `elemOf` exts 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 (hasExtension $ inject ["jpg"]) 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 $ readTextFile $ 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 <- makeTemplate (readTextFile (inject "template.html")) (inject "CONTENT") 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 $ readTextFile $ 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) fontsDir <- inject "fonts" fontsNames <- listDirectory fontsDir fontsPaths <- mapDepGenM (joinPaths fontsDir) fontsNames fontsPathsAreSubdirs <- mapDepGenM isDirectory fontsPaths fontsPaths' <- filterDepGenM fontsPathsAreSubdirs fontsPaths makeDir (joinPaths outputDir fontsDir) mapDepGenM_ (handleFontDir outputDir) fontsPaths' handleFontDir :: Token FilePath -> Token FilePath -> DepGenM () handleFontDir outputDir fontPath = do makeDir (joinPaths outputDir fontPath) files <- listDirectory fontPath paths <- mapDepGenM (joinPaths fontPath) files mask <- mapDepGenM (hasExtension $ inject ["woff2", "css"]) paths paths' <- filterDepGenM mask paths mapDepGenM_ (\p -> copyFile p (joinPaths outputDir p)) paths'