From 6d614b887fe14c8d14f0380934ce1136657a5a3d Mon Sep 17 00:00:00 2001 From: Jens Petersen Date: Thu, 17 Sep 2020 02:31:10 +0800 Subject: [PATCH] add 'list' command to query package version in snapshot - currently not working for core ghc libs with resolver - without a resolver the latest Hackage version is displayed --- ChangeLog.md | 3 ++ doc/GUIDE.md | 3 ++ package.yaml | 1 + src/Stack/List.hs | 76 +++++++++++++++++++++++++++++++++++++++++++++++ src/main/Main.hs | 17 ++++++++++- stack.cabal | 1 + 6 files changed, 100 insertions(+), 1 deletion(-) create mode 100644 src/Stack/List.hs diff --git a/ChangeLog.md b/ChangeLog.md index 5f1321decc..e658326d16 100644 --- a/ChangeLog.md +++ b/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 diff --git a/doc/GUIDE.md b/doc/GUIDE.md index 0e50a357b5..3e747ab89b 100644 --- a/doc/GUIDE.md +++ b/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. diff --git a/package.yaml b/package.yaml index 80ba42cf3a..853786c75b 100644 --- a/package.yaml +++ b/package.yaml @@ -194,6 +194,7 @@ library: - Stack.Hoogle - Stack.IDE - Stack.Init + - Stack.List - Stack.Ls - Stack.Lock - Stack.New diff --git a/src/Stack/List.hs b/src/Stack/List.hs new file mode 100644 index 0000000000..2ba9ef775c --- /dev/null +++ b/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 diff --git a/src/main/Main.hs b/src/main/Main.hs index 9929f128b5..60f00e8cd0 100644 --- a/src/main/Main.hs +++ b/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) diff --git a/stack.cabal b/stack.cabal index 3176aa1f3c..43d2ebee1b 100644 --- a/stack.cabal +++ b/stack.cabal @@ -149,6 +149,7 @@ library Stack.Hoogle Stack.IDE Stack.Init + Stack.List Stack.Ls Stack.Lock Stack.New