Also copy original images

This commit is contained in:
Niels G. W. Serup 2024-09-26 00:02:51 +02:00
parent fa2e3c144a
commit 5d5dbbec74
No known key found for this signature in database
GPG Key ID: 38EEEBCE67324F19
4 changed files with 14 additions and 1 deletions

View File

@ -25,6 +25,7 @@ module DependencyGenerator
, readTemplate
, convertImage
, saveFile
, copyFile
, makeDir
, runPandoc
) where
@ -197,6 +198,12 @@ saveFile (a, b) = do
b' <- toToken b
runFunctionIO' SaveFile $ TupleToken (a', b')
copyFile :: (TokenableTo FilePath a, TokenableTo FilePath b) => (a, b) -> DepGenM ()
copyFile (a, b) = do
a' <- toToken a
b' <- toToken b
runFunctionIO' CopyFile $ TupleToken (a', b')
makeDir :: TokenableTo FilePath a => a -> DepGenM ()
makeDir a = runFunctionIO' MakeDir =<< toToken a

View File

@ -18,6 +18,9 @@ evalFunctionIO f x = case (f, x) of
(SaveFile, Tuple (String _, String _)) ->
pure $ Empty
(CopyFile, Tuple (String _, String _)) ->
pure $ Empty
(MakeDir, String _) ->
pure $ Empty

View File

@ -15,7 +15,9 @@ handleRecipeDir outputDir template indexName dir = do
exts <- unzipSndDepGenM (mapDepGenM fileComponents dirContents)
areImageFilenames <- mapDepGenM isImageExtension exts
imageFilenames <- filterDepGenM areImageFilenames dirContents
imagePaths <- mapDepGenM (curry joinPaths outputDir) imageFilenames
imagePaths <- mapDepGenM (curry joinPaths dir) imageFilenames
imagePathsOut <- mapDepGenM (curry joinPaths outputDir) imageFilenames
mapDepGenM_ ((copyFile =<<) . untupleDepGenM) (ZipToken (imagePaths, imagePathsOut))
thumbnailImagePaths <- mapDepGenM (thumbnailImagePath outputDir) imageFilenames
mapDepGenM_
(\files -> convertImage (files, inject $ ResizeToWidth 800))

View File

@ -8,6 +8,7 @@ data FunctionIO = ListDirectory
| ReadTemplate
| ConvertImage
| SaveFile
| CopyFile
| MakeDir
| RunPandoc
deriving (Show, Lift)