From d5e3b05b3ec8b032f9cb439822e9028a4822bdc6 Mon Sep 17 00:00:00 2001 From: Mike Pilgrem Date: Sun, 16 Aug 2026 21:01:11 +0100 Subject: [PATCH] Fix #6956 Add `ls dependencies text --query ITEM` option --- ChangeLog.md | 6 ++++++ doc/commands/ls_command.md | 18 +++++++++++------- src/Stack/Ls.hs | 25 ++++++++++++++----------- src/Stack/Options/LsParser.hs | 29 ++++++++++++++++++++--------- src/Stack/Types/LsOpts.hs | 13 +++++++------ 5 files changed, 58 insertions(+), 33 deletions(-) diff --git a/ChangeLog.md b/ChangeLog.md index 746527c940..9d740209a3 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -32,6 +32,12 @@ Behavior changes: Other enhancements: +* Add option `--query ITEM`, which can be specified multiple times, to Stack's + `ls dependencies text` command (the default `ls dependencies` command), to + cause Stack to filter out from the results all packages other than those + queried. Like the existing `--filter ITEM` option, an item is either a + package name or `$locals` for all project packages. + Bug fixes: * `stack test --no-rerun-tests` correctly skips test suites that have diff --git a/doc/commands/ls_command.md b/doc/commands/ls_command.md index 9485b849d1..b07a42e413 100644 --- a/doc/commands/ls_command.md +++ b/doc/commands/ls_command.md @@ -34,10 +34,11 @@ Available commands: or ~~~text -stack ls dependencies [--[no-]license] [--separator SEP] [--filter ITEM] - [--[no-]external] [--[no-]include-base] [--depth DEPTH] - [--prune PACKAGES] [TARGET] [--flag PACKAGE:[-]FLAG] - [--test] [--bench] [--global-hints] +stack ls dependencies [--[no-]license] [--separator SEP] [--query ITEM] + [--filter ITEM] [--[no-]external] [--[no-]include-base] + [--depth DEPTH] [--prune PACKAGES] [TARGET] + [--flag PACKAGE:[-]FLAG] [--test] [--bench] + [--global-hints] ~~~ `stack ls dependencies` lists package versions used for a project. @@ -52,9 +53,12 @@ By default: and what follows is a space character. Pass the `--separator` option to specify a different separator; * with the `text` command, all relevant package names are included. Pass the - `--filter` option to specify an item to be filtered out from the results, if - present. An item can be `$locals` (for all project packages) or a package - name. It can be specified multiple times; + `--query` option to specify an item to be retained in the results, if + present. Pass the `--filter` option to specify an item to be filtered out + from the results, if present. In both cases, an item is either a package + name or `$locals` for all project packages. In both cases, the option can be + specified multiple times. If the `--query` option is used, all non-retained + items are filtered out from the results; !!! note diff --git a/src/Stack/Ls.hs b/src/Stack/Ls.hs index 1e978441ad..8909161a77 100644 --- a/src/Stack/Ls.hs +++ b/src/Stack/Ls.hs @@ -60,7 +60,7 @@ import Stack.Types.EnvConfig ( EnvConfig (..), installationRootDeps ) import Stack.Types.LsOpts ( LsCmdOpts (..), LsCmds (..), ListDepsFormat (..) , ListDepsFormatOpts (..), ListDepsOpts (..) - , ListDepsTextFilter (..), ListGlobalsOpts (..) + , ListDepsTextItem (..), ListGlobalsOpts (..) , ListStylesOpts (..), ListToolsOpts (..), LsView (..) , SnapshotOpts (..) ) @@ -324,20 +324,23 @@ listDependencies opts = do T.putStrLn "Packages" >> printTree treeOpts dotOpts 0 [] (treeRoots opts pkgs) resultGraph ListDepsJSON -> printJSON pkgs resultGraph - ListDepsText textOpts listDepsTextFilters -> do + ListDepsText textOpts listDepsTextQueries listDepsTextFilters -> do let resultGraph' = Map.filterWithKey p resultGraph + locals = Set.toList pkgs + includes = expandLocals locals listDepsTextQueries p k _ = - Set.notMember k (exclude (Set.toList pkgs) listDepsTextFilters) + Set.notMember k (expandLocals locals listDepsTextFilters) + && (Set.null includes || Set.member k includes) void $ Map.traverseWithKey (go "" textOpts) (snd <$> resultGraph') where - exclude :: [PackageName] -> [ListDepsTextFilter] -> Set PackageName - exclude locals = Set.fromList . exclude' locals - - exclude' :: [PackageName] -> [ListDepsTextFilter] -> [PackageName] - exclude' _ [] = [] - exclude' locals (f:fs) = case f of - FilterPackage pkgName -> pkgName : exclude' locals fs - FilterLocals -> locals <> exclude' locals fs + expandLocals :: [PackageName] -> [ListDepsTextItem] -> Set PackageName + expandLocals locals = Set.fromList . expandLocals' locals + + expandLocals' :: [PackageName] -> [ListDepsTextItem] -> [PackageName] + expandLocals' _ [] = [] + expandLocals' locals (x:xs) = case x of + PackageNameOnly pkgName -> pkgName : expandLocals' locals xs + AllProjectPackages -> locals <> expandLocals' locals xs ListDepsConstraints -> do let constraintOpts = ListDepsFormatOpts { sep = " ==" diff --git a/src/Stack/Options/LsParser.hs b/src/Stack/Options/LsParser.hs index 97dadf0029..2ea3900991 100644 --- a/src/Stack/Options/LsParser.hs +++ b/src/Stack/Options/LsParser.hs @@ -23,7 +23,7 @@ import Stack.Options.DotParser ( dotOptsParser ) import Stack.Prelude hiding ( sep ) import Stack.Types.LsOpts ( ListDepsFormat (..), ListDepsFormatOpts (..) - , ListDepsOpts (..), ListDepsTextFilter (..) + , ListDepsOpts (..), ListDepsTextItem (..) , ListGlobalsOpts (..), ListStylesOpts (..) , ListToolsOpts (..), LsCmdOpts (..), LsCmds (..) , LsView (..), SnapshotOpts (..), ListGlobalsOpts @@ -171,11 +171,22 @@ formatSubCommand cmd desc formatParser = cmd (OA.info (toListDepsOptsParser formatParser) (OA.progDesc desc)) listDepsTextParser :: OA.Parser ListDepsFormat -listDepsTextParser = - ListDepsText <$> listDepsFormatOptsParser <*> textFilterParser +listDepsTextParser = ListDepsText + <$> listDepsFormatOptsParser + <*> textQueryParser + <*> textFilterParser + +textQueryParser :: OA.Parser [ListDepsTextItem] +textQueryParser = many (OA.option parseListDepsTextItem + ( OA.long "query" + <> OA.metavar "ITEM" + <> OA.help "Item to be retained, if present, being either $locals (for all \ + \project packages) or a package name (can be specified multiple \ + \times). All non-retained items are filtered out of the results." + )) -textFilterParser :: OA.Parser [ListDepsTextFilter] -textFilterParser = many (OA.option parseListDepsTextFilter +textFilterParser :: OA.Parser [ListDepsTextItem] +textFilterParser = many (OA.option parseListDepsTextItem ( OA.long "filter" <> OA.metavar "ITEM" <> OA.help "Item to be filtered out of the results, if present, being either \ @@ -183,12 +194,12 @@ textFilterParser = many (OA.option parseListDepsTextFilter \specified multiple times)." )) -parseListDepsTextFilter :: OA.ReadM ListDepsTextFilter -parseListDepsTextFilter = OA.eitherReader $ \s -> +parseListDepsTextItem :: OA.ReadM ListDepsTextItem +parseListDepsTextItem = OA.eitherReader $ \s -> if s == "$locals" - then Right FilterLocals + then Right AllProjectPackages else case parsePackageName s of - Just pkgName -> Right $ FilterPackage pkgName + Just pkgName -> Right $ PackageNameOnly pkgName Nothing -> Left $ s <> " is not a valid package name." listDepsConstraintsParser :: OA.Parser ListDepsFormat diff --git a/src/Stack/Types/LsOpts.hs b/src/Stack/Types/LsOpts.hs index b953840609..c818d5e46f 100644 --- a/src/Stack/Types/LsOpts.hs +++ b/src/Stack/Types/LsOpts.hs @@ -17,7 +17,7 @@ module Stack.Types.LsOpts , ListDepsOpts (..) , ListDepsFormat (..) , ListDepsFormatOpts (..) - , ListDepsTextFilter (..) + , ListDepsTextItem (..) , ListGlobalsOpts (..) , ListStylesOpts (..) , ListToolsOpts (..) @@ -70,7 +70,7 @@ data ListDepsOpts = ListDepsOpts -- | Type representing formats for printing dependencies. data ListDepsFormat - = ListDepsText ListDepsFormatOpts [ListDepsTextFilter] + = ListDepsText ListDepsFormatOpts [ListDepsTextItem] [ListDepsTextItem] | ListDepsTree ListDepsFormatOpts | ListDepsJSON | ListDepsConstraints @@ -84,11 +84,12 @@ data ListDepsFormatOpts = ListDepsFormatOpts -- ^ Print dependency licenses instead of versions. } --- | Type representing items to filter the results of @stack ls dependencies@. -data ListDepsTextFilter - = FilterPackage PackageName +-- | Type representing items to query or filter from the results of +-- @stack ls dependencies text@. +data ListDepsTextItem + = PackageNameOnly PackageName -- ^ Item is a package name. - | FilterLocals + | AllProjectPackages -- ^ Item represents all project packages. -- | Type representing command line options for the @stack ls stack-colors@ and