Commit d9e75bb2 authored by Bas Lijnse's avatar Bas Lijnse

Made rules-based matching obligatory for filecollections to allow intermediate...

Made rules-based matching obligatory for filecollections to allow intermediate matching when scanning directories
parent b9dc544c
Pipeline #35756 passed with stage
in 6 minutes and 45 seconds
...@@ -7,8 +7,15 @@ import iTasks ...@@ -7,8 +7,15 @@ import iTasks
from Data.Map import :: Map from Data.Map import :: Map
from System.FilePath import :: FilePath from System.FilePath import :: FilePath
//Determine if a path is part of the collection based on the relative path /**
:: FileFilter :== FilePath -> FileFilterDecision * Determine if a path is part of the collection based on the relative path
* The path is tested against est the path against a list of 'glob'-like rules.
* Return the decision for the first rule that matches.
* If none of the rules match, the default decision is to exclude the path
*/
:: FileFilter :== [(FileFilterRule,FileFilterDecision)]
:: FileFilterRule :== String
:: FileFilterDecision :: FileFilterDecision
= IncludeFile //The file is part of the managed collection = IncludeFile //The file is part of the managed collection
| ExcludeFile //The file is not part of the collection, do not touch it | ExcludeFile //The file is not part of the collection, do not touch it
...@@ -33,12 +40,6 @@ derive class iTask FileCollectionItem ...@@ -33,12 +40,6 @@ derive class iTask FileCollectionItem
*/ */
fileCollection :: FileFilter Bool Bool -> SDSSource FilePath FileCollection FileCollection fileCollection :: FileFilter Bool Bool -> SDSSource FilePath FileCollection FileCollection
/**
* Test the path against a list of 'glob' rules. Return the decision for the first rule that matches.
* If none of the rules match, the default decision is returned.
*/
matchRules :: [(String,FileFilterDecision)] FileFilterDecision -> FileFilter
//Filter to ignore all hidden files (e.g. starting with a '.') //Filter to ignore all hidden files (e.g. starting with a '.')
ignoreHiddenFiles :: FileFilter ignoreHiddenFiles :: FileFilter
......
...@@ -21,7 +21,7 @@ EXCLUDE_FILE :== "exclude.txt" ...@@ -21,7 +21,7 @@ EXCLUDE_FILE :== "exclude.txt"
//Writes a map of key/value pairs to a directory with one file per key/value //Writes a map of key/value pairs to a directory with one file per key/value
//It will ignore all files in the directory that don't match the filter //It will ignore all files in the directory that don't match the filter
fileCollection :: FileFilter Bool Bool -> SDSSource FilePath FileCollection FileCollection fileCollection :: FileFilter Bool Bool -> SDSSource FilePath FileCollection FileCollection
fileCollection isFileInCollection readOnly deleteRemovedFiles = worldShare (read isFileInCollection) (write readOnly isFileInCollection) notify fileCollection rules readOnly deleteRemovedFiles = worldShare (read (matchRules rules)) (write readOnly (matchRules rules)) notify
where where
read isFileInCollection dir world = case readDirectory dir world of read isFileInCollection dir world = case readDirectory dir world of
(Error (2,msg),world) = (Ok 'DM'.newMap,world) //Directory does not exist yet (Error (2,msg),world) = (Ok 'DM'.newMap,world) //Directory does not exist yet
...@@ -38,7 +38,20 @@ where ...@@ -38,7 +38,20 @@ where
| otherwise = case getFileInfo (dir </> f) world of | otherwise = case getFileInfo (dir </> f) world of
(Error (_,msg),world) = (Error msg,world) (Error (_,msg),world) = (Error msg,world)
(Ok {FileInfo|directory},world) (Ok {FileInfo|directory},world)
# decision = isFileInCollection f # decision = isFileInCollection f False
# intermediate = isFileInCollection f True
//Read a subcollection
| directory && (decision =: IncludeFile || intermediate =: IncludeFile)
= case read (\p i -> (isFileInCollection (f </> p) i)) (dir </> f) world of
(Error e,world) = (Error e,world)
(Ok fcollection,world) = case readFiles isFileInCollection excludes dir fs world of
(Error e,world) = (Error e,world)
(Ok collection,world)
//Only include the directory if it was explicitly included or it has matching files in it
| (decision =: IncludeFile) || (not $ 'DM'.null fcollection)
= (Ok [(f,FileCollection fcollection):collection], world)
| otherwise
= (Ok collection, world)
//Skip files that don't match the filter //Skip files that don't match the filter
| decision =: ExcludeFile | decision =: ExcludeFile
= readFiles isFileInCollection excludes dir fs world = readFiles isFileInCollection excludes dir fs world
...@@ -46,12 +59,6 @@ where ...@@ -46,12 +59,6 @@ where
| decision =: ReferenceFile = case readFiles isFileInCollection excludes dir fs world of | decision =: ReferenceFile = case readFiles isFileInCollection excludes dir fs world of
(Error e,world) = (Error e,world) (Error e,world) = (Error e,world)
(Ok collection,world) = (Ok [(f,FileReference):collection], world) (Ok collection,world) = (Ok [(f,FileReference):collection], world)
//Read a subcollection
| decision =: IncludeFile && directory = case read (\x -> (isFileInCollection (f </> x))) (dir </> f) world of
(Error e,world) = (Error e,world)
(Ok fcollection,world) = case readFiles isFileInCollection excludes dir fs world of
(Error e,world) = (Error e,world)
(Ok collection,world) = (Ok [(f,FileCollection fcollection):collection], world)
//Read the file content //Read the file content
| otherwise = case readFile (dir </> f) world of | otherwise = case readFile (dir </> f) world of
(Error e,world) = (Error (toString e),world) (Error e,world) = (Error (toString e),world)
...@@ -71,7 +78,7 @@ where ...@@ -71,7 +78,7 @@ where
(Ok curfiles,world) = case writeFiles ('DM'.toList collection) isFileInCollection dir world of (Ok curfiles,world) = case writeFiles ('DM'.toList collection) isFileInCollection dir world of
(Error e,world) = (Error e,world) (Error e,world) = (Error e,world)
(Ok newfiles,world) = cleanupRemovedFiles curfiles newfiles isFileInCollection dir world (Ok newfiles,world) = cleanupRemovedFiles curfiles newfiles isFileInCollection dir world
//The direcrory does not exist yet, create it first and then write the collection //The directory does not exist yet, create it first and then write the collection
(Error (2,_),world) = case ensureDirectory dir world of (Error (2,_),world) = case ensureDirectory dir world of
(Error e,world) = (Error e,world) (Error e,world) = (Error e,world)
(Ok (),world) = case writeFiles ('DM'.toList collection) isFileInCollection dir world of (Ok (),world) = case writeFiles ('DM'.toList collection) isFileInCollection dir world of
...@@ -81,7 +88,7 @@ where ...@@ -81,7 +88,7 @@ where
writeFiles [] isFileInCollection dir world = (Ok [],world) writeFiles [] isFileInCollection dir world = (Ok [],world)
writeFiles [(name,FileContent content):fs] isFileInCollection dir world writeFiles [(name,FileContent content):fs] isFileInCollection dir world
# decision = isFileInCollection name # decision = isFileInCollection name False
| decision =: ExcludeFile = writeFiles fs isFileInCollection dir world //Don't write files that don't match the filter | decision =: ExcludeFile = writeFiles fs isFileInCollection dir world //Don't write files that don't match the filter
| otherwise = case writeFile (dir </> name) content world of | otherwise = case writeFile (dir </> name) content world of
(Error e,world) = (Error (toString e),world) (Error e,world) = (Error (toString e),world)
...@@ -90,11 +97,14 @@ where ...@@ -90,11 +97,14 @@ where
(Ok curfiles,world) = (Ok [name:curfiles],world) (Ok curfiles,world) = (Ok [name:curfiles],world)
writeFiles [(name,FileCollection collection):fs] isFileInCollection dir world writeFiles [(name,FileCollection collection):fs] isFileInCollection dir world
# decision = isFileInCollection name # decision = isFileInCollection name False
| decision =: ExcludeFile = writeFiles fs isFileInCollection dir world //Don't write files that don't match the filter # intermediate = isFileInCollection name True
//Don't write directories that don't match the filter
| decision =: ExcludeFile && intermediate =: ExcludeFile
= writeFiles fs isFileInCollection dir world
| otherwise = case ensureDirectory (dir </> name) world of | otherwise = case ensureDirectory (dir </> name) world of
(Error e,world) = (Error e,world) (Error e,world) = (Error e,world)
(Ok (),world) = case write False (\x -> isFileInCollection (name </> x)) (dir </> name) collection world of (Ok (),world) = case write False (\p i -> isFileInCollection (name </> p) i) (dir </> name) collection world of
(Error e,world) = (Error e,world) (Error e,world) = (Error e,world)
(Ok (),world) = case writeFiles fs isFileInCollection dir world of (Ok (),world) = case writeFiles fs isFileInCollection dir world of
(Error e,world) = (Error e,world) (Error e,world) = (Error e,world)
...@@ -124,9 +134,11 @@ where ...@@ -124,9 +134,11 @@ where
| deleteRemovedFiles = deleteFiles filesToRemove dir world | deleteRemovedFiles = deleteFiles filesToRemove dir world
| otherwise = excludeFiles filesToRemove dir world | otherwise = excludeFiles filesToRemove dir world
where where
filesToRemove = [f \\ f <- filesInDirectory | f <> "." && f <> ".." && filesToRemove
f <> EXCLUDE_FILE && not (isMember f filesInCollection) && = [name \\ name <- filesInDirectory
(isFileInCollection f) =: IncludeFile | name <> "." && name <> ".." && name <> EXCLUDE_FILE
&& not (isMember name filesInCollection) //The file is not (longer) in the collection
&& not ((isFileInCollection name True) =: ExcludeFile) //The file or directory is explicilty part of the collection
] ]
excludeFiles files dir world = case writeFile (dir </> EXCLUDE_FILE) (join OS_NEWLINE files) world of excludeFiles files dir world = case writeFile (dir </> EXCLUDE_FILE) (join OS_NEWLINE files) world of
...@@ -142,21 +154,24 @@ where ...@@ -142,21 +154,24 @@ where
= startsWith writeParameter registeredParameter || startsWith registeredParameter writeParameter = startsWith writeParameter registeredParameter || startsWith registeredParameter writeParameter
ignoreHiddenFiles :: FileFilter ignoreHiddenFiles :: FileFilter
ignoreHiddenFiles = matchRules [("**/.*",ExcludeFile)] IncludeFile ignoreHiddenFiles = [("**/.*",ExcludeFile),("**",IncludeFile)]
matchRules :: [(String,FileFilterDecision)] FileFilterDecision -> FileFilter matchRules :: [(String,FileFilterDecision)] String Bool -> FileFilterDecision
matchRules rules default = matchRules` rules matchRules [] path intermediate = ExcludeFile
matchRules [(pattern,decision):rs] path intermediate
| match pattern 0 path 0 intermediate = if intermediate IncludeFile decision
| otherwise = matchRules rs path intermediate
where where
matchRules` [] path = default
matchRules` [(pattern,decision):rs] path = if (match pattern 0 path 0) decision (matchRules` rs path)
//Because there is no 'proper' glob-like file matching library in Clean platform, //Because there is no 'proper' glob-like file matching library in Clean platform,
//this simple and somewhat limited matcher will have to do //this simple and somewhat limited matcher will have to do
match :: !String !Int !String !Int -> Bool match :: !String !Int !String !Int !Bool -> Bool
match pattern ppos input ipos match pattern ppos input ipos intermediate
//All input has been read, if the pattern has been fully processed, or we were processing the last '*' we have a match //All input has been read. We have a match when:
| ipos >= size input = ppos == size pattern || (ppos == size pattern - 1 && pattern.[ppos] == '*') | ipos >= size input
//The pattern has been fully, matched but there is input left = ppos == size pattern // - the pattern has been fully processed
|| intermediate // - we accept intermediate paths
|| (ppos == size pattern - 1 && pattern.[ppos] == '*') //- we were processing the last '*' we have a match
//The pattern has been fully matched but there is input left
| ppos >= size pattern = False | ppos >= size pattern = False
//Special case: pattern ends with '/**' accept anything after the '/' //Special case: pattern ends with '/**' accept anything after the '/'
| ppos + 3 == size pattern | ppos + 3 == size pattern
...@@ -165,17 +180,17 @@ where ...@@ -165,17 +180,17 @@ where
//Special case '**/' match any number of directories //Special case '**/' match any number of directories
| ppos + 2 < size pattern && pattern.[ppos] == '*' && pattern.[ppos + 1] == '*' && pattern.[ppos + 2] == '/' | ppos + 2 < size pattern && pattern.[ppos] == '*' && pattern.[ppos + 1] == '*' && pattern.[ppos + 2] == '/'
//Don't match any more characters //Don't match any more characters
= match pattern (ppos + 3) input ipos = match pattern (ppos + 3) input ipos intermediate
//.. or we try to match starting after the next slash //.. or we try to match starting after the next slash
|| maybe False (\ipos -> match pattern ppos input ipos) (nextDir input ipos) || maybe False (\ipos -> match pattern ppos input ipos intermediate) (nextDir input ipos)
//Special case: '*' match any number of characters (but not '/') //Special case: '*' match any number of characters (but not '/')
| pattern.[ppos] == '*' | pattern.[ppos] == '*'
//Don't match any more characters //Don't match any more characters
= match pattern (ppos + 1) input ipos = match pattern (ppos + 1) input ipos intermediate
//.. or we can read an extra character and try to match //.. or we can read an extra character and try to match
|| (input.[ipos] <> '/' && match pattern ppos input (ipos + 1)) || (input.[ipos] <> '/' && match pattern ppos input (ipos + 1) intermediate)
//Match the expected character //Match the expected character
| input.[ipos] == pattern.[ppos] = match pattern (ppos + 1) input (ipos + 1) | input.[ipos] == pattern.[ppos] = match pattern (ppos + 1) input (ipos + 1) intermediate
| otherwise = False //The pattern does not match | otherwise = False //The pattern does not match
where where
nextDir input ipos nextDir input ipos
...@@ -201,6 +216,7 @@ setIntContent key value collection = 'DM'.put key (FileContent (toString value)) ...@@ -201,6 +216,7 @@ setIntContent key value collection = 'DM'.put key (FileContent (toString value))
toPaths :: FileCollection -> [FilePath] toPaths :: FileCollection -> [FilePath]
toPaths collection = flatten (map toPath ('DM'.toList collection)) toPaths collection = flatten (map toPath ('DM'.toList collection))
where where
toPath (name,FileReference) = [name]
toPath (name,FileContent _) = [name] toPath (name,FileContent _) = [name]
toPath (name,FileCollection collection) = [name:[name </> path \\ path <- toPaths collection]] toPath (name,FileCollection collection) = [name:[name </> path \\ path <- toPaths collection]]
......
...@@ -59,21 +59,21 @@ where ...@@ -59,21 +59,21 @@ where
runInteractiveTests :: Task () runInteractiveTests :: Task ()
runInteractiveTests runInteractiveTests
= ( (Title "Select test") @>> editSelectionWithShared [SelectMultiple False, SelectInTree fileCollectionToTree selectTest] tests (const []) @? tvHd = ( (Title "Select test") @>> widthAttr FlexSize @>> editSelectionWithShared [SelectMultiple False, SelectInTree fileCollectionToTree selectTest] tests (const []) @? tvHd
>&> withSelection (viewInformation [] "Select a test") testInteractive ) <<@ ArrangeWithSideBar 0 LeftSide True @! () >&> withSelection (viewInformation [] "Select a test") testInteractive ) <<@ ArrangeWithSideBar 0 LeftSide True @! ()
where where
tests = sdsFocus INTERACTIVE_TESTS_PATH (fileCollection (\path isDirectory -> isDirectory || takeExtension path == "icl") False) tests = sdsFocus INTERACTIVE_TESTS_PATH (fileCollection [("**/*.icl",ReferenceFile)] True False)
fileCollectionToTree collection = itemsToTree [] collection fileCollectionToTree collection = itemsToTree [] collection
where where
itemsToTree prefix subCollection = map (itemToTree prefix) ('DM'.toList subCollection) itemsToTree prefix subCollection = map (itemToTree prefix) ('DM'.toList subCollection)
itemToTree prefix (name,FileContent _)
= {ChoiceNode|id = determineItemId (fileName [name:prefix]) collection, label = name
, expanded = False, icon = Nothing, children = []}
itemToTree prefix (name,FileCollection subCollection) itemToTree prefix (name,FileCollection subCollection)
= {ChoiceNode|id = determineItemId (fileName [name:prefix]) collection, label = name = {ChoiceNode|id = determineItemId (fileName [name:prefix]) collection, label = name
, expanded = False, icon = Nothing, children = itemsToTree [name:prefix] subCollection} , expanded = False, icon = Nothing, children = itemsToTree [name:prefix] subCollection}
itemToTree prefix (name,_)
= {ChoiceNode|id = determineItemId (fileName [name:prefix]) collection, label = name
, expanded = False, icon = Nothing, children = []}
fileName path = join {OS_PATH_SEPARATOR} (reverse path) fileName path = join {OS_PATH_SEPARATOR} (reverse path)
...@@ -88,7 +88,7 @@ where ...@@ -88,7 +88,7 @@ where
runUnitTests :: Task () runUnitTests :: Task ()
runUnitTests = withShared 'DM'.newMap runUnitTests = withShared 'DM'.newMap
\results -> \results ->
(( (((Title "Tests") @>> editSelectionWithShared (( (((Title "Tests") @>> widthAttr FlexSize @>> editSelectionWithShared
[SelectMultiple False, SelectInTree toModuleSelectTree selectByIndex] [SelectMultiple False, SelectInTree toModuleSelectTree selectByIndex]
(sdsFocus UNIT_TESTS_PATH moduleList) (const []) @? tvHd) (sdsFocus UNIT_TESTS_PATH moduleList) (const []) @? tvHd)
) )
...@@ -148,7 +148,7 @@ where ...@@ -148,7 +148,7 @@ where
exploreCode :: Task () exploreCode :: Task ()
exploreCode exploreCode
= (( (((Title "Modules") @>> editSelectionWithShared = (( (((Title "Modules") @>> widthAttr FlexSize @>> editSelectionWithShared
[SelectMultiple False, SelectInTree toModuleSelectTree selectByIndex] [SelectMultiple False, SelectInTree toModuleSelectTree selectByIndex]
(sdsFocus LIBRARY_PATH moduleList) (const []) @? tvHd) (sdsFocus LIBRARY_PATH moduleList) (const []) @? tvHd)
-|| viewQualityMetrics -|| viewQualityMetrics
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment