Generalize *TouchesFilesystem
This commit is contained in:
parent
fac43fcd88
commit
3fbaf2a093
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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' "")
|
||||
|
|
|
@ -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]
|
||||
|
|
Loading…
Reference in New Issue