From 94c2fbfbc91173f9c5d0f47d599f32c74f17ba47 Mon Sep 17 00:00:00 2001 From: "Niels G. W. Serup" Date: Sat, 5 Oct 2024 22:51:13 +0200 Subject: [PATCH] Refactor to be more nested --- byg/src/DependencyGenerator.hs | 30 +++++-- byg/src/Evaluation/FunctionIO.hs | 2 +- byg/src/SiteGenerator.hs | 142 ++++++++++++++----------------- byg/src/Types/FunctionIO.hs | 2 +- 4 files changed, 92 insertions(+), 84 deletions(-) diff --git a/byg/src/DependencyGenerator.hs b/byg/src/DependencyGenerator.hs index d772ba5..75c95af 100644 --- a/byg/src/DependencyGenerator.hs +++ b/byg/src/DependencyGenerator.hs @@ -10,6 +10,8 @@ module DependencyGenerator , runFunctionIO , mapDepGenM , mapDepGenM_ + , forDepGenM + , forDepGenM_ , filterDepGenM , filterDepGenM' , zipDepGenM @@ -35,11 +37,14 @@ module DependencyGenerator , isDirectory , readTextFile , convertImage - , saveFile + , saveTextFile , copyFile , copyFile' , makeDir , runPandoc + + , hasExtension + , copyTo ) where import Prelude hiding (String, FilePath) @@ -134,6 +139,12 @@ mapDepGenM_ f input = do _ <- mapDepGenM (\x -> f x >> pure NoToken) input pure () +forDepGenM :: TokenableTo [a] v => v -> (Token a -> DepGenM' b) -> DepGenM' [b] +forDepGenM = flip mapDepGenM + +forDepGenM_ :: TokenableTo [a] v => v -> (Token a -> DepGenM ()) -> DepGenM () +forDepGenM_ = flip mapDepGenM_ + filterDepGenM' :: (TokenableTo [Bool] v, TokenableTo [a] u) => v -> u -> DepGenM' [a] filterDepGenM' mask input = do tup <- toTupleToken input mask @@ -234,11 +245,11 @@ isDirectory a = runFunctionIO IsDirectory =<< toToken a readTextFile :: TokenableTo FilePath a => a -> DepGenM' Text readTextFile a = runFunctionIO ReadTextFile =<< toToken a -convertImage :: (TokenableTo (FilePath, FilePath) a, TokenableTo ImageConversionSettings b) => a -> b -> DepGenM () -convertImage a b = runFunctionIO' ConvertImage =<< toTupleToken a b +convertImage :: (TokenableTo FilePath a, TokenableTo FilePath b, TokenableTo ImageConversionSettings c) => a -> b -> c -> DepGenM () +convertImage a b c = runFunctionIO' ConvertImage =<< toTupleToken (toTupleToken a b) c -saveFile :: (TokenableTo Text a, TokenableTo FilePath b) => a -> b -> DepGenM () -saveFile a b = runFunctionIO' SaveFile =<< toTupleToken a b +saveTextFile :: (TokenableTo Text a, TokenableTo FilePath b) => a -> b -> DepGenM () +saveTextFile a b = runFunctionIO' SaveTextFile =<< toTupleToken a b copyFile :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGenM () copyFile a b = runFunctionIO' CopyFile =<< toTupleToken a b @@ -251,3 +262,12 @@ makeDir a = runFunctionIO' MakeDir =<< toToken a runPandoc :: TokenableTo Text a => a -> DepGenM' Text runPandoc a = runFunctionIO RunPandoc =<< toToken a + + +hasExtension :: (TokenableTo [String] a, TokenableTo FilePath b) => a -> b -> DepGenM' Bool +hasExtension exts filename = do + ext <- lowerString $ untupleSndDepGenM $ fileComponents filename + ext `elemOf` exts + +copyTo :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGenM () +copyTo path targetDir = copyFile path (joinPaths targetDir path) diff --git a/byg/src/Evaluation/FunctionIO.hs b/byg/src/Evaluation/FunctionIO.hs index 1b25e67..26895ca 100644 --- a/byg/src/Evaluation/FunctionIO.hs +++ b/byg/src/Evaluation/FunctionIO.hs @@ -39,7 +39,7 @@ evalFunctionIO f x = case (f, x) of CP.saveJpgImage 90 target $ CP.ImageRGB8 imageResized pure Empty - (SaveFile, Tuple (Text t, String (StringWrapper s))) -> do + (SaveTextFile, Tuple (Text t, String (StringWrapper s))) -> do T.writeFile s t pure Empty diff --git a/byg/src/SiteGenerator.hs b/byg/src/SiteGenerator.hs index 72e4823..626ff26 100644 --- a/byg/src/SiteGenerator.hs +++ b/byg/src/SiteGenerator.hs @@ -6,93 +6,81 @@ 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 - suffix <- inject "-thumbnail." - concatStrings [ base, suffix, ext ] - -makeImageHTML :: Token (FilePath, FilePath) -> DepGenM' Text -makeImageHTML t = do - (thumbnail, actual) <- untupleDepGenM t - concatTexts [ 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 Template -> Token FilePath -> Token FilePath -> DepGenM () -handleRecipeDir outputDir template indexName dir = do +handleRecipeDir outputDir htmlTemplate indexName dir = do recipeDirOut <- joinPaths outputDir dir makeDir recipeDirOut - dirContents <- listDirectory dir - imageFilenames <- filterDepGenM (hasExtension $ inject ["jpg"]) 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) - md <- readTextFile $ joinPaths dir $ inject "ret.md" + 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 ] + convertImage path (joinPaths recipeDirOut thumbnailName) (inject (ResizeToWidth 800)) + concatTexts [ inject "

\n" + ] ingredienserHeadline <- inject "## Ingredienser" - mdTemplate <- makeTemplate md ingredienserHeadline - htmlBodyImages <- mapDepGenM makeImageHTML $ zipDepGenM thumbnailImageFilenames imageFilenames - imagesHtml <- concatTexts htmlBodyImages - md' <- applyTemplate mdTemplate - $ concatTexts [ inject "

Opskrift fortsætter efter billedet.

\n" - , pure imagesHtml - , inject "\n\n" - , pure ingredienserHeadline - ] - htmlBody <- runPandoc md' - html <- applyTemplate template htmlBody - saveFile html $ joinPaths recipeDirOut indexName + mdTemplate <- makeTemplate + (readTextFile (joinPaths dir (inject "ret.md"))) + ingredienserHeadline + html <- applyTemplate htmlTemplate + $ runPandoc + $ applyTemplate mdTemplate + $ concatTexts [ inject "

Opskrift fortsætter efter billedet.

\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 - template <- makeTemplate (readTextFile (inject "template.html")) (inject "CONTENT") - indexName <- inject "index.html" - dirNames <- listDirectory recipesDir - dirPaths <- mapDepGenM (joinPaths recipesDir) dirNames - dirPaths' <- filterDepGenM isDirectory dirPaths - mapDepGenM_ (handleRecipeDir outputDir template indexName) dirPaths' - 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 - fontsPaths' <- filterDepGenM isDirectory fontsPaths - makeDir (joinPaths outputDir fontsDir) - mapDepGenM_ (handleFontDir outputDir) fontsPaths' + recipeSubDirs <- filterDepGenM isDirectory + $ mapDepGenM (joinPaths recipesDir) + $ listDirectory recipesDir + mapDepGenM_ (handleRecipeDir outputDir htmlTemplate indexName) recipeSubDirs -handleFontDir :: Token FilePath -> Token FilePath -> DepGenM () -handleFontDir outputDir fontPath = do - makeDir (joinPaths outputDir fontPath) - files <- listDirectory fontPath - paths <- mapDepGenM (joinPaths fontPath) files - paths' <- filterDepGenM (hasExtension $ inject ["woff2", "css"]) paths - mapDepGenM_ (\p -> copyFile p (joinPaths outputDir p)) paths' + -- 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 diff --git a/byg/src/Types/FunctionIO.hs b/byg/src/Types/FunctionIO.hs index 4a1f25b..5d9bcd7 100644 --- a/byg/src/Types/FunctionIO.hs +++ b/byg/src/Types/FunctionIO.hs @@ -8,7 +8,7 @@ data FunctionIO = ListDirectory | IsDirectory | ReadTextFile | ConvertImage - | SaveFile + | SaveTextFile | CopyFile | MakeDir | RunPandoc