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