Add filterComputationM

This commit is contained in:
Niels G. W. Serup 2024-09-21 22:40:17 +02:00
parent fce1d88025
commit 06067a6cfc
No known key found for this signature in database
GPG Key ID: 38EEEBCE67324F19
2 changed files with 23 additions and 1 deletions

View File

@ -1,8 +1,11 @@
module ComputationM module ComputationM
( ComputationM ( ComputationM
, Token
, evalComputationM , evalComputationM
, inject , inject
, mapComputationM , mapComputationM
, mapComputationM_
, filterComputationM
, runFunction , runFunction
, runFunctionIO , runFunctionIO
) where ) where
@ -19,11 +22,13 @@ data TypedRun a b where
GetListElem :: TypedRun [b] b GetListElem :: TypedRun [b] b
SetListElem :: TypedRun a [a] SetListElem :: TypedRun a [a]
MapComp :: [DependencyUntyped] -> TypedRun [a] [b] MapComp :: [DependencyUntyped] -> TypedRun [a] [b]
FilterComp :: TypedRun ([a], [Bool]) [a]
deriving instance (Show a, Show b) => Show (TypedRun a b) deriving instance (Show a, Show b) => Show (TypedRun a b)
data Token a where data Token a where
Token :: Int -> Token a Token :: Int -> Token a
ZipToken :: Token a -> Token b -> Token (a, b)
NoToken :: Token () NoToken :: Token ()
deriving instance Show (Token a) deriving instance Show (Token a)
@ -90,3 +95,13 @@ mapComputationM f input = genDependency' $ \target -> do
setListElem outp target setListElem outp target
put top' put top'
pure (Dependency input (MapComp res) target) pure (Dependency input (MapComp res) target)
mapComputationM_ :: Show a => (Token a -> ComputationM ()) -> Token [a] -> ComputationM ()
mapComputationM_ f input = do
_ <- mapComputationM f input
pure NoToken
filterComputationM :: Show a => (Token a -> ComputationM Bool) -> Token [a] -> ComputationM [a]
filterComputationM f input = do
conds <- mapComputationM f input
genDependency (Dependency (ZipToken input conds) FilterComp)

View File

@ -3,11 +3,18 @@ module Main where
import ComputationM import ComputationM
import Functions import Functions
handleRecipeDir :: Token FilePath -> ComputationM ()
handleRecipeDir dir = do
dirContents <- listDirectory dir
imageFilenames <- filterComputationM isImageFilename dirContents
t <- inject ("hej", "hey.txt")
saveFile t
test :: ComputationM () test :: ComputationM ()
test = do test = do
dir <- inject "retter" dir <- inject "retter"
dirContents <- listDirectory dir dirContents <- listDirectory dir
_ <- mapComputationM openImage dirContents mapComputationM_ handleRecipeDir dirContents
t <- inject ("hej", "hey.txt") t <- inject ("hej", "hey.txt")
saveFile t saveFile t