Implement untupling and use more general append instead of ConvertedImageFilename

This commit is contained in:
Niels G. W. Serup 2024-09-25 23:32:49 +02:00
parent fe87351976
commit 992edea3ee
No known key found for this signature in database
GPG Key ID: 38EEEBCE67324F19
5 changed files with 45 additions and 11 deletions

View File

@ -9,14 +9,17 @@ module DependencyGenerator
, mapDepGenM
, mapDepGenM_
, filterDepGenM
, untupleFstDepGenM
, untupleSndDepGenM
, untupleDepGenM
, unzipFstDepGenM
, unzipSndDepGenM
, unzipDepGenM
, appendStrings
, joinPaths
, fileComponents
, isImageExtension
, convertedImageFilename
, applyTemplate
, listDirectory
, readTemplate
@ -101,6 +104,27 @@ filterDepGenM :: Token [Bool] -> Token [a] -> DepGenM' [a]
filterDepGenM mask input = do
genDependency (makeDependency (TupleToken (input, mask)) FilterComp)
untupleFstDepGenM :: TokenableTo (a, b) t => t -> DepGenM (Token a)
untupleFstDepGenM t = do
t' <- toToken t
case t' of
TupleToken (a, _) -> pure a
Token _ -> genDependency (makeDependency t' UntupleFst)
untupleSndDepGenM :: TokenableTo (a, b) t => t -> DepGenM (Token b)
untupleSndDepGenM t = do
t' <- toToken t
case t' of
TupleToken (_, b) -> pure b
Token _ -> genDependency (makeDependency t' UntupleSnd)
untupleDepGenM :: TokenableTo (a, b) t => t -> DepGenM (Token a, Token b)
untupleDepGenM t = do
t' <- toToken t
a <- untupleFstDepGenM t'
b <- untupleSndDepGenM t'
pure (a, b)
unzipFstDepGenM :: TokenableTo [(a, b)] t => t -> DepGenM (Token [a])
unzipFstDepGenM t = do
t' <- toToken t
@ -131,6 +155,12 @@ instance TokenableTo a (Token a) where
instance TokenableTo a (DepGenM' a) where
toToken = id
appendStrings :: (TokenableTo String a, TokenableTo String b) => (a, b) -> DepGenM' String
appendStrings (a, b) = do
a' <- toToken a
b' <- toToken b
runFunction AppendStrings $ TupleToken (a', b')
joinPaths :: (TokenableTo FilePath a, TokenableTo FilePath b) => (a, b) -> DepGenM' FilePath
joinPaths (a, b) = do
a' <- toToken a
@ -143,9 +173,6 @@ fileComponents a = runFunction FileComponents =<< toToken a
isImageExtension :: TokenableTo FilePath a => a -> DepGenM' Bool
isImageExtension a = runFunction IsImageExtension =<< toToken a
convertedImageFilename :: TokenableTo FilePath a => a -> DepGenM' FilePath
convertedImageFilename a = runFunction ConvertedImageFilename =<< toToken a
applyTemplate :: (TokenableTo Template a, TokenableTo String b) => (a, b) -> DepGenM' String
applyTemplate (a, b) = do
a' <- toToken a

View File

@ -6,6 +6,9 @@ import Types (Function(..), Value(..))
evalFunction :: Function -> Value -> Value
evalFunction f x = case (f, x) of
(AppendStrings, Tuple (String _, String _)) ->
String undefined
(JoinPaths, Tuple (String _, String _)) ->
String undefined
@ -15,9 +18,6 @@ evalFunction f x = case (f, x) of
(IsImageExtension, String _) ->
Bool undefined
(ConvertedImageFilename, String _) ->
String undefined
(ApplyTemplate, Tuple (Template _, String _)) ->
String undefined

View File

@ -3,16 +3,21 @@ module SiteGenerator (generateSite) where
import Types
import DependencyGenerator
thumbnailImageFilename :: Token FilePath -> DepGenM' FilePath
thumbnailImageFilename filename = do
(base, ext) <- untupleDepGenM (fileComponents filename)
appendStrings (appendStrings (base, inject "-thumbnail."), ext)
handleRecipeDir :: Token FilePath -> Token Template -> Token FilePath -> DepGenM ()
handleRecipeDir outputDir template dir = do
dirContents <- listDirectory dir
exts <- unzipSndDepGenM (mapDepGenM fileComponents dirContents)
areImageFilenames <- mapDepGenM isImageExtension exts
imageFilenames <- filterDepGenM areImageFilenames dirContents
convertedImageFilenames <- mapDepGenM convertedImageFilename imageFilenames
thumbnailImageFilenames <- mapDepGenM thumbnailImageFilename imageFilenames
mapDepGenM_
(\files -> convertImage (files, inject $ ResizeToWidth 800))
(ZipToken (imageFilenames, convertedImageFilenames))
(ZipToken (imageFilenames, thumbnailImageFilenames))
recipeDirOut <- joinPaths (outputDir, dir)
makeDir recipeDirOut
htmlBody <- runPandoc (joinPaths (dir, inject "ret.md"))

View File

@ -23,6 +23,8 @@ data Action = Function Function
| FilterComp
| GetListElem
| SetListElem
| UntupleFst
| UntupleSnd
| UnzipFst
| UnzipSnd
| MapComp [Dependency]

View File

@ -4,10 +4,10 @@ module Types.Function
import Language.Haskell.TH.Syntax (Lift)
data Function = JoinPaths
data Function = AppendStrings
| JoinPaths
| FileComponents
| IsImageExtension
| ConvertedImageFilename
| ApplyTemplate
deriving (Show, Lift)