From 9e6c793d5441b6aee9870f87817ea952bd8b7ed3 Mon Sep 17 00:00:00 2001
From: "Niels G. W. Serup" <ngws@metanohi.name>
Date: Tue, 15 Oct 2024 22:14:00 +0200
Subject: [PATCH] Use the & operator and generate rudimentary retter/index.html

---
 byg/src/Functions/Pandoc.hs |  5 +++
 byg/src/SiteGenerator.hs    | 71 ++++++++++++++++++++++---------------
 2 files changed, 47 insertions(+), 29 deletions(-)

diff --git a/byg/src/Functions/Pandoc.hs b/byg/src/Functions/Pandoc.hs
index 34c1d35..a1a4485 100644
--- a/byg/src/Functions/Pandoc.hs
+++ b/byg/src/Functions/Pandoc.hs
@@ -1,6 +1,7 @@
 module Functions.Pandoc
   ( readMarkdown
   , writeHtml
+  , markdownToHtml
   , extractTitle
   ) where
 
@@ -8,6 +9,7 @@ import Types (Token)
 import DependencyGenerator (DepGenM, TokenableTo(..), onToken)
 
 import Data.Text (Text)
+import Control.Monad ((>=>))
 import Text.Pandoc.Definition (Pandoc)
 import qualified Text.Pandoc.Definition as PD
 import qualified Text.Pandoc.Shared as PS
@@ -25,6 +27,9 @@ readMarkdown = onToken $ runPandoc . P.readMarkdown settings
 writeHtml :: TokenableTo Pandoc a => a -> DepGenM (Token Text)
 writeHtml = onToken $ runPandoc . P.writeHtml5String P.def
 
+markdownToHtml :: TokenableTo Text a => a -> DepGenM (Token Text)
+markdownToHtml = readMarkdown >=> writeHtml
+
 extractTitle :: TokenableTo Pandoc a => a -> DepGenM (Token Text)
 extractTitle = onToken $ \(PD.Pandoc _ blocks) -> case blocks of
   (PD.Header 1 _ inlines : _) -> PS.stringify inlines
diff --git a/byg/src/SiteGenerator.hs b/byg/src/SiteGenerator.hs
index ea76679..236e0d7 100644
--- a/byg/src/SiteGenerator.hs
+++ b/byg/src/SiteGenerator.hs
@@ -4,6 +4,7 @@ import Types (Token(..))
 import DependencyGenerator
 import Functions
 
+import Data.Function ((&))
 import Data.Text (Text)
 import qualified Data.Text as T
 import Control.Monad (forM_)
@@ -12,8 +13,9 @@ handleRecipeDir :: Token FilePath -> Token Template -> Token FilePath -> Token F
 handleRecipeDir outputDir htmlTemplate indexName dir = do
   recipeDirOut <- joinPaths outputDir dir
   makeDir recipeDirOut
-  imageFilenames <- filterDepGenM (hasExtension (inject ["jpg"]))
-                    $ listDirectory dir
+  imageFilenames <-
+    listDirectory dir
+    & filterDepGenM (hasExtension (inject ["jpg"]))
   htmlBodyImages <- forDepGenM imageFilenames $ \name -> do
     path <- joinPaths dir name
     path `copyTo` outputDir
@@ -31,25 +33,30 @@ handleRecipeDir outputDir htmlTemplate indexName dir = do
   mdTemplate <- makeTemplate
     (readTextFile (joinPaths dir (inject "ret.md")))
     ingredienserHeadline
-  pandoc <- readMarkdown
-            $ applyTemplate mdTemplate
-            $ onToken T.concat [ inject "<p class=\"imagetext\">Opskrift fortsætter efter billedet.</p>\n"
-                               , onToken T.concat htmlBodyImages
-                               , inject "\n"
-                               , pure ingredienserHeadline
-                               ]
+  pandoc <-
+    [ inject "<p class=\"imagetext\">Opskrift fortsætter efter billedet.</p>\n"
+    , onToken T.concat htmlBodyImages
+    , inject "\n"
+    , pure ingredienserHeadline
+    ]
+    & onToken T.concat
+    & applyTemplate mdTemplate
+    & readMarkdown
   title <- extractTitle pandoc
-  html <- applyTemplate htmlTemplate
-          $ writeHtml pandoc
+  html <-
+    pandoc
+    & writeHtml
+    & applyTemplate htmlTemplate
   saveTextFile html (joinPaths recipeDirOut indexName)
   pure $ TupleToken title dir
 
 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
+  paths <-
+    listDirectory dir
+    & mapDepGenM (joinPaths dir)
+    & filterDepGenM (hasExtension (inject ["woff2", "css"]))
   mapDepGenM_ (`copyTo` outputDir) paths
 
 generateSite :: DepGenM ()
@@ -63,24 +70,28 @@ generateSite = do
   recipesDir <- inject "retter"
   outputRecipesDir <- joinPaths outputDir recipesDir
   makeDir $ outputRecipesDir
-  recipeSubDirs <- filterDepGenM isDirectory
-                   $ mapDepGenM (joinPaths recipesDir)
-                   $ listDirectory recipesDir
+  recipeSubDirs <-
+    listDirectory recipesDir
+    & mapDepGenM (joinPaths recipesDir)
+    & filterDepGenM isDirectory
   infos <- mapDepGenM (handleRecipeDir outputDir htmlTemplate indexName) recipeSubDirs
-  allRecipesHtml <- applyTemplate htmlTemplate
-                    $ writeHtml
-                    $ readMarkdown
-                    $ onToken (T.append "# Alle retter\n\n" . T.intercalate "\n" . map (\(t, u) -> T.concat ["- ", "[", t, "](/", T.pack u, ")"])) infos
+  allRecipesHtml <-
+    infos
+    & onToken (T.append "# Alle retter\n\n"
+               . T.intercalate "\n"
+               . map (\(t, u) -> T.concat ["- ", "[", t, "](/", T.pack u, ")"]))
+    & markdownToHtml
+    & applyTemplate htmlTemplate
   saveTextFile allRecipesHtml (joinPaths outputRecipesDir indexName)
 
   -- Handle about page
   outputAboutDir <- joinPaths outputDir (inject "om")
   makeDir outputAboutDir
-  aboutHtml <- applyTemplate htmlTemplate
-               $ writeHtml
-               $ readMarkdown
-               $ readTextFile
-               $ inject "om.md"
+  aboutHtml <-
+    inject "om.md"
+    & readTextFile
+    & markdownToHtml
+    & applyTemplate htmlTemplate
   saveTextFile aboutHtml (joinPaths outputAboutDir indexName)
 
   -- Handle style
@@ -95,7 +106,9 @@ generateSite = do
   -- Handle fonts
   fontsDir <- inject "fonts"
   makeDir $ joinPaths outputDir fontsDir
-  fontSubDirs <- filterDepGenM isDirectory
-                 $ mapDepGenM (joinPaths fontsDir)
-                 $ listDirectory fontsDir
+  fontSubDirs <-
+    fontsDir
+    & listDirectory
+    & mapDepGenM (joinPaths fontsDir)
+    & filterDepGenM isDirectory
   mapDepGenM_ (handleFontDir outputDir) fontSubDirs