add 'list' command to query package-version in snapshot

ChangeLog.md

@@ -18,6 +18,9 @@ Behavior changes:
 
 Other enhancements:
 
+* `stack list` is a new command to list package versions in a snapshot.
+  See [#5431](https://github.com/commercialhaskell/stack/pull/5431)
+
 Bug fixes:
 
 * `stack new` now suppports branches other than `master` as default for

doc/GUIDE.md

@@ -1666,6 +1666,9 @@ users. Here's a quick rundown:
   (`-l`) and nightly (`-n`) snapshots.
 * `stack ls dependencies` lists all of the packages and versions used for a
   project
+* `stack list [PACKAGE]...` list the version of the specified package(s) in a
+  snapshot, or without an argument list all the snapshot's package versions.
+  If no resolver is specified the latest package version from Hackage is given.
 * `stack sig` subcommand can help you with GPG signing & verification
     * `sign` will sign an sdist tarball and submit the signature to
       sig.commercialhaskell.org for storage in the sig-archive git repo.

package.yaml

@@ -194,6 +194,7 @@ library:
   - Stack.Hoogle
   - Stack.IDE
   - Stack.Init
+  - Stack.List
   - Stack.Ls
   - Stack.Lock
   - Stack.New

src/Stack/List.hs

@@ -0,0 +1,76 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module Stack.List
+  ( listPackages
+  ) where
+
+import Stack.Prelude
+import qualified RIO.Map as Map
+import RIO.List (intercalate)
+import RIO.Process (HasProcessContext)
+
+newtype ListException
+  = CouldNotParsePackageSelectors [String]
+    deriving Typeable
+instance Exception ListException
+instance Show ListException where
+    show (CouldNotParsePackageSelectors strs) = unlines $ map ("- " ++) strs
+
+-- | Intended to work for the command line command.
+listPackages
+  :: forall env. (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
+  => Maybe RawSnapshot -- ^ when looking up by name, take from this build plan
+  -> [String] -- ^ names or identifiers
+  -> RIO env ()
+listPackages mSnapshot input = do
+    let (errs1, names) = case mSnapshot of
+                   Just snapshot | null input ->
+                                     ([], Map.keys (rsPackages snapshot))
+                   _ -> partitionEithers $ map parse input
+    (errs2, locs) <- partitionEithers <$> traverse toLoc names
+    case errs1 ++ errs2 of
+      [] -> pure ()
+      errs -> throwM $ CouldNotParsePackageSelectors errs
+    mapM_ (logInfo . fromString . packageIdentifierString) locs
+  where
+    toLoc | Just snapshot <- mSnapshot = toLocSnapshot snapshot
+          | otherwise = toLocNoSnapshot
+
+    toLocNoSnapshot :: PackageName -> RIO env (Either String PackageIdentifier)
+    toLocNoSnapshot name = do
+      mloc1 <- getLatestHackageLocation YesRequireHackageIndex name UsePreferredVersions
+      mloc <-
+        case mloc1 of
+          Just _ -> pure mloc1
+          Nothing -> do
+            updated <- updateHackageIndex $ Just $ "Could not find package " <> fromString (packageNameString name) <> ", updating"
+            case updated of
+              UpdateOccurred -> getLatestHackageLocation YesRequireHackageIndex name UsePreferredVersions
+              NoUpdateOccurred -> pure Nothing
+      case mloc of
+        Nothing -> do
+          candidates <- getHackageTypoCorrections name
+          pure $ Left $ concat
+            [ "Could not find package "
+            , packageNameString name
+            , " on Hackage"
+            , if null candidates
+                then ""
+                else ". Perhaps you meant: " ++ intercalate ", " (map packageNameString candidates)
+            ]
+        Just loc -> pure $ Right (packageLocationIdent loc)
+
+    toLocSnapshot :: RawSnapshot -> PackageName -> RIO env (Either String PackageIdentifier)
+    toLocSnapshot snapshot name =
+        case Map.lookup name (rsPackages snapshot) of
+          Nothing ->
+            pure $ Left $ "Package does not appear in snapshot: " ++ packageNameString name
+          Just sp -> do
+            loc <- cplComplete <$> completePackageLocation (rspLocation sp)
+            pure $ Right (packageLocationIdent loc)
+
+    parse s =
+        case parsePackageName s of
+            Just x -> Right x
+            Nothing -> Left $ "Could not parse as package name or identifier: " ++ s

src/main/Main.hs

@@ -50,6 +50,7 @@ import qualified Stack.Nix as Nix
 import           Stack.FileWatch
 import           Stack.Ghci
 import           Stack.Hoogle
+import           Stack.List
 import           Stack.Ls
 import qualified Stack.IDE as IDE
 import           Stack.Init
@@ -349,6 +350,10 @@ commandLineHandler currentDir progName isInterpreter = complicatedOptions
                     "Query general build information (experimental)"
                     queryCmd
                     (many $ strArgument $ metavar "SELECTOR...")
+        addCommand' "list"
+                    "List package id's in snapshot (experimental)"
+                    listCmd
+                    (many $ strArgument $ metavar "PACKAGE")
         addSubCommands'
             "ide"
             "IDE-specific commands"
@@ -850,7 +855,17 @@ templatesCmd () = withConfig NoReexec templatesHelp
 queryCmd :: [String] -> RIO Runner ()
 queryCmd selectors = withConfig YesReexec $ withDefaultEnvConfig $ queryBuildInfo $ map T.pack selectors
 
--- | Generate a combined HPC report
+-- | List packages
+listCmd :: [String] -> RIO Runner ()
+listCmd names = withConfig NoReexec $ do
+    mresolver <- view $ globalOptsL.to globalResolver
+    mSnapshot <- forM mresolver $ \resolver -> do
+      concrete <- makeConcreteResolver resolver
+      loc <- completeSnapshotLocation concrete
+      loadSnapshot loc
+    listPackages mSnapshot names
+
+-- | generate a combined HPC report
 hpcReportCmd :: HpcReportOpts -> RIO Runner ()
 hpcReportCmd hropts = do
     let (tixFiles, targetNames) = partition (".tix" `T.isSuffixOf`) (hroptsInputs hropts)

stack.cabal

@@ -149,6 +149,7 @@ library
       Stack.Hoogle
       Stack.IDE
       Stack.Init
+      Stack.List
       Stack.Ls
       Stack.Lock
       Stack.New