Add filterComputationM
This commit is contained in:
parent
fce1d88025
commit
06067a6cfc
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue