Use the & operator and generate rudimentary retter/index.html

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

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"]))
+  imageFilenames <-
-                    $ listDirectory dir
+    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
+  pandoc <-
-            $ applyTemplate mdTemplate
+    [ inject "<p class=\"imagetext\">Opskrift fortsætter efter billedet.</p>\n"
-            $ onToken T.concat [ inject "<p class=\"imagetext\">Opskrift fortsætter efter billedet.</p>\n"
+    , onToken T.concat htmlBodyImages
-                               , onToken T.concat htmlBodyImages
+    , inject "\n"
-                               , inject "\n"
+    , pure ingredienserHeadline
-                               , pure ingredienserHeadline
+    ]
-                               ]
+    & onToken T.concat
+    & applyTemplate mdTemplate
+    & readMarkdown
   title <- extractTitle pandoc
-  html <- applyTemplate htmlTemplate
+  html <-
-          $ writeHtml pandoc
+    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"]))
+  paths <-
-           $ mapDepGenM (joinPaths dir)
+    listDirectory dir
-           $ 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
+  recipeSubDirs <-
-                   $ mapDepGenM (joinPaths recipesDir)
+    listDirectory recipesDir
-                   $ listDirectory recipesDir
+    & mapDepGenM (joinPaths recipesDir)
+    & filterDepGenM isDirectory
   infos <- mapDepGenM (handleRecipeDir outputDir htmlTemplate indexName) recipeSubDirs
-  allRecipesHtml <- applyTemplate htmlTemplate
+  allRecipesHtml <-
-                    $ writeHtml
+    infos
-                    $ readMarkdown
+    & onToken (T.append "# Alle retter\n\n"
-                    $ onToken (T.append "# Alle retter\n\n" . T.intercalate "\n" . map (\(t, u) -> T.concat ["- ", "[", t, "](/", T.pack u, ")"])) infos
+               . 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
+  aboutHtml <-
-               $ writeHtml
+    inject "om.md"
-               $ readMarkdown
+    & readTextFile
-               $ readTextFile
+    & markdownToHtml
-               $ inject "om.md"
+    & 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
+  fontSubDirs <-
-                 $ mapDepGenM (joinPaths fontsDir)
+    fontsDir
-                 $ listDirectory fontsDir
+    & listDirectory
+    & mapDepGenM (joinPaths fontsDir)
+    & filterDepGenM isDirectory
   mapDepGenM_ (handleFontDir outputDir) fontSubDirs