ngws
/
mad
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Provide better filter ergonomics for the common case

This commit is contained in:
Niels G. W. Serup 2024-10-05 21:57:04 +02:00
parent 90a968ea7d
commit 9311d51464
No known key found for this signature in database
GPG Key ID: 38EEEBCE67324F19
2 changed files with 12 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
byg/src/DependencyGenerator.hs
View File

@ -11,6 +11,7 @@ module DependencyGenerator
, mapDepGenM , mapDepGenM
, mapDepGenM_ , mapDepGenM_
, filterDepGenM , filterDepGenM
, filterDepGenM'
, zipDepGenM , zipDepGenM
, untupleFstDepGenM , untupleFstDepGenM
, untupleSndDepGenM , untupleSndDepGenM
@ -133,11 +134,16 @@ mapDepGenM_ f input = do
_ <- mapDepGenM (\x -> f x >> pure NoToken) input _ <- mapDepGenM (\x -> f x >> pure NoToken) input
pure () pure ()
filterDepGenM :: (TokenableTo [Bool] v, TokenableTo [a] u) => v -> u -> DepGenM' [a] filterDepGenM' :: (TokenableTo [Bool] v, TokenableTo [a] u) => v -> u -> DepGenM' [a]
filterDepGenM mask input = do filterDepGenM' mask input = do
tup <- toTupleToken input mask tup <- toTupleToken input mask
genDependency (makeDependency tup FilterComp) genDependency (makeDependency tup FilterComp)
filterDepGenM :: TokenableTo [a] v => (Token a -> DepGenM' Bool) -> v -> DepGenM' [a]
filterDepGenM f input = do
mask <- mapDepGenM f input
filterDepGenM' mask input
zipDepGenM :: (TokenableTo [a] v, TokenableTo [b] u) => v -> u -> DepGenM' [(a, b)] zipDepGenM :: (TokenableTo [a] v, TokenableTo [b] u) => v -> u -> DepGenM' [(a, b)]
zipDepGenM a b = do zipDepGenM a b = do
a' <- toToken a a' <- toToken a

12
byg/src/SiteGenerator.hs
View File

@ -34,8 +34,7 @@ handleRecipeDir outputDir template indexName dir = do
recipeDirOut <- joinPaths outputDir dir recipeDirOut <- joinPaths outputDir dir
makeDir recipeDirOut makeDir recipeDirOut
dirContents <- listDirectory dir dirContents <- listDirectory dir
areImageFilenames <- mapDepGenM (hasExtension $ inject ["jpg"]) dirContents imageFilenames <- filterDepGenM (hasExtension $ inject ["jpg"]) dirContents
imageFilenames <- filterDepGenM areImageFilenames dirContents
imagePaths <- mapDepGenM (joinPaths dir) imageFilenames imagePaths <- mapDepGenM (joinPaths dir) imageFilenames
imagePathsOut <- mapDepGenM (joinPaths recipeDirOut) imageFilenames imagePathsOut <- mapDepGenM (joinPaths recipeDirOut) imageFilenames
mapDepGenM_ copyFile' $ zipDepGenM imagePaths imagePathsOut mapDepGenM_ copyFile' $ zipDepGenM imagePaths imagePathsOut
@ -69,8 +68,7 @@ generateSite = do
indexName <- inject "index.html" indexName <- inject "index.html"
dirNames <- listDirectory recipesDir dirNames <- listDirectory recipesDir
dirPaths <- mapDepGenM (joinPaths recipesDir) dirNames dirPaths <- mapDepGenM (joinPaths recipesDir) dirNames
dirPathsAreSubdirs <- mapDepGenM isDirectory dirPaths dirPaths' <- filterDepGenM isDirectory dirPaths
dirPaths' <- filterDepGenM dirPathsAreSubdirs dirPaths
mapDepGenM_ (handleRecipeDir outputDir template indexName) dirPaths' mapDepGenM_ (handleRecipeDir outputDir template indexName) dirPaths'
html <- applyTemplate template $ runPandoc $ readTextFile $ inject "om.md" html <- applyTemplate template $ runPandoc $ readTextFile $ inject "om.md"
aboutDir <- joinPaths outputDir $ inject "om" aboutDir <- joinPaths outputDir $ inject "om"
@ -87,8 +85,7 @@ generateSite = do
fontsDir <- inject "fonts" fontsDir <- inject "fonts"
fontsNames <- listDirectory fontsDir fontsNames <- listDirectory fontsDir
fontsPaths <- mapDepGenM (joinPaths fontsDir) fontsNames fontsPaths <- mapDepGenM (joinPaths fontsDir) fontsNames
fontsPathsAreSubdirs <- mapDepGenM isDirectory fontsPaths fontsPaths' <- filterDepGenM isDirectory fontsPaths
fontsPaths' <- filterDepGenM fontsPathsAreSubdirs fontsPaths
makeDir (joinPaths outputDir fontsDir) makeDir (joinPaths outputDir fontsDir)
mapDepGenM_ (handleFontDir outputDir) fontsPaths' mapDepGenM_ (handleFontDir outputDir) fontsPaths'
@ -97,6 +94,5 @@ handleFontDir outputDir fontPath = do
makeDir (joinPaths outputDir fontPath) makeDir (joinPaths outputDir fontPath)
files <- listDirectory fontPath files <- listDirectory fontPath
paths <- mapDepGenM (joinPaths fontPath) files paths <- mapDepGenM (joinPaths fontPath) files
mask <- mapDepGenM (hasExtension $ inject ["woff2", "css"]) paths paths' <- filterDepGenM (hasExtension $ inject ["woff2", "css"]) paths
paths' <- filterDepGenM mask paths
mapDepGenM_ (\p -> copyFile p (joinPaths outputDir p)) paths' mapDepGenM_ (\p -> copyFile p (joinPaths outputDir p)) paths'