Fix #6956 Add ls dependencies text --query ITEM option

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

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
 

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 = " =="

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,24 +171,35 @@ 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 \
              \$locals (for all project packages) or a package name (can be \
              \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

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