Refactor to be more nested

2024-10-05 22:51:13 +02:00 · 2024-10-05 22:51:13 +02:00 · 94c2fbfbc9
parent 9311d51464
commit 94c2fbfbc9
4 changed files with 92 additions and 84 deletions
--- 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)
--- 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

--- 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 "<p class=\"image\"><a href=\""
-              , toText actual
-              , inject "\"><img src=\""
-              , toText thumbnail
-              , inject "\"></a></p>"
-              ]
-
-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 "<p class=\"image\"><a href=\""
+                , toText name
+                , inject "\"><img src=\""
+                , toText thumbnailName
+                , inject "\"></a></p>\n"
+                ]
  ingredienserHeadline <- inject "## Ingredienser"
-  mdTemplate <- makeTemplate md ingredienserHeadline
-  htmlBodyImages <- mapDepGenM makeImageHTML $ zipDepGenM thumbnailImageFilenames imageFilenames
-  imagesHtml <- concatTexts htmlBodyImages
-  md' <- applyTemplate mdTemplate
-    $ concatTexts [ inject "<p class=\"imagetext\">Opskrift fortsætter efter billedet.</p>\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 "<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
-  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
--- 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