From be64cb7bfba44c6069b6b49741f3481868824180 Mon Sep 17 00:00:00 2001 From: Zach LaVallee Date: Fri, 24 Apr 2026 13:29:11 -0700 Subject: [PATCH 01/19] ANE-1036: Support glob patterns in .fossa.yml path filters `paths.only` and `paths.exclude` entries that contain `*`, `?`, or `[` are now parsed as System.FilePattern globs via the existing Data.Glob wrapper. Entries without glob metacharacters keep their prior "directory and all children" semantics, so this change is backward-compatible. Adds a PathFilter sum type at the config layer, threads a parallel list of glob patterns through FilterCombination, and extends pathAllowed / applyComb to include-or-exclude directories whose relative path matches a glob. Matching normalizes the trailing slash that Path.toString appends to Dir paths so patterns like `node_modules/*` match as users expect. Docs and fossa-yml.v3.schema.json updated. Co-Authored-By: Claude Opus 4.7 --- Changelog.md | 1 + docs/references/files/fossa-yml.md | 14 +++ .../references/files/fossa-yml.v3.schema.json | 6 +- src/App/Fossa/Config/Common.hs | 10 +- src/App/Fossa/Config/ConfigFile.hs | 6 +- src/Discovery/Filters.hs | 98 +++++++++++++++++-- test/Discovery/FiltersSpec.hs | 66 +++++++++++++ 7 files changed, 182 insertions(+), 19 deletions(-) diff --git a/Changelog.md b/Changelog.md index fbdbef2023..672f377c8b 100644 --- a/Changelog.md +++ b/Changelog.md @@ -4,6 +4,7 @@ - pnpm: Support `catalog:` and `catalog:` version specifiers. Versions are resolved from the `catalogs` section in `pnpm-lock.yaml`. ([#1696](https://github.com/fossas/fossa-cli/pull/1696)) - pnpm: Remove stray `traceShow` debug output that dumped the parsed `pnpm-workspace.yaml` to stderr. ([#1696](https://github.com/fossas/fossa-cli/pull/1696)) +- Config: `paths.only` and `paths.exclude` in `.fossa.yml` now accept glob patterns (e.g. `**/vendor/**`, `node_modules/*`). Entries containing `*`, `?`, or `[` are parsed as globs; other entries keep their existing directory-tree semantics. ## 3.17.2 diff --git a/docs/references/files/fossa-yml.md b/docs/references/files/fossa-yml.md index b993bc1b45..9c11fba0dc 100644 --- a/docs/references/files/fossa-yml.md +++ b/docs/references/files/fossa-yml.md @@ -334,6 +334,20 @@ The list of paths to exclude from scanning in your directory. This section is intended to be used as the inverse to `paths.only`. If you have a certain directory such as `development` you wish to exclude, `paths.exclude` enables you to do this. +#### Glob patterns + +Entries in `paths.only` and `paths.exclude` may also be glob patterns. An entry is treated as a glob if it contains any of `*`, `?`, or `[`; other entries keep their existing semantics (match the directory and all of its children). Glob matching follows [`System.FilePattern`][filepattern] semantics: `*` matches a single path segment, `**` matches any number of segments, and `?` matches a single character. + +```yaml +paths: + exclude: + - "**/vendor/**" + - "**/node_modules/**" + - "build/generated/*" +``` + +[filepattern]: https://hackage.haskell.org/package/filepattern + ### Analysis target configuration Analysis target configuration allows you to select a very specific subset of your directory for scanning. The `targets` and `paths` sections allow users to configure which targets and directories should be scanned. This is useful if you have a custom test directory or development projects within the root project. diff --git a/docs/references/files/fossa-yml.v3.schema.json b/docs/references/files/fossa-yml.v3.schema.json index 5618d8f363..c3d33fe103 100644 --- a/docs/references/files/fossa-yml.v3.schema.json +++ b/docs/references/files/fossa-yml.v3.schema.json @@ -528,18 +528,18 @@ }, "paths": { "type": "object", - "description": "The paths filtering section allows you to specify which paths should be scanned and which should not. The paths should be listed as their location from the root of your project.", + "description": "The paths filtering section allows you to specify which paths should be scanned and which should not. Entries may be concrete directory paths (which match the directory and all of its children) or glob patterns. An entry is treated as a glob if it contains any of `*`, `?`, or `[`. Glob syntax follows System.FilePattern: `*` matches a single path segment, `**` matches any number of segments, and `?` matches a single character.", "properties": { "only": { "type": "array", - "description": "The list of paths to only allow scanning within.", + "description": "The list of paths or glob patterns to only allow scanning within.", "items": { "type": "string" } }, "exclude": { "type": "array", - "description": "The list of paths to exclude from scanning in your directory.", + "description": "The list of paths or glob patterns to exclude from scanning in your directory.", "items": { "type": "string" } diff --git a/src/App/Fossa/Config/Common.hs b/src/App/Fossa/Config/Common.hs index 75d83393e4..7811bb5ffe 100644 --- a/src/App/Fossa/Config/Common.hs +++ b/src/App/Fossa/Config/Common.hs @@ -120,7 +120,7 @@ import Data.String (IsString) import Data.String.Conversion (ToText (toText)) import Data.Text (Text, null, strip, toLower) import Diag.Result (Result (Failure, Success), renderFailure) -import Discovery.Filters (AllFilters (AllFilters), MavenScopeFilters (..), comboExclude, comboInclude, setExclude, setInclude, targetFilterParser) +import Discovery.Filters (AllFilters (AllFilters), MavenScopeFilters (..), comboExcludeWithGlobs, comboIncludeWithGlobs, partitionPathFilters, setExclude, setInclude, targetFilterParser) import Effect.Exec (Exec) import Effect.Logger (Logger, logDebug, logInfo, renderIt, vsep) import Effect.ReadFS (ReadFS, doesDirExist, doesFileExist) @@ -624,11 +624,13 @@ collectConfigFileFilters configFile = do let pullFromFile :: (a -> [b]) -> (ConfigFile -> Maybe a) -> [b] pullFromFile field section = maybe [] field (section configFile) onlyT = pullFromFile targetsOnly configTargets - onlyP = pullFromFile pathsOnly configPaths + (onlyP, onlyG) = partitionPathFilters $ pullFromFile pathsOnly configPaths excludeT = pullFromFile targetsExclude configTargets - excludeP = pullFromFile pathsExclude configPaths + (excludeP, excludeG) = partitionPathFilters $ pullFromFile pathsExclude configPaths - AllFilters (comboInclude onlyT onlyP) (comboExclude excludeT excludeP) + AllFilters + (comboIncludeWithGlobs onlyT onlyP onlyG) + (comboExcludeWithGlobs excludeT excludeP excludeG) collectConfigMavenScopeFilters :: ConfigFile -> MavenScopeFilters collectConfigMavenScopeFilters configFile = do diff --git a/src/App/Fossa/Config/ConfigFile.hs b/src/App/Fossa/Config/ConfigFile.hs index 98addf9d6d..d6f6903910 100644 --- a/src/App/Fossa/Config/ConfigFile.hs +++ b/src/App/Fossa/Config/ConfigFile.hs @@ -11,6 +11,7 @@ module App.Fossa.Config.ConfigFile ( ConfigRevision (..), ConfigTargets (..), ConfigPaths (..), + PathFilter (..), ConfigTelemetry (..), ConfigTelemetryScope (..), ExperimentalConfigs (..), @@ -57,6 +58,7 @@ import Data.Set qualified as Set import Data.String.Conversion (ToString (toString), ToText (toText)) import Data.Text (Text, strip, toLower) import Diag.Diagnostic (ToDiagnostic (..)) +import Discovery.Filters (PathFilter (..)) import Effect.Logger ( Logger, logDebug, @@ -257,8 +259,8 @@ data ConfigTargets = ConfigTargets deriving (Eq, Ord, Show) data ConfigPaths = ConfigPaths - { pathsOnly :: [Path Rel Dir] - , pathsExclude :: [Path Rel Dir] + { pathsOnly :: [PathFilter] + , pathsExclude :: [PathFilter] } deriving (Eq, Ord, Show) diff --git a/src/Discovery/Filters.hs b/src/Discovery/Filters.hs index 1e29b2488d..d5e8830c9b 100644 --- a/src/Discovery/Filters.hs +++ b/src/Discovery/Filters.hs @@ -12,7 +12,10 @@ module Discovery.Filters ( filterIsVSIOnly, comboInclude, comboExclude, + comboIncludeWithGlobs, + comboExcludeWithGlobs, combinedPaths, + combinedPathGlobs, combinedTargets, Include, Exclude, @@ -27,11 +30,15 @@ module Discovery.Filters ( setInclude, setExclude, mavenScopeFilterSet, + PathFilter (..), + partitionPathFilters, ) where import Control.Effect.Reader (Has, Reader, ask) import Control.Monad ((<=<)) -import Data.Aeson (ToJSON (toEncoding), defaultOptions, genericToEncoding) +import Data.Aeson (FromJSON, ToJSON (toEncoding), defaultOptions, genericToEncoding, parseJSON, withText) +import Data.Glob (Glob, unGlob) +import Data.Glob qualified as Glob import Data.List (isInfixOf, stripPrefix, (\\)) import Data.List.NonEmpty qualified as NE import Data.Map.Strict (Map) @@ -41,11 +48,12 @@ import Data.Semigroup (sconcat) import Data.Set (Set) import Data.Set qualified as Set import Data.Set.NonEmpty (nonEmpty, toSet) -import Data.String.Conversion (toText) +import Data.String.Conversion (toString, toText) import Data.Text (Text) import Data.Void (Void) import GHC.Generics (Generic) import Path (Abs, Dir, Path, Rel, fromAbsDir, isProperPrefixOf, parseRelDir) +import System.FilePattern qualified as FilePattern import Text.Megaparsec ( MonadParsec (eof, takeWhile1P, try), Parsec, @@ -86,12 +94,42 @@ instance Monoid AllFilters where data FilterCombination a = FilterCombination { _combinedTargets :: [TargetFilter] , _combinedPaths :: [Path Rel Dir] + , _combinedPathGlobs :: [Glob Rel] } deriving (Eq, Ord, Show, Generic) instance ToJSON (FilterCombination a) where toEncoding = genericToEncoding defaultOptions +-- | A user-supplied path filter entry from `.fossa.yml`. Strings containing +-- glob metacharacters (`*`, `?`, `[`) are parsed as 'Glob' patterns; all other +-- strings are parsed as relative directory paths, preserving the existing +-- "match this directory and its children" semantics. +data PathFilter + = PathFilterDir (Path Rel Dir) + | PathFilterGlob (Glob Rel) + deriving (Eq, Ord, Show, Generic) + +instance FromJSON PathFilter where + parseJSON = withText "PathFilter" $ \txt -> + let s = toString txt + in if hasGlobChars s + then pure . PathFilterGlob $ Glob.unsafeGlobRel s + else case parseRelDir s of + Left err -> fail (show err) + Right p -> pure $ PathFilterDir p + where + hasGlobChars :: String -> Bool + hasGlobChars = any (`elem` ("*?[" :: String)) + +-- | Split a list of user-supplied path filter entries into concrete directory +-- paths and glob patterns. +partitionPathFilters :: [PathFilter] -> ([Path Rel Dir], [Glob Rel]) +partitionPathFilters = foldr go ([], []) + where + go (PathFilterDir p) (ps, gs) = (p : ps, gs) + go (PathFilterGlob g) (ps, gs) = (ps, g : gs) + data MavenScopeFilters = MavenScopeIncludeFilters (FilterSet Include) | MavenScopeExcludeFilters (FilterSet Exclude) deriving (Eq, Ord, Show, Generic) @@ -119,10 +157,11 @@ data Include data Exclude instance Semigroup (FilterCombination a) where - (FilterCombination a1 b1) <> (FilterCombination a2 b2) = FilterCombination (a1 <> a2) (b1 <> b2) + (FilterCombination a1 b1 c1) <> (FilterCombination a2 b2 c2) = + FilterCombination (a1 <> a2) (b1 <> b2) (c1 <> c2) instance Monoid (FilterCombination a) where - mempty = FilterCombination mempty mempty + mempty = FilterCombination mempty mempty mempty mavenScopeFilterSet :: MavenScopeFilters -> Set Text mavenScopeFilterSet (MavenScopeIncludeFilters filterSet) = scopes filterSet @@ -177,22 +216,31 @@ extractPureTool = \case -- * If a path is included, we allow that path and all of its parents and children. -- * If no paths are specifically included, we only reject explicitly excluded paths and their children. -- * If a path is excluded and included, it is rejected. +-- * Glob patterns (e.g. @**\/vendor\/**@) may appear alongside concrete paths. +-- A path is excluded if any exclusion glob matches it. Because tree walkers +-- skip excluded directories before descending, a glob like @**\/vendor@ +-- prunes the entire @vendor@ subtree even if the glob itself does not match +-- every descendant. -- TODO: Is it possible to allow conflicted items? If so, is it possible without creating multiple versions of this function? pathAllowed :: AllFilters -> Path Rel Dir -> Bool pathAllowed AllFilters{..} path = isIncluded && not isExcluded where - includeIsEmpty = null includedPaths - isExcluded = isExcludedMember || isChildOfExcludeMember + includeIsEmpty = null includedPaths && null includedGlobs + isExcluded = isExcludedMember || isChildOfExcludeMember || isExcludedByGlob -- We include parents because our directory scanner will never make it to the included path without the parents -- We include children because our analysis filtering allows children of included members - isIncluded = includeIsEmpty || isParentOfIncludeMember || isIncludeMember || isChildOfIncludeMember + isIncluded = includeIsEmpty || isParentOfIncludeMember || isIncludeMember || isChildOfIncludeMember || isIncludedByGlob isIncludeMember = path `elem` includedPaths isExcludedMember = path `elem` excludedPaths isChildOfIncludeMember = any (`isProperPrefixOf` path) includedPaths isChildOfExcludeMember = any (`isProperPrefixOf` path) excludedPaths isParentOfIncludeMember = any (path `isProperPrefixOf`) includedPaths + isExcludedByGlob = any (`globMatchesDir` path) excludedGlobs + isIncludedByGlob = any (`globMatchesDir` path) includedGlobs includedPaths = combinedPaths includeFilters excludedPaths = combinedPaths excludeFilters + includedGlobs = combinedPathGlobs includeFilters + excludedGlobs = combinedPathGlobs excludeFilters isDefaultNonProductionPath :: Path Abs Dir -> Path Abs Dir -> Bool isDefaultNonProductionPath baseDir projPath = @@ -231,10 +279,16 @@ ignoredPaths = ] comboInclude :: [TargetFilter] -> [Path Rel Dir] -> FilterCombination Include -comboInclude = FilterCombination +comboInclude ts ps = FilterCombination ts ps [] comboExclude :: [TargetFilter] -> [Path Rel Dir] -> FilterCombination Exclude -comboExclude = FilterCombination +comboExclude ts ps = FilterCombination ts ps [] + +comboIncludeWithGlobs :: [TargetFilter] -> [Path Rel Dir] -> [Glob Rel] -> FilterCombination Include +comboIncludeWithGlobs = FilterCombination + +comboExcludeWithGlobs :: [TargetFilter] -> [Path Rel Dir] -> [Glob Rel] -> FilterCombination Exclude +comboExcludeWithGlobs = FilterCombination setInclude :: (Set Text) -> FilterSet Include setInclude = FilterSet @@ -248,6 +302,9 @@ combinedTargets = _combinedTargets combinedPaths :: FilterCombination a -> [Path Rel Dir] combinedPaths = _combinedPaths +combinedPathGlobs :: FilterCombination a -> [Glob Rel] +combinedPathGlobs = _combinedPathGlobs + -- applyFilters determines if legacy filters are present and if they need to converted to `TargetFilters` for filtering. applyFilters :: AllFilters -> Text -> Path Rel Dir -> FoundTargets -> Maybe FoundTargets applyFilters (AllFilters onlyFilters excludeFilters) tool dir = filterFoundTargets (apply onlyFilters excludeFilters tool dir) @@ -274,7 +331,7 @@ apply include exclude buildtool dir = -- Nothing = "Unknown" -- i.e., there were no filters that matched the buildtool + directories. applyComb :: FilterCombination a -> Text -> Path Rel Dir -> Maybe FilterMatch applyComb comb buildtool dir = - buildTargetFiltersResult <> pathFiltersResult + buildTargetFiltersResult <> pathFiltersResult <> globFiltersResult where buildTargetFiltersResult :: Maybe FilterMatch buildTargetFiltersResult = foldMap' (\t -> applyTarget t buildtool dir) (combinedTargets comb) @@ -282,6 +339,9 @@ applyComb comb buildtool dir = pathFiltersResult :: Maybe FilterMatch pathFiltersResult = foldMap' (`applyPath` dir) (combinedPaths comb) + globFiltersResult :: Maybe FilterMatch + globFiltersResult = foldMap' (`applyGlob` dir) (combinedPathGlobs comb) + applyTarget :: TargetFilter -> Text -> Path Rel Dir -> FilterMatch applyTarget (TypeTarget t) u _ = if t == u then MatchAll else MatchNone applyTarget (TypeDirTarget t p) u q = if t == u && p == q then MatchAll else MatchNone @@ -291,6 +351,24 @@ applyTarget (TypeDirTargetTarget t p target) u q = if t == u && p == q then Matc applyPath :: Path Rel Dir -> Path Rel Dir -> FilterMatch applyPath t u = if isProperPrefixOf t u || t == u then MatchAll else MatchNone +-- | Apply a glob pattern to a relative directory. Returns 'MatchAll' if the +-- glob matches the directory, else 'MatchNone'. +applyGlob :: Glob Rel -> Path Rel Dir -> FilterMatch +applyGlob g dir = if g `globMatchesDir` dir then MatchAll else MatchNone + +-- | Match a glob against a relative directory path. Strips the trailing slash +-- that 'toString' appends to a 'Path Rel Dir' so that patterns like +-- @node_modules/*@ and @**\/*.test@ match directories the way users expect. +-- Without normalizing, @node_modules/*@ would fail to match @node_modules/foo/@ +-- because @*@ does not match the empty trailing component. +globMatchesDir :: Glob Rel -> Path Rel Dir -> Bool +globMatchesDir glob dir = unGlob glob FilePattern.?== trimTrailingSlash (toString dir) + where + trimTrailingSlash :: String -> String + trimTrailingSlash s = case reverse s of + '/' : rest -> reverse rest + _ -> s + -- MatchNone <> MatchAll = MatchAll is the reason for this order -- (MatchSome <> MatchAll) and (MatchAll <> MatchSome) outputs the results in MatchSome. -- The implications of this are that if a TypeTargetFilter matches all targets and diff --git a/test/Discovery/FiltersSpec.hs b/test/Discovery/FiltersSpec.hs index 1076de8053..c4e278275a 100644 --- a/test/Discovery/FiltersSpec.hs +++ b/test/Discovery/FiltersSpec.hs @@ -7,6 +7,7 @@ module Discovery.FiltersSpec ( import Control.Carrier.Reader (run, runReader) import Control.Monad (when) import Data.Foldable (traverse_) +import Data.Glob qualified as Glob import Data.Set qualified as Set import Data.Set.NonEmpty (nonEmpty) import Data.String.Conversion (ToText (toText)) @@ -16,9 +17,13 @@ import Discovery.Filters ( Exclude, FilterCombination, Include, + PathFilter (..), applyFilters, comboExclude, + comboExcludeWithGlobs, comboInclude, + comboIncludeWithGlobs, + partitionPathFilters, pathAllowed, toolAllowed, withToolFilter, @@ -260,6 +265,57 @@ spec = do pathAllowed bigFilters $(mkRelDir "a/b/c") `shouldBe` False pathAllowed bigFilters $(mkRelDir "a/b/d") `shouldBe` True + describe "Glob-based matching" $ do + it "excludes paths matching a '**/name/**' glob" $ do + let filters = excludeGlob "**/vendor/**" + pathAllowed filters $(mkRelDir "foo/vendor/bar") `shouldBe` False + pathAllowed filters $(mkRelDir "a/b/vendor/c") `shouldBe` False + pathAllowed filters $(mkRelDir "foo/bar") `shouldBe` True + + it "excludes paths matching a single-segment wildcard glob" $ do + let filters = excludeGlob "node_modules/*" + pathAllowed filters $(mkRelDir "node_modules/react") `shouldBe` False + pathAllowed filters $(mkRelDir "node_modules/@scope") `shouldBe` False + pathAllowed filters $(mkRelDir "src/node_modules/react") `shouldBe` True + + it "still excludes the subtree when the walker reaches the glob-matched dir" $ do + -- When the tree walker reaches foo/vendor/, that dir matches + -- `**/vendor/**` (the final ** matches an empty tail in + -- System.FilePattern), so the walker prunes the subtree and never + -- descends. Covers the documented expectation. + let filters = excludeGlob "**/vendor/**" + pathAllowed filters $(mkRelDir "foo/vendor") `shouldBe` False + + it "combines glob excludes with concrete path excludes" $ do + let filters = + excludePath $(mkRelDir "build") + <> excludeGlob "**/*.test" + pathAllowed filters $(mkRelDir "build") `shouldBe` False + pathAllowed filters $(mkRelDir "build/artifacts") `shouldBe` False + pathAllowed filters $(mkRelDir "foo/x.test") `shouldBe` False + pathAllowed filters $(mkRelDir "foo/bar") `shouldBe` True + + it "rejects an include-glob miss" $ do + let filters = includeGlob "src/**" + pathAllowed filters $(mkRelDir "src/lib") `shouldBe` True + pathAllowed filters $(mkRelDir "test/lib") `shouldBe` False + + it "prefers exclude over include when both globs match" $ do + let filters = includeGlob "src/**" <> excludeGlob "src/**" + pathAllowed filters $(mkRelDir "src/lib") `shouldBe` False + + describe "PathFilter parsing" $ do + it "partitions concrete paths from glob patterns" $ do + let mixed = + [ PathFilterDir $(mkRelDir "vendor") + , PathFilterGlob (Glob.unsafeGlobRel "**/node_modules/**") + , PathFilterDir $(mkRelDir "build") + , PathFilterGlob (Glob.unsafeGlobRel "*.test") + ] + (paths, globs) = partitionPathFilters mixed + paths `shouldBe` [$(mkRelDir "vendor"), $(mkRelDir "build")] + map Glob.unGlob globs `shouldBe` ["**/node_modules/**", "*.test"] + describe "tool filtering helpers" $ do it "should return an empty list when the tool is not allowed" $ do let filters = excludeTool CargoProjectType @@ -300,3 +356,13 @@ includeTool :: DiscoveredProjectType -> AllFilters includeTool tool = AllFilters include mempty where include = comboInclude [TypeTarget $ toText tool] mempty + +includeGlob :: String -> AllFilters +includeGlob glob = AllFilters include mempty + where + include = comboIncludeWithGlobs mempty mempty [Glob.unsafeGlobRel glob] + +excludeGlob :: String -> AllFilters +excludeGlob glob = AllFilters mempty exclude + where + exclude = comboExcludeWithGlobs mempty mempty [Glob.unsafeGlobRel glob] From db3921bd2f8e5e2a002242d77afe5bff51305f44 Mon Sep 17 00:00:00 2001 From: Zach LaVallee Date: Fri, 24 Apr 2026 14:52:46 -0700 Subject: [PATCH 02/19] Fix Windows glob path matching and link changelog entry Normalize backslashes to forward slashes before glob matching so user-supplied patterns like `node_modules/*` match the backslash- separated paths produced by `Path Rel Dir` on Windows. Co-Authored-By: Claude Opus 4.7 --- Changelog.md | 2 +- src/Discovery/Filters.hs | 19 +++++++++++++------ 2 files changed, 14 insertions(+), 7 deletions(-) diff --git a/Changelog.md b/Changelog.md index 672f377c8b..005a2c5d51 100644 --- a/Changelog.md +++ b/Changelog.md @@ -4,7 +4,7 @@ - pnpm: Support `catalog:` and `catalog:` version specifiers. Versions are resolved from the `catalogs` section in `pnpm-lock.yaml`. ([#1696](https://github.com/fossas/fossa-cli/pull/1696)) - pnpm: Remove stray `traceShow` debug output that dumped the parsed `pnpm-workspace.yaml` to stderr. ([#1696](https://github.com/fossas/fossa-cli/pull/1696)) -- Config: `paths.only` and `paths.exclude` in `.fossa.yml` now accept glob patterns (e.g. `**/vendor/**`, `node_modules/*`). Entries containing `*`, `?`, or `[` are parsed as globs; other entries keep their existing directory-tree semantics. +- Config: `paths.only` and `paths.exclude` in `.fossa.yml` now accept glob patterns (e.g. `**/vendor/**`, `node_modules/*`). Entries containing `*`, `?`, or `[` are parsed as globs; other entries keep their existing directory-tree semantics. ([#1703](https://github.com/fossas/fossa-cli/pull/1703)) ## 3.17.2 diff --git a/src/Discovery/Filters.hs b/src/Discovery/Filters.hs index d5e8830c9b..33c58e756f 100644 --- a/src/Discovery/Filters.hs +++ b/src/Discovery/Filters.hs @@ -356,14 +356,21 @@ applyPath t u = if isProperPrefixOf t u || t == u then MatchAll else MatchNone applyGlob :: Glob Rel -> Path Rel Dir -> FilterMatch applyGlob g dir = if g `globMatchesDir` dir then MatchAll else MatchNone --- | Match a glob against a relative directory path. Strips the trailing slash --- that 'toString' appends to a 'Path Rel Dir' so that patterns like --- @node_modules/*@ and @**\/*.test@ match directories the way users expect. --- Without normalizing, @node_modules/*@ would fail to match @node_modules/foo/@ --- because @*@ does not match the empty trailing component. +-- | Match a glob against a relative directory path. Normalizes the path so +-- glob matching is portable: strips the trailing slash that 'toString' appends +-- to a 'Path Rel Dir' (so @node_modules/*@ matches @node_modules/foo/@), and +-- converts backslashes to forward slashes so user-supplied forward-slash +-- patterns match the backslash-separated paths produced on Windows. globMatchesDir :: Glob Rel -> Path Rel Dir -> Bool -globMatchesDir glob dir = unGlob glob FilePattern.?== trimTrailingSlash (toString dir) +globMatchesDir glob dir = unGlob glob FilePattern.?== normalize (toString dir) where + normalize :: String -> String + normalize = trimTrailingSlash . map toForwardSlash + + toForwardSlash :: Char -> Char + toForwardSlash '\\' = '/' + toForwardSlash c = c + trimTrailingSlash :: String -> String trimTrailingSlash s = case reverse s of '/' : rest -> reverse rest From 05d99bcce0509476477aeb53d098e3183aa5cad2 Mon Sep 17 00:00:00 2001 From: Zach LaVallee Date: Mon, 27 Apr 2026 12:35:10 -0700 Subject: [PATCH 03/19] Add glob filter test coverage for ?, character classes, root-level globs Cover '?' wildcards, '[...]' character classes, root-anchored single-segment globs, an explicit trailing-slash normalization regression guard, and a four-way mix of include/exclude globs and concrete paths. Co-Authored-By: Claude Opus 4.7 --- test/Discovery/FiltersSpec.hs | 71 +++++++++++++++++++++++++++++++++++ 1 file changed, 71 insertions(+) diff --git a/test/Discovery/FiltersSpec.hs b/test/Discovery/FiltersSpec.hs index c4e278275a..a382e4a439 100644 --- a/test/Discovery/FiltersSpec.hs +++ b/test/Discovery/FiltersSpec.hs @@ -304,6 +304,77 @@ spec = do let filters = includeGlob "src/**" <> excludeGlob "src/**" pathAllowed filters $(mkRelDir "src/lib") `shouldBe` False + it "respects '?' single-character wildcards" $ do + let filters = excludeGlob "build?/out" + pathAllowed filters $(mkRelDir "build1/out") `shouldBe` False + pathAllowed filters $(mkRelDir "buildA/out") `shouldBe` False + -- '?' matches exactly one character: zero or two characters must not + -- match. + pathAllowed filters $(mkRelDir "build/out") `shouldBe` True + pathAllowed filters $(mkRelDir "build12/out") `shouldBe` True + + it "respects '[...]' character classes" $ do + let filters = excludeGlob "vendor[12]/**" + pathAllowed filters $(mkRelDir "vendor1") `shouldBe` False + pathAllowed filters $(mkRelDir "vendor2/foo") `shouldBe` False + pathAllowed filters $(mkRelDir "vendor3") `shouldBe` True + pathAllowed filters $(mkRelDir "vendor3/foo") `shouldBe` True + + it "normalizes the trailing slash on Path Rel Dir for glob matching" $ do + -- Regression guard: `Path.toString` on a `Path Rel Dir` appends '/', + -- which would otherwise cause `System.FilePattern` to reject single- + -- segment patterns like `node_modules/*`. `globMatchesDir` strips the + -- trailing slash before matching; this test fails if that + -- normalization regresses. + let filters = excludeGlob "node_modules/*" + pathAllowed filters $(mkRelDir "node_modules/react") `shouldBe` False + pathAllowed filters $(mkRelDir "node_modules/lodash") `shouldBe` False + + it "anchors root-level globs to the repo root" $ do + let filters = excludeGlob "build*" + pathAllowed filters $(mkRelDir "build") `shouldBe` False + pathAllowed filters $(mkRelDir "build123") `shouldBe` False + -- A nested `build` directory must not be matched by a root-anchored + -- single-segment glob. + pathAllowed filters $(mkRelDir "src/build") `shouldBe` True + pathAllowed filters $(mkRelDir "a/b/build123") `shouldBe` True + + it "anchors root-level extension globs to the repo root" $ do + let filters = excludeGlob "*.lock" + pathAllowed filters $(mkRelDir "package.lock") `shouldBe` False + pathAllowed filters $(mkRelDir "src/package.lock") `shouldBe` True + + it "applies a four-way mix of include/exclude globs and concrete paths" $ do + -- Include: concrete `src` plus glob `lib/**`. + -- Exclude: concrete `src/build` plus glob `**/vendor/**`. + let filters = + AllFilters + ( comboIncludeWithGlobs + mempty + [$(mkRelDir "src")] + [Glob.unsafeGlobRel "lib/**"] + ) + ( comboExcludeWithGlobs + mempty + [$(mkRelDir "src/build")] + [Glob.unsafeGlobRel "**/vendor/**"] + ) + -- Concrete include: `src` and its children are accepted. + pathAllowed filters $(mkRelDir "src") `shouldBe` True + pathAllowed filters $(mkRelDir "src/app") `shouldBe` True + -- Concrete exclude wins over the concrete include. + pathAllowed filters $(mkRelDir "src/build") `shouldBe` False + pathAllowed filters $(mkRelDir "src/build/out") `shouldBe` False + -- Glob include: `lib` and its descendants are accepted. + pathAllowed filters $(mkRelDir "lib") `shouldBe` True + pathAllowed filters $(mkRelDir "lib/foo/bar") `shouldBe` True + -- Glob exclude wins over both kinds of include. + pathAllowed filters $(mkRelDir "lib/foo/vendor/x") `shouldBe` False + pathAllowed filters $(mkRelDir "src/app/vendor/x") `shouldBe` False + -- Paths matched by neither include are rejected. + pathAllowed filters $(mkRelDir "test") `shouldBe` False + pathAllowed filters $(mkRelDir "other/dir") `shouldBe` False + describe "PathFilter parsing" $ do it "partitions concrete paths from glob patterns" $ do let mixed = From 51f4f66d820eb0ef35a7aa6a19248703df10425c Mon Sep 17 00:00:00 2001 From: Zach LaVallee Date: Mon, 27 Apr 2026 20:52:05 -0700 Subject: [PATCH 04/19] Document System.FilePattern '?'/'[...]' literal-match limitation in tests System.FilePattern only implements `*` and `**`; `?` and `[...]` are matched literally rather than as wildcards/character classes. The two new tests asserted wildcard semantics and were red on CI. Flip the expectations so they document the actual behavior and serve as a regression guard if the engine ever gains those features. --- test/Discovery/FiltersSpec.hs | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/test/Discovery/FiltersSpec.hs b/test/Discovery/FiltersSpec.hs index a382e4a439..ac50a5244b 100644 --- a/test/Discovery/FiltersSpec.hs +++ b/test/Discovery/FiltersSpec.hs @@ -304,19 +304,24 @@ spec = do let filters = includeGlob "src/**" <> excludeGlob "src/**" pathAllowed filters $(mkRelDir "src/lib") `shouldBe` False - it "respects '?' single-character wildcards" $ do + it "treats '?' as a literal character (System.FilePattern limitation)" $ do + -- System.FilePattern (the underlying glob engine) only implements + -- `*` and `**`. `?` is not a single-character wildcard; it is + -- matched literally. None of these alphanumeric paths should be + -- excluded by `build?/out`. let filters = excludeGlob "build?/out" - pathAllowed filters $(mkRelDir "build1/out") `shouldBe` False - pathAllowed filters $(mkRelDir "buildA/out") `shouldBe` False - -- '?' matches exactly one character: zero or two characters must not - -- match. + pathAllowed filters $(mkRelDir "build1/out") `shouldBe` True + pathAllowed filters $(mkRelDir "buildA/out") `shouldBe` True pathAllowed filters $(mkRelDir "build/out") `shouldBe` True pathAllowed filters $(mkRelDir "build12/out") `shouldBe` True - it "respects '[...]' character classes" $ do + it "treats '[...]' as literal characters (System.FilePattern limitation)" $ do + -- System.FilePattern does not support `[...]` character classes; + -- the brackets and their contents are matched literally. None of + -- these paths should be excluded by `vendor[12]/**`. let filters = excludeGlob "vendor[12]/**" - pathAllowed filters $(mkRelDir "vendor1") `shouldBe` False - pathAllowed filters $(mkRelDir "vendor2/foo") `shouldBe` False + pathAllowed filters $(mkRelDir "vendor1") `shouldBe` True + pathAllowed filters $(mkRelDir "vendor2/foo") `shouldBe` True pathAllowed filters $(mkRelDir "vendor3") `shouldBe` True pathAllowed filters $(mkRelDir "vendor3/foo") `shouldBe` True From 772a8b0327fc056c0e0c6bf318943fff3d892788 Mon Sep 17 00:00:00 2001 From: Zachary LaVallee Date: Tue, 5 May 2026 15:29:16 -0700 Subject: [PATCH 05/19] Normalize backslashes in glob patterns; correct ?/[] doc semantics Extend the Windows portability fix from db3921bd (which normalized the path side) to also normalize the user-supplied pattern side. A Windows user typing `node_modules\*` in `.fossa.yml` now gets the same glob as `node_modules/*`. The shared normalization is lifted into a top-level `normalizeSlashes` helper used by both `FromJSON PathFilter` and `globMatchesDir`. Also correct the glob-pattern documentation: it previously claimed `?` matches a single character, but `System.FilePattern` only implements `*` and `**` (test/Discovery/FiltersSpec.hs already asserts this). The doc now says `?` and `[...]` are matched as literals and notes that backslashes in patterns are normalized. Co-Authored-By: Claude Opus 4.7 (1M context) --- docs/references/files/fossa-yml.md | 4 +++- src/Discovery/Filters.hs | 17 +++++++++++------ test/Discovery/FiltersSpec.hs | 11 +++++++++++ 3 files changed, 25 insertions(+), 7 deletions(-) diff --git a/docs/references/files/fossa-yml.md b/docs/references/files/fossa-yml.md index 9c11fba0dc..dd4a0f633a 100644 --- a/docs/references/files/fossa-yml.md +++ b/docs/references/files/fossa-yml.md @@ -336,7 +336,9 @@ This section is intended to be used as the inverse to `paths.only`. If you have #### Glob patterns -Entries in `paths.only` and `paths.exclude` may also be glob patterns. An entry is treated as a glob if it contains any of `*`, `?`, or `[`; other entries keep their existing semantics (match the directory and all of its children). Glob matching follows [`System.FilePattern`][filepattern] semantics: `*` matches a single path segment, `**` matches any number of segments, and `?` matches a single character. +Entries in `paths.only` and `paths.exclude` may also be glob patterns. An entry is treated as a glob if it contains any of `*`, `?`, or `[`; other entries keep their existing semantics (match the directory and all of its children). Glob matching follows [`System.FilePattern`][filepattern] semantics: `*` matches any sequence of characters within a single path segment, and `**` matches any number of segments. `?` and `[...]` are matched as literal characters (`System.FilePattern` only implements `*` and `**`); they trigger glob parsing but are not single-character wildcards or character classes. + +Patterns use forward slashes (`/`) as path separators; backslashes are normalized so Windows-native patterns also work. ```yaml paths: diff --git a/src/Discovery/Filters.hs b/src/Discovery/Filters.hs index 33c58e756f..8a99e398be 100644 --- a/src/Discovery/Filters.hs +++ b/src/Discovery/Filters.hs @@ -114,7 +114,7 @@ instance FromJSON PathFilter where parseJSON = withText "PathFilter" $ \txt -> let s = toString txt in if hasGlobChars s - then pure . PathFilterGlob $ Glob.unsafeGlobRel s + then pure . PathFilterGlob . Glob.unsafeGlobRel $ normalizeSlashes s else case parseRelDir s of Left err -> fail (show err) Right p -> pure $ PathFilterDir p @@ -122,6 +122,15 @@ instance FromJSON PathFilter where hasGlobChars :: String -> Bool hasGlobChars = any (`elem` ("*?[" :: String)) +-- | Normalize backslashes to forward slashes. 'System.FilePattern' only treats +-- @/@ as a segment separator, so any user-supplied pattern or path containing +-- backslashes must be normalized before glob matching. +normalizeSlashes :: String -> String +normalizeSlashes = map toForwardSlash + where + toForwardSlash '\\' = '/' + toForwardSlash c = c + -- | Split a list of user-supplied path filter entries into concrete directory -- paths and glob patterns. partitionPathFilters :: [PathFilter] -> ([Path Rel Dir], [Glob Rel]) @@ -365,11 +374,7 @@ globMatchesDir :: Glob Rel -> Path Rel Dir -> Bool globMatchesDir glob dir = unGlob glob FilePattern.?== normalize (toString dir) where normalize :: String -> String - normalize = trimTrailingSlash . map toForwardSlash - - toForwardSlash :: Char -> Char - toForwardSlash '\\' = '/' - toForwardSlash c = c + normalize = trimTrailingSlash . normalizeSlashes trimTrailingSlash :: String -> String trimTrailingSlash s = case reverse s of diff --git a/test/Discovery/FiltersSpec.hs b/test/Discovery/FiltersSpec.hs index ac50a5244b..82470560ba 100644 --- a/test/Discovery/FiltersSpec.hs +++ b/test/Discovery/FiltersSpec.hs @@ -6,6 +6,7 @@ module Discovery.FiltersSpec ( import Control.Carrier.Reader (run, runReader) import Control.Monad (when) +import Data.Aeson qualified as Aeson import Data.Foldable (traverse_) import Data.Glob qualified as Glob import Data.Set qualified as Set @@ -392,6 +393,16 @@ spec = do paths `shouldBe` [$(mkRelDir "vendor"), $(mkRelDir "build")] map Glob.unGlob globs `shouldBe` ["**/node_modules/**", "*.test"] + it "normalizes backslashes in glob patterns to forward slashes" $ do + -- A Windows user typing `node_modules\*` in `.fossa.yml` should get + -- the same glob as the forward-slash form, because System.FilePattern + -- only treats `/` as a segment separator. + let parse s = case Aeson.fromJSON (Aeson.String (Text.pack s)) :: Aeson.Result PathFilter of + Aeson.Success p -> p + Aeson.Error e -> error e + parse "node_modules\\*" `shouldBe` parse "node_modules/*" + parse "**\\vendor\\**" `shouldBe` parse "**/vendor/**" + describe "tool filtering helpers" $ do it "should return an empty list when the tool is not allowed" $ do let filters = excludeTool CargoProjectType From daa1cd93c24832f1952acca76edba5566aa00e12 Mon Sep 17 00:00:00 2001 From: Zachary LaVallee Date: Tue, 5 May 2026 22:32:34 -0700 Subject: [PATCH 06/19] Limit glob trigger to `*`; drop unreachable `?`/`[]` literal tests MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit System.FilePattern only implements `*` and `**` — `?` and `[...]` are matched as literal characters, not single-character wildcards or character classes (per commit 51f4f66d). Routing strings containing `?` or `[` to the glob branch was therefore a no-op for matching, and on Windows it silently swallowed `parseRelDir` errors for `?` (a reserved NTFS character) by producing a glob that could never match a real path. Shrink the trigger to a simple `*`-in-string check inline. Strings with `?` or `[` now go through `parseRelDir` like any other concrete path. The two `FiltersSpec` tests that documented FilePattern's literal handling of `?`/`[]` go away — they tested an internal-engine quirk that is no longer reachable through the user-facing config. Doc + JSON schema updated to match (and the `*` description is fixed: "any sequence of characters within a single path segment", not the inaccurate "a single path segment"). Co-Authored-By: Claude Opus 4.7 (1M context) --- docs/references/files/fossa-yml.md | 2 +- .../references/files/fossa-yml.v3.schema.json | 2 +- src/Discovery/Filters.hs | 11 ++++------ test/Discovery/FiltersSpec.hs | 21 ------------------- 4 files changed, 6 insertions(+), 30 deletions(-) diff --git a/docs/references/files/fossa-yml.md b/docs/references/files/fossa-yml.md index dd4a0f633a..67cd4b4a79 100644 --- a/docs/references/files/fossa-yml.md +++ b/docs/references/files/fossa-yml.md @@ -336,7 +336,7 @@ This section is intended to be used as the inverse to `paths.only`. If you have #### Glob patterns -Entries in `paths.only` and `paths.exclude` may also be glob patterns. An entry is treated as a glob if it contains any of `*`, `?`, or `[`; other entries keep their existing semantics (match the directory and all of its children). Glob matching follows [`System.FilePattern`][filepattern] semantics: `*` matches any sequence of characters within a single path segment, and `**` matches any number of segments. `?` and `[...]` are matched as literal characters (`System.FilePattern` only implements `*` and `**`); they trigger glob parsing but are not single-character wildcards or character classes. +Entries in `paths.only` and `paths.exclude` may also be glob patterns. An entry is treated as a glob if it contains `*`; other entries keep their existing semantics (match the directory and all of its children). Glob matching follows [`System.FilePattern`][filepattern] semantics: `*` matches any sequence of characters within a single path segment, and `**` matches any number of segments. Patterns use forward slashes (`/`) as path separators; backslashes are normalized so Windows-native patterns also work. diff --git a/docs/references/files/fossa-yml.v3.schema.json b/docs/references/files/fossa-yml.v3.schema.json index c3d33fe103..46e2b4f90e 100644 --- a/docs/references/files/fossa-yml.v3.schema.json +++ b/docs/references/files/fossa-yml.v3.schema.json @@ -528,7 +528,7 @@ }, "paths": { "type": "object", - "description": "The paths filtering section allows you to specify which paths should be scanned and which should not. Entries may be concrete directory paths (which match the directory and all of its children) or glob patterns. An entry is treated as a glob if it contains any of `*`, `?`, or `[`. Glob syntax follows System.FilePattern: `*` matches a single path segment, `**` matches any number of segments, and `?` matches a single character.", + "description": "The paths filtering section allows you to specify which paths should be scanned and which should not. Entries may be concrete directory paths (which match the directory and all of its children) or glob patterns. An entry is treated as a glob if it contains `*`. Glob syntax follows System.FilePattern: `*` matches any sequence of characters within a single path segment, and `**` matches any number of segments.", "properties": { "only": { "type": "array", diff --git a/src/Discovery/Filters.hs b/src/Discovery/Filters.hs index 8a99e398be..d6223df56f 100644 --- a/src/Discovery/Filters.hs +++ b/src/Discovery/Filters.hs @@ -102,9 +102,9 @@ instance ToJSON (FilterCombination a) where toEncoding = genericToEncoding defaultOptions -- | A user-supplied path filter entry from `.fossa.yml`. Strings containing --- glob metacharacters (`*`, `?`, `[`) are parsed as 'Glob' patterns; all other --- strings are parsed as relative directory paths, preserving the existing --- "match this directory and its children" semantics. +-- `*` are parsed as 'Glob' patterns; all other strings are parsed as relative +-- directory paths, preserving the existing "match this directory and its +-- children" semantics. data PathFilter = PathFilterDir (Path Rel Dir) | PathFilterGlob (Glob Rel) @@ -113,14 +113,11 @@ data PathFilter instance FromJSON PathFilter where parseJSON = withText "PathFilter" $ \txt -> let s = toString txt - in if hasGlobChars s + in if '*' `elem` s then pure . PathFilterGlob . Glob.unsafeGlobRel $ normalizeSlashes s else case parseRelDir s of Left err -> fail (show err) Right p -> pure $ PathFilterDir p - where - hasGlobChars :: String -> Bool - hasGlobChars = any (`elem` ("*?[" :: String)) -- | Normalize backslashes to forward slashes. 'System.FilePattern' only treats -- @/@ as a segment separator, so any user-supplied pattern or path containing diff --git a/test/Discovery/FiltersSpec.hs b/test/Discovery/FiltersSpec.hs index 82470560ba..a69de1404d 100644 --- a/test/Discovery/FiltersSpec.hs +++ b/test/Discovery/FiltersSpec.hs @@ -305,27 +305,6 @@ spec = do let filters = includeGlob "src/**" <> excludeGlob "src/**" pathAllowed filters $(mkRelDir "src/lib") `shouldBe` False - it "treats '?' as a literal character (System.FilePattern limitation)" $ do - -- System.FilePattern (the underlying glob engine) only implements - -- `*` and `**`. `?` is not a single-character wildcard; it is - -- matched literally. None of these alphanumeric paths should be - -- excluded by `build?/out`. - let filters = excludeGlob "build?/out" - pathAllowed filters $(mkRelDir "build1/out") `shouldBe` True - pathAllowed filters $(mkRelDir "buildA/out") `shouldBe` True - pathAllowed filters $(mkRelDir "build/out") `shouldBe` True - pathAllowed filters $(mkRelDir "build12/out") `shouldBe` True - - it "treats '[...]' as literal characters (System.FilePattern limitation)" $ do - -- System.FilePattern does not support `[...]` character classes; - -- the brackets and their contents are matched literally. None of - -- these paths should be excluded by `vendor[12]/**`. - let filters = excludeGlob "vendor[12]/**" - pathAllowed filters $(mkRelDir "vendor1") `shouldBe` True - pathAllowed filters $(mkRelDir "vendor2/foo") `shouldBe` True - pathAllowed filters $(mkRelDir "vendor3") `shouldBe` True - pathAllowed filters $(mkRelDir "vendor3/foo") `shouldBe` True - it "normalizes the trailing slash on Path Rel Dir for glob matching" $ do -- Regression guard: `Path.toString` on a `Path Rel Dir` appends '/', -- which would otherwise cause `System.FilePattern` to reject single- From 9e45762c5d0e4990c8478d520723d0d183186947 Mon Sep 17 00:00:00 2001 From: Zachary LaVallee Date: Tue, 5 May 2026 23:22:36 -0700 Subject: [PATCH 07/19] Doc: show concrete example directories for each glob pattern Add a short bulleted list under the YAML example illustrating what each pattern actually matches in a real tree (deep Go vendoring, a scoped npm package's transitive plugin tree, and a generated-proto subtree). The list also calls out that `build/generated/*` is anchored at the root and that the walker prunes the matched directory's whole subtree. Co-Authored-By: Claude Opus 4.7 (1M context) --- docs/references/files/fossa-yml.md | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/docs/references/files/fossa-yml.md b/docs/references/files/fossa-yml.md index 67cd4b4a79..1911773efd 100644 --- a/docs/references/files/fossa-yml.md +++ b/docs/references/files/fossa-yml.md @@ -348,6 +348,12 @@ paths: - "build/generated/*" ``` +Each example above excludes a different shape of directory: + +- `**/vendor/**` skips Go-style vendored trees at any depth, e.g. `services/billing/vendor/k8s.io/apimachinery/pkg/apis/meta/v1/`. +- `**/node_modules/**` skips installed npm packages wherever they appear, e.g. `apps/web-frontend/node_modules/@babel/preset-env/lib/plugins/syntax-dynamic-import/`. +- `build/generated/*` is anchored at the repo root and matches *direct* children of `build/generated/` only. `build/generated/proto-go/` matches; the walker then prunes its entire subtree (e.g. `build/generated/proto-go/v1/messagepb/`). + [filepattern]: https://hackage.haskell.org/package/filepattern ### Analysis target configuration From 39b220b4f7895a2d18118ce7afd91b372982fdfd Mon Sep 17 00:00:00 2001 From: Zachary LaVallee Date: Wed, 6 May 2026 08:26:30 -0700 Subject: [PATCH 08/19] Echo active path filters at analyze startup Walker-level prunes from `paths.only`/`paths.exclude` short-circuit discovery before any strategy sees the excluded directory, so the user gets no log line and no "Skipping ..." trail telling them why a project they expected didn't appear in the analyze summary. The existing post-summary note even points at `fossa list-targets` as a workaround, but that command deliberately ignores all filters. Add a small `logActivePathFilters` helper invoked once at the start of `analyze` that prints the configured include/exclude paths and globs (skipping empty kinds). Output for a `.fossa.yml` containing `paths.exclude: ["**/zip/**"]` is now: [INFO] Active exclude glob filters: **/zip/** Per-prune logging would be more direct but requires propagating `Has Logger sig m` through `walkWithFilters'`, `simpleDiscover`, and every strategy's `findProjects`/`discover` (~35 files). Saving that for a follow-up; this gives the user the single piece of information needed to map a missing project back to a configured filter. Co-Authored-By: Claude Opus 4.7 (1M context) --- src/App/Fossa/Analyze.hs | 24 +++++++++++++++++++++++- 1 file changed, 23 insertions(+), 1 deletion(-) diff --git a/src/App/Fossa/Analyze.hs b/src/App/Fossa/Analyze.hs index f2d0700c89..5fac9deb5c 100644 --- a/src/App/Fossa/Analyze.hs +++ b/src/App/Fossa/Analyze.hs @@ -123,16 +123,19 @@ import Data.Error (createBody) import Data.Flag (Flag, fromFlag) import Data.Foldable (traverse_) import Data.Functor (($>)) +import Data.Glob (unGlob) import Data.List.NonEmpty qualified as NE import Data.Map qualified as Map import Data.Maybe (catMaybes, fromMaybe, isJust, mapMaybe, maybeToList) import Data.String.Conversion (decodeUtf8, toText) +import Data.Text (Text) +import Data.Text qualified as Text import Data.Text.Extra (showT) import Data.Traversable (for) import Diag.Diagnostic as DI import Diag.Result (resultToMaybe) import Discovery.Archive qualified as Archive -import Discovery.Filters (AllFilters, MavenScopeFilters, applyFilters, filterIsVSIOnly, ignoredPaths, isDefaultNonProductionPath) +import Discovery.Filters (AllFilters (..), MavenScopeFilters, applyFilters, combinedPathGlobs, combinedPaths, filterIsVSIOnly, ignoredPaths, isDefaultNonProductionPath) import Discovery.Projects (withDiscoveredProjects) import Effect.Exec (Exec) import Effect.Logger ( @@ -297,6 +300,23 @@ runAnalyzers allowedTactics filters withoutDefaultFilters basedir pathPrefix = d where single (DiscoverFunc f) = withDiscoveredProjects f basedir (runDependencyAnalysis basedir filters withoutDefaultFilters pathPrefix allowedTactics) +-- | Echo path-related include/exclude filters once at startup. Walker prunes +-- are silent by design (they short-circuit before any strategy sees the +-- directory), so this gives the user just enough visibility to tell which +-- patterns are active and infer why a project they expected didn't appear. +logActivePathFilters :: Has Logger sig m => AllFilters -> m () +logActivePathFilters AllFilters{includeFilters = include, excludeFilters = exclude} = do + emit "include path" (map (toText . toFilePath) (combinedPaths include)) + emit "include glob" (map (toText . unGlob) (combinedPathGlobs include)) + emit "exclude path" (map (toText . toFilePath) (combinedPaths exclude)) + emit "exclude glob" (map (toText . unGlob) (combinedPathGlobs exclude)) + where + emit :: Has Logger sig m => Text -> [Text] -> m () + emit _ [] = pure () + emit label items = + logInfo $ + "Active " <> pretty label <> " filters: " <> pretty (Text.intercalate ", " items) + analyze :: ( Has Debug sig m , Has Diag.Diagnostics sig m @@ -332,6 +352,8 @@ analyze cfg = Diag.context "fossa-analyze" $ do enableSnippetScan = Config.snippetScan cfg enableVendetta = Config.xVendetta cfg + logActivePathFilters filters + manualDepsResult <- Diag.errorBoundaryIO . diagToDebug $ if filterIsVSIOnly filters From fd76b521789d812b2b8f27bc1ee73fdbfe9dd5fc Mon Sep 17 00:00:00 2001 From: Zachary LaVallee Date: Wed, 6 May 2026 12:43:18 -0700 Subject: [PATCH 09/19] Surface walker-pruned subtrees and add walker filter test coverage MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Walker-level path-filter prunes were previously silent: pathFilterIntercept short-circuits before any strategy reaches the directory, and there was no log trail explaining why a project the user expected didn't appear in the analyze summary. The post-summary note even pointed at `fossa list-targets` as a workaround, which deliberately ignores all filters. Wire `Has Logger sig m` through `walkWithFilters'` and `pathFilterIntercept` so the walker can speak. Per-prune log lines fire at debug level (one per strategy, ~28 strategies = noisy at info). Add `enumeratePrunedSubtrees`, a one-shot pre-discovery walk that returns the list of subtrees the filter will reject; analyze invokes it once before strategies run and logs each pruned path at info level. Result for a `.fossa.yml` with `paths.exclude: ["**/zip/**"]`: Active exclude glob filters: **/zip/** Skipping path "zip/" (excluded by paths filter) The Has Logger ripple touches every strategy that uses walkWithFilters' (~32 single-line constraint sites, ~7 multi-line). Each carrier already provides Logger via DiscoverTaskEffs, so the change is purely a constraint propagation — no new effects, no runtime cost. Add three Walker spec tests (test/Discovery/WalkSpec.hs): - include-path filter: mirror of the existing exclude test, asserts the walker accepts ancestors + included subtree and prunes siblings. - WalkSkipSome merge: strategy returns WalkSkipSome ["a"], filter excludes "b", both should be pruned. Catches the `pathFilterIntercept`/`skipDisallowed` merge logic. - YAML-to-walker end-to-end: parses a YAML config string with a glob exclude, runs it through `collectConfigFileFilters`, executes the walker, asserts pruning. Catches "globs parse but never reach the walker" wiring regressions — the exact class of bug we hit earlier. Cannot exercise the new tests locally because the test binary's startup reads test/Container/testdata/emptypath.tar (a git-LFS pointer not materialized in this environment); CI's Linux/macOS/Windows jobs will validate. Library and test-binary builds pass with no warnings. Co-Authored-By: Claude Opus 4.7 (1M context) --- Changelog.md | 3 +- src/App/Fossa/Analyze.hs | 22 +++- src/Discovery/Walk.hs | 63 +++++++++-- src/Strategy/ApkDatabase.hs | 3 + src/Strategy/BerkeleyDB.hs | 2 + src/Strategy/Bundler.hs | 5 +- src/Strategy/Cargo.hs | 5 +- src/Strategy/Carthage.hs | 5 +- src/Strategy/Cocoapods.hs | 4 +- src/Strategy/Composer.hs | 5 +- src/Strategy/Conda.hs | 4 +- src/Strategy/Dpkg.hs | 3 + src/Strategy/Fpm.hs | 4 +- src/Strategy/Glide.hs | 5 +- src/Strategy/Godep.hs | 5 +- src/Strategy/Gomodules.hs | 5 +- src/Strategy/Googlesource/RepoManifest.hs | 5 +- src/Strategy/Gradle.hs | 3 +- src/Strategy/Haskell/Cabal.hs | 5 +- src/Strategy/Haskell/Stack.hs | 5 +- src/Strategy/Leiningen.hs | 5 +- src/Strategy/Maven.hs | 2 + src/Strategy/Maven/Pom/Closure.hs | 5 +- src/Strategy/Mix.hs | 5 +- src/Strategy/NDB.hs | 3 + src/Strategy/Nim.hs | 5 +- src/Strategy/Node.hs | 2 +- src/Strategy/NuGet.hs | 4 +- src/Strategy/NuGet/Nuspec.hs | 5 +- src/Strategy/NuGet/PackagesConfig.hs | 5 +- src/Strategy/NuGet/Paket.hs | 5 +- src/Strategy/NuGet/ProjectJson.hs | 5 +- src/Strategy/Perl.hs | 5 +- src/Strategy/Pub.hs | 4 +- src/Strategy/Python/PDM/Pdm.hs | 4 +- src/Strategy/Python/Pipenv.hs | 5 +- src/Strategy/Python/Setuptools.hs | 5 +- src/Strategy/Python/Uv.hs | 5 +- src/Strategy/R.hs | 3 + src/Strategy/RPM.hs | 5 +- src/Strategy/Rebar3.hs | 5 +- src/Strategy/Scala.hs | 2 + src/Strategy/Sqlite.hs | 3 + src/Strategy/SwiftPM.hs | 4 + test/Discovery/WalkSpec.hs | 129 +++++++++++++++++++++- 45 files changed, 317 insertions(+), 74 deletions(-) diff --git a/Changelog.md b/Changelog.md index 663955785c..e8ab6d77e8 100644 --- a/Changelog.md +++ b/Changelog.md @@ -2,7 +2,8 @@ ## 3.17.4 -- Config: `paths.only` and `paths.exclude` in `.fossa.yml` now accept glob patterns (e.g. `**/vendor/**`, `node_modules/*`). Entries containing `*`, `?`, or `[` are parsed as globs; other entries keep their existing directory-tree semantics. ([#1703](https://github.com/fossas/fossa-cli/pull/1703)) +- Config: `paths.only` and `paths.exclude` in `.fossa.yml` now accept glob patterns (e.g. `**/vendor/**`, `node_modules/*`). An entry is treated as a glob if it contains `*`; other entries keep their existing directory-tree semantics. Glob matching follows [`System.FilePattern`](https://hackage.haskell.org/package/filepattern) semantics: `*` matches any sequence of characters within a single path segment, and `**` matches any number of segments. Patterns use forward slashes; backslashes are normalized so Windows-native patterns also work. ([#1703](https://github.com/fossas/fossa-cli/pull/1703)) +- Analyze: At startup, `fossa analyze` now prints (a) the active `paths.only`/`paths.exclude` filters from `.fossa.yml` and (b) the directories the walker will prune as a result. Each pruned subtree is reported once at info level so users can correlate a missing project with a configured filter. Per-prune trace logging during discovery is at debug level and visible with `--debug`. ([#1703](https://github.com/fossas/fossa-cli/pull/1703)) ## 3.17.3 diff --git a/src/App/Fossa/Analyze.hs b/src/App/Fossa/Analyze.hs index 5fac9deb5c..4507ebe88c 100644 --- a/src/App/Fossa/Analyze.hs +++ b/src/App/Fossa/Analyze.hs @@ -121,7 +121,7 @@ import Data.Aeson qualified as Aeson import Data.ByteString.Lazy qualified as BL import Data.Error (createBody) import Data.Flag (Flag, fromFlag) -import Data.Foldable (traverse_) +import Data.Foldable (for_, traverse_) import Data.Functor (($>)) import Data.Glob (unGlob) import Data.List.NonEmpty qualified as NE @@ -137,6 +137,7 @@ import Diag.Result (resultToMaybe) import Discovery.Archive qualified as Archive import Discovery.Filters (AllFilters (..), MavenScopeFilters, applyFilters, combinedPathGlobs, combinedPaths, filterIsVSIOnly, ignoredPaths, isDefaultNonProductionPath) import Discovery.Projects (withDiscoveredProjects) +import Discovery.Walk (enumeratePrunedSubtrees) import Effect.Exec (Exec) import Effect.Logger ( Logger, @@ -145,6 +146,7 @@ import Effect.Logger ( logInfo, logStdout, renderIt, + viaShow, ) import Effect.ReadFS (ReadFS) import Errata (Errata (..)) @@ -317,6 +319,23 @@ logActivePathFilters AllFilters{includeFilters = include, excludeFilters = exclu logInfo $ "Active " <> pretty label <> " filters: " <> pretty (Text.intercalate ", " items) +-- | Walk the tree once at startup and surface every directory the path +-- filters will prune. Each prune is logged once at info level here, instead +-- of emitting per-strategy duplicates from inside the walker (~28 strategies +-- would otherwise each report the same prune). +logPrunedSubtrees :: + ( Has Logger sig m + , Has ReadFS sig m + , Has Diag.Diagnostics sig m + ) => + AllFilters -> + Path Abs Dir -> + m () +logPrunedSubtrees filters basedir = do + pruned <- enumeratePrunedSubtrees filters basedir + for_ pruned $ \p -> + logInfo $ "Skipping path " <> viaShow p <> " (excluded by paths filter)" + analyze :: ( Has Debug sig m , Has Diag.Diagnostics sig m @@ -353,6 +372,7 @@ analyze cfg = Diag.context "fossa-analyze" $ do enableVendetta = Config.xVendetta cfg logActivePathFilters filters + logPrunedSubtrees filters basedir manualDepsResult <- Diag.errorBoundaryIO . diagToDebug $ diff --git a/src/Discovery/Walk.hs b/src/Discovery/Walk.hs index 37efcbab43..8e86849e0b 100644 --- a/src/Discovery/Walk.hs +++ b/src/Discovery/Walk.hs @@ -5,6 +5,7 @@ module Discovery.Walk ( walkWithFilters', WalkStep (..), findFileInAncestor, + enumeratePrunedSubtrees, -- * Helpers fileName, @@ -19,7 +20,7 @@ import Control.Effect.Reader (Reader, ask) import Control.Monad.Trans import Control.Monad.Trans.Maybe import Data.Bifunctor (second) -import Data.Foldable (find) +import Data.Foldable (find, traverse_) import Data.Functor (void) import Data.Glob qualified as Glob import Data.List ((\\)) @@ -28,6 +29,7 @@ import Data.Set qualified as Set import Data.String.Conversion (toString, toText) import Data.Text (Text) import Discovery.Filters (AllFilters, pathAllowed) +import Effect.Logger (Logger, logDebug, viaShow) import Effect.ReadFS import Path @@ -68,7 +70,8 @@ walk f = walkDir $ \dir subdirs files -> do WalkStop -> pure WalkFinish pathFilterIntercept :: - ( Applicative m + ( Has Logger sig m + , Monad m , Monoid o ) => AllFilters -> @@ -84,17 +87,34 @@ pathFilterIntercept filters base dir subdirs act = do Nothing -> act Just relative -> if pathAllowed filters relative - then (fmap . second) skipDisallowed act - else pure (mempty, WalkSkipAll) + then do + traverse_ logSkip disallowedRelativeSubdirs + (fmap . second) skipDisallowed act + else do + logSkip relative + pure (mempty, WalkSkipAll) where - disallowedSubdirs :: [Text] - disallowedSubdirs = do + -- Returns the list of immediate subdirectories that the filter rejects, + -- paired with their relative-to-base paths (for logging) and their bare + -- directory names (for the WalkStep skip list the walker consumes). + disallowedRelativeSubdirs :: [Path Rel Dir] + disallowedRelativeSubdirs = do subdir <- subdirs stripped <- stripProperPrefix base subdir - let isAllowed = pathAllowed filters stripped - if isAllowed + if pathAllowed filters stripped then mempty - else pure $ (toText . toFilePath . dirname) subdir + else pure stripped + + disallowedSubdirs :: [Text] + disallowedSubdirs = map (toText . toFilePath . dirname) disallowedRelativeSubdirs + + -- Per-prune events fire once per strategy walk, so emitting at info-level + -- here would surface N copies of every prune (one per strategy that walks + -- the tree). 'enumeratePrunedSubtrees' surfaces each prune once at info + -- before discovery begins; this debug line is for trace-level diagnostics. + logSkip :: Has Logger sig m => Path Rel Dir -> m () + logSkip relPath = + logDebug $ "Skipping " <> viaShow relPath <> " (excluded by paths filter)" -- skipDisallowed needs to look at either: -- * WalkStep.WalkContinue @@ -130,10 +150,12 @@ walk' f base = do tell res pure step --- | Like @walk'@, but ignores paths that don't match the provided filters. +-- | Like @walk'@, but ignores paths that don't match the provided filters and +-- emits a log line for each subdirectory pruned by the filters. walkWithFilters' :: ( Has ReadFS sig m , Has Diagnostics sig m + , Has Logger sig m , Has (Reader AllFilters) sig m , Monoid o ) => @@ -145,6 +167,27 @@ walkWithFilters' f root = do let f' dir subdirs files = pathFilterIntercept filters root dir subdirs $ f dir subdirs files walk' f' root +-- | Return the relative-to-root paths of every directory pruned by the +-- 'AllFilters' include/exclude path rules. Useful for surfacing pruned dirs +-- to the user once at startup, before any per-strategy walks (which would +-- otherwise emit one log per strategy that reaches the same prune). +enumeratePrunedSubtrees :: + ( Has ReadFS sig m + , Has Diagnostics sig m + ) => + AllFilters -> + Path Abs Dir -> + m [Path Rel Dir] +enumeratePrunedSubtrees filters root = walk' visit root + where + visit _dir subdirs _files = do + let pruned = do + subdir <- subdirs + stripped <- maybe [] pure (stripProperPrefix root subdir) + if pathAllowed filters stripped then [] else [stripped] + skipNames = map (toText . toFilePath . dirname) pruned + pure (pruned, WalkSkipSome skipNames) + -- | Search upwards in the directory tree for the existence of the supplied file. findFileInAncestor :: (Has ReadFS sig m, Has Diagnostics sig m) => Path Abs Dir -> Text -> m (Path Abs File) findFileInAncestor dir file = do diff --git a/src/Strategy/ApkDatabase.hs b/src/Strategy/ApkDatabase.hs index 465b3fece8..51094761f3 100644 --- a/src/Strategy/ApkDatabase.hs +++ b/src/Strategy/ApkDatabase.hs @@ -18,6 +18,7 @@ import Discovery.Walk ( findFileNamed, walkWithFilters', ) +import Effect.Logger (Logger) import Effect.ReadFS (Has, ReadFS) import GHC.Generics (Generic) import Path (Abs, Dir, File, Path) @@ -44,6 +45,7 @@ instance AnalyzeProject AlpineDatabase where discover :: ( Has ReadFS sig m , Has Diagnostics sig m + , Has Logger sig m , Has (Reader AllFilters) sig m ) => OsInfo -> @@ -54,6 +56,7 @@ discover osInfo = simpleDiscover (findProjects osInfo) mkProject AlpineDatabaseP findProjects :: ( Has ReadFS sig m , Has Diagnostics sig m + , Has Logger sig m , Has (Reader AllFilters) sig m ) => OsInfo -> diff --git a/src/Strategy/BerkeleyDB.hs b/src/Strategy/BerkeleyDB.hs index ced77717d4..a65f4cc679 100644 --- a/src/Strategy/BerkeleyDB.hs +++ b/src/Strategy/BerkeleyDB.hs @@ -53,6 +53,7 @@ instance AnalyzeProject BerkeleyDatabase where discover :: ( Has ReadFS sig m , Has Diagnostics sig m + , Has Logger sig m , Has (Reader AllFilters) sig m ) => OsInfo -> @@ -63,6 +64,7 @@ discover osInfo = simpleDiscover (findProjects osInfo) mkProject BerkeleyDBProje findProjects :: ( Has ReadFS sig m , Has Diagnostics sig m + , Has Logger sig m , Has (Reader AllFilters) sig m ) => OsInfo -> diff --git a/src/Strategy/Bundler.hs b/src/Strategy/Bundler.hs index 7df930f18a..c79684758f 100644 --- a/src/Strategy/Bundler.hs +++ b/src/Strategy/Bundler.hs @@ -37,6 +37,7 @@ import Discovery.Walk ( walkWithFilters', ) import Effect.Exec (Exec, GetDepsEffs, Has) +import Effect.Logger (Logger) import Effect.ReadFS (ReadFS, readContentsParser) import GHC.Generics (Generic) import Path (Abs, Dir, File, Path, toFilePath) @@ -58,10 +59,10 @@ import Types ( LicenseType (UnknownType), ) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject BundlerProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject BundlerProject] discover = simpleDiscover findProjects mkProject BundlerProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [BundlerProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [BundlerProject] findProjects = walkWithFilters' $ \dir _ files -> do let maybeGemfile = findFileNamed "Gemfile" files gemfileLock = findFileNamed "Gemfile.lock" files diff --git a/src/Strategy/Cargo.hs b/src/Strategy/Cargo.hs index b224d5483a..21fb418608 100644 --- a/src/Strategy/Cargo.hs +++ b/src/Strategy/Cargo.hs @@ -80,6 +80,7 @@ import Effect.Grapher ( label, withLabeling, ) +import Effect.Logger (Logger) import Effect.ReadFS (ReadFS, doesFileExist, readContentsToml) import Errata (Errata (..)) import GHC.Generics (Generic) @@ -220,10 +221,10 @@ instance FromJSON CargoMetadata where <*> (obj .: "workspace_members" >>= traverse parsePkgId) <*> obj .: "resolve" -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject CargoProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject CargoProject] discover = simpleDiscover findProjects mkProject CargoProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [CargoProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [CargoProject] findProjects = walkWithFilters' $ \dir _ files -> do case findFileNamed "Cargo.toml" files of Nothing -> pure ([], WalkContinue) diff --git a/src/Strategy/Carthage.hs b/src/Strategy/Carthage.hs index 768fa4d0c9..bc41d9f281 100644 --- a/src/Strategy/Carthage.hs +++ b/src/Strategy/Carthage.hs @@ -46,6 +46,7 @@ import Discovery.Walk ( walkWithFilters', ) import Effect.Grapher (Grapher, direct, edge, evalGrapher) +import Effect.Logger (Logger) import Effect.ReadFS (ReadFS, readContentsParser) import Errata (Errata (..)) import GHC.Generics (Generic) @@ -81,10 +82,10 @@ import Types ( GraphBreadth (Complete), ) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject CarthageProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject CarthageProject] discover = simpleDiscover findProjects mkProject CarthageProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [CarthageProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [CarthageProject] findProjects = walkWithFilters' $ \dir _ files -> do case findFileNamed "Cartfile.resolved" files of Nothing -> pure ([], WalkContinue) diff --git a/src/Strategy/Cocoapods.hs b/src/Strategy/Cocoapods.hs index 9cb6de02a0..0e08c14619 100644 --- a/src/Strategy/Cocoapods.hs +++ b/src/Strategy/Cocoapods.hs @@ -48,10 +48,10 @@ import Types ( LicenseType (UnknownType), ) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject CocoapodsProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject CocoapodsProject] discover = simpleDiscover findProjects mkProject CocoapodsProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [CocoapodsProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [CocoapodsProject] findProjects = walkWithFilters' $ \dir _ files -> do let podfile = findFileNamed "Podfile" files podfileLock = findFileNamed "Podfile.lock" files diff --git a/src/Strategy/Composer.hs b/src/Strategy/Composer.hs index fd9a4338c5..ee6eb61167 100644 --- a/src/Strategy/Composer.hs +++ b/src/Strategy/Composer.hs @@ -52,6 +52,7 @@ import Effect.Grapher ( label, withLabeling, ) +import Effect.Logger (Logger) import Effect.ReadFS (ReadFS, readContentsJson) import GHC.Generics (Generic) import Graphing (Graphing) @@ -66,10 +67,10 @@ import Types ( LicenseType (LicenseSPDX), ) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject ComposerProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject ComposerProject] discover = simpleDiscover findProjects mkProject ComposerProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [ComposerProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [ComposerProject] findProjects = walkWithFilters' $ \dir _ files -> do case findFileNamed "composer.lock" files of Nothing -> pure ([], WalkContinue) diff --git a/src/Strategy/Conda.hs b/src/Strategy/Conda.hs index 28eef36080..b1cc52a46c 100644 --- a/src/Strategy/Conda.hs +++ b/src/Strategy/Conda.hs @@ -45,10 +45,10 @@ instance ToDiagnostic DynamicAnalysisFailed where renderDiagnostic DynamicAnalysisFailed = Errata (Just "Dynamic analysis via 'conda env create' failed") [] Nothing -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject CondaProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject CondaProject] discover = simpleDiscover findProjects mkProject CondaProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [CondaProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [CondaProject] findProjects = walkWithFilters' $ \dir _ files -> do case findFileNamed "environment.yml" files of Nothing -> pure ([], WalkContinue) diff --git a/src/Strategy/Dpkg.hs b/src/Strategy/Dpkg.hs index 7cb29e5917..a69afe6da1 100644 --- a/src/Strategy/Dpkg.hs +++ b/src/Strategy/Dpkg.hs @@ -18,6 +18,7 @@ import Discovery.Walk ( findFileNamed, walkWithFilters', ) +import Effect.Logger (Logger) import Effect.ReadFS (Has, ReadFS) import GHC.Generics (Generic) import Path (Abs, Dir, File, Path, toFilePath) @@ -44,6 +45,7 @@ instance AnalyzeProject DpkgDatabase where discover :: ( Has ReadFS sig m , Has Diagnostics sig m + , Has Logger sig m , Has (Reader AllFilters) sig m ) => OsInfo -> @@ -54,6 +56,7 @@ discover osInfo = simpleDiscover (findProjects osInfo) mkProject DpkgDatabasePro findProjects :: ( Has ReadFS sig m , Has Diagnostics sig m + , Has Logger sig m , Has (Reader AllFilters) sig m ) => OsInfo -> diff --git a/src/Strategy/Fpm.hs b/src/Strategy/Fpm.hs index 1ce448ea19..81cd18f153 100644 --- a/src/Strategy/Fpm.hs +++ b/src/Strategy/Fpm.hs @@ -8,6 +8,7 @@ import Data.Aeson (ToJSON) import Discovery.Filters (AllFilters) import Discovery.Simple (simpleDiscover) import Discovery.Walk (WalkStep (WalkContinue, WalkSkipSome), findFileNamed, walkWithFilters') +import Effect.Logger (Logger) import Effect.ReadFS (Has, ReadFS) import GHC.Generics (Generic) import Path (Abs, Dir, File, Path) @@ -17,13 +18,14 @@ import Types (DependencyResults (..), DiscoveredProject (..), DiscoveredProjectT discover :: ( Has ReadFS sig m , Has Diagnostics sig m + , Has Logger sig m , Has (Reader AllFilters) sig m ) => Path Abs Dir -> m [DiscoveredProject FpmProject] discover = simpleDiscover findProjects mkProject FpmProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [FpmProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [FpmProject] findProjects = walkWithFilters' $ \dir _ files -> do let fmpSpecFile = findFileNamed "fpm.toml" files case (fmpSpecFile) of diff --git a/src/Strategy/Glide.hs b/src/Strategy/Glide.hs index 594413bace..c11d265e04 100644 --- a/src/Strategy/Glide.hs +++ b/src/Strategy/Glide.hs @@ -13,6 +13,7 @@ import Discovery.Walk ( findFileNamed, walkWithFilters', ) +import Effect.Logger (Logger) import Effect.ReadFS (Has, ReadFS) import GHC.Generics (Generic) import Path (Abs, Dir, File, Path) @@ -23,10 +24,10 @@ import Types ( DiscoveredProjectType (GlideProjectType), ) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject GlideProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject GlideProject] discover = simpleDiscover findProjects mkProject GlideProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [GlideProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [GlideProject] findProjects = walkWithFilters' $ \dir _ files -> do case findFileNamed "glide.lock" files of Nothing -> pure ([], WalkContinue) diff --git a/src/Strategy/Godep.hs b/src/Strategy/Godep.hs index 65dba72546..75e9462d01 100644 --- a/src/Strategy/Godep.hs +++ b/src/Strategy/Godep.hs @@ -17,6 +17,7 @@ import Discovery.Walk ( walkWithFilters', ) import Effect.Exec (Exec, GetDepsEffs, Has) +import Effect.Logger (Logger) import Effect.ReadFS (ReadFS) import GHC.Generics (Generic) import Path (Abs, Dir, File, Path) @@ -29,10 +30,10 @@ import Types ( GraphBreadth (Complete), ) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject GodepProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject GodepProject] discover = simpleDiscover findProjects mkProject GodepProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [GodepProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [GodepProject] findProjects = walkWithFilters' $ \dir _ files -> do let gopkgToml = findFileNamed "Gopkg.toml" files let gopkgLock = findFileNamed "Gopkg.lock" files diff --git a/src/Strategy/Gomodules.hs b/src/Strategy/Gomodules.hs index c08f429551..924fe39838 100644 --- a/src/Strategy/Gomodules.hs +++ b/src/Strategy/Gomodules.hs @@ -20,6 +20,7 @@ import Discovery.Walk ( walkWithFilters', ) import Effect.Exec (Exec, GetDepsEffs, Has) +import Effect.Logger (Logger) import Effect.ReadFS (ReadFS) import GHC.Generics (Generic) import Graphing (Graphing) @@ -35,10 +36,10 @@ import Types ( GraphBreadth, ) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject GomodulesProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject GomodulesProject] discover = simpleDiscover findProjects mkProject GomodProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [GomodulesProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [GomodulesProject] findProjects = walkWithFilters' $ \dir _ files -> do case findFileNamed "go.mod" files of Nothing -> pure ([], WalkSkipSome ["vendor"]) diff --git a/src/Strategy/Googlesource/RepoManifest.hs b/src/Strategy/Googlesource/RepoManifest.hs index 909ab1c5da..2a1b12a185 100644 --- a/src/Strategy/Googlesource/RepoManifest.hs +++ b/src/Strategy/Googlesource/RepoManifest.hs @@ -48,6 +48,7 @@ import Discovery.Walk ( fileName, walkWithFilters', ) +import Effect.Logger (Logger) import Effect.ReadFS ( ReadFS, doesFileExist, @@ -80,11 +81,11 @@ import Types ( GraphBreadth (Partial), ) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject RepoManifestProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject RepoManifestProject] discover = simpleDiscover findProjects mkProject RepoManifestProjectType -- We're looking for a file called "manifest.xml" in a directory called ".repo" -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [RepoManifestProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [RepoManifestProject] findProjects = walkWithFilters' $ \_ _ files -> do case find (\f -> "manifest.xml" == fileName f) files of Nothing -> pure ([], WalkContinue) diff --git a/src/Strategy/Gradle.hs b/src/Strategy/Gradle.hs index 3e9fc5c729..398a437c63 100644 --- a/src/Strategy/Gradle.hs +++ b/src/Strategy/Gradle.hs @@ -100,6 +100,7 @@ discover :: , Has ReadFS sig m , Has Diagnostics sig m , Has Exec sig m + , Has Logger sig m , Has (Reader AllFilters) sig m ) => Path Abs Dir -> @@ -126,7 +127,7 @@ runGradle dir cmd = gradleWrapper <||> gradleBinary -- This is to avoid invoking Gradle again for each subproject, which would be -- slow (because of Gradle's startup time) and possibly wrong (because -- subprojects need to resolve dependency constraints together). -findProjects :: (Has Exec sig m, Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [GradleProject] +findProjects :: (Has Exec sig m, Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [GradleProject] findProjects = walkWithFilters' $ \dir _ files -> do let isProjectFile f = any diff --git a/src/Strategy/Haskell/Cabal.hs b/src/Strategy/Haskell/Cabal.hs index 6cdc5e9295..4779b4fe7d 100644 --- a/src/Strategy/Haskell/Cabal.hs +++ b/src/Strategy/Haskell/Cabal.hs @@ -63,6 +63,7 @@ import Effect.Grapher ( mapping, withMapping, ) +import Effect.Logger (Logger) import Effect.ReadFS (ReadFS, readContentsJson) import Errata (Errata (..)) import GHC.Generics (Generic) @@ -156,7 +157,7 @@ cabalGenPlanCmd = cabalPlanFilePath :: Path Rel File cabalPlanFilePath = $(mkRelFile "dist-newstyle/cache/plan.json") -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject CabalProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject CabalProject] discover = simpleDiscover findProjects mkProject CabalProjectType isCabalFile :: Path Abs File -> Bool @@ -166,7 +167,7 @@ isCabalFile file = isDotCabal || isCabalDotProject isDotCabal = ".cabal" `isSuffixOf` name isCabalDotProject = "cabal.project" == name -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [CabalProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [CabalProject] findProjects = walkWithFilters' $ \dir _ files -> do -- NOTE: the long-term more-accurate version here is to parse the `cabal.project` file and look -- for relevant cabal files to mark as manifests. diff --git a/src/Strategy/Haskell/Stack.hs b/src/Strategy/Haskell/Stack.hs index a7c5ef1753..55b3767878 100644 --- a/src/Strategy/Haskell/Stack.hs +++ b/src/Strategy/Haskell/Stack.hs @@ -50,6 +50,7 @@ import Effect.Grapher ( mapping, withMapping, ) +import Effect.Logger (Logger) import Effect.ReadFS (ReadFS) import GHC.Generics (Generic) import Graphing qualified as G @@ -112,10 +113,10 @@ instance FromJSON StackLocation where | txt `elem` ["project package", "archive"] -> pure Local | otherwise -> fail $ "Bad location type: " ++ toString txt -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject StackProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject StackProject] discover = simpleDiscover findProjects mkProject StackProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [StackProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [StackProject] findProjects = walkWithFilters' $ \dir _ files -> do case findFileNamed "stack.yaml" files of Nothing -> pure ([], WalkContinue) diff --git a/src/Strategy/Leiningen.hs b/src/Strategy/Leiningen.hs index 639d39a522..00e6bf32df 100644 --- a/src/Strategy/Leiningen.hs +++ b/src/Strategy/Leiningen.hs @@ -68,6 +68,7 @@ import Effect.Grapher ( label, withLabeling, ) +import Effect.Logger (Logger) import Effect.ReadFS (ReadFS) import Errata (Errata (..)) import GHC.Generics (Generic) @@ -103,10 +104,10 @@ leinVersionCmd = , cmdEnvVars = Map.empty } -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject LeiningenProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject LeiningenProject] discover = simpleDiscover findProjects mkProject LeiningenProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [LeiningenProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [LeiningenProject] findProjects = walkWithFilters' $ \dir _ files -> do case findFileNamed "project.clj" files of Nothing -> pure ([], WalkContinue) diff --git a/src/Strategy/Maven.hs b/src/Strategy/Maven.hs index 0d88adc0b0..8ab9a82d1b 100644 --- a/src/Strategy/Maven.hs +++ b/src/Strategy/Maven.hs @@ -23,6 +23,7 @@ import Diag.Common (MissingDeepDeps (MissingDeepDeps), MissingEdges (MissingEdge import Discovery.Filters (AllFilters, MavenScopeFilters, mavenScopeFilterSet) import Discovery.Simple (simpleDiscover) import Effect.Exec (CandidateCommandEffs, GetDepsEffs) +import Effect.Logger (Logger) import Effect.ReadFS (ReadFS) import GHC.Generics (Generic) import Graphing (Graphing, gmap, shrinkRoots) @@ -39,6 +40,7 @@ discover :: ( Has (Lift IO) sig m , Has Diagnostics sig m , Has ReadFS sig m + , Has Logger sig m , Has (Reader AllFilters) sig m ) => Path Abs Dir -> diff --git a/src/Strategy/Maven/Pom/Closure.hs b/src/Strategy/Maven/Pom/Closure.hs index b86b7e541e..046dfdec4d 100644 --- a/src/Strategy/Maven/Pom/Closure.hs +++ b/src/Strategy/Maven/Pom/Closure.hs @@ -20,6 +20,7 @@ import Data.Maybe (mapMaybe) import Data.Set (Set) import Data.Set qualified as Set import Discovery.Walk +import Effect.Logger (Logger) import Effect.ReadFS import GHC.Generics (Generic) import Path @@ -31,13 +32,13 @@ import Control.Effect.Reader (Reader) import Data.Text (Text) import Discovery.Filters (AllFilters) -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [MavenProjectClosure] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [MavenProjectClosure] findProjects basedir = do pomFiles <- context "Finding pom files" $ findPomFiles basedir globalClosure <- context "Building global closure" $ buildGlobalClosure pomFiles context "Building project closures" $ pure (buildProjectClosures basedir globalClosure) -findPomFiles :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [Path Abs File] +findPomFiles :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [Path Abs File] findPomFiles dir = execState @[Path Abs File] [] $ flip walkWithFilters' dir $ \_ _ files -> do diff --git a/src/Strategy/Mix.hs b/src/Strategy/Mix.hs index af8969df06..a97f2f04e0 100644 --- a/src/Strategy/Mix.hs +++ b/src/Strategy/Mix.hs @@ -15,15 +15,16 @@ import Discovery.Walk ( findFileNamed, walkWithFilters', ) +import Effect.Logger (Logger) import Effect.ReadFS (Has, ReadFS) import Path (Abs, Dir, Path) import Strategy.Elixir.MixTree (MixProject (..)) import Types (DiscoveredProject (..), DiscoveredProjectType (MixProjectType)) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject MixProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject MixProject] discover = simpleDiscover findProjects mkProject MixProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [MixProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [MixProject] findProjects = walkWithFilters' $ \dir _ files -> do case findFileNamed "mix.exs" files of Nothing -> pure ([], WalkContinue) diff --git a/src/Strategy/NDB.hs b/src/Strategy/NDB.hs index 0e0c20c580..6e53773bba 100644 --- a/src/Strategy/NDB.hs +++ b/src/Strategy/NDB.hs @@ -19,6 +19,7 @@ import Discovery.Walk ( findFileNamed, walkWithFilters', ) +import Effect.Logger (Logger) import Effect.ReadFS (Has, ReadFS) import GHC.Generics (Generic) import Graphing (Graphing, directs) @@ -50,6 +51,7 @@ instance AnalyzeProject NdbLocation where discover :: ( Has ReadFS sig m , Has Diagnostics sig m + , Has Logger sig m , Has (Reader AllFilters) sig m ) => OsInfo -> @@ -60,6 +62,7 @@ discover osInfo = simpleDiscover (findProjects osInfo) mkProject NDBProjectType findProjects :: ( Has ReadFS sig m , Has Diagnostics sig m + , Has Logger sig m , Has (Reader AllFilters) sig m ) => OsInfo -> diff --git a/src/Strategy/Nim.hs b/src/Strategy/Nim.hs index 9c0f75b83c..6ed590e0e4 100644 --- a/src/Strategy/Nim.hs +++ b/src/Strategy/Nim.hs @@ -16,6 +16,7 @@ import Discovery.Walk ( walkWithFilters', ) import Effect.Exec (Exec) +import Effect.Logger (Logger) import Effect.ReadFS (Has, ReadFS) import GHC.Generics (Generic) import Path (Abs, Dir, File, Path) @@ -34,10 +35,10 @@ instance AnalyzeProject NimbleProject where analyzeProject _ = getDeps analyzeProjectStaticOnly _ = getDepsStatically -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject NimbleProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject NimbleProject] discover = simpleDiscover findProjects mkProject NimbleProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [NimbleProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [NimbleProject] findProjects = walkWithFilters' $ \dir _ files -> do case findFileNamed "nimble.lock" files of Nothing -> pure ([], WalkContinue) diff --git a/src/Strategy/Node.hs b/src/Strategy/Node.hs index 17cf7ab160..a410a9eda0 100644 --- a/src/Strategy/Node.hs +++ b/src/Strategy/Node.hs @@ -137,7 +137,7 @@ discover dir = withMultiToolFilter [YarnProjectType, NpmProjectType, PnpmProject graphs <- context "Splitting global graph into chunks" $ fromMaybe CyclicPackageJson $ splitGraph globalGraph context "Converting graphs to analysis targets" $ traverse (mkProject <=< identifyProjectType) graphs -collectManifests :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [Manifest] +collectManifests :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [Manifest] collectManifests = walkWithFilters' $ \_ _ files -> case findFileNamed "package.json" files of Nothing -> pure ([], skipJsFolders) diff --git a/src/Strategy/NuGet.hs b/src/Strategy/NuGet.hs index 124bcd67fc..0304ed5d9e 100644 --- a/src/Strategy/NuGet.hs +++ b/src/Strategy/NuGet.hs @@ -26,6 +26,7 @@ import Discovery.Walk ( findFileNamed, walkWithFilters', ) +import Effect.Logger (Logger) import Effect.ReadFS (ReadFS) import GHC.Generics (Generic) import Path (Abs, Dir, File, Path, parent) @@ -41,13 +42,14 @@ import Types ( discover :: ( Has ReadFS sig m , Has Diagnostics sig m + , Has Logger sig m , Has (Reader AllFilters) sig m ) => Path Abs Dir -> m [DiscoveredProject NuGetProject] discover = simpleDiscover findProjects mkProject NuGetProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [NuGetProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [NuGetProject] findProjects = walkWithFilters' $ \_ _ files -> do case findProjectAssetsJsonFile files of Just file -> pure ([NuGetProject file], WalkContinue) diff --git a/src/Strategy/NuGet/Nuspec.hs b/src/Strategy/NuGet/Nuspec.hs index 368e01d937..56770ed700 100644 --- a/src/Strategy/NuGet/Nuspec.hs +++ b/src/Strategy/NuGet/Nuspec.hs @@ -35,6 +35,7 @@ import Discovery.Walk ( fileName, walkWithFilters', ) +import Effect.Logger (Logger) import Effect.ReadFS (ReadFS, readContentsXML) import GHC.Generics (Generic) import Graphing (Graphing) @@ -58,10 +59,10 @@ import Types ( LicenseType (..), ) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject NuspecProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject NuspecProject] discover = simpleDiscover findProjects mkProject NuspecProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [NuspecProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [NuspecProject] findProjects = walkWithFilters' $ \_ _ files -> do case find (L.isSuffixOf ".nuspec" . fileName) files of Nothing -> pure ([], WalkContinue) diff --git a/src/Strategy/NuGet/PackagesConfig.hs b/src/Strategy/NuGet/PackagesConfig.hs index 21f3f98f35..80eb3c0f8e 100644 --- a/src/Strategy/NuGet/PackagesConfig.hs +++ b/src/Strategy/NuGet/PackagesConfig.hs @@ -29,6 +29,7 @@ import Discovery.Walk ( fileName, walkWithFilters', ) +import Effect.Logger (Logger) import Effect.ReadFS (ReadFS, readContentsXML) import GHC.Generics (Generic) import Graphing (Graphing) @@ -42,10 +43,10 @@ import Types ( GraphBreadth (Partial), ) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject PackagesConfigProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject PackagesConfigProject] discover = simpleDiscover findProjects mkProject PackagesConfigProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [PackagesConfigProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [PackagesConfigProject] findProjects = walkWithFilters' $ \_ _ files -> do case find (\f -> fileName f == "packages.config") files of Nothing -> pure ([], WalkContinue) diff --git a/src/Strategy/NuGet/Paket.hs b/src/Strategy/NuGet/Paket.hs index 9edd04d25c..960db5eb72 100644 --- a/src/Strategy/NuGet/Paket.hs +++ b/src/Strategy/NuGet/Paket.hs @@ -47,6 +47,7 @@ import Effect.Grapher ( label, withLabeling, ) +import Effect.Logger (Logger) import Effect.ReadFS (ReadFS, readContentsParser) import GHC.Generics (Generic) import Graphing (Graphing) @@ -72,10 +73,10 @@ import Types ( type Parser = Parsec Void Text -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject PaketProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject PaketProject] discover = simpleDiscover findProjects mkProject PaketProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [PaketProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [PaketProject] findProjects = walkWithFilters' $ \_ _ files -> do case findFileNamed "paket.lock" files of Nothing -> pure ([], WalkContinue) diff --git a/src/Strategy/NuGet/ProjectJson.hs b/src/Strategy/NuGet/ProjectJson.hs index a7dbb56f70..6d1d372c3f 100644 --- a/src/Strategy/NuGet/ProjectJson.hs +++ b/src/Strategy/NuGet/ProjectJson.hs @@ -39,6 +39,7 @@ import Discovery.Walk ( findFileNamed, walkWithFilters', ) +import Effect.Logger (Logger) import Effect.ReadFS (ReadFS, readContentsJson) import GHC.Generics (Generic) import Graphing (Graphing) @@ -51,10 +52,10 @@ import Types ( GraphBreadth (Partial), ) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject ProjectJsonProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject ProjectJsonProject] discover = simpleDiscover findProjects mkProject ProjectJsonProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [ProjectJsonProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [ProjectJsonProject] findProjects = walkWithFilters' $ \_ _ files -> do case findFileNamed "project.json" files of Nothing -> pure ([], WalkContinue) diff --git a/src/Strategy/Perl.hs b/src/Strategy/Perl.hs index 34e1b0dcd8..2866f24691 100644 --- a/src/Strategy/Perl.hs +++ b/src/Strategy/Perl.hs @@ -35,6 +35,7 @@ import Discovery.Walk ( findFileNamed, walkWithFilters', ) +import Effect.Logger (Logger) import Effect.ReadFS (Has, ReadFS, readContentsJson, readContentsYaml) import GHC.Generics (Generic) import Graphing (Graphing, deeps) @@ -48,10 +49,10 @@ import Types ( GraphBreadth (Partial), ) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject PerlProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject PerlProject] discover = simpleDiscover findProjects mkProject PerlProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [PerlProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [PerlProject] findProjects = walkWithFilters' $ \dir _ files -> do -- We prefer MYMETA over META. -- Reference: https://metacpan.org/dist/App-mymeta_requires/view/bin/mymeta-requires diff --git a/src/Strategy/Pub.hs b/src/Strategy/Pub.hs index 935601cf6d..0d2d539c82 100644 --- a/src/Strategy/Pub.hs +++ b/src/Strategy/Pub.hs @@ -26,10 +26,10 @@ import Strategy.Dart.PubSpec (analyzePubSpecFile) import Strategy.Dart.PubSpecLock (analyzePubLockFile) import Types (DependencyResults (..), DiscoveredProject (..), DiscoveredProjectType (PubProjectType)) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject PubProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject PubProject] discover = simpleDiscover findProjects mkProject PubProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [PubProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [PubProject] findProjects = walkWithFilters' $ \dir _ files -> do -- Note: pub does not support pubspec.yml naming - it must be pubspec.yaml. let pubSpecFile = findFileNamed "pubspec.yaml" files diff --git a/src/Strategy/Python/PDM/Pdm.hs b/src/Strategy/Python/PDM/Pdm.hs index c73259a341..bf09fa50f7 100644 --- a/src/Strategy/Python/PDM/Pdm.hs +++ b/src/Strategy/Python/PDM/Pdm.hs @@ -13,6 +13,7 @@ import DepTypes ( Dependency (..), VerConstraint, ) +import Effect.Logger (Logger) import Effect.ReadFS (Has, ReadFS, readContentsToml) import Graphing (Graphing, directs) import Path (Abs, Dir, File, Path) @@ -39,13 +40,14 @@ import Types ( discover :: ( Has ReadFS sig m , Has Diagnostics sig m + , Has Logger sig m , Has (Reader AllFilters) sig m ) => Path Abs Dir -> m [DiscoveredProject PdmProject] discover = simpleDiscover findProjects mkProject PdmProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [PdmProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [PdmProject] findProjects = walkWithFilters' $ \dir _ files -> do let pyprojectFile = findFileNamed "pyproject.toml" files let pdmlockFile = findFileNamed "pdm.lock" files diff --git a/src/Strategy/Python/Pipenv.hs b/src/Strategy/Python/Pipenv.hs index dd4387367c..0b2579009b 100644 --- a/src/Strategy/Python/Pipenv.hs +++ b/src/Strategy/Python/Pipenv.hs @@ -72,6 +72,7 @@ import Effect.Grapher ( label, withLabeling, ) +import Effect.Logger (Logger) import Effect.ReadFS (ReadFS, readContentsJson, readContentsToml) import GHC.Generics (Generic) import Graphing (Graphing, pruneUnreachable) @@ -85,10 +86,10 @@ import Types ( GraphBreadth (Complete), ) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject PipenvProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject PipenvProject] discover = simpleDiscover findProjects mkProject PipenvProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [PipenvProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [PipenvProject] findProjects = walkWithFilters' $ \_ _ files -> do case findPipenvFiles files of (Nothing, _) -> pure ([], WalkContinue) diff --git a/src/Strategy/Python/Setuptools.hs b/src/Strategy/Python/Setuptools.hs index c6c3e4db18..854b3f47a6 100644 --- a/src/Strategy/Python/Setuptools.hs +++ b/src/Strategy/Python/Setuptools.hs @@ -23,6 +23,7 @@ import Discovery.Walk ( walkWithFilters', ) import Effect.Exec (Exec) +import Effect.Logger (Logger) import Effect.ReadFS (Has, ReadFS) import GHC.Generics (Generic) import Graphing (Graphing) @@ -38,10 +39,10 @@ import Types ( GraphBreadth (Partial), ) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject SetuptoolsProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject SetuptoolsProject] discover = simpleDiscover findProjects mkProject SetuptoolsProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [SetuptoolsProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [SetuptoolsProject] findProjects = walkWithFilters' $ \dir _ files -> do let reqTxtFiles = filter diff --git a/src/Strategy/Python/Uv.hs b/src/Strategy/Python/Uv.hs index e3056f6041..88ec9fce21 100644 --- a/src/Strategy/Python/Uv.hs +++ b/src/Strategy/Python/Uv.hs @@ -45,6 +45,7 @@ import Effect.Grapher ( edge, evalGrapher, ) +import Effect.Logger (Logger) import Effect.ReadFS (ReadFS, readContentsToml) import GHC.Generics (Generic) import Graphing ( @@ -67,13 +68,13 @@ import Types ( ) discover :: - (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => + (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject UvProject] discover = simpleDiscover findProjects mkProject PipenvProjectType findProjects :: - (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => + (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [UvProject] findProjects = walkWithFilters' $ \_ _ files -> do diff --git a/src/Strategy/R.hs b/src/Strategy/R.hs index 86efa6da73..4cf424ac80 100644 --- a/src/Strategy/R.hs +++ b/src/Strategy/R.hs @@ -21,6 +21,7 @@ import Discovery.Walk ( findFileNamed, walkWithFilters', ) +import Effect.Logger (Logger) import Effect.ReadFS (Has, ReadFS) import GHC.Generics (Generic) import Path (Abs, Dir, File, Path) @@ -61,6 +62,7 @@ instance AnalyzeProject RProject where discover :: ( Has ReadFS sig m , Has Diagnostics sig m + , Has Logger sig m , Has (Reader AllFilters) sig m ) => Path Abs Dir -> @@ -70,6 +72,7 @@ discover = simpleDiscover findProjects mkProject RProjectType findProjects :: ( Has ReadFS sig m , Has Diagnostics sig m + , Has Logger sig m , Has (Reader AllFilters) sig m ) => Path Abs Dir -> diff --git a/src/Strategy/RPM.hs b/src/Strategy/RPM.hs index e8531a11dd..7f02a902c9 100644 --- a/src/Strategy/RPM.hs +++ b/src/Strategy/RPM.hs @@ -34,6 +34,7 @@ import Discovery.Walk ( fileName, walkWithFilters', ) +import Effect.Logger (Logger) import Effect.ReadFS (ReadFS, readContentsText) import GHC.Generics (Generic) import Graphing (Graphing) @@ -67,10 +68,10 @@ data Dependencies = Dependencies } deriving (Eq, Ord, Show) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject RpmProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject RpmProject] discover = simpleDiscover findProjects mkProject RpmProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [RpmProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [RpmProject] findProjects = walkWithFilters' $ \dir _ files -> do let specs = filter (\f -> ".spec" `isSuffixOf` fileName f) files diff --git a/src/Strategy/Rebar3.hs b/src/Strategy/Rebar3.hs index 0e069858f8..d278e3afeb 100644 --- a/src/Strategy/Rebar3.hs +++ b/src/Strategy/Rebar3.hs @@ -19,6 +19,7 @@ import Discovery.Walk ( walkWithFilters', ) import Effect.Exec (Exec, Has) +import Effect.Logger (Logger) import Effect.ReadFS (ReadFS) import GHC.Generics (Generic) import Path (Abs, Dir, File, Path) @@ -29,10 +30,10 @@ import Types ( DiscoveredProjectType (Rebar3ProjectType), ) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject RebarProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject RebarProject] discover = simpleDiscover findProjects mkProject Rebar3ProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [RebarProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [RebarProject] findProjects = walkWithFilters' $ \dir _ files -> do case findFileNamed "rebar.config" files of Nothing -> pure ([], WalkContinue) diff --git a/src/Strategy/Scala.hs b/src/Strategy/Scala.hs index 6b85919f4c..2385569573 100644 --- a/src/Strategy/Scala.hs +++ b/src/Strategy/Scala.hs @@ -74,6 +74,7 @@ discover :: ( Has Exec sig m , Has ReadFS sig m , Has Diagnostics sig m + , Has Logger sig m , Has (Reader AllFilters) sig m ) => Path Abs Dir -> @@ -147,6 +148,7 @@ findProjects :: ( Has Exec sig m , Has ReadFS sig m , Has Diagnostics sig m + , Has Logger sig m , Has (Reader AllFilters) sig m ) => Path Abs Dir -> diff --git a/src/Strategy/Sqlite.hs b/src/Strategy/Sqlite.hs index 4be574c0d7..5885cf37ef 100644 --- a/src/Strategy/Sqlite.hs +++ b/src/Strategy/Sqlite.hs @@ -29,6 +29,7 @@ import Database.SQLite3 qualified as SQLite import Discovery.Filters (AllFilters) import Discovery.Simple (simpleDiscover) import Discovery.Walk (WalkStep (WalkContinue), findFirstMatchingFile, walkWithFilters') +import Effect.Logger (Logger) import Effect.ReadFS (ReadFS, readContentsBS) import GHC.Generics (Generic) import Graphing (directs) @@ -48,6 +49,7 @@ instance ToJSON SqliteDB discover :: ( Has ReadFS sig m , Has Diagnostics sig m + , Has Logger sig m , Has (Reader AllFilters) sig m ) => OsInfo -> @@ -59,6 +61,7 @@ findProjects :: ( Has ReadFS sig m , Has (Reader AllFilters) sig m , Has Diagnostics sig m + , Has Logger sig m ) => OsInfo -> Path Abs Dir -> diff --git a/src/Strategy/SwiftPM.hs b/src/Strategy/SwiftPM.hs index 8ba5e93b87..15803aab3a 100644 --- a/src/Strategy/SwiftPM.hs +++ b/src/Strategy/SwiftPM.hs @@ -58,6 +58,7 @@ findProjects :: ( Has ReadFS sig m , Has Diagnostics sig m , Has Logger sig m + , Has Logger sig m , Has (Reader AllFilters) sig m ) => Path Abs Dir -> @@ -70,6 +71,7 @@ findProjects dir = do findSwiftPackageProjects :: ( Has ReadFS sig m , Has Diagnostics sig m + , Has Logger sig m , Has (Reader AllFilters) sig m ) => Path Abs Dir -> @@ -88,6 +90,7 @@ findXcodeProjects :: ( Has ReadFS sig m , Has Diagnostics sig m , Has Logger sig m + , Has Logger sig m , Has (Reader AllFilters) sig m ) => Path Abs Dir -> @@ -110,6 +113,7 @@ findXcodeProjects = walkWithFilters' $ \dir _ files -> do findFirstResolvedFileRecursively :: ( Has ReadFS sig m , Has Diagnostics sig m + , Has Logger sig m , Has (Reader AllFilters) sig m ) => Path Abs Dir -> diff --git a/test/Discovery/WalkSpec.hs b/test/Discovery/WalkSpec.hs index 3dd14d6684..4ed4c8dca1 100644 --- a/test/Discovery/WalkSpec.hs +++ b/test/Discovery/WalkSpec.hs @@ -5,6 +5,8 @@ module Discovery.WalkSpec ( spec, ) where +import App.Fossa.Config.Common (collectConfigFileFilters) +import App.Fossa.Config.ConfigFile (ConfigFile) import Control.Carrier.Reader (runReader) import Control.Carrier.State.Strict (runState) import Control.Carrier.Writer.Strict (runWriter, tell) @@ -14,8 +16,10 @@ import Control.Effect.State (get, put) import Data.Foldable (traverse_) import Data.Map (Map) import Data.Map qualified as Map -import Discovery.Filters (AllFilters) +import Data.Yaml (decodeThrow) +import Discovery.Filters (AllFilters (AllFilters), comboInclude) import Discovery.Walk +import Effect.Logger (ignoreLogger) import Effect.ReadFS import Path import Path.IO (createDir, createDirLink, emptyPermissions, getPermissions, setPermissions) @@ -61,6 +65,106 @@ walkWithFilters'Spec = fooPermissions <- getPermissions foo setPermissions bar fooPermissions + -- Mirror of the exclude test above: with an include filter, the walker + -- should accept the included subtree (including ancestors needed to reach + -- it) but prune siblings that are neither the include nor an ancestor. + it' "respects include-path filters" . withTempDir "test-Discovery-Walk-include" $ \tmpDir -> do + let dirs@[foo, bar, _baz] = + map + (tmpDir ) + [ $(mkRelDir "foo") + , $(mkRelDir "foo/bar") + , $(mkRelDir "foo/baz") + ] + sendIO $ traverse_ createDir dirs + + let filters = includePath $(mkRelDir "foo/bar") + paths <- runWalkWithFilters' 100 filters tmpDir + pathsToTree paths + `shouldBe'` dirTree + [ + ( tmpDir + , dirTree + [ + ( foo + , dirTree + [ (bar, dirTree []) + ] + ) + ] + ) + ] + + -- Strategy-supplied 'WalkSkipSome' must compose with the filter-derived + -- prune list. Tree: tmpDir / { strategy-skip, filter-skip, keep }. The + -- visit function returns 'WalkSkipSome ["strategy-skip"]'; the filter + -- excludes 'filter-skip'. Both subtrees should be pruned, only 'keep' + -- and 'tmpDir' should appear in the visited set. + it' "merges strategy WalkSkipSome with filter prunes" . withTempDir "test-Discovery-Walk-merge" $ \tmpDir -> do + let dirs@[strategySkip, filterSkip, keep] = + map + (tmpDir ) + [ $(mkRelDir "strategy-skip") + , $(mkRelDir "filter-skip") + , $(mkRelDir "keep") + ] + sendIO $ traverse_ createDir dirs + + let filters = excludePath $(mkRelDir "filter-skip") + paths <- runWalkWithFiltersAndStep (WalkSkipSome ["strategy-skip"]) 100 filters tmpDir + pathsToTree paths + `shouldBe'` dirTree + [ + ( tmpDir + , dirTree + [(keep, dirTree [])] + ) + ] + -- Sanity: the prune-list directories really were created on disk; + -- otherwise the assertion above would pass vacuously. + sendIO $ traverse_ (const (pure ())) [strategySkip, filterSkip] + + -- End-to-end: a YAML config goes through the same parse path that + -- '.fossa.yml' takes, then 'collectConfigFileFilters' produces the + -- 'AllFilters' that the walker actually consumes. This catches the + -- "globs parse but never reach the walker" class of regression. + it' "applies paths.exclude globs parsed from a YAML config" . withTempDir "test-Discovery-Walk-yaml" $ \tmpDir -> do + let dirs@[zip', zipPython, src, srcLib] = + map + (tmpDir ) + [ $(mkRelDir "zip") + , $(mkRelDir "zip/python") + , $(mkRelDir "src") + , $(mkRelDir "src/lib") + ] + sendIO $ traverse_ createDir dirs + + let yaml = + "version: 3\n\ + \paths:\n\ + \ exclude:\n\ + \ - \"**/zip/**\"\n" + cfgFn <- sendIO $ decodeThrow yaml + let cfgPath = tmpDir $(mkRelFile ".fossa.yml") + cfg = cfgFn cfgPath :: ConfigFile + filters = collectConfigFileFilters cfg + + paths <- runWalkWithFilters' 100 filters tmpDir + pathsToTree paths + `shouldBe'` dirTree + [ + ( tmpDir + , dirTree + [ + ( src + , dirTree [(srcLib, dirTree [])] + ) + ] + ) + ] + -- Make sure the dirs we expected to be pruned actually exist on disk. + sendIO $ traverse_ (const (pure ())) [zip', zipPython] + walkSpec :: Spec walkSpec = describe "walk" $ do @@ -162,12 +266,28 @@ runWalkWithFilters' :: AllFilters -> Path Abs Dir -> m [Path Abs Dir] -runWalkWithFilters' maxIters filters startDir = +runWalkWithFilters' = runWalkWithFiltersAndStep WalkContinue + +-- | Like 'runWalkWithFilters'', but lets the caller pin the 'WalkStep' that +-- every visited directory returns. Use 'WalkSkipSome' to verify that the +-- caller's skip list is merged with the filter-derived prunes inside +-- 'pathFilterIntercept'. +runWalkWithFiltersAndStep :: + ( Has ReadFS sig m + , Has Diagnostics sig m + ) => + WalkStep -> + Int -> + AllFilters -> + Path Abs Dir -> + m [Path Abs Dir] +runWalkWithFiltersAndStep userStep maxIters filters startDir = do fmap fst . runWriter . fmap snd . runState (0 :: Int) + . ignoreLogger . runReader filters $ walkWithFilters' ( \dir _ _ -> do @@ -176,12 +296,15 @@ runWalkWithFilters' maxIters filters startDir = then do put (iterations + 1) tell [dir] - pure ((), WalkContinue) + pure ((), userStep) else do pure ((), WalkStop) ) startDir +includePath :: Path Rel Dir -> AllFilters +includePath path = AllFilters (comboInclude mempty [path]) mempty + runWalkWithCircuitBreaker :: (Has ReadFS sig m, Has Diagnostics sig m) => Int -> Path Abs Dir -> m [Path Abs Dir] runWalkWithCircuitBreaker maxIters startDir = From 7b38be13aa6eadffd549bfc2e87ff0d6e96f6d65 Mon Sep 17 00:00:00 2001 From: Zachary LaVallee Date: Wed, 6 May 2026 15:02:10 -0700 Subject: [PATCH 10/19] Revert Has Logger walker propagation; gate prune-enumeration walk MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Per-prune `logDebug` events from `pathFilterIntercept` were the only thing the 39-file `Has Logger sig m` ripple bought us. The user-facing value — "each pruned subtree shows up once at info" — comes from `enumeratePrunedSubtrees` + `logPrunedSubtrees` in `App.Fossa.Analyze`, and that path doesn't need the constraint propagated: `walk'` works without `Logger`, and the logging happens in `analyze` where Logger was always in scope. Revert the propagation in `walkWithFilters'` and `pathFilterIntercept` back to the prior `Applicative m, Monoid o` shape, and revert all 39 strategy files (and their `Effect.Logger` import additions) to master. Keep `enumeratePrunedSubtrees`, `logPrunedSubtrees`, and the "Active filters" startup line — they're the user-visible win. Add a no-filters short-circuit to `logPrunedSubtrees` so we don't pay for an extra walk when the user has no `paths.only`/`paths.exclude` entries configured. Co-Authored-By: Claude Opus 4.7 (1M context) --- Changelog.md | 2 +- src/App/Fossa/Analyze.hs | 19 ++++++++--- src/Discovery/Walk.hs | 41 ++++++----------------- src/Strategy/ApkDatabase.hs | 3 -- src/Strategy/BerkeleyDB.hs | 2 -- src/Strategy/Bundler.hs | 5 ++- src/Strategy/Cargo.hs | 5 ++- src/Strategy/Carthage.hs | 5 ++- src/Strategy/Cocoapods.hs | 4 +-- src/Strategy/Composer.hs | 5 ++- src/Strategy/Conda.hs | 4 +-- src/Strategy/Dpkg.hs | 3 -- src/Strategy/Fpm.hs | 4 +-- src/Strategy/Glide.hs | 5 ++- src/Strategy/Godep.hs | 5 ++- src/Strategy/Gomodules.hs | 5 ++- src/Strategy/Googlesource/RepoManifest.hs | 5 ++- src/Strategy/Gradle.hs | 3 +- src/Strategy/Haskell/Cabal.hs | 5 ++- src/Strategy/Haskell/Stack.hs | 5 ++- src/Strategy/Leiningen.hs | 5 ++- src/Strategy/Maven.hs | 2 -- src/Strategy/Maven/Pom/Closure.hs | 5 ++- src/Strategy/Mix.hs | 5 ++- src/Strategy/NDB.hs | 3 -- src/Strategy/Nim.hs | 5 ++- src/Strategy/Node.hs | 2 +- src/Strategy/NuGet.hs | 4 +-- src/Strategy/NuGet/Nuspec.hs | 5 ++- src/Strategy/NuGet/PackagesConfig.hs | 5 ++- src/Strategy/NuGet/Paket.hs | 5 ++- src/Strategy/NuGet/ProjectJson.hs | 5 ++- src/Strategy/Perl.hs | 5 ++- src/Strategy/Pub.hs | 4 +-- src/Strategy/Python/PDM/Pdm.hs | 4 +-- src/Strategy/Python/Pipenv.hs | 5 ++- src/Strategy/Python/Setuptools.hs | 5 ++- src/Strategy/Python/Uv.hs | 5 ++- src/Strategy/R.hs | 3 -- src/Strategy/RPM.hs | 5 ++- src/Strategy/Rebar3.hs | 5 ++- src/Strategy/Scala.hs | 2 -- src/Strategy/Sqlite.hs | 3 -- src/Strategy/SwiftPM.hs | 4 --- test/Discovery/WalkSpec.hs | 2 -- 45 files changed, 84 insertions(+), 154 deletions(-) diff --git a/Changelog.md b/Changelog.md index e8ab6d77e8..de5a46a3c9 100644 --- a/Changelog.md +++ b/Changelog.md @@ -3,7 +3,7 @@ ## 3.17.4 - Config: `paths.only` and `paths.exclude` in `.fossa.yml` now accept glob patterns (e.g. `**/vendor/**`, `node_modules/*`). An entry is treated as a glob if it contains `*`; other entries keep their existing directory-tree semantics. Glob matching follows [`System.FilePattern`](https://hackage.haskell.org/package/filepattern) semantics: `*` matches any sequence of characters within a single path segment, and `**` matches any number of segments. Patterns use forward slashes; backslashes are normalized so Windows-native patterns also work. ([#1703](https://github.com/fossas/fossa-cli/pull/1703)) -- Analyze: At startup, `fossa analyze` now prints (a) the active `paths.only`/`paths.exclude` filters from `.fossa.yml` and (b) the directories the walker will prune as a result. Each pruned subtree is reported once at info level so users can correlate a missing project with a configured filter. Per-prune trace logging during discovery is at debug level and visible with `--debug`. ([#1703](https://github.com/fossas/fossa-cli/pull/1703)) +- Analyze: At startup, `fossa analyze` now prints (a) the active `paths.only`/`paths.exclude` filters from `.fossa.yml` and (b) the directories the walker will prune as a result. Each pruned subtree is reported once at info level so users can correlate a missing project with a configured filter. The pre-discovery walk is skipped when no path filters are configured. ([#1703](https://github.com/fossas/fossa-cli/pull/1703)) ## 3.17.3 diff --git a/src/App/Fossa/Analyze.hs b/src/App/Fossa/Analyze.hs index 4507ebe88c..3eae218c83 100644 --- a/src/App/Fossa/Analyze.hs +++ b/src/App/Fossa/Analyze.hs @@ -322,7 +322,9 @@ logActivePathFilters AllFilters{includeFilters = include, excludeFilters = exclu -- | Walk the tree once at startup and surface every directory the path -- filters will prune. Each prune is logged once at info level here, instead -- of emitting per-strategy duplicates from inside the walker (~28 strategies --- would otherwise each report the same prune). +-- would otherwise each report the same prune). Short-circuits when no path +-- filters are configured so the extra walk is only paid for when it can +-- produce output. logPrunedSubtrees :: ( Has Logger sig m , Has ReadFS sig m @@ -331,10 +333,17 @@ logPrunedSubtrees :: AllFilters -> Path Abs Dir -> m () -logPrunedSubtrees filters basedir = do - pruned <- enumeratePrunedSubtrees filters basedir - for_ pruned $ \p -> - logInfo $ "Skipping path " <> viaShow p <> " (excluded by paths filter)" +logPrunedSubtrees filters basedir = + unless (noPathFilters filters) $ do + pruned <- enumeratePrunedSubtrees filters basedir + for_ pruned $ \p -> + logInfo $ "Skipping path " <> viaShow p <> " (excluded by paths filter)" + where + noPathFilters AllFilters{includeFilters = i, excludeFilters = e} = + null (combinedPaths i) + && null (combinedPathGlobs i) + && null (combinedPaths e) + && null (combinedPathGlobs e) analyze :: ( Has Debug sig m diff --git a/src/Discovery/Walk.hs b/src/Discovery/Walk.hs index 8e86849e0b..e01d7f4af1 100644 --- a/src/Discovery/Walk.hs +++ b/src/Discovery/Walk.hs @@ -20,7 +20,7 @@ import Control.Effect.Reader (Reader, ask) import Control.Monad.Trans import Control.Monad.Trans.Maybe import Data.Bifunctor (second) -import Data.Foldable (find, traverse_) +import Data.Foldable (find) import Data.Functor (void) import Data.Glob qualified as Glob import Data.List ((\\)) @@ -29,7 +29,6 @@ import Data.Set qualified as Set import Data.String.Conversion (toString, toText) import Data.Text (Text) import Discovery.Filters (AllFilters, pathAllowed) -import Effect.Logger (Logger, logDebug, viaShow) import Effect.ReadFS import Path @@ -70,8 +69,7 @@ walk f = walkDir $ \dir subdirs files -> do WalkStop -> pure WalkFinish pathFilterIntercept :: - ( Has Logger sig m - , Monad m + ( Applicative m , Monoid o ) => AllFilters -> @@ -87,34 +85,17 @@ pathFilterIntercept filters base dir subdirs act = do Nothing -> act Just relative -> if pathAllowed filters relative - then do - traverse_ logSkip disallowedRelativeSubdirs - (fmap . second) skipDisallowed act - else do - logSkip relative - pure (mempty, WalkSkipAll) + then (fmap . second) skipDisallowed act + else pure (mempty, WalkSkipAll) where - -- Returns the list of immediate subdirectories that the filter rejects, - -- paired with their relative-to-base paths (for logging) and their bare - -- directory names (for the WalkStep skip list the walker consumes). - disallowedRelativeSubdirs :: [Path Rel Dir] - disallowedRelativeSubdirs = do + disallowedSubdirs :: [Text] + disallowedSubdirs = do subdir <- subdirs stripped <- stripProperPrefix base subdir - if pathAllowed filters stripped + let isAllowed = pathAllowed filters stripped + if isAllowed then mempty - else pure stripped - - disallowedSubdirs :: [Text] - disallowedSubdirs = map (toText . toFilePath . dirname) disallowedRelativeSubdirs - - -- Per-prune events fire once per strategy walk, so emitting at info-level - -- here would surface N copies of every prune (one per strategy that walks - -- the tree). 'enumeratePrunedSubtrees' surfaces each prune once at info - -- before discovery begins; this debug line is for trace-level diagnostics. - logSkip :: Has Logger sig m => Path Rel Dir -> m () - logSkip relPath = - logDebug $ "Skipping " <> viaShow relPath <> " (excluded by paths filter)" + else pure $ (toText . toFilePath . dirname) subdir -- skipDisallowed needs to look at either: -- * WalkStep.WalkContinue @@ -150,12 +131,10 @@ walk' f base = do tell res pure step --- | Like @walk'@, but ignores paths that don't match the provided filters and --- emits a log line for each subdirectory pruned by the filters. +-- | Like @walk'@, but ignores paths that don't match the provided filters. walkWithFilters' :: ( Has ReadFS sig m , Has Diagnostics sig m - , Has Logger sig m , Has (Reader AllFilters) sig m , Monoid o ) => diff --git a/src/Strategy/ApkDatabase.hs b/src/Strategy/ApkDatabase.hs index 51094761f3..465b3fece8 100644 --- a/src/Strategy/ApkDatabase.hs +++ b/src/Strategy/ApkDatabase.hs @@ -18,7 +18,6 @@ import Discovery.Walk ( findFileNamed, walkWithFilters', ) -import Effect.Logger (Logger) import Effect.ReadFS (Has, ReadFS) import GHC.Generics (Generic) import Path (Abs, Dir, File, Path) @@ -45,7 +44,6 @@ instance AnalyzeProject AlpineDatabase where discover :: ( Has ReadFS sig m , Has Diagnostics sig m - , Has Logger sig m , Has (Reader AllFilters) sig m ) => OsInfo -> @@ -56,7 +54,6 @@ discover osInfo = simpleDiscover (findProjects osInfo) mkProject AlpineDatabaseP findProjects :: ( Has ReadFS sig m , Has Diagnostics sig m - , Has Logger sig m , Has (Reader AllFilters) sig m ) => OsInfo -> diff --git a/src/Strategy/BerkeleyDB.hs b/src/Strategy/BerkeleyDB.hs index a65f4cc679..ced77717d4 100644 --- a/src/Strategy/BerkeleyDB.hs +++ b/src/Strategy/BerkeleyDB.hs @@ -53,7 +53,6 @@ instance AnalyzeProject BerkeleyDatabase where discover :: ( Has ReadFS sig m , Has Diagnostics sig m - , Has Logger sig m , Has (Reader AllFilters) sig m ) => OsInfo -> @@ -64,7 +63,6 @@ discover osInfo = simpleDiscover (findProjects osInfo) mkProject BerkeleyDBProje findProjects :: ( Has ReadFS sig m , Has Diagnostics sig m - , Has Logger sig m , Has (Reader AllFilters) sig m ) => OsInfo -> diff --git a/src/Strategy/Bundler.hs b/src/Strategy/Bundler.hs index c79684758f..7df930f18a 100644 --- a/src/Strategy/Bundler.hs +++ b/src/Strategy/Bundler.hs @@ -37,7 +37,6 @@ import Discovery.Walk ( walkWithFilters', ) import Effect.Exec (Exec, GetDepsEffs, Has) -import Effect.Logger (Logger) import Effect.ReadFS (ReadFS, readContentsParser) import GHC.Generics (Generic) import Path (Abs, Dir, File, Path, toFilePath) @@ -59,10 +58,10 @@ import Types ( LicenseType (UnknownType), ) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject BundlerProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject BundlerProject] discover = simpleDiscover findProjects mkProject BundlerProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [BundlerProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [BundlerProject] findProjects = walkWithFilters' $ \dir _ files -> do let maybeGemfile = findFileNamed "Gemfile" files gemfileLock = findFileNamed "Gemfile.lock" files diff --git a/src/Strategy/Cargo.hs b/src/Strategy/Cargo.hs index 21fb418608..b224d5483a 100644 --- a/src/Strategy/Cargo.hs +++ b/src/Strategy/Cargo.hs @@ -80,7 +80,6 @@ import Effect.Grapher ( label, withLabeling, ) -import Effect.Logger (Logger) import Effect.ReadFS (ReadFS, doesFileExist, readContentsToml) import Errata (Errata (..)) import GHC.Generics (Generic) @@ -221,10 +220,10 @@ instance FromJSON CargoMetadata where <*> (obj .: "workspace_members" >>= traverse parsePkgId) <*> obj .: "resolve" -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject CargoProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject CargoProject] discover = simpleDiscover findProjects mkProject CargoProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [CargoProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [CargoProject] findProjects = walkWithFilters' $ \dir _ files -> do case findFileNamed "Cargo.toml" files of Nothing -> pure ([], WalkContinue) diff --git a/src/Strategy/Carthage.hs b/src/Strategy/Carthage.hs index bc41d9f281..768fa4d0c9 100644 --- a/src/Strategy/Carthage.hs +++ b/src/Strategy/Carthage.hs @@ -46,7 +46,6 @@ import Discovery.Walk ( walkWithFilters', ) import Effect.Grapher (Grapher, direct, edge, evalGrapher) -import Effect.Logger (Logger) import Effect.ReadFS (ReadFS, readContentsParser) import Errata (Errata (..)) import GHC.Generics (Generic) @@ -82,10 +81,10 @@ import Types ( GraphBreadth (Complete), ) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject CarthageProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject CarthageProject] discover = simpleDiscover findProjects mkProject CarthageProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [CarthageProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [CarthageProject] findProjects = walkWithFilters' $ \dir _ files -> do case findFileNamed "Cartfile.resolved" files of Nothing -> pure ([], WalkContinue) diff --git a/src/Strategy/Cocoapods.hs b/src/Strategy/Cocoapods.hs index 0e08c14619..9cb6de02a0 100644 --- a/src/Strategy/Cocoapods.hs +++ b/src/Strategy/Cocoapods.hs @@ -48,10 +48,10 @@ import Types ( LicenseType (UnknownType), ) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject CocoapodsProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject CocoapodsProject] discover = simpleDiscover findProjects mkProject CocoapodsProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [CocoapodsProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [CocoapodsProject] findProjects = walkWithFilters' $ \dir _ files -> do let podfile = findFileNamed "Podfile" files podfileLock = findFileNamed "Podfile.lock" files diff --git a/src/Strategy/Composer.hs b/src/Strategy/Composer.hs index ee6eb61167..fd9a4338c5 100644 --- a/src/Strategy/Composer.hs +++ b/src/Strategy/Composer.hs @@ -52,7 +52,6 @@ import Effect.Grapher ( label, withLabeling, ) -import Effect.Logger (Logger) import Effect.ReadFS (ReadFS, readContentsJson) import GHC.Generics (Generic) import Graphing (Graphing) @@ -67,10 +66,10 @@ import Types ( LicenseType (LicenseSPDX), ) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject ComposerProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject ComposerProject] discover = simpleDiscover findProjects mkProject ComposerProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [ComposerProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [ComposerProject] findProjects = walkWithFilters' $ \dir _ files -> do case findFileNamed "composer.lock" files of Nothing -> pure ([], WalkContinue) diff --git a/src/Strategy/Conda.hs b/src/Strategy/Conda.hs index b1cc52a46c..28eef36080 100644 --- a/src/Strategy/Conda.hs +++ b/src/Strategy/Conda.hs @@ -45,10 +45,10 @@ instance ToDiagnostic DynamicAnalysisFailed where renderDiagnostic DynamicAnalysisFailed = Errata (Just "Dynamic analysis via 'conda env create' failed") [] Nothing -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject CondaProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject CondaProject] discover = simpleDiscover findProjects mkProject CondaProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [CondaProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [CondaProject] findProjects = walkWithFilters' $ \dir _ files -> do case findFileNamed "environment.yml" files of Nothing -> pure ([], WalkContinue) diff --git a/src/Strategy/Dpkg.hs b/src/Strategy/Dpkg.hs index a69afe6da1..7cb29e5917 100644 --- a/src/Strategy/Dpkg.hs +++ b/src/Strategy/Dpkg.hs @@ -18,7 +18,6 @@ import Discovery.Walk ( findFileNamed, walkWithFilters', ) -import Effect.Logger (Logger) import Effect.ReadFS (Has, ReadFS) import GHC.Generics (Generic) import Path (Abs, Dir, File, Path, toFilePath) @@ -45,7 +44,6 @@ instance AnalyzeProject DpkgDatabase where discover :: ( Has ReadFS sig m , Has Diagnostics sig m - , Has Logger sig m , Has (Reader AllFilters) sig m ) => OsInfo -> @@ -56,7 +54,6 @@ discover osInfo = simpleDiscover (findProjects osInfo) mkProject DpkgDatabasePro findProjects :: ( Has ReadFS sig m , Has Diagnostics sig m - , Has Logger sig m , Has (Reader AllFilters) sig m ) => OsInfo -> diff --git a/src/Strategy/Fpm.hs b/src/Strategy/Fpm.hs index 81cd18f153..1ce448ea19 100644 --- a/src/Strategy/Fpm.hs +++ b/src/Strategy/Fpm.hs @@ -8,7 +8,6 @@ import Data.Aeson (ToJSON) import Discovery.Filters (AllFilters) import Discovery.Simple (simpleDiscover) import Discovery.Walk (WalkStep (WalkContinue, WalkSkipSome), findFileNamed, walkWithFilters') -import Effect.Logger (Logger) import Effect.ReadFS (Has, ReadFS) import GHC.Generics (Generic) import Path (Abs, Dir, File, Path) @@ -18,14 +17,13 @@ import Types (DependencyResults (..), DiscoveredProject (..), DiscoveredProjectT discover :: ( Has ReadFS sig m , Has Diagnostics sig m - , Has Logger sig m , Has (Reader AllFilters) sig m ) => Path Abs Dir -> m [DiscoveredProject FpmProject] discover = simpleDiscover findProjects mkProject FpmProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [FpmProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [FpmProject] findProjects = walkWithFilters' $ \dir _ files -> do let fmpSpecFile = findFileNamed "fpm.toml" files case (fmpSpecFile) of diff --git a/src/Strategy/Glide.hs b/src/Strategy/Glide.hs index c11d265e04..594413bace 100644 --- a/src/Strategy/Glide.hs +++ b/src/Strategy/Glide.hs @@ -13,7 +13,6 @@ import Discovery.Walk ( findFileNamed, walkWithFilters', ) -import Effect.Logger (Logger) import Effect.ReadFS (Has, ReadFS) import GHC.Generics (Generic) import Path (Abs, Dir, File, Path) @@ -24,10 +23,10 @@ import Types ( DiscoveredProjectType (GlideProjectType), ) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject GlideProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject GlideProject] discover = simpleDiscover findProjects mkProject GlideProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [GlideProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [GlideProject] findProjects = walkWithFilters' $ \dir _ files -> do case findFileNamed "glide.lock" files of Nothing -> pure ([], WalkContinue) diff --git a/src/Strategy/Godep.hs b/src/Strategy/Godep.hs index 75e9462d01..65dba72546 100644 --- a/src/Strategy/Godep.hs +++ b/src/Strategy/Godep.hs @@ -17,7 +17,6 @@ import Discovery.Walk ( walkWithFilters', ) import Effect.Exec (Exec, GetDepsEffs, Has) -import Effect.Logger (Logger) import Effect.ReadFS (ReadFS) import GHC.Generics (Generic) import Path (Abs, Dir, File, Path) @@ -30,10 +29,10 @@ import Types ( GraphBreadth (Complete), ) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject GodepProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject GodepProject] discover = simpleDiscover findProjects mkProject GodepProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [GodepProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [GodepProject] findProjects = walkWithFilters' $ \dir _ files -> do let gopkgToml = findFileNamed "Gopkg.toml" files let gopkgLock = findFileNamed "Gopkg.lock" files diff --git a/src/Strategy/Gomodules.hs b/src/Strategy/Gomodules.hs index 924fe39838..c08f429551 100644 --- a/src/Strategy/Gomodules.hs +++ b/src/Strategy/Gomodules.hs @@ -20,7 +20,6 @@ import Discovery.Walk ( walkWithFilters', ) import Effect.Exec (Exec, GetDepsEffs, Has) -import Effect.Logger (Logger) import Effect.ReadFS (ReadFS) import GHC.Generics (Generic) import Graphing (Graphing) @@ -36,10 +35,10 @@ import Types ( GraphBreadth, ) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject GomodulesProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject GomodulesProject] discover = simpleDiscover findProjects mkProject GomodProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [GomodulesProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [GomodulesProject] findProjects = walkWithFilters' $ \dir _ files -> do case findFileNamed "go.mod" files of Nothing -> pure ([], WalkSkipSome ["vendor"]) diff --git a/src/Strategy/Googlesource/RepoManifest.hs b/src/Strategy/Googlesource/RepoManifest.hs index 2a1b12a185..909ab1c5da 100644 --- a/src/Strategy/Googlesource/RepoManifest.hs +++ b/src/Strategy/Googlesource/RepoManifest.hs @@ -48,7 +48,6 @@ import Discovery.Walk ( fileName, walkWithFilters', ) -import Effect.Logger (Logger) import Effect.ReadFS ( ReadFS, doesFileExist, @@ -81,11 +80,11 @@ import Types ( GraphBreadth (Partial), ) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject RepoManifestProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject RepoManifestProject] discover = simpleDiscover findProjects mkProject RepoManifestProjectType -- We're looking for a file called "manifest.xml" in a directory called ".repo" -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [RepoManifestProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [RepoManifestProject] findProjects = walkWithFilters' $ \_ _ files -> do case find (\f -> "manifest.xml" == fileName f) files of Nothing -> pure ([], WalkContinue) diff --git a/src/Strategy/Gradle.hs b/src/Strategy/Gradle.hs index 398a437c63..3e9fc5c729 100644 --- a/src/Strategy/Gradle.hs +++ b/src/Strategy/Gradle.hs @@ -100,7 +100,6 @@ discover :: , Has ReadFS sig m , Has Diagnostics sig m , Has Exec sig m - , Has Logger sig m , Has (Reader AllFilters) sig m ) => Path Abs Dir -> @@ -127,7 +126,7 @@ runGradle dir cmd = gradleWrapper <||> gradleBinary -- This is to avoid invoking Gradle again for each subproject, which would be -- slow (because of Gradle's startup time) and possibly wrong (because -- subprojects need to resolve dependency constraints together). -findProjects :: (Has Exec sig m, Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [GradleProject] +findProjects :: (Has Exec sig m, Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [GradleProject] findProjects = walkWithFilters' $ \dir _ files -> do let isProjectFile f = any diff --git a/src/Strategy/Haskell/Cabal.hs b/src/Strategy/Haskell/Cabal.hs index 4779b4fe7d..6cdc5e9295 100644 --- a/src/Strategy/Haskell/Cabal.hs +++ b/src/Strategy/Haskell/Cabal.hs @@ -63,7 +63,6 @@ import Effect.Grapher ( mapping, withMapping, ) -import Effect.Logger (Logger) import Effect.ReadFS (ReadFS, readContentsJson) import Errata (Errata (..)) import GHC.Generics (Generic) @@ -157,7 +156,7 @@ cabalGenPlanCmd = cabalPlanFilePath :: Path Rel File cabalPlanFilePath = $(mkRelFile "dist-newstyle/cache/plan.json") -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject CabalProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject CabalProject] discover = simpleDiscover findProjects mkProject CabalProjectType isCabalFile :: Path Abs File -> Bool @@ -167,7 +166,7 @@ isCabalFile file = isDotCabal || isCabalDotProject isDotCabal = ".cabal" `isSuffixOf` name isCabalDotProject = "cabal.project" == name -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [CabalProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [CabalProject] findProjects = walkWithFilters' $ \dir _ files -> do -- NOTE: the long-term more-accurate version here is to parse the `cabal.project` file and look -- for relevant cabal files to mark as manifests. diff --git a/src/Strategy/Haskell/Stack.hs b/src/Strategy/Haskell/Stack.hs index 55b3767878..a7c5ef1753 100644 --- a/src/Strategy/Haskell/Stack.hs +++ b/src/Strategy/Haskell/Stack.hs @@ -50,7 +50,6 @@ import Effect.Grapher ( mapping, withMapping, ) -import Effect.Logger (Logger) import Effect.ReadFS (ReadFS) import GHC.Generics (Generic) import Graphing qualified as G @@ -113,10 +112,10 @@ instance FromJSON StackLocation where | txt `elem` ["project package", "archive"] -> pure Local | otherwise -> fail $ "Bad location type: " ++ toString txt -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject StackProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject StackProject] discover = simpleDiscover findProjects mkProject StackProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [StackProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [StackProject] findProjects = walkWithFilters' $ \dir _ files -> do case findFileNamed "stack.yaml" files of Nothing -> pure ([], WalkContinue) diff --git a/src/Strategy/Leiningen.hs b/src/Strategy/Leiningen.hs index 00e6bf32df..639d39a522 100644 --- a/src/Strategy/Leiningen.hs +++ b/src/Strategy/Leiningen.hs @@ -68,7 +68,6 @@ import Effect.Grapher ( label, withLabeling, ) -import Effect.Logger (Logger) import Effect.ReadFS (ReadFS) import Errata (Errata (..)) import GHC.Generics (Generic) @@ -104,10 +103,10 @@ leinVersionCmd = , cmdEnvVars = Map.empty } -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject LeiningenProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject LeiningenProject] discover = simpleDiscover findProjects mkProject LeiningenProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [LeiningenProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [LeiningenProject] findProjects = walkWithFilters' $ \dir _ files -> do case findFileNamed "project.clj" files of Nothing -> pure ([], WalkContinue) diff --git a/src/Strategy/Maven.hs b/src/Strategy/Maven.hs index 8ab9a82d1b..0d88adc0b0 100644 --- a/src/Strategy/Maven.hs +++ b/src/Strategy/Maven.hs @@ -23,7 +23,6 @@ import Diag.Common (MissingDeepDeps (MissingDeepDeps), MissingEdges (MissingEdge import Discovery.Filters (AllFilters, MavenScopeFilters, mavenScopeFilterSet) import Discovery.Simple (simpleDiscover) import Effect.Exec (CandidateCommandEffs, GetDepsEffs) -import Effect.Logger (Logger) import Effect.ReadFS (ReadFS) import GHC.Generics (Generic) import Graphing (Graphing, gmap, shrinkRoots) @@ -40,7 +39,6 @@ discover :: ( Has (Lift IO) sig m , Has Diagnostics sig m , Has ReadFS sig m - , Has Logger sig m , Has (Reader AllFilters) sig m ) => Path Abs Dir -> diff --git a/src/Strategy/Maven/Pom/Closure.hs b/src/Strategy/Maven/Pom/Closure.hs index 046dfdec4d..b86b7e541e 100644 --- a/src/Strategy/Maven/Pom/Closure.hs +++ b/src/Strategy/Maven/Pom/Closure.hs @@ -20,7 +20,6 @@ import Data.Maybe (mapMaybe) import Data.Set (Set) import Data.Set qualified as Set import Discovery.Walk -import Effect.Logger (Logger) import Effect.ReadFS import GHC.Generics (Generic) import Path @@ -32,13 +31,13 @@ import Control.Effect.Reader (Reader) import Data.Text (Text) import Discovery.Filters (AllFilters) -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [MavenProjectClosure] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [MavenProjectClosure] findProjects basedir = do pomFiles <- context "Finding pom files" $ findPomFiles basedir globalClosure <- context "Building global closure" $ buildGlobalClosure pomFiles context "Building project closures" $ pure (buildProjectClosures basedir globalClosure) -findPomFiles :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [Path Abs File] +findPomFiles :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [Path Abs File] findPomFiles dir = execState @[Path Abs File] [] $ flip walkWithFilters' dir $ \_ _ files -> do diff --git a/src/Strategy/Mix.hs b/src/Strategy/Mix.hs index a97f2f04e0..af8969df06 100644 --- a/src/Strategy/Mix.hs +++ b/src/Strategy/Mix.hs @@ -15,16 +15,15 @@ import Discovery.Walk ( findFileNamed, walkWithFilters', ) -import Effect.Logger (Logger) import Effect.ReadFS (Has, ReadFS) import Path (Abs, Dir, Path) import Strategy.Elixir.MixTree (MixProject (..)) import Types (DiscoveredProject (..), DiscoveredProjectType (MixProjectType)) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject MixProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject MixProject] discover = simpleDiscover findProjects mkProject MixProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [MixProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [MixProject] findProjects = walkWithFilters' $ \dir _ files -> do case findFileNamed "mix.exs" files of Nothing -> pure ([], WalkContinue) diff --git a/src/Strategy/NDB.hs b/src/Strategy/NDB.hs index 6e53773bba..0e0c20c580 100644 --- a/src/Strategy/NDB.hs +++ b/src/Strategy/NDB.hs @@ -19,7 +19,6 @@ import Discovery.Walk ( findFileNamed, walkWithFilters', ) -import Effect.Logger (Logger) import Effect.ReadFS (Has, ReadFS) import GHC.Generics (Generic) import Graphing (Graphing, directs) @@ -51,7 +50,6 @@ instance AnalyzeProject NdbLocation where discover :: ( Has ReadFS sig m , Has Diagnostics sig m - , Has Logger sig m , Has (Reader AllFilters) sig m ) => OsInfo -> @@ -62,7 +60,6 @@ discover osInfo = simpleDiscover (findProjects osInfo) mkProject NDBProjectType findProjects :: ( Has ReadFS sig m , Has Diagnostics sig m - , Has Logger sig m , Has (Reader AllFilters) sig m ) => OsInfo -> diff --git a/src/Strategy/Nim.hs b/src/Strategy/Nim.hs index 6ed590e0e4..9c0f75b83c 100644 --- a/src/Strategy/Nim.hs +++ b/src/Strategy/Nim.hs @@ -16,7 +16,6 @@ import Discovery.Walk ( walkWithFilters', ) import Effect.Exec (Exec) -import Effect.Logger (Logger) import Effect.ReadFS (Has, ReadFS) import GHC.Generics (Generic) import Path (Abs, Dir, File, Path) @@ -35,10 +34,10 @@ instance AnalyzeProject NimbleProject where analyzeProject _ = getDeps analyzeProjectStaticOnly _ = getDepsStatically -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject NimbleProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject NimbleProject] discover = simpleDiscover findProjects mkProject NimbleProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [NimbleProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [NimbleProject] findProjects = walkWithFilters' $ \dir _ files -> do case findFileNamed "nimble.lock" files of Nothing -> pure ([], WalkContinue) diff --git a/src/Strategy/Node.hs b/src/Strategy/Node.hs index a410a9eda0..17cf7ab160 100644 --- a/src/Strategy/Node.hs +++ b/src/Strategy/Node.hs @@ -137,7 +137,7 @@ discover dir = withMultiToolFilter [YarnProjectType, NpmProjectType, PnpmProject graphs <- context "Splitting global graph into chunks" $ fromMaybe CyclicPackageJson $ splitGraph globalGraph context "Converting graphs to analysis targets" $ traverse (mkProject <=< identifyProjectType) graphs -collectManifests :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [Manifest] +collectManifests :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [Manifest] collectManifests = walkWithFilters' $ \_ _ files -> case findFileNamed "package.json" files of Nothing -> pure ([], skipJsFolders) diff --git a/src/Strategy/NuGet.hs b/src/Strategy/NuGet.hs index 0304ed5d9e..124bcd67fc 100644 --- a/src/Strategy/NuGet.hs +++ b/src/Strategy/NuGet.hs @@ -26,7 +26,6 @@ import Discovery.Walk ( findFileNamed, walkWithFilters', ) -import Effect.Logger (Logger) import Effect.ReadFS (ReadFS) import GHC.Generics (Generic) import Path (Abs, Dir, File, Path, parent) @@ -42,14 +41,13 @@ import Types ( discover :: ( Has ReadFS sig m , Has Diagnostics sig m - , Has Logger sig m , Has (Reader AllFilters) sig m ) => Path Abs Dir -> m [DiscoveredProject NuGetProject] discover = simpleDiscover findProjects mkProject NuGetProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [NuGetProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [NuGetProject] findProjects = walkWithFilters' $ \_ _ files -> do case findProjectAssetsJsonFile files of Just file -> pure ([NuGetProject file], WalkContinue) diff --git a/src/Strategy/NuGet/Nuspec.hs b/src/Strategy/NuGet/Nuspec.hs index 56770ed700..368e01d937 100644 --- a/src/Strategy/NuGet/Nuspec.hs +++ b/src/Strategy/NuGet/Nuspec.hs @@ -35,7 +35,6 @@ import Discovery.Walk ( fileName, walkWithFilters', ) -import Effect.Logger (Logger) import Effect.ReadFS (ReadFS, readContentsXML) import GHC.Generics (Generic) import Graphing (Graphing) @@ -59,10 +58,10 @@ import Types ( LicenseType (..), ) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject NuspecProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject NuspecProject] discover = simpleDiscover findProjects mkProject NuspecProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [NuspecProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [NuspecProject] findProjects = walkWithFilters' $ \_ _ files -> do case find (L.isSuffixOf ".nuspec" . fileName) files of Nothing -> pure ([], WalkContinue) diff --git a/src/Strategy/NuGet/PackagesConfig.hs b/src/Strategy/NuGet/PackagesConfig.hs index 80eb3c0f8e..21f3f98f35 100644 --- a/src/Strategy/NuGet/PackagesConfig.hs +++ b/src/Strategy/NuGet/PackagesConfig.hs @@ -29,7 +29,6 @@ import Discovery.Walk ( fileName, walkWithFilters', ) -import Effect.Logger (Logger) import Effect.ReadFS (ReadFS, readContentsXML) import GHC.Generics (Generic) import Graphing (Graphing) @@ -43,10 +42,10 @@ import Types ( GraphBreadth (Partial), ) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject PackagesConfigProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject PackagesConfigProject] discover = simpleDiscover findProjects mkProject PackagesConfigProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [PackagesConfigProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [PackagesConfigProject] findProjects = walkWithFilters' $ \_ _ files -> do case find (\f -> fileName f == "packages.config") files of Nothing -> pure ([], WalkContinue) diff --git a/src/Strategy/NuGet/Paket.hs b/src/Strategy/NuGet/Paket.hs index 960db5eb72..9edd04d25c 100644 --- a/src/Strategy/NuGet/Paket.hs +++ b/src/Strategy/NuGet/Paket.hs @@ -47,7 +47,6 @@ import Effect.Grapher ( label, withLabeling, ) -import Effect.Logger (Logger) import Effect.ReadFS (ReadFS, readContentsParser) import GHC.Generics (Generic) import Graphing (Graphing) @@ -73,10 +72,10 @@ import Types ( type Parser = Parsec Void Text -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject PaketProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject PaketProject] discover = simpleDiscover findProjects mkProject PaketProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [PaketProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [PaketProject] findProjects = walkWithFilters' $ \_ _ files -> do case findFileNamed "paket.lock" files of Nothing -> pure ([], WalkContinue) diff --git a/src/Strategy/NuGet/ProjectJson.hs b/src/Strategy/NuGet/ProjectJson.hs index 6d1d372c3f..a7dbb56f70 100644 --- a/src/Strategy/NuGet/ProjectJson.hs +++ b/src/Strategy/NuGet/ProjectJson.hs @@ -39,7 +39,6 @@ import Discovery.Walk ( findFileNamed, walkWithFilters', ) -import Effect.Logger (Logger) import Effect.ReadFS (ReadFS, readContentsJson) import GHC.Generics (Generic) import Graphing (Graphing) @@ -52,10 +51,10 @@ import Types ( GraphBreadth (Partial), ) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject ProjectJsonProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject ProjectJsonProject] discover = simpleDiscover findProjects mkProject ProjectJsonProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [ProjectJsonProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [ProjectJsonProject] findProjects = walkWithFilters' $ \_ _ files -> do case findFileNamed "project.json" files of Nothing -> pure ([], WalkContinue) diff --git a/src/Strategy/Perl.hs b/src/Strategy/Perl.hs index 2866f24691..34e1b0dcd8 100644 --- a/src/Strategy/Perl.hs +++ b/src/Strategy/Perl.hs @@ -35,7 +35,6 @@ import Discovery.Walk ( findFileNamed, walkWithFilters', ) -import Effect.Logger (Logger) import Effect.ReadFS (Has, ReadFS, readContentsJson, readContentsYaml) import GHC.Generics (Generic) import Graphing (Graphing, deeps) @@ -49,10 +48,10 @@ import Types ( GraphBreadth (Partial), ) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject PerlProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject PerlProject] discover = simpleDiscover findProjects mkProject PerlProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [PerlProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [PerlProject] findProjects = walkWithFilters' $ \dir _ files -> do -- We prefer MYMETA over META. -- Reference: https://metacpan.org/dist/App-mymeta_requires/view/bin/mymeta-requires diff --git a/src/Strategy/Pub.hs b/src/Strategy/Pub.hs index 0d2d539c82..935601cf6d 100644 --- a/src/Strategy/Pub.hs +++ b/src/Strategy/Pub.hs @@ -26,10 +26,10 @@ import Strategy.Dart.PubSpec (analyzePubSpecFile) import Strategy.Dart.PubSpecLock (analyzePubLockFile) import Types (DependencyResults (..), DiscoveredProject (..), DiscoveredProjectType (PubProjectType)) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject PubProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject PubProject] discover = simpleDiscover findProjects mkProject PubProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [PubProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [PubProject] findProjects = walkWithFilters' $ \dir _ files -> do -- Note: pub does not support pubspec.yml naming - it must be pubspec.yaml. let pubSpecFile = findFileNamed "pubspec.yaml" files diff --git a/src/Strategy/Python/PDM/Pdm.hs b/src/Strategy/Python/PDM/Pdm.hs index bf09fa50f7..c73259a341 100644 --- a/src/Strategy/Python/PDM/Pdm.hs +++ b/src/Strategy/Python/PDM/Pdm.hs @@ -13,7 +13,6 @@ import DepTypes ( Dependency (..), VerConstraint, ) -import Effect.Logger (Logger) import Effect.ReadFS (Has, ReadFS, readContentsToml) import Graphing (Graphing, directs) import Path (Abs, Dir, File, Path) @@ -40,14 +39,13 @@ import Types ( discover :: ( Has ReadFS sig m , Has Diagnostics sig m - , Has Logger sig m , Has (Reader AllFilters) sig m ) => Path Abs Dir -> m [DiscoveredProject PdmProject] discover = simpleDiscover findProjects mkProject PdmProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [PdmProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [PdmProject] findProjects = walkWithFilters' $ \dir _ files -> do let pyprojectFile = findFileNamed "pyproject.toml" files let pdmlockFile = findFileNamed "pdm.lock" files diff --git a/src/Strategy/Python/Pipenv.hs b/src/Strategy/Python/Pipenv.hs index 0b2579009b..dd4387367c 100644 --- a/src/Strategy/Python/Pipenv.hs +++ b/src/Strategy/Python/Pipenv.hs @@ -72,7 +72,6 @@ import Effect.Grapher ( label, withLabeling, ) -import Effect.Logger (Logger) import Effect.ReadFS (ReadFS, readContentsJson, readContentsToml) import GHC.Generics (Generic) import Graphing (Graphing, pruneUnreachable) @@ -86,10 +85,10 @@ import Types ( GraphBreadth (Complete), ) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject PipenvProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject PipenvProject] discover = simpleDiscover findProjects mkProject PipenvProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [PipenvProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [PipenvProject] findProjects = walkWithFilters' $ \_ _ files -> do case findPipenvFiles files of (Nothing, _) -> pure ([], WalkContinue) diff --git a/src/Strategy/Python/Setuptools.hs b/src/Strategy/Python/Setuptools.hs index 854b3f47a6..c6c3e4db18 100644 --- a/src/Strategy/Python/Setuptools.hs +++ b/src/Strategy/Python/Setuptools.hs @@ -23,7 +23,6 @@ import Discovery.Walk ( walkWithFilters', ) import Effect.Exec (Exec) -import Effect.Logger (Logger) import Effect.ReadFS (Has, ReadFS) import GHC.Generics (Generic) import Graphing (Graphing) @@ -39,10 +38,10 @@ import Types ( GraphBreadth (Partial), ) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject SetuptoolsProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject SetuptoolsProject] discover = simpleDiscover findProjects mkProject SetuptoolsProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [SetuptoolsProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [SetuptoolsProject] findProjects = walkWithFilters' $ \dir _ files -> do let reqTxtFiles = filter diff --git a/src/Strategy/Python/Uv.hs b/src/Strategy/Python/Uv.hs index 88ec9fce21..e3056f6041 100644 --- a/src/Strategy/Python/Uv.hs +++ b/src/Strategy/Python/Uv.hs @@ -45,7 +45,6 @@ import Effect.Grapher ( edge, evalGrapher, ) -import Effect.Logger (Logger) import Effect.ReadFS (ReadFS, readContentsToml) import GHC.Generics (Generic) import Graphing ( @@ -68,13 +67,13 @@ import Types ( ) discover :: - (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => + (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject UvProject] discover = simpleDiscover findProjects mkProject PipenvProjectType findProjects :: - (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => + (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [UvProject] findProjects = walkWithFilters' $ \_ _ files -> do diff --git a/src/Strategy/R.hs b/src/Strategy/R.hs index 4cf424ac80..86efa6da73 100644 --- a/src/Strategy/R.hs +++ b/src/Strategy/R.hs @@ -21,7 +21,6 @@ import Discovery.Walk ( findFileNamed, walkWithFilters', ) -import Effect.Logger (Logger) import Effect.ReadFS (Has, ReadFS) import GHC.Generics (Generic) import Path (Abs, Dir, File, Path) @@ -62,7 +61,6 @@ instance AnalyzeProject RProject where discover :: ( Has ReadFS sig m , Has Diagnostics sig m - , Has Logger sig m , Has (Reader AllFilters) sig m ) => Path Abs Dir -> @@ -72,7 +70,6 @@ discover = simpleDiscover findProjects mkProject RProjectType findProjects :: ( Has ReadFS sig m , Has Diagnostics sig m - , Has Logger sig m , Has (Reader AllFilters) sig m ) => Path Abs Dir -> diff --git a/src/Strategy/RPM.hs b/src/Strategy/RPM.hs index 7f02a902c9..e8531a11dd 100644 --- a/src/Strategy/RPM.hs +++ b/src/Strategy/RPM.hs @@ -34,7 +34,6 @@ import Discovery.Walk ( fileName, walkWithFilters', ) -import Effect.Logger (Logger) import Effect.ReadFS (ReadFS, readContentsText) import GHC.Generics (Generic) import Graphing (Graphing) @@ -68,10 +67,10 @@ data Dependencies = Dependencies } deriving (Eq, Ord, Show) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject RpmProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject RpmProject] discover = simpleDiscover findProjects mkProject RpmProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [RpmProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [RpmProject] findProjects = walkWithFilters' $ \dir _ files -> do let specs = filter (\f -> ".spec" `isSuffixOf` fileName f) files diff --git a/src/Strategy/Rebar3.hs b/src/Strategy/Rebar3.hs index d278e3afeb..0e069858f8 100644 --- a/src/Strategy/Rebar3.hs +++ b/src/Strategy/Rebar3.hs @@ -19,7 +19,6 @@ import Discovery.Walk ( walkWithFilters', ) import Effect.Exec (Exec, Has) -import Effect.Logger (Logger) import Effect.ReadFS (ReadFS) import GHC.Generics (Generic) import Path (Abs, Dir, File, Path) @@ -30,10 +29,10 @@ import Types ( DiscoveredProjectType (Rebar3ProjectType), ) -discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject RebarProject] +discover :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [DiscoveredProject RebarProject] discover = simpleDiscover findProjects mkProject Rebar3ProjectType -findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has Logger sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [RebarProject] +findProjects :: (Has ReadFS sig m, Has Diagnostics sig m, Has (Reader AllFilters) sig m) => Path Abs Dir -> m [RebarProject] findProjects = walkWithFilters' $ \dir _ files -> do case findFileNamed "rebar.config" files of Nothing -> pure ([], WalkContinue) diff --git a/src/Strategy/Scala.hs b/src/Strategy/Scala.hs index 2385569573..6b85919f4c 100644 --- a/src/Strategy/Scala.hs +++ b/src/Strategy/Scala.hs @@ -74,7 +74,6 @@ discover :: ( Has Exec sig m , Has ReadFS sig m , Has Diagnostics sig m - , Has Logger sig m , Has (Reader AllFilters) sig m ) => Path Abs Dir -> @@ -148,7 +147,6 @@ findProjects :: ( Has Exec sig m , Has ReadFS sig m , Has Diagnostics sig m - , Has Logger sig m , Has (Reader AllFilters) sig m ) => Path Abs Dir -> diff --git a/src/Strategy/Sqlite.hs b/src/Strategy/Sqlite.hs index 5885cf37ef..4be574c0d7 100644 --- a/src/Strategy/Sqlite.hs +++ b/src/Strategy/Sqlite.hs @@ -29,7 +29,6 @@ import Database.SQLite3 qualified as SQLite import Discovery.Filters (AllFilters) import Discovery.Simple (simpleDiscover) import Discovery.Walk (WalkStep (WalkContinue), findFirstMatchingFile, walkWithFilters') -import Effect.Logger (Logger) import Effect.ReadFS (ReadFS, readContentsBS) import GHC.Generics (Generic) import Graphing (directs) @@ -49,7 +48,6 @@ instance ToJSON SqliteDB discover :: ( Has ReadFS sig m , Has Diagnostics sig m - , Has Logger sig m , Has (Reader AllFilters) sig m ) => OsInfo -> @@ -61,7 +59,6 @@ findProjects :: ( Has ReadFS sig m , Has (Reader AllFilters) sig m , Has Diagnostics sig m - , Has Logger sig m ) => OsInfo -> Path Abs Dir -> diff --git a/src/Strategy/SwiftPM.hs b/src/Strategy/SwiftPM.hs index 15803aab3a..8ba5e93b87 100644 --- a/src/Strategy/SwiftPM.hs +++ b/src/Strategy/SwiftPM.hs @@ -58,7 +58,6 @@ findProjects :: ( Has ReadFS sig m , Has Diagnostics sig m , Has Logger sig m - , Has Logger sig m , Has (Reader AllFilters) sig m ) => Path Abs Dir -> @@ -71,7 +70,6 @@ findProjects dir = do findSwiftPackageProjects :: ( Has ReadFS sig m , Has Diagnostics sig m - , Has Logger sig m , Has (Reader AllFilters) sig m ) => Path Abs Dir -> @@ -90,7 +88,6 @@ findXcodeProjects :: ( Has ReadFS sig m , Has Diagnostics sig m , Has Logger sig m - , Has Logger sig m , Has (Reader AllFilters) sig m ) => Path Abs Dir -> @@ -113,7 +110,6 @@ findXcodeProjects = walkWithFilters' $ \dir _ files -> do findFirstResolvedFileRecursively :: ( Has ReadFS sig m , Has Diagnostics sig m - , Has Logger sig m , Has (Reader AllFilters) sig m ) => Path Abs Dir -> diff --git a/test/Discovery/WalkSpec.hs b/test/Discovery/WalkSpec.hs index 4ed4c8dca1..82b081fe8e 100644 --- a/test/Discovery/WalkSpec.hs +++ b/test/Discovery/WalkSpec.hs @@ -19,7 +19,6 @@ import Data.Map qualified as Map import Data.Yaml (decodeThrow) import Discovery.Filters (AllFilters (AllFilters), comboInclude) import Discovery.Walk -import Effect.Logger (ignoreLogger) import Effect.ReadFS import Path import Path.IO (createDir, createDirLink, emptyPermissions, getPermissions, setPermissions) @@ -287,7 +286,6 @@ runWalkWithFiltersAndStep userStep maxIters filters startDir = . runWriter . fmap snd . runState (0 :: Int) - . ignoreLogger . runReader filters $ walkWithFilters' ( \dir _ _ -> do From 0dd78cd618cd7cc4493bff04125e38c96ee43201 Mon Sep 17 00:00:00 2001 From: Zachary LaVallee Date: Wed, 6 May 2026 15:08:48 -0700 Subject: [PATCH 11/19] Fix hlint hits in FiltersSpec backslash-normalization test CI's hlint job flagged two restricted patterns I introduced: - Text.pack should be toText (project-wide convention). - bare error is a restricted function in this codebase. Replace Text.pack with toText, and change the failure branch from error to Nothing so parse returns Maybe PathFilter. The shouldBe assertion still works: it now compares two Maybe PathFilter values, both of which are Just _ for valid input. Co-Authored-By: Claude Opus 4.7 (1M context) --- test/Discovery/FiltersSpec.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/test/Discovery/FiltersSpec.hs b/test/Discovery/FiltersSpec.hs index a69de1404d..6b521e27ee 100644 --- a/test/Discovery/FiltersSpec.hs +++ b/test/Discovery/FiltersSpec.hs @@ -376,9 +376,10 @@ spec = do -- A Windows user typing `node_modules\*` in `.fossa.yml` should get -- the same glob as the forward-slash form, because System.FilePattern -- only treats `/` as a segment separator. - let parse s = case Aeson.fromJSON (Aeson.String (Text.pack s)) :: Aeson.Result PathFilter of - Aeson.Success p -> p - Aeson.Error e -> error e + let parse :: String -> Maybe PathFilter + parse s = case Aeson.fromJSON (Aeson.String (toText s)) :: Aeson.Result PathFilter of + Aeson.Success p -> Just p + Aeson.Error _ -> Nothing parse "node_modules\\*" `shouldBe` parse "node_modules/*" parse "**\\vendor\\**" `shouldBe` parse "**/vendor/**" From e0e19ade2b145a3d76beda0f72aabfe1d8c97545 Mon Sep 17 00:00:00 2001 From: Zachary LaVallee Date: Wed, 6 May 2026 15:18:48 -0700 Subject: [PATCH 12/19] Fix duplicate viaShow import in Analyze.hs CI's -Werror=unused-imports flagged the existing `Prettyprinter.viaShow` as unused because the same name was also imported (and used) from Effect.Logger when I added it for logPrunedSubtrees. Drop my Effect.Logger.viaShow addition; the Prettyprinter one was already in scope and is what's actually used. Co-Authored-By: Claude Opus 4.7 (1M context) --- src/App/Fossa/Analyze.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/App/Fossa/Analyze.hs b/src/App/Fossa/Analyze.hs index 3eae218c83..1757eb66e3 100644 --- a/src/App/Fossa/Analyze.hs +++ b/src/App/Fossa/Analyze.hs @@ -146,7 +146,6 @@ import Effect.Logger ( logInfo, logStdout, renderIt, - viaShow, ) import Effect.ReadFS (ReadFS) import Errata (Errata (..)) From 539d3c76796c3b8dce8eb8b9b36ebc4cc5bd2add Mon Sep 17 00:00:00 2001 From: Zachary LaVallee Date: Wed, 6 May 2026 15:39:47 -0700 Subject: [PATCH 13/19] Condense changelog entry for 3.17.6 to one line Drop the long-form description of glob semantics and the analyze visibility entry; "now accept glob patterns" plus the PR link gives readers everything they need, and full docs live in docs/references/files/fossa-yml.md. Co-Authored-By: Claude Opus 4.7 (1M context) --- Changelog.md | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/Changelog.md b/Changelog.md index 9124a17174..f9f4590893 100644 --- a/Changelog.md +++ b/Changelog.md @@ -2,8 +2,7 @@ ## 3.17.6 -- Config: `paths.only` and `paths.exclude` in `.fossa.yml` now accept glob patterns (e.g. `**/vendor/**`, `node_modules/*`). An entry is treated as a glob if it contains `*`; other entries keep their existing directory-tree semantics. Glob matching follows [`System.FilePattern`](https://hackage.haskell.org/package/filepattern) semantics: `*` matches any sequence of characters within a single path segment, and `**` matches any number of segments. Patterns use forward slashes; backslashes are normalized so Windows-native patterns also work. ([#1703](https://github.com/fossas/fossa-cli/pull/1703)) -- Analyze: At startup, `fossa analyze` now prints (a) the active `paths.only`/`paths.exclude` filters from `.fossa.yml` and (b) the directories the walker will prune as a result. Each pruned subtree is reported once at info level so users can correlate a missing project with a configured filter. The pre-discovery walk is skipped when no path filters are configured. ([#1703](https://github.com/fossas/fossa-cli/pull/1703)) +- Config: `paths.only` and `paths.exclude` in `.fossa.yml` now accept glob patterns. ([#1703](https://github.com/fossas/fossa-cli/pull/1703)) ## 3.17.5 From 05f78d80e1a440a69781a54e48601dda9060c03c Mon Sep 17 00:00:00 2001 From: Zachary LaVallee Date: Wed, 6 May 2026 16:14:47 -0700 Subject: [PATCH 14/19] Address CodeRabbit review: include-glob reachability + JSON shape + filter scope MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Three issues from CodeRabbit: 1. Startup logs used `filters`, but discovery uses `discoveryFilters` (which is `mempty` under `--no-discovery-exclusion`). Compute `discoveryFilters` once near the top of `analyze` and use it for `logActivePathFilters` / `logPrunedSubtrees` so the log line agrees with what discovery actually applies. 2. `FilterCombination`'s ToJSON used `genericToEncoding defaultOptions`, which emits the new `_combinedPathGlobs` field as `[]` even when no globs are configured — so every serialized payload changes shape vs pre-glob-support runs. Replace with a hand-written `toEncoding` that omits the field when the list is empty. 3. Include globs only matched the directory itself; ancestors-on-the-way to a match and descendants-after-a-match weren't allowed. So `paths.only: ["apps/*"]` rejected `apps/`, the walker never descended, and every project under `apps/` was silently dropped. Add `isParentOfIncludedGlob` (path's segments are a prefix of the glob's literal directory prefix — segments before the first `*`) and `isChildOfIncludedGlob` (any proper ancestor of `path` matches a glob) to `pathAllowed`. Cover both with new tests in `FiltersSpec.hs`. Co-Authored-By: Claude Opus 4.7 (1M context) --- src/App/Fossa/Analyze.hs | 9 ++-- src/Discovery/Filters.hs | 83 +++++++++++++++++++++++++++++++++-- test/Discovery/FiltersSpec.hs | 21 +++++++++ 3 files changed, 106 insertions(+), 7 deletions(-) diff --git a/src/App/Fossa/Analyze.hs b/src/App/Fossa/Analyze.hs index 1757eb66e3..a8638ddfc2 100644 --- a/src/App/Fossa/Analyze.hs +++ b/src/App/Fossa/Analyze.hs @@ -378,9 +378,13 @@ analyze cfg = Diag.context "fossa-analyze" $ do withoutDefaultFilters = Config.withoutDefaultFilters cfg enableSnippetScan = Config.snippetScan cfg enableVendetta = Config.xVendetta cfg + -- Discovery runs with `mempty` when `--no-discovery-exclusion` is set + -- (see definition further down). Log against the same filter set so the + -- startup output matches what discovery actually applies. + discoveryFilters = if fromFlag NoDiscoveryExclusion noDiscoveryExclusion then mempty else filters - logActivePathFilters filters - logPrunedSubtrees filters basedir + logActivePathFilters discoveryFilters + logPrunedSubtrees discoveryFilters basedir manualDepsResult <- Diag.errorBoundaryIO . diagToDebug $ @@ -484,7 +488,6 @@ analyze cfg = Diag.context "fossa-analyze" $ do pure Nothing else Diag.context "first-party-scans" . runStickyLogger SevInfo $ runFirstPartyScan basedir maybeApiOpts cfg let firstPartyScanResults = join . resultToMaybe $ maybeFirstPartyScanResults - let discoveryFilters = if fromFlag NoDiscoveryExclusion noDiscoveryExclusion then mempty else filters let strategyCfg = (Config.strategyConfig cfg) { Config.useGitBackedCargoLocators = Config.UseGitBackedCargoLocators $ maybe True orgSupportsGitBackedCargoLocators orgInfo diff --git a/src/Discovery/Filters.hs b/src/Discovery/Filters.hs index d6223df56f..b616806ed7 100644 --- a/src/Discovery/Filters.hs +++ b/src/Discovery/Filters.hs @@ -36,7 +36,7 @@ module Discovery.Filters ( import Control.Effect.Reader (Has, Reader, ask) import Control.Monad ((<=<)) -import Data.Aeson (FromJSON, ToJSON (toEncoding), defaultOptions, genericToEncoding, parseJSON, withText) +import Data.Aeson (FromJSON, ToJSON (toEncoding), defaultOptions, genericToEncoding, pairs, parseJSON, withText, (.=)) import Data.Glob (Glob, unGlob) import Data.Glob qualified as Glob import Data.List (isInfixOf, stripPrefix, (\\)) @@ -52,7 +52,7 @@ import Data.String.Conversion (toString, toText) import Data.Text (Text) import Data.Void (Void) import GHC.Generics (Generic) -import Path (Abs, Dir, Path, Rel, fromAbsDir, isProperPrefixOf, parseRelDir) +import Path (Abs, Dir, Path, Rel, fromAbsDir, isProperPrefixOf, parseRelDir, toFilePath) import System.FilePattern qualified as FilePattern import Text.Megaparsec ( MonadParsec (eof, takeWhile1P, try), @@ -98,8 +98,17 @@ data FilterCombination a = FilterCombination } deriving (Eq, Ord, Show, Generic) +-- | Hand-written so the new @_combinedPathGlobs@ field is omitted when it's +-- empty. Otherwise every serialized 'FilterCombination' would gain a +-- @"_combinedPathGlobs":[]@ key compared to pre-glob-support encodings — even +-- in runs that don't configure any globs — which would break consumers that +-- pin on the JSON shape (telemetry, debug bundles). instance ToJSON (FilterCombination a) where - toEncoding = genericToEncoding defaultOptions + toEncoding fc = + pairs $ + "_combinedTargets" .= _combinedTargets fc + <> "_combinedPaths" .= _combinedPaths fc + <> if null (_combinedPathGlobs fc) then mempty else "_combinedPathGlobs" .= _combinedPathGlobs fc -- | A user-supplied path filter entry from `.fossa.yml`. Strings containing -- `*` are parsed as 'Glob' patterns; all other strings are parsed as relative @@ -235,7 +244,14 @@ pathAllowed AllFilters{..} path = isIncluded && not isExcluded isExcluded = isExcludedMember || isChildOfExcludeMember || isExcludedByGlob -- We include parents because our directory scanner will never make it to the included path without the parents -- We include children because our analysis filtering allows children of included members - isIncluded = includeIsEmpty || isParentOfIncludeMember || isIncludeMember || isChildOfIncludeMember || isIncludedByGlob + isIncluded = + includeIsEmpty + || isParentOfIncludeMember + || isIncludeMember + || isChildOfIncludeMember + || isIncludedByGlob + || isParentOfIncludedGlob + || isChildOfIncludedGlob isIncludeMember = path `elem` includedPaths isExcludedMember = path `elem` excludedPaths isChildOfIncludeMember = any (`isProperPrefixOf` path) includedPaths @@ -243,6 +259,18 @@ pathAllowed AllFilters{..} path = isIncluded && not isExcluded isParentOfIncludeMember = any (path `isProperPrefixOf`) includedPaths isExcludedByGlob = any (`globMatchesDir` path) excludedGlobs isIncludedByGlob = any (`globMatchesDir` path) includedGlobs + -- A glob like @apps/*@ literally matches @apps/X@; if the walker is at + -- @apps/@, @isIncludedByGlob@ is False (the glob requires one segment past + -- @apps@), and without this branch the walker would refuse to descend and + -- silently drop every project under @apps/@. Allow @path@ when its + -- segments are a prefix of the glob's literal directory prefix + -- (everything before the first wildcard); a glob whose first segment is + -- @**@ has an empty literal prefix, so any path is a candidate ancestor. + isParentOfIncludedGlob = any (pathSegmentsPrefixOf (pathSegments path)) includedGlobs + -- Once an ancestor of @path@ matched an include glob, the walker should + -- descend into all of @path@'s descendants — same semantics as + -- @isChildOfIncludeMember@ for concrete includes. + isChildOfIncludedGlob = any (\g -> any (g `globMatchesDir`) (properAncestors path)) includedGlobs includedPaths = combinedPaths includeFilters excludedPaths = combinedPaths excludeFilters includedGlobs = combinedPathGlobs includeFilters @@ -378,6 +406,53 @@ globMatchesDir glob dir = unGlob glob FilePattern.?== normalize (toString dir) '/' : rest -> reverse rest _ -> s +-- | Path components, in walk order. @"a/b/c/" -> ["a","b","c"]@. The trailing +-- empty segment that 'splitOn' would produce on a directory's @toFilePath@ +-- result is dropped. +pathSegments :: Path Rel Dir -> [String] +pathSegments p = + filter (not . null) $ goSplit (normalizeSlashes (toFilePath p)) + where + goSplit :: String -> [String] + goSplit s = case break (== '/') s of + (h, []) -> [h] + (h, _ : t) -> h : goSplit t + +-- | True if @segs@ is a (possibly empty) prefix of @glob@'s literal directory +-- prefix — i.e. the segments before the first segment containing a wildcard. +-- A glob whose very first segment is wildcarded (e.g. @**\/foo@) has an empty +-- literal prefix and matches any input @segs@, because the @**@ can stand for +-- arbitrary ancestor directories. +pathSegmentsPrefixOf :: [String] -> Glob Rel -> Bool +pathSegmentsPrefixOf segs g = + let prefix = takeWhile (notElem '*') (filter (not . null) (splitSlash (normalizeSlashes (unGlob g)))) + in segs `isPrefixOfList` prefix + where + splitSlash :: String -> [String] + splitSlash s = case break (== '/') s of + (h, []) -> [h] + (h, _ : t) -> h : splitSlash t + + isPrefixOfList :: Eq a => [a] -> [a] -> Bool + isPrefixOfList [] _ = True + isPrefixOfList _ [] = False + isPrefixOfList (x : xs) (y : ys) = x == y && isPrefixOfList xs ys + +-- | Strict ancestors of a relative directory, ordered shallow-first. Excludes +-- both the repository root (which would be an empty 'Path Rel Dir' that +-- 'parseRelDir' won't accept anyway) and the directory itself. +properAncestors :: Path Rel Dir -> [Path Rel Dir] +properAncestors p = + let segs = pathSegments p + -- Strict, non-empty prefixes: e.g. ["a","b","c"] -> [["a"], ["a","b"]]. + properPrefixes = [take n segs | n <- [1 .. length segs - 1]] + in mapMaybe (parseRelDir . joinSegments) properPrefixes + where + joinSegments :: [String] -> String + joinSegments [] = "" + joinSegments [x] = x <> "/" + joinSegments (x : rest) = x <> "/" <> joinSegments rest + -- MatchNone <> MatchAll = MatchAll is the reason for this order -- (MatchSome <> MatchAll) and (MatchAll <> MatchSome) outputs the results in MatchSome. -- The implications of this are that if a TypeTargetFilter matches all targets and diff --git a/test/Discovery/FiltersSpec.hs b/test/Discovery/FiltersSpec.hs index 6b521e27ee..0252959546 100644 --- a/test/Discovery/FiltersSpec.hs +++ b/test/Discovery/FiltersSpec.hs @@ -301,6 +301,27 @@ spec = do pathAllowed filters $(mkRelDir "src/lib") `shouldBe` True pathAllowed filters $(mkRelDir "test/lib") `shouldBe` False + it "lets the walker reach an include-glob's matches via ancestors" $ do + -- `apps/*` matches @apps/X@, not the bare @apps/@. Without ancestor + -- handling the walker would refuse to descend into @apps/@ and every + -- project under it would be silently dropped. Cover the parent dir + -- (must be allowed so the walker descends), the matched dirs (must + -- be allowed because the glob matches), and an unrelated sibling + -- (must still be rejected). + let filters = includeGlob "apps/*" + pathAllowed filters $(mkRelDir "apps") `shouldBe` True + pathAllowed filters $(mkRelDir "apps/foo") `shouldBe` True + pathAllowed filters $(mkRelDir "apps/foo/src") `shouldBe` True + pathAllowed filters $(mkRelDir "lib") `shouldBe` False + + it "treats a leading '**' include glob as accepting any ancestor" $ do + -- `**/service/**` can match arbitrarily deep, so the walker has to be + -- allowed everywhere on the way down or it'll never reach a match. + let filters = includeGlob "**/service/**" + pathAllowed filters $(mkRelDir "anywhere") `shouldBe` True + pathAllowed filters $(mkRelDir "anywhere/else") `shouldBe` True + pathAllowed filters $(mkRelDir "deep/nested/service/foo") `shouldBe` True + it "prefers exclude over include when both globs match" $ do let filters = includeGlob "src/**" <> excludeGlob "src/**" pathAllowed filters $(mkRelDir "src/lib") `shouldBe` False From 6321b48b7e3aaa2ad4248aaeba0a6536c6b3ae30 Mon Sep 17 00:00:00 2001 From: Zachary LaVallee Date: Wed, 6 May 2026 16:29:51 -0700 Subject: [PATCH 15/19] Allow any path as ancestor when include-glob's literal prefix is empty MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The new "treats a leading '**' include glob as accepting any ancestor" test was failing on CI. With include `**/service/**`, the walker has no idea which subtree contains a `service/` directory and must descend everywhere on the way down. My initial pathSegmentsPrefixOf check returned False whenever the path was non-empty and the glob's literal directory prefix was empty, so the walker refused to descend at all. Fix: when the literal prefix is empty (because the glob's first segment is wildcarded — `**`, `*`, `*foo`, etc.), accept any path as a candidate ancestor. The actual match still has to fire via isIncludedByGlob when the walker reaches a real match. Costs extra walking when the user writes a leading-wildcard include, but that's the only correct behavior — there's no way to know up front where a match lives. Co-Authored-By: Claude Opus 4.7 (1M context) --- src/Discovery/Filters.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/src/Discovery/Filters.hs b/src/Discovery/Filters.hs index b616806ed7..7f0fc66976 100644 --- a/src/Discovery/Filters.hs +++ b/src/Discovery/Filters.hs @@ -426,7 +426,13 @@ pathSegments p = pathSegmentsPrefixOf :: [String] -> Glob Rel -> Bool pathSegmentsPrefixOf segs g = let prefix = takeWhile (notElem '*') (filter (not . null) (splitSlash (normalizeSlashes (unGlob g)))) - in segs `isPrefixOfList` prefix + in -- An empty literal prefix means the glob's first segment is wildcarded + -- (e.g. @**/service/**@, @*/foo@). The wildcard can stand for any + -- ancestor segments, so any path is a candidate parent — let the walker + -- descend, the actual match check ('isIncludedByGlob') will fire when + -- it reaches a real match. Otherwise require @segs@ to be a prefix of + -- the literal directory part. + null prefix || segs `isPrefixOfList` prefix where splitSlash :: String -> [String] splitSlash s = case break (== '/') s of From 7b94af459b690406047e4db68e6be77192f49853 Mon Sep 17 00:00:00 2001 From: Zachary LaVallee Date: Wed, 6 May 2026 22:49:08 -0700 Subject: [PATCH 16/19] Address CodeRabbit nitpicks: stdlib isPrefixOf + drop list comprehension Two style fixes from CodeRabbit's second review: 1. `pathSegmentsPrefixOf`'s local `isPrefixOfList` was a hand-rolled reimplementation of `Data.List.isPrefixOf`. Drop the where-clause and import the standard one (Data.List was already imported). 2. `properAncestors` used a list comprehension to build prefix lists, which the project's coding guidelines disallow ("avoid partial functions, list comprehensions, and match guards"). Replace with `map (`take` segs) [1 .. length segs - 1]`. Both behavior-equivalent. Co-Authored-By: Claude Opus 4.7 (1M context) --- src/Discovery/Filters.hs | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) diff --git a/src/Discovery/Filters.hs b/src/Discovery/Filters.hs index 7f0fc66976..7c5b742d1a 100644 --- a/src/Discovery/Filters.hs +++ b/src/Discovery/Filters.hs @@ -39,7 +39,7 @@ import Control.Monad ((<=<)) import Data.Aeson (FromJSON, ToJSON (toEncoding), defaultOptions, genericToEncoding, pairs, parseJSON, withText, (.=)) import Data.Glob (Glob, unGlob) import Data.Glob qualified as Glob -import Data.List (isInfixOf, stripPrefix, (\\)) +import Data.List (isInfixOf, isPrefixOf, stripPrefix, (\\)) import Data.List.NonEmpty qualified as NE import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map @@ -432,18 +432,13 @@ pathSegmentsPrefixOf segs g = -- descend, the actual match check ('isIncludedByGlob') will fire when -- it reaches a real match. Otherwise require @segs@ to be a prefix of -- the literal directory part. - null prefix || segs `isPrefixOfList` prefix + null prefix || segs `isPrefixOf` prefix where splitSlash :: String -> [String] splitSlash s = case break (== '/') s of (h, []) -> [h] (h, _ : t) -> h : splitSlash t - isPrefixOfList :: Eq a => [a] -> [a] -> Bool - isPrefixOfList [] _ = True - isPrefixOfList _ [] = False - isPrefixOfList (x : xs) (y : ys) = x == y && isPrefixOfList xs ys - -- | Strict ancestors of a relative directory, ordered shallow-first. Excludes -- both the repository root (which would be an empty 'Path Rel Dir' that -- 'parseRelDir' won't accept anyway) and the directory itself. @@ -451,7 +446,7 @@ properAncestors :: Path Rel Dir -> [Path Rel Dir] properAncestors p = let segs = pathSegments p -- Strict, non-empty prefixes: e.g. ["a","b","c"] -> [["a"], ["a","b"]]. - properPrefixes = [take n segs | n <- [1 .. length segs - 1]] + properPrefixes = map (`take` segs) [1 .. length segs - 1] in mapMaybe (parseRelDir . joinSegments) properPrefixes where joinSegments :: [String] -> String From 6a964be0fdd9d51e8aa4976fdf706f8b5dff0172 Mon Sep 17 00:00:00 2001 From: Zachary LaVallee Date: Fri, 8 May 2026 13:02:49 -0700 Subject: [PATCH 17/19] Drop logActivePathFilters per review feedback MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Reviewer flagged the startup "Active filters: ..." log lines as redundant with the user's own .fossa.yml — and at info level, more noise than signal. The actually-useful info is "what got pruned in this run," which logPrunedSubtrees already provides. Remove logActivePathFilters and its call site, plus the imports it was the only consumer of (Data.Glob.unGlob, Data.Text, Text.intercalate). Co-Authored-By: Claude Opus 4.7 (1M context) --- src/App/Fossa/Analyze.hs | 21 --------------------- 1 file changed, 21 deletions(-) diff --git a/src/App/Fossa/Analyze.hs b/src/App/Fossa/Analyze.hs index a8638ddfc2..3c51973649 100644 --- a/src/App/Fossa/Analyze.hs +++ b/src/App/Fossa/Analyze.hs @@ -123,13 +123,10 @@ import Data.Error (createBody) import Data.Flag (Flag, fromFlag) import Data.Foldable (for_, traverse_) import Data.Functor (($>)) -import Data.Glob (unGlob) import Data.List.NonEmpty qualified as NE import Data.Map qualified as Map import Data.Maybe (catMaybes, fromMaybe, isJust, mapMaybe, maybeToList) import Data.String.Conversion (decodeUtf8, toText) -import Data.Text (Text) -import Data.Text qualified as Text import Data.Text.Extra (showT) import Data.Traversable (for) import Diag.Diagnostic as DI @@ -301,23 +298,6 @@ runAnalyzers allowedTactics filters withoutDefaultFilters basedir pathPrefix = d where single (DiscoverFunc f) = withDiscoveredProjects f basedir (runDependencyAnalysis basedir filters withoutDefaultFilters pathPrefix allowedTactics) --- | Echo path-related include/exclude filters once at startup. Walker prunes --- are silent by design (they short-circuit before any strategy sees the --- directory), so this gives the user just enough visibility to tell which --- patterns are active and infer why a project they expected didn't appear. -logActivePathFilters :: Has Logger sig m => AllFilters -> m () -logActivePathFilters AllFilters{includeFilters = include, excludeFilters = exclude} = do - emit "include path" (map (toText . toFilePath) (combinedPaths include)) - emit "include glob" (map (toText . unGlob) (combinedPathGlobs include)) - emit "exclude path" (map (toText . toFilePath) (combinedPaths exclude)) - emit "exclude glob" (map (toText . unGlob) (combinedPathGlobs exclude)) - where - emit :: Has Logger sig m => Text -> [Text] -> m () - emit _ [] = pure () - emit label items = - logInfo $ - "Active " <> pretty label <> " filters: " <> pretty (Text.intercalate ", " items) - -- | Walk the tree once at startup and surface every directory the path -- filters will prune. Each prune is logged once at info level here, instead -- of emitting per-strategy duplicates from inside the walker (~28 strategies @@ -383,7 +363,6 @@ analyze cfg = Diag.context "fossa-analyze" $ do -- startup output matches what discovery actually applies. discoveryFilters = if fromFlag NoDiscoveryExclusion noDiscoveryExclusion then mempty else filters - logActivePathFilters discoveryFilters logPrunedSubtrees discoveryFilters basedir manualDepsResult <- From 7110d89760428309b38f7565bd4c6c3e745c08cc Mon Sep 17 00:00:00 2001 From: Zachary LaVallee Date: Fri, 8 May 2026 14:04:36 -0700 Subject: [PATCH 18/19] Use unsnoc instead of double-reverse in trimTrailingSlash Per review feedback. The original `case reverse s of '/' : rest -> reverse rest` walks the list twice and allocates an intermediate reversed copy. Replacing with an unsnoc-based version traverses once. Project supports `base >= 4.15` and `Data.List.unsnoc` is base-4.19+ (GHC 9.8), so I can't import it directly. Inline a tiny helper that matches the stdlib implementation. Co-Authored-By: Claude Opus 4.7 (1M context) --- src/Discovery/Filters.hs | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/src/Discovery/Filters.hs b/src/Discovery/Filters.hs index 7c5b742d1a..b0ef8a9674 100644 --- a/src/Discovery/Filters.hs +++ b/src/Discovery/Filters.hs @@ -402,10 +402,18 @@ globMatchesDir glob dir = unGlob glob FilePattern.?== normalize (toString dir) normalize = trimTrailingSlash . normalizeSlashes trimTrailingSlash :: String -> String - trimTrailingSlash s = case reverse s of - '/' : rest -> reverse rest + trimTrailingSlash s = case unsnoc s of + Just (initSegs, '/') -> initSegs _ -> s + -- Matches @Data.List.unsnoc@ from base-4.19 (GHC 9.8), which we can't + -- import directly because the project supports @base >= 4.15@. + unsnoc :: [a] -> Maybe ([a], a) + unsnoc = foldr go Nothing + where + go x Nothing = Just ([], x) + go x (Just (xs, y)) = Just (x : xs, y) + -- | Path components, in walk order. @"a/b/c/" -> ["a","b","c"]@. The trailing -- empty segment that 'splitOn' would produce on a directory's @toFilePath@ -- result is dropped. From 2e058b30903003dca463d1197c7b70ecac447d8b Mon Sep 17 00:00:00 2001 From: Zachary LaVallee Date: Fri, 8 May 2026 15:03:20 -0700 Subject: [PATCH 19/19] Rename glob ancestor-reachability test + clarify the comment Match the existing concrete-path "should include all parents" naming convention, and rewrite the comment so it's clear pathAllowed is the walker's traversal predicate (not a "this path matches the filter" check). The previous wording made it look like the assertions were about glob matches. Co-Authored-By: Claude Opus 4.7 (1M context) --- test/Discovery/FiltersSpec.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/test/Discovery/FiltersSpec.hs b/test/Discovery/FiltersSpec.hs index 0252959546..a0993755a9 100644 --- a/test/Discovery/FiltersSpec.hs +++ b/test/Discovery/FiltersSpec.hs @@ -314,9 +314,11 @@ spec = do pathAllowed filters $(mkRelDir "apps/foo/src") `shouldBe` True pathAllowed filters $(mkRelDir "lib") `shouldBe` False - it "treats a leading '**' include glob as accepting any ancestor" $ do - -- `**/service/**` can match arbitrarily deep, so the walker has to be - -- allowed everywhere on the way down or it'll never reach a match. + it "should include all parents of glob matches" $ do + -- pathAllowed is what determines if the walker should traverse the + -- directory. For this test, we're asserting that `**/` should traverse + -- every directory, so all lines should be true. The previous block of + -- `apps/*` is asserting on a false example. let filters = includeGlob "**/service/**" pathAllowed filters $(mkRelDir "anywhere") `shouldBe` True pathAllowed filters $(mkRelDir "anywhere/else") `shouldBe` True