Generalize *TouchesFilesystem

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

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

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 =
+  evalFunctionIO ListDirectory s = SD.listDirectory s
-    SD.listDirectory s
+  functionIOReads ListDirectory s = [s]
-  functionIOTouchesFilesystem ListDirectory = False
+  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 =
+  evalFunctionIO IsDirectory s = SD.doesDirectoryExist s
-    SD.doesDirectoryExist s
+  functionIOReads IsDirectory s = [s]
-  functionIOTouchesFilesystem IsDirectory = False
+  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

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 =
+  evalFunctionIO ReadTextFile s = T.readFile s
-    T.readFile s
+  functionIOReads ReadTextFile s = [s]
-  functionIOTouchesFilesystem ReadTextFile = False
+  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) =
+  evalFunctionIO SaveTextFile (t, s) = T.writeFile s t
-    T.writeFile s t
+  functionIOReads SaveTextFile = const []
-  functionIOTouchesFilesystem SaveTextFile = True
+  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

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
+actionReads :: Action a b -> a -> [FilePath]
-actionTouchesFilesystem = \case
+actionReads = \case
-  Function _ -> False
+  FunctionIO f -> functionIOReads f
-  FunctionIO f -> functionIOTouchesFilesystem f
+  _ -> const []
-  Inject _ -> False
+
-  FilterComp -> False
+actionWrites :: Action a b -> a -> [FilePath]
-  UntupleFst -> False
+actionWrites = \case
-  UntupleSnd -> False
+  FunctionIO f -> functionIOWrites f
-  UnzipFst -> False
+  _ -> const []
-  UnzipSnd -> False
+
-  MapComp subDeps _ _ -> any dependencyTouchesFilesystem subDeps
+actionWritesAny :: Action a b -> Bool
-  where dependencyTouchesFilesystem (Dependency _ _ action _ _) =
+actionWritesAny = \case
-          actionTouchesFilesystem action
+  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' "")

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]