diff --git a/byg/src/DependencyRunner.hs b/byg/src/DependencyRunner.hs index 005c86d..ff8fd38 100644 --- a/byg/src/DependencyRunner.hs +++ b/byg/src/DependencyRunner.hs @@ -35,7 +35,7 @@ evaluate = \case runDep :: Dependency -> DepRunM () runDep (Dependency _ a action _ b) = - if actionTouchesFilesystem action + if actionWritesAny action then void m else putTokenValue b $ NotEvaluated m where m :: DepRunM Value diff --git a/byg/src/Functions/Image.hs b/byg/src/Functions/Image.hs index 61c0404..b385a3a 100644 --- a/byg/src/Functions/Image.hs +++ b/byg/src/Functions/Image.hs @@ -30,7 +30,9 @@ instance IsFunctionIO OpenImage FilePath Image where case imageOrig of Left e -> error ("unexpected error: " ++ e) Right image -> pure $ ImageWrapper $ CP.convertRGB8 image - functionIOTouchesFilesystem OpenImage = False + functionIOReads OpenImage s = [s] + functionIOWrites OpenImage = const [] + functionIOWritesAny OpenImage = False openImage :: TokenableTo FilePath a => a -> DepGenM (Token Image) openImage a = runFunctionIO OpenImage =<< toToken a @@ -40,7 +42,9 @@ data SaveImage = SaveImage deriving Show instance IsFunctionIO SaveImage (Image, FilePath) () where evalFunctionIO SaveImage (ImageWrapper image, s) = CP.saveJpgImage 90 s $ CP.ImageRGB8 image - functionIOTouchesFilesystem SaveImage = True + functionIOReads SaveImage = const [] + functionIOWrites SaveImage (_, s) = [s] + functionIOWritesAny SaveImage = True saveImage :: (TokenableTo Image a, TokenableTo FilePath b) => a -> b -> DepGenM () saveImage a b = runFunctionIO_ SaveImage =<< toTupleToken a b diff --git a/byg/src/Functions/Paths.hs b/byg/src/Functions/Paths.hs index 051277a..b5e0d7b 100644 --- a/byg/src/Functions/Paths.hs +++ b/byg/src/Functions/Paths.hs @@ -35,9 +35,10 @@ hasExtension exts filename = do data ListDirectory = ListDirectory deriving Show instance IsFunctionIO ListDirectory FilePath [FilePath] where - evalFunctionIO ListDirectory s = - SD.listDirectory s - functionIOTouchesFilesystem ListDirectory = False + evalFunctionIO ListDirectory s = SD.listDirectory s + functionIOReads ListDirectory s = [s] + functionIOWrites ListDirectory = const [] + functionIOWritesAny ListDirectory = False listDirectory :: TokenableTo FilePath a => a -> DepGenM (Token [FilePath]) listDirectory a = runFunctionIO ListDirectory =<< toToken a @@ -45,9 +46,10 @@ listDirectory a = runFunctionIO ListDirectory =<< toToken a data IsDirectory = IsDirectory deriving Show instance IsFunctionIO IsDirectory FilePath Bool where - evalFunctionIO IsDirectory s = - SD.doesDirectoryExist s - functionIOTouchesFilesystem IsDirectory = False + evalFunctionIO IsDirectory s = SD.doesDirectoryExist s + functionIOReads IsDirectory s = [s] + functionIOWrites IsDirectory = const [] + functionIOWritesAny IsDirectory = False isDirectory :: TokenableTo FilePath a => a -> DepGenM (Token Bool) isDirectory a = runFunctionIO IsDirectory =<< toToken a @@ -57,7 +59,9 @@ data MakeDir = MakeDir deriving Show instance IsFunctionIO MakeDir FilePath () where evalFunctionIO MakeDir s = SD.createDirectory s - functionIOTouchesFilesystem MakeDir = True + functionIOReads MakeDir = const [] + functionIOWrites MakeDir s = [s] + functionIOWritesAny MakeDir = True makeDir :: TokenableTo FilePath a => a -> DepGenM () makeDir a = runFunctionIO_ MakeDir =<< toToken a @@ -67,7 +71,9 @@ data CopyFile = CopyFile deriving Show instance IsFunctionIO CopyFile (FilePath, FilePath) () where evalFunctionIO CopyFile (source, target) = SD.copyFile source target - functionIOTouchesFilesystem CopyFile = True + functionIOReads CopyFile (i, _) = [i] + functionIOWrites CopyFile (_, o) = [o] + functionIOWritesAny CopyFile = True copyFile :: (TokenableTo FilePath a, TokenableTo FilePath b) => a -> b -> DepGenM () copyFile a b = runFunctionIO_ CopyFile =<< toTupleToken a b diff --git a/byg/src/Functions/Text.hs b/byg/src/Functions/Text.hs index 35b8d62..1a14952 100644 --- a/byg/src/Functions/Text.hs +++ b/byg/src/Functions/Text.hs @@ -12,9 +12,10 @@ import qualified Data.Text.IO as T data ReadTextFile = ReadTextFile deriving Show instance IsFunctionIO ReadTextFile FilePath Text where - evalFunctionIO ReadTextFile s = - T.readFile s - functionIOTouchesFilesystem ReadTextFile = False + evalFunctionIO ReadTextFile s = T.readFile s + functionIOReads ReadTextFile s = [s] + functionIOWrites ReadTextFile = const [] + functionIOWritesAny ReadTextFile = False readTextFile :: TokenableTo FilePath a => a -> DepGenM (Token Text) readTextFile a = runFunctionIO ReadTextFile =<< toToken a @@ -22,9 +23,10 @@ readTextFile a = runFunctionIO ReadTextFile =<< toToken a data SaveTextFile = SaveTextFile deriving Show instance IsFunctionIO SaveTextFile (Text, FilePath) () where - evalFunctionIO SaveTextFile (t, s) = - T.writeFile s t - functionIOTouchesFilesystem SaveTextFile = True + evalFunctionIO SaveTextFile (t, s) = T.writeFile s t + functionIOReads SaveTextFile = const [] + functionIOWrites SaveTextFile (_, s) = [s] + functionIOWritesAny SaveTextFile = True saveTextFile :: (TokenableTo Text a, TokenableTo FilePath b) => a -> b -> DepGenM () saveTextFile a b = runFunctionIO_ SaveTextFile =<< toTupleToken a b diff --git a/byg/src/Types/Dependency.hs b/byg/src/Types/Dependency.hs index f96e71e..6c9312a 100644 --- a/byg/src/Types/Dependency.hs +++ b/byg/src/Types/Dependency.hs @@ -6,7 +6,9 @@ module Types.Dependency , makeDependency , actionSourceType , actionTargetType - , actionTouchesFilesystem + , actionReads + , actionWrites + , actionWritesAny , formatDependencyTrees ) where @@ -49,19 +51,23 @@ actionSourceType _ = typeRep actionTargetType :: Typeable b => Action a b -> TypeRep b actionTargetType _ = typeRep -actionTouchesFilesystem :: Action a b -> Bool -actionTouchesFilesystem = \case - Function _ -> False - FunctionIO f -> functionIOTouchesFilesystem f - Inject _ -> False - FilterComp -> False - UntupleFst -> False - UntupleSnd -> False - UnzipFst -> False - UnzipSnd -> False - MapComp subDeps _ _ -> any dependencyTouchesFilesystem subDeps - where dependencyTouchesFilesystem (Dependency _ _ action _ _) = - actionTouchesFilesystem action +actionReads :: Action a b -> a -> [FilePath] +actionReads = \case + FunctionIO f -> functionIOReads f + _ -> const [] + +actionWrites :: Action a b -> a -> [FilePath] +actionWrites = \case + FunctionIO f -> functionIOWrites f + _ -> const [] + +actionWritesAny :: Action a b -> Bool +actionWritesAny = \case + FunctionIO f -> functionIOWritesAny f + MapComp subDeps _ _ -> any dependencyWritesAny subDeps + _ -> False + where dependencyWritesAny :: Dependency -> Bool + dependencyWritesAny (Dependency _ _ action _ _) = actionWritesAny action formatDependencyTrees :: [Dependency] -> Text formatDependencyTrees = T.concat . (formatDependencyTrees' "") diff --git a/byg/src/Types/Functions.hs b/byg/src/Types/Functions.hs index 1073c14..b7ca208 100644 --- a/byg/src/Types/Functions.hs +++ b/byg/src/Types/Functions.hs @@ -7,4 +7,6 @@ import Type.Reflection (Typeable) class (Show f, Show a, Typeable a, Show b, Typeable b) => IsFunctionIO f a b | f -> a b where evalFunctionIO :: f -> a -> IO b - functionIOTouchesFilesystem :: f -> Bool + functionIOReads :: f -> a -> [FilePath] + functionIOWritesAny :: f -> Bool + functionIOWrites :: f -> a -> [FilePath]