Check whether something touches the filesystem

This commit is contained in:
Niels G. W. Serup 2024-10-06 00:23:19 +02:00
parent 9170a7f044
commit ed37ba9a09
No known key found for this signature in database
GPG Key ID: 38EEEBCE67324F19
2 changed files with 30 additions and 1 deletions

View File

@ -1,11 +1,13 @@
module Evaluation.FunctionIO
( evalFunctionIO
, functionIOTouchesFilesystem
) where
import Prelude hiding (String, FilePath)
import Types.Values
import Types (FunctionIO(..), Value(..), toValue, makeImage)
import Types.FunctionIO
import Types.Value (Value(..), toValue, makeImage)
import qualified Data.Text.IO as T
import qualified Codec.Picture as CP
@ -46,3 +48,14 @@ evalFunctionIO f x = case (f, x) of
_ ->
error ("unexpected combination of function and argument type; got function " ++ show f ++ " with argument " ++ show x)
functionIOTouchesFilesystem :: FunctionIO -> Bool
functionIOTouchesFilesystem = \case
ListDirectory -> False
IsDirectory -> False
ReadTextFile -> False
OpenImage -> False
SaveImage -> True
SaveTextFile -> True
CopyFile -> True
MakeDir -> True

View File

@ -5,6 +5,7 @@ module Types.Dependency
, Dependency(..)
, makeDependency
, makeUToken
, actionTouchesFilesystem
, formatDependencyTrees
) where
@ -12,6 +13,7 @@ import Types.Token (Token(..))
import Types.Value (Value)
import Types.Function (Function)
import Types.FunctionIO (FunctionIO)
import Evaluation.FunctionIO (functionIOTouchesFilesystem)
import Text.Printf (printf)
import Data.Text (Text)
@ -50,6 +52,20 @@ makeUToken = \case
ListToken ts -> UListToken (map makeUToken ts)
NoToken -> UNoToken
actionTouchesFilesystem :: Action -> 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
formatDependencyTrees :: [Dependency] -> Text
formatDependencyTrees = T.concat . (formatDependencyTrees' "")
where formatDependencyTrees' indentation = concatMap (formatDependencyTree indentation)