Merge pull request #6562 from commercialhaskell/re6561

Re #6561 Extend `stack list` to packages indirectly in snapshot

ChangeLog.md

@@ -31,6 +31,9 @@ Behaviour changes:
   is parsed. Previously, if another version of the package was in the snapshot,
   Stack would construct the build plan with that other version or, if it was
   not, Stack would defer an error to the construction of the build plan.
+* The `list` command, with a specified snapshot and package, also reports the
+  version of the package included indirectly in the snapshot (as a boot package
+  of the compiler specified by the snapshot).
 
 Other enhancements:
 

doc/list_command.md

@@ -14,16 +14,17 @@ Hackage, even after updating the package index, suggestions (not  necessarily
 good ones) will be made about the intended package name.
 
 `stack --snapshot <snapshot> list <package_name>` will send to the standard
-output stream the version of the package in the specified snapshot, unless the
-package comes with GHC on Unix-like operating systems. If the package name
-cannot be found in the snapshot, the command will fail, identifying only the
-package(s) that did not appear in the snapshot.
+output stream the version of the package included in the specified snapshot
+(either directly or indirectly, if a boot package of the compiler specified by
+the snapshot). If the package name cannot be found in the snapshot, the command
+will fail, identifying only the package(s) that did not appear in the snapshot.
 
 More than one package name can be specified.
 
 `stack --snapshot <snapshot> list` will send to the standard output stream a
-list of all the packages in the specified snapshot, except those which come with
-GHC on Unix-like operating systems.
+list of all the packages included directly in the specified snapshot (that is,
+excluding those included only indirectly as a boot package of the compiler
+specified by the snapshot).
 
 For example:
 
@@ -46,12 +47,12 @@ Error: [S-4926]
 
 stack --snapshot lts-22.7 list base unix Win32 acme-missiles pantry
 Error: [S-4926]
-       * Package does not appear in snapshot: base.
-       * Package does not appear in snapshot: unix.
-       * Package does not appear in snapshot: Win32.
-       * Package does not appear in snapshot: acme-missiles.
+       * Package does not appear in snapshot (directly or indirectly): acme-missiles.
 
-stack --snapshot lts-22.7 list pantry
+stack --snapshot lts-22.7 list base unix Win32 pantry
+base-4.18.2.0
+unix-2.8.4.0
+Win32-2.13.3.0
 pantry-0.9.3.1
 
 stack --snapshot lts-22.7 list

src/Stack/CLI.hs

@@ -386,7 +386,8 @@ commandLineHandler currentDir progName isInterpreter =
 
   list = addCommand'
     "list"
-    "List package id's in snapshot (experimental)."
+    "List package versions included in the package index, or in a specified \
+    \snapshot (directly or indirectly)."
     listCmd
     (many $ strArgument $ metavar "PACKAGE")
 

src/Stack/List.hs

@@ -13,6 +13,7 @@ import           RIO.Process ( HasProcessContext )
 import           Stack.Config ( getRawSnapshot )
 import           Stack.Prelude
 import           Stack.Runners ( ShouldReexec (..), withConfig )
+import           Stack.SourceMap ( globalsFromHints )
 import           Stack.Types.Runner ( Runner )
 
 -- | Type representing exceptions thrown by functions exported by the
@@ -33,17 +34,21 @@ instance Exception ListPrettyException
 listCmd :: [String] -> RIO Runner ()
 listCmd names = withConfig NoReexec $ do
   mSnapshot <- getRawSnapshot
-  listPackages mSnapshot names
+  let mWc = rsCompiler <$> mSnapshot
+  mGlobals <- mapM globalsFromHints mWc
+  listPackages mSnapshot mGlobals names
 
 -- | Intended to work for the command line command.
 listPackages ::
      forall env. (HasPantryConfig env, HasProcessContext env, HasTerm env)
   => Maybe RawSnapshot
      -- ^ When looking up by name, take from this build plan.
+  -> Maybe (Map PackageName Version)
+     -- ^ Global hints for snapshot wanted compiler.
   -> [String]
      -- ^ Names or identifiers.
   -> RIO env ()
-listPackages mSnapshot input = do
+listPackages mSnapshot mGlobals input = do
   let (errs1, names) = case mSnapshot of
         Just snapshot | null input -> ([], Map.keys (rsPackages snapshot))
         _ -> partitionEithers $ map parse input
@@ -98,11 +103,15 @@ listPackages mSnapshot input = do
     -> RIO env (Either StyleDoc PackageIdentifier)
   toLocSnapshot snapshot name =
     case Map.lookup name (rsPackages snapshot) of
-      Nothing ->
-        pure $ Left $ fillSep
-          [ flow "Package does not appear in snapshot:"
-          , style Current (fromPackageName name) <> "."
-          ]
+      Nothing -> case Map.lookup name =<< mGlobals of
+        Nothing -> 
+          pure $ Left $ fillSep
+            [ flow "Package does not appear in snapshot (directly or \
+                   \indirectly):"
+            , style Current (fromPackageName name) <> "."
+            ]
+        Just version ->
+          pure $ Right $ PackageIdentifier name version
       Just sp -> do
         loc <- cplComplete <$> completePackageLocation (rspLocation sp)
         pure $ Right (packageLocationIdent loc)