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

This commit is contained in:
Niels G. W. Serup 2024-10-15 22:14:00 +02:00
parent e51e7a5376
commit 9e6c793d54
No known key found for this signature in database
GPG Key ID: 38EEEBCE67324F19
2 changed files with 47 additions and 29 deletions

View File

@ -1,6 +1,7 @@
module Functions.Pandoc module Functions.Pandoc
( readMarkdown ( readMarkdown
, writeHtml , writeHtml
, markdownToHtml
, extractTitle , extractTitle
) where ) where
@ -8,6 +9,7 @@ import Types (Token)
import DependencyGenerator (DepGenM, TokenableTo(..), onToken) import DependencyGenerator (DepGenM, TokenableTo(..), onToken)
import Data.Text (Text) import Data.Text (Text)
import Control.Monad ((>=>))
import Text.Pandoc.Definition (Pandoc) import Text.Pandoc.Definition (Pandoc)
import qualified Text.Pandoc.Definition as PD import qualified Text.Pandoc.Definition as PD
import qualified Text.Pandoc.Shared as PS 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 :: TokenableTo Pandoc a => a -> DepGenM (Token Text)
writeHtml = onToken $ runPandoc . P.writeHtml5String P.def 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 :: TokenableTo Pandoc a => a -> DepGenM (Token Text)
extractTitle = onToken $ \(PD.Pandoc _ blocks) -> case blocks of extractTitle = onToken $ \(PD.Pandoc _ blocks) -> case blocks of
(PD.Header 1 _ inlines : _) -> PS.stringify inlines (PD.Header 1 _ inlines : _) -> PS.stringify inlines

View File

@ -4,6 +4,7 @@ import Types (Token(..))
import DependencyGenerator import DependencyGenerator
import Functions import Functions
import Data.Function ((&))
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Control.Monad (forM_) import Control.Monad (forM_)
@ -12,8 +13,9 @@ handleRecipeDir :: Token FilePath -> Token Template -> Token FilePath -> Token F
handleRecipeDir outputDir htmlTemplate indexName dir = do handleRecipeDir outputDir htmlTemplate indexName dir = do
recipeDirOut <- joinPaths outputDir dir recipeDirOut <- joinPaths outputDir dir
makeDir recipeDirOut makeDir recipeDirOut
imageFilenames <- filterDepGenM (hasExtension (inject ["jpg"])) imageFilenames <-
$ listDirectory dir listDirectory dir
& filterDepGenM (hasExtension (inject ["jpg"]))
htmlBodyImages <- forDepGenM imageFilenames $ \name -> do htmlBodyImages <- forDepGenM imageFilenames $ \name -> do
path <- joinPaths dir name path <- joinPaths dir name
path `copyTo` outputDir path `copyTo` outputDir
@ -31,25 +33,30 @@ handleRecipeDir outputDir htmlTemplate indexName dir = do
mdTemplate <- makeTemplate mdTemplate <- makeTemplate
(readTextFile (joinPaths dir (inject "ret.md"))) (readTextFile (joinPaths dir (inject "ret.md")))
ingredienserHeadline 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 title <- extractTitle pandoc
html <- applyTemplate htmlTemplate html <-
$ writeHtml pandoc pandoc
& writeHtml
& applyTemplate htmlTemplate
saveTextFile html (joinPaths recipeDirOut indexName) saveTextFile html (joinPaths recipeDirOut indexName)
pure $ TupleToken title dir pure $ TupleToken title dir
handleFontDir :: Token FilePath -> Token FilePath -> DepGenM () handleFontDir :: Token FilePath -> Token FilePath -> DepGenM ()
handleFontDir outputDir dir = do handleFontDir outputDir dir = do
makeDir $ joinPaths outputDir dir 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 mapDepGenM_ (`copyTo` outputDir) paths
generateSite :: DepGenM () generateSite :: DepGenM ()
@ -63,24 +70,28 @@ generateSite = do
recipesDir <- inject "retter" recipesDir <- inject "retter"
outputRecipesDir <- joinPaths outputDir recipesDir outputRecipesDir <- joinPaths outputDir recipesDir
makeDir $ outputRecipesDir 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 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) saveTextFile allRecipesHtml (joinPaths outputRecipesDir indexName)
-- Handle about page -- Handle about page
outputAboutDir <- joinPaths outputDir (inject "om") outputAboutDir <- joinPaths outputDir (inject "om")
makeDir outputAboutDir makeDir outputAboutDir
aboutHtml <- applyTemplate htmlTemplate aboutHtml <-
$ writeHtml inject "om.md"
$ readMarkdown & readTextFile
$ readTextFile & markdownToHtml
$ inject "om.md" & applyTemplate htmlTemplate
saveTextFile aboutHtml (joinPaths outputAboutDir indexName) saveTextFile aboutHtml (joinPaths outputAboutDir indexName)
-- Handle style -- Handle style
@ -95,7 +106,9 @@ generateSite = do
-- Handle fonts -- Handle fonts
fontsDir <- inject "fonts" fontsDir <- inject "fonts"
makeDir $ joinPaths outputDir fontsDir makeDir $ joinPaths outputDir fontsDir
fontSubDirs <- filterDepGenM isDirectory fontSubDirs <-
$ mapDepGenM (joinPaths fontsDir) fontsDir
$ listDirectory fontsDir & listDirectory
& mapDepGenM (joinPaths fontsDir)
& filterDepGenM isDirectory
mapDepGenM_ (handleFontDir outputDir) fontSubDirs mapDepGenM_ (handleFontDir outputDir) fontSubDirs