Make the functions easier to call inline

This commit is contained in:
Niels G. W. Serup 2024-09-25 22:09:26 +02:00
parent ad83c8c941
commit 6ecb577402
No known key found for this signature in database
GPG Key ID: 38EEEBCE67324F19
2 changed files with 51 additions and 40 deletions

View File

@ -1,3 +1,4 @@
{-# LANGUAGE FunctionalDependencies #-}
module DependencyGenerator
( DepGenM
, DepGenM'
@ -99,33 +100,53 @@ filterDepGenM f input = do
conds <- mapDepGenM f input
genDependency (makeDependency (TupleToken (input, conds)) FilterComp)
class TokenableTo t s | s -> t where
toToken :: s -> DepGenM' t
joinPaths :: (Token FilePath, Token FilePath) -> DepGenM' FilePath
joinPaths = runFunction JoinPaths . TupleToken
instance TokenableTo a (Token a) where
toToken = pure
isImageFilename :: Token FilePath -> DepGenM' Bool
isImageFilename = runFunction IsImageFilename
instance TokenableTo a (DepGenM' a) where
toToken = id
convertedImageFilename :: Token FilePath -> DepGenM' FilePath
convertedImageFilename = runFunction ConvertedImageFilename
joinPaths :: (TokenableTo FilePath a, TokenableTo FilePath b) => (a, b) -> DepGenM' FilePath
joinPaths (a, b) = do
a' <- toToken a
b' <- toToken b
runFunction JoinPaths $ TupleToken (a', b')
applyTemplate :: (Token Template, Token String) -> DepGenM' String
applyTemplate = runFunction ApplyTemplate . TupleToken
isImageFilename :: TokenableTo FilePath a => a -> DepGenM' Bool
isImageFilename a = runFunction IsImageFilename =<< toToken a
listDirectory :: Token FilePath -> DepGenM' [FilePath]
listDirectory = runFunctionIO ListDirectory
convertedImageFilename :: TokenableTo FilePath a => a -> DepGenM' FilePath
convertedImageFilename a = runFunction ConvertedImageFilename =<< toToken a
readTemplate :: Token FilePath -> DepGenM' Template
readTemplate = runFunctionIO ReadTemplate
applyTemplate :: (TokenableTo Template a, TokenableTo String b) => (a, b) -> DepGenM' String
applyTemplate (a, b) = do
a' <- toToken a
b' <- toToken b
runFunction ApplyTemplate $ TupleToken (a', b')
convertImage :: (Token (FilePath, FilePath), Token ImageConversionSettings) -> DepGenM ()
convertImage = runFunctionIO' ConvertImage . TupleToken
listDirectory :: TokenableTo FilePath a => a -> DepGenM' [FilePath]
listDirectory a = runFunctionIO ListDirectory =<< toToken a
saveFile :: (Token String, Token FilePath) -> DepGenM ()
saveFile = runFunctionIO' SaveFile . TupleToken
readTemplate :: TokenableTo FilePath a => a -> DepGenM' Template
readTemplate a = runFunctionIO ReadTemplate =<< toToken a
makeDir :: Token FilePath -> DepGenM ()
makeDir = runFunctionIO' MakeDir
convertImage :: (TokenableTo (FilePath, FilePath) a, TokenableTo ImageConversionSettings b) => (a, b) -> DepGenM ()
convertImage (a, b) = do
a' <- toToken a
b' <- toToken b
runFunctionIO' ConvertImage $ TupleToken (a', b')
runPandoc :: Token FilePath -> DepGenM' String
runPandoc = runFunctionIO RunPandoc
saveFile :: (TokenableTo String a, TokenableTo FilePath b) => (a, b) -> DepGenM ()
saveFile (a, b) = do
a' <- toToken a
b' <- toToken b
runFunctionIO' SaveFile $ TupleToken (a', b')
makeDir :: TokenableTo FilePath a => a -> DepGenM ()
makeDir a = runFunctionIO' MakeDir =<< toToken a
runPandoc :: TokenableTo FilePath a => a -> DepGenM' String
runPandoc a = runFunctionIO RunPandoc =<< toToken a

View File

@ -8,32 +8,22 @@ handleRecipeDir outputDir template dir = do
dirContents <- listDirectory dir
imageFilenames <- filterDepGenM isImageFilename dirContents
convertedImageFilenames <- mapDepGenM convertedImageFilename imageFilenames
flip mapDepGenM_ (ZipToken (imageFilenames, convertedImageFilenames)) $ \files -> do
settings <- inject $ ResizeToWidth 800
convertImage (files, settings)
recipeFilenameIn <- inject "ret.md"
recipePathIn <- joinPaths (dir, recipeFilenameIn)
mapDepGenM_
(\files -> convertImage (files, inject $ ResizeToWidth 800))
(ZipToken (imageFilenames, convertedImageFilenames))
recipeDirOut <- joinPaths (outputDir, dir)
makeDir recipeDirOut
recipeFilenameOut <- inject "index.html"
recipePathOut <- joinPaths (recipeDirOut, recipeFilenameOut)
htmlBody <- runPandoc recipePathIn
htmlBody <- runPandoc (joinPaths (dir, inject "ret.md"))
html <- applyTemplate (template, htmlBody)
saveFile (html, recipePathOut)
saveFile (html, joinPaths (recipeDirOut, inject "index.html"))
generateSite :: DepGenM ()
generateSite = do
outputDir <- inject "site"
makeDir outputDir
templateFilename <- inject "template.html"
template <- readTemplate templateFilename
dir <- inject "retter"
dirContents <- listDirectory dir
template <- readTemplate (inject "template.html")
dirContents <- listDirectory (inject "retter")
mapDepGenM_ (handleRecipeDir outputDir template) dirContents
aboutPathIn <- inject "om.md"
aboutFilenameOut <- inject "om.html"
aboutPathOut <- joinPaths (outputDir, aboutFilenameOut)
aboutHtmlBody <- runPandoc aboutPathIn
aboutHtml <- applyTemplate (template, aboutHtmlBody)
saveFile (aboutHtml, aboutPathOut)
htmlBody <- runPandoc (inject "om.md")
html <- applyTemplate (template, htmlBody)
saveFile (html, joinPaths (outputDir, inject "om.html"))