Generalize *TouchesFilesystem

This commit is contained in:
Niels G. W. Serup 2024-10-21 22:17:23 +02:00
parent fac43fcd88
commit 3fbaf2a093
No known key found for this signature in database
GPG Key ID: 38EEEBCE67324F19
6 changed files with 52 additions and 32 deletions

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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' "")

View File

@ -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]