Refactor to be more nested

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 :: (TokenableTo FilePath a, TokenableTo FilePath b, TokenableTo ImageConversionSettings c) => a -> b -> c -> DepGenM ()
-convertImage a b = runFunctionIO' ConvertImage =<< toTupleToken a b
+convertImage a b c = runFunctionIO' ConvertImage =<< toTupleToken (toTupleToken a b) c
 
-saveFile :: (TokenableTo Text a, TokenableTo FilePath b) => a -> b -> DepGenM ()
+saveTextFile :: (TokenableTo Text a, TokenableTo FilePath b) => a -> b -> DepGenM ()
-saveFile a b = runFunctionIO' SaveFile =<< toTupleToken a b
+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)

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
 

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"]))
-  imageFilenames <- filterDepGenM (hasExtension $ inject ["jpg"]) dirContents
+                    $ listDirectory dir
-  imagePaths <- mapDepGenM (joinPaths dir) imageFilenames
+  htmlBodyImages <- forDepGenM imageFilenames $ \name -> do
-  imagePathsOut <- mapDepGenM (joinPaths recipeDirOut) imageFilenames
+    path <- joinPaths dir name
-  mapDepGenM_ copyFile' $ zipDepGenM imagePaths imagePathsOut
+    path `copyTo` outputDir
-  thumbnailImageFilenames <- mapDepGenM thumbnailImageFilename imageFilenames
+    (base, ext) <- untupleDepGenM $ fileComponents name
-  thumbnailImagePaths <- mapDepGenM (joinPaths recipeDirOut) thumbnailImageFilenames
+    thumbnailName <- concatStrings [ pure base, inject "-thumbnail.", pure ext ]
-  mapDepGenM_
+    convertImage path (joinPaths recipeDirOut thumbnailName) (inject (ResizeToWidth 800))
-    (\files -> convertImage files $ inject $ ResizeToWidth 800)
+    concatTexts [ inject "<p class=\"image\"><a href=\""
-    (zipDepGenM imagePaths thumbnailImagePaths)
+                , toText name
-  md <- readTextFile $ joinPaths dir $ inject "ret.md"
+                , inject "\"><img src=\""
+                , toText thumbnailName
+                , inject "\"></a></p>\n"
+                ]
   ingredienserHeadline <- inject "## Ingredienser"
-  mdTemplate <- makeTemplate md ingredienserHeadline
+  mdTemplate <- makeTemplate
-  htmlBodyImages <- mapDepGenM makeImageHTML $ zipDepGenM thumbnailImageFilenames imageFilenames
+    (readTextFile (joinPaths dir (inject "ret.md")))
-  imagesHtml <- concatTexts htmlBodyImages
+    ingredienserHeadline
-  md' <- applyTemplate mdTemplate
+  html <- applyTemplate htmlTemplate
-    $ concatTexts [ inject "<p class=\"imagetext\">Opskrift fortsætter efter billedet.</p>\n"
+          $ runPandoc
-                  , pure imagesHtml
+          $ applyTemplate mdTemplate
-                  , inject "\n\n"
+          $ concatTexts [ inject "<p class=\"imagetext\">Opskrift fortsætter efter billedet.</p>\n"
-                  , pure ingredienserHeadline
+                        , concatTexts htmlBodyImages
-                  ]
+                        , inject "\n"
-  htmlBody <- runPandoc md'
+                        , pure ingredienserHeadline
-  html <- applyTemplate template htmlBody
+                        ]
-  saveFile html $ joinPaths recipeDirOut indexName
+  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")
+  recipeSubDirs <- filterDepGenM isDirectory
-  indexName <- inject "index.html"
+                   $ mapDepGenM (joinPaths recipesDir)
-  dirNames <- listDirectory recipesDir
+                   $ listDirectory recipesDir
-  dirPaths <- mapDepGenM (joinPaths recipesDir) dirNames
+  mapDepGenM_ (handleRecipeDir outputDir htmlTemplate indexName) recipeSubDirs
-  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'
 
-handleFontDir :: Token FilePath -> Token FilePath -> DepGenM ()
+  -- Handle about page
-handleFontDir outputDir fontPath = do
+  outputAboutDir <- joinPaths outputDir (inject "om")
-  makeDir (joinPaths outputDir fontPath)
+  makeDir outputAboutDir
-  files <- listDirectory fontPath
+  aboutHtml <- applyTemplate htmlTemplate $ runPandoc $ readTextFile $ inject "om.md"
-  paths <- mapDepGenM (joinPaths fontPath) files
+  saveTextFile aboutHtml (joinPaths outputAboutDir indexName)
-  paths' <- filterDepGenM (hasExtension $ inject ["woff2", "css"]) paths
+
-  mapDepGenM_ (\p -> copyFile p (joinPaths outputDir p)) paths'
+  -- 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

byg/src/Types/FunctionIO.hs

@@ -8,7 +8,7 @@ data FunctionIO = ListDirectory
                 | IsDirectory
                 | ReadTextFile
                 | ConvertImage
-                | SaveFile
+                | SaveTextFile
                 | CopyFile
                 | MakeDir
                 | RunPandoc