Add Concat and implement img body html

This commit is contained in:
Niels G. W. Serup 2024-09-26 00:33:52 +02:00
parent bd6ede1df9
commit 91e52aeb2a
No known key found for this signature in database
GPG Key ID: 38EEEBCE67324F19
4 changed files with 26 additions and 6 deletions

View File

@ -17,6 +17,7 @@ module DependencyGenerator
, unzipDepGenM
, appendStrings
, concatStrings
, joinPaths
, fileComponents
, isImageExtension
@ -163,6 +164,9 @@ appendStrings (a, b) = do
b' <- toToken b
runFunction AppendStrings $ TupleToken (a', b')
concatStrings :: TokenableTo [String] a => a -> DepGenM' String
concatStrings a = runFunction ConcatStrings =<< toToken a
joinPaths :: (TokenableTo FilePath a, TokenableTo FilePath b) => (a, b) -> DepGenM' FilePath
joinPaths (a, b) = do
a' <- toToken a

View File

@ -9,6 +9,9 @@ evalFunction f x = case (f, x) of
(AppendStrings, Tuple (String _, String _)) ->
String undefined
(ConcatStrings, List _) ->
String undefined
(JoinPaths, Tuple (String _, String _)) ->
String undefined

View File

@ -3,11 +3,19 @@ module SiteGenerator (generateSite) where
import Types
import DependencyGenerator
thumbnailImagePath :: Token FilePath -> Token FilePath -> DepGenM' FilePath
thumbnailImagePath outputDir filename = do
thumbnailImageFilename :: Token FilePath -> DepGenM' FilePath
thumbnailImageFilename filename = do
(base, ext) <- untupleDepGenM (fileComponents filename)
name <- appendStrings (appendStrings (base, inject "-thumbnail."), ext)
joinPaths (outputDir, name)
appendStrings (appendStrings (base, inject "-thumbnail."), ext)
makeImageHTML :: Token (FilePath, FilePath) -> DepGenM' String
makeImageHTML t = do
(thumbnail, actual) <- untupleDepGenM t
appendStrings (inject "<p><a href=\"",
appendStrings (actual,
appendStrings (inject "\"><img src=\"",
appendStrings (thumbnail,
inject "\"></a></p>"))))
handleRecipeDir :: Token FilePath -> Token Template -> Token FilePath -> Token FilePath -> DepGenM ()
handleRecipeDir outputDir template indexName dir = do
@ -20,11 +28,15 @@ handleRecipeDir outputDir template indexName dir = do
imagePaths <- mapDepGenM (curry joinPaths dir) imageFilenames
imagePathsOut <- mapDepGenM (curry joinPaths recipeDirOut) imageFilenames
mapDepGenM_ copyFile' (ZipToken (imagePaths, imagePathsOut))
thumbnailImagePaths <- mapDepGenM (thumbnailImagePath recipeDirOut) imageFilenames
thumbnailImageFilenames <- mapDepGenM thumbnailImageFilename imageFilenames
thumbnailImagePaths <- mapDepGenM (curry joinPaths recipeDirOut) thumbnailImageFilenames
mapDepGenM_
(\files -> convertImage (files, inject $ ResizeToWidth 800))
(ZipToken (imagePaths, thumbnailImagePaths))
htmlBody <- runPandoc (joinPaths (dir, inject "ret.md"))
htmlBodyBase <- runPandoc (joinPaths (dir, inject "ret.md"))
htmlBodyImages <- mapDepGenM makeImageHTML (ZipToken (thumbnailImageFilenames, imageFilenames))
imagesHtml <- concatStrings htmlBodyImages
htmlBody <- appendStrings (htmlBodyBase, imagesHtml)
html <- applyTemplate (template, htmlBody)
saveFile (html, joinPaths (recipeDirOut, indexName))

View File

@ -5,6 +5,7 @@ module Types.Function
import Language.Haskell.TH.Syntax (Lift)
data Function = AppendStrings
| ConcatStrings
| JoinPaths
| FileComponents
| IsImageExtension