Fix #6229 Add stack ls dependencies --filter '$locals'

ChangeLog.md

@@ -54,6 +54,9 @@ Other enhancements:
   be muted if unwanted.
 * The compiler version is included in Stack's build message (e.g.
   `stack> build (lib + exe + test) with ghc-9.4.8`).
+* Add option `--filter <item>` to Stack's `ls dependencies text` command to
+  filter out an item from the results, if present. The item can be `$locals` for
+  all local packages.
 
 Bug fixes:
 * Fix the `Curator` instance of `ToJSON`, as regards `expect-haddock-failure`.

doc/ls_command.md

@@ -33,10 +33,10 @@ Available commands:
 or
 
 ~~~text
-stack ls dependencies [--separator SEP] [--[no-]license] [--[no-]external]
-                      [--[no-]include-base] [--depth DEPTH] [--prune PACKAGES]
-                      [TARGET] [--flag PACKAGE:[-]FLAG] [--test] [--bench]
-                      [--global-hints]
+stack ls dependencies [--separator SEP] [--[no-]license] [--filter ITEM]
+                      [--[no-]external] [--[no-]include-base] [--depth DEPTH]
+                      [--prune PACKAGES] [TARGET] [--flag PACKAGE:[-]FLAG]
+                      [--test] [--bench] [--global-hints]
 ~~~
 
 `stack ls dependencies` lists all of the packages and versions used for a
@@ -46,8 +46,16 @@ specified as an argument. For further information, see the
 
 Subcommands specify the format of the output, as follows:
 
-* `cabal` lists the packages in the format of exact Cabal constraints.
-  For example (extract):
+*   `cabal` lists the packages in the format of exact Cabal constraints.
+
+    ~~~text
+    stack ls dependencies cabal [--[no-]external] [--[no-]include-base]
+                                [--depth DEPTH] [--prune PACKAGES] [TARGET]
+                                [--flag PACKAGE:[-]FLAG] [--test] [--bench]
+                                [--global-hints]
+    ~~~
+
+    For example (extract):
 
     ~~~text
     constraints:
@@ -56,14 +64,22 @@ Subcommands specify the format of the output, as follows:
     , Glob ==0.10.2
     ~~~
 
-* `json` lists dependencies in JSON format (an array of objects). For example
-  (extract):
+*   `json` lists dependencies in JSON format (an array of objects).
+
+    ~~~text
+    stack ls dependencies json [--[no-]external] [--[no-]include-base]
+                               [--depth DEPTH] [--prune PACKAGES] [TARGET]
+                               [--flag PACKAGE:[-]FLAG] [--test] [--bench]
+                               [--global-hints]
+    ~~~
+
+    For example (extract):
 
     ~~~text
     [{"dependencies":["base","bytestring"],"license":"BSD3","location":{"type":"hackage","url":"https://hackage.haskell.org/package/zlib-0.6.3.0"},"name":"zlib","version":"0.6.3.0"},
     ~~~
 
-  Each object has the following keys:
+    Each object has the following keys:
 
     ~~~json
     name: zlib
@@ -77,16 +93,33 @@ Subcommands specify the format of the output, as follows:
     - bytestring
     ~~~
 
-* `text` (the default) lists the packages, each on a separate line. For example
-  (extract):
+*   `text` (the default) lists the packages, each on a separate line.
+
+    ~~~text
+    stack ls dependencies text [--separator SEP] [--[no-]license] [--filter ITEM]
+                               [--[no-]external] [--[no-]include-base]
+                               [--depth DEPTH] [--prune PACKAGES] [TARGET]
+                               [--flag PACKAGE:[-]FLAG] [--test] [--bench]
+                               [--global-hints]
+    ~~~
+
+    For example (extract):
 
     ~~~text
     Cabal 3.6.3.0
     Cabal-syntax 3.6.0.0
     Glob 0.10.2
     ~~~
 
-* `tree` lists dependencies in the format of a tree. For example (extract):
+*   `tree` lists dependencies in the format of a tree.
+
+    ~~~text
+    stack ls dependencies tree [--separator SEP] [--[no-]license] [--[no-]external]
+                               [--[no-]include-base] [--depth DEPTH]
+                               [--prune PACKAGES] [TARGET] [--flag PACKAGE:[-]FLAG] [--test] [--bench] [--global-hints]
+    ~~~
+
+    For example (extract):
 
     ~~~text
     Packages
@@ -100,14 +133,24 @@ Subcommands specify the format of the output, as follows:
       │ │ │ ├─┬ ghc-prim 0.8.0
     ~~~
 
-The `--separator` option specifies the separator between the package name and
-its version. The default is a space character.
+The `--separator` option, with the `text` or `tree` subcommand, specifies the
+separator between the package name and its version. The default is a space
+character.
 
 Set the `--license` flag, after the `text` or `tree` subcommand, to replace each
 package's version with its licence. (Consistent with the Cabal package
 description format specification, only the American English spelling (license)
 is accepted.)
 
+The `--filter` option, with the `text` subcommand, specifies an item to be
+filtered out from the results, if present. An item can be `$locals` (for all
+local packages) or a package name. It can be specified multiple times.
+
+!!! note
+
+    The special value `$locals` will need to be enclosed with single quotes to
+    distinguish it from a shell variable.
+
 Set the `--no-external` flag to exclude external dependencies.
 
 Set the `--no-include-base` flag to exclude dependencies on the `base` package.

src/Stack/Ls.hs

@@ -11,6 +11,7 @@ module Stack.Ls
   , ListDepsOpts (..)
   , ListDepsFormat (..)
   , ListDepsFormatOpts (..)
+  , ListDepsTextFilter (..)
   , ListStylesOpts (..)
   , ListToolsOpts (..)
   , lsCmd
@@ -111,7 +112,7 @@ data ListDepsOpts = ListDepsOpts
   }
 
 data ListDepsFormat
-  = ListDepsText ListDepsFormatOpts
+  = ListDepsText ListDepsFormatOpts [ListDepsTextFilter]
   | ListDepsTree ListDepsFormatOpts
   | ListDepsJSON
   | ListDepsConstraints
@@ -123,6 +124,13 @@ data ListDepsFormatOpts = ListDepsFormatOpts
     -- ^ Print dependency licenses instead of versions.
   }
 
+-- | Type representing items to filter the results of @stack ls dependencies@.
+data ListDepsTextFilter
+  = FilterPackage PackageName
+    -- ^ Item is a package name.
+  | FilterLocals
+    -- ^ Item represents all local packages.
+
 -- | Type representing command line options for the @stack ls stack-colors@ and
 -- @stack ls stack-colours@ commands.
 data ListStylesOpts = ListStylesOpts
@@ -329,8 +337,20 @@ listDependencies opts = do
       T.putStrLn "Packages"
       >> printTree treeOpts dotOpts 0 [] (treeRoots opts pkgs) resultGraph
     ListDepsJSON -> printJSON pkgs resultGraph
-    ListDepsText textOpts ->
-      void $ Map.traverseWithKey (go "" textOpts) (snd <$> resultGraph)
+    ListDepsText textOpts listDepsTextFilters -> do
+      let resultGraph' = Map.filterWithKey p resultGraph
+          p k _ =
+            Set.notMember k (exclude (Set.toList pkgs) listDepsTextFilters)
+      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
     ListDepsConstraints -> do
       let constraintOpts = ListDepsFormatOpts " ==" False
       T.putStrLn "constraints:"

src/Stack/Options/LsParser.hs

@@ -12,10 +12,10 @@ import           Options.Applicative ( idm )
 import           Options.Applicative.Builder.Extra ( boolFlags, textOption )
 import           Stack.Constants ( globalFooter )
 import           Stack.Ls
-                   ( ListDepsOpts (..), ListDepsFormat (..)
-                   , ListDepsFormatOpts (..), ListStylesOpts (..)
-                   , ListToolsOpts (..), LsCmdOpts (..), LsCmds (..)
-                   , LsView (..), SnapshotOpts (..)
+                   ( ListDepsFormat (..), ListDepsFormatOpts (..)
+                   , ListDepsOpts (..), ListDepsTextFilter (..)
+                   , ListStylesOpts (..), ListToolsOpts (..), LsCmdOpts (..)
+                   , LsCmds (..), LsView (..), SnapshotOpts (..)
                    )
 import           Stack.Options.DotParser ( dotOptsParser )
 import           Stack.Prelude
@@ -125,8 +125,36 @@ listDepsOptsParser = OA.subparser
       )
   <|> toListDepsOptsParser listDepsTextParser
 
+formatSubCommand ::
+     String
+  -> String
+  -> OA.Parser ListDepsFormat
+  -> OA.Mod OA.CommandFields ListDepsOpts
+formatSubCommand cmd desc formatParser =
+  OA.command
+    cmd
+    (OA.info (toListDepsOptsParser formatParser) (OA.progDesc desc))
+
 listDepsTextParser :: OA.Parser ListDepsFormat
-listDepsTextParser = ListDepsText <$> listDepsFormatOptsParser
+listDepsTextParser =
+  ListDepsText <$> listDepsFormatOptsParser <*> textFilterParser
+
+textFilterParser :: OA.Parser [ListDepsTextFilter]
+textFilterParser = many (OA.option parseListDepsTextFilter
+  (  OA.long "filter"
+  <> OA.metavar "ITEM"
+  <> OA.help "Item to be filtered out of the results, if present, being either \
+             \$locals (for all local packages) or a package name (can be \
+             \specified multiple times)."
+  ))
+
+parseListDepsTextFilter :: OA.ReadM ListDepsTextFilter
+parseListDepsTextFilter = OA.eitherReader $ \s ->
+  if s == "$locals"
+    then Right FilterLocals
+    else case parsePackageName s of
+      Just pkgName -> Right $ FilterPackage pkgName
+      Nothing -> Left $ s <> " is not a valid package name."
 
 listDepsConstraintsParser :: OA.Parser ListDepsFormat
 listDepsConstraintsParser = pure ListDepsConstraints
@@ -167,16 +195,6 @@ toListDepsOptsParser formatParser = ListDepsOpts
   <$> formatParser
   <*> dotOptsParser True
 
-formatSubCommand ::
-     String
-  -> String
-  -> OA.Parser ListDepsFormat
-  -> OA.Mod OA.CommandFields ListDepsOpts
-formatSubCommand cmd desc formatParser =
-  OA.command
-    cmd
-    (OA.info (toListDepsOptsParser formatParser) (OA.progDesc desc))
-
 listStylesOptsParser :: OA.Parser ListStylesOpts
 listStylesOptsParser = ListStylesOpts
   <$> boolFlags False