Merge branch 'master' into 4027-ram-usage

ChangeLog.md

@@ -16,6 +16,10 @@ Other enhancements:
   `extra-deps` of `stack.yaml`
 * `stack build` suggests trying another GHC version should the build
   plan end up requiring unattainable `base` version.
+* `stack build` missing dependency suggestions (on failure to construct a valid
+  build plan because of missing deps) are now printed with their latest
+  cabal file revision hash. See
+  [#4068](https://github.com/commercialhaskell/stack/pull/4068).
 
 Bug fixes:
 
@@ -40,6 +44,11 @@ Bug fixes:
   [#3996](https://github.com/commercialhaskell/stack/issues/3996).
 * Fix a regression which might use a lot of RAM. See
   [#4027](https://github.com/commercialhaskell/stack/issues/4027).
+* Order of commandline arguments does not matter anymore.
+  See [#3959](https://github.com/commercialhaskell/stack/issues/3959)
+* When prompting users about saving their Hackage credentials on upload,
+  flush to stdout before waiting for the response so the prompt actually
+  displays.
 
 
 ## v1.7.1

src/Stack/Build/ConstructPlan.hs

@@ -22,6 +22,7 @@ import           Stack.Prelude hiding (Display (..))
 import           Control.Monad.RWS.Strict hiding ((<>))
 import           Control.Monad.State.Strict (execState)
 import qualified Data.HashSet as HashSet
+import qualified Data.HashMap.Strict as HashMap
 import           Data.List
 import qualified Data.Map.Strict as M
 import qualified Data.Map.Strict as Map
@@ -135,7 +136,7 @@ data Ctx = Ctx
     , ctxEnvConfig   :: !EnvConfig
     , callStack      :: ![PackageName]
     , extraToBuild   :: !(Set PackageName)
-    , getVersions    :: !(PackageName -> IO (Set Version))
+    , getVersions    :: !(PackageName -> IO (HashMap Version (Maybe CabalHash)))
     , wanted         :: !(Set PackageName)
     , localNames     :: !(Set PackageName)
     }
@@ -623,17 +624,22 @@ addPackageDeps treatAsDep package = do
     deps' <- packageDepsWithTools package
     deps <- forM (Map.toList deps') $ \(depname, (range, depType)) -> do
         eres <- addDep treatAsDep depname
-        let getLatestApplicable = do
-                vs <- liftIO $ getVersions ctx depname
-                return (latestApplicableVersion range vs)
+        let getLatestApplicableVersionAndRev = do
+                vsAndRevs <- liftIO $ getVersions ctx depname
+                let vs = Set.fromList (HashMap.keys vsAndRevs)
+                case latestApplicableVersion range vs of
+                  Nothing -> pure Nothing
+                  Just lappVer -> do
+                    let mlappRev = join (HashMap.lookup lappVer vsAndRevs)
+                    pure $ (lappVer,) <$> mlappRev
         case eres of
             Left e -> do
                 addParent depname range Nothing
                 let bd =
                         case e of
                             UnknownPackage name -> assert (name == depname) NotInBuildPlan
                             _ -> Couldn'tResolveItsDependencies (packageVersion package)
-                mlatestApplicable <- getLatestApplicable
+                mlatestApplicable <- getLatestApplicableVersionAndRev
                 return $ Left (depname, (range, mlatestApplicable, bd))
             Right adr | depType == AsLibrary && not (adrHasLibrary adr) ->
                 return $ Left (depname, (range, Nothing, HasNoLibrary))
@@ -677,7 +683,7 @@ addPackageDeps treatAsDep package = do
                         ADRFound loc (Library ident gid _) -> return $ Right
                             (Set.empty, Map.singleton ident gid, loc)
                     else do
-                        mlatestApplicable <- getLatestApplicable
+                        mlatestApplicable <- getLatestApplicableVersionAndRev
                         return $ Left (depname, (range, mlatestApplicable, DependencyMismatch $ adrVersion adr))
     case partitionEithers deps of
         -- Note that the Monoid for 'InstallLocation' means that if any
@@ -939,8 +945,9 @@ data ConstructPlanException
 
 deriving instance Ord VersionRange
 
--- | For display purposes only, Nothing if package not found
-type LatestApplicableVersion = Maybe Version
+-- | The latest applicable version and it's latest cabal file revision.
+-- For display purposes only, Nothing if package not found
+type LatestApplicableVersion = Maybe (Version, CabalHash)
 
 -- | Reason why a dependency was not used
 data BadDependency
@@ -977,7 +984,7 @@ pprintExceptions exceptions stackYaml parentMap wanted =
       [ "  *" <+> align (flow "Consider trying 'stack solver', which uses the cabal-install solver to attempt to find some working build configuration. This can be convenient when dealing with many complicated constraint errors, but results may be unpredictable.")
       , line <> line
       ] ++ addExtraDepsRecommendations
-      
+
   where
     exceptions' = nubOrd exceptions
 
@@ -1004,13 +1011,16 @@ pprintExceptions exceptions stackYaml parentMap wanted =
        Map.unions $ map go $ Map.toList m
      where
        -- TODO: Likely a good idea to distinguish these to the user.  In particular, for DependencyMismatch
-       go (name, (_range, Just version, NotInBuildPlan)) =
-           Map.singleton name version
-       go (name, (_range, Just version, DependencyMismatch{})) =
-           Map.singleton name version
+       go (name, (_range, Just (version,cabalHash), NotInBuildPlan)) =
+           Map.singleton name (version,cabalHash)
+       go (name, (_range, Just (version,cabalHash), DependencyMismatch{})) =
+           Map.singleton name (version, cabalHash)
        go _ = Map.empty
-    pprintExtra (name, version) =
-      fromString (concat ["- ", packageNameString name, "-", versionString version])
+    pprintExtra (name, (version, cabalHash)) =
+      let cfInfo = CFIHash Nothing cabalHash
+          packageId = PackageIdentifier name version
+          packageIdRev = PackageIdentifierRevision packageId cfInfo
+       in fromString $ packageIdentifierRevisionString packageIdRev
 
     allNotInBuildPlan = Set.fromList $ concatMap toNotInBuildPlan exceptions'
     toNotInBuildPlan (DependencyPlanFailures _ pDeps) =
@@ -1091,11 +1101,11 @@ pprintExceptions exceptions stackYaml parentMap wanted =
                     | isNothing mversion ->
                         flow "(no package with that name found, perhaps there is a typo in a package's build-depends or an omission from the stack.yaml packages list?)"
                     | otherwise -> ""
-                Just la
-                    | mlatestApplicable == mversion -> softline <>
+                Just (laVer, _)
+                    | Just laVer == mversion -> softline <>
                         flow "(latest matching version is specified)"
                     | otherwise -> softline <>
-                        flow "(latest matching version is" <+> styleGood (display la) <> ")"
+                        flow "(latest matching version is" <+> styleGood (display laVer) <> ")"
 
 -- | Get the shortest reason for the package to be in the build plan. In
 -- other words, trace the parent dependencies back to a 'wanted'

src/Stack/Build/Target.hs

@@ -71,6 +71,7 @@ module Stack.Build.Target
     ) where
 
 import           Stack.Prelude
+import qualified Data.HashMap.Strict as HashMap
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 import qualified Data.Text as T
@@ -342,7 +343,7 @@ resolveRawTarget globals snap deps locals (ri, rt) =
               }
       where
         getLatestVersion pn =
-            fmap fst . Set.maxView <$> getPackageVersions pn
+            fmap fst . Set.maxView . Set.fromList . HashMap.keys <$> getPackageVersions pn
 
     go (RTPackageIdentifier ident@(PackageIdentifier name version))
       | Map.member name locals = return $ Left $ T.concat

src/Stack/Options/BenchParser.hs

@@ -19,7 +19,7 @@ benchOptsParser hide0 = BenchmarkOptsMonoid
                                  help ("Forward BENCH_ARGS to the benchmark suite. " <>
                                        "Supports templates from `cabal bench`") <>
                                  hide))
-        <*> optionalFirst (switch (long "no-run-benchmarks" <>
+        <*> optionalFirst (flag' True (long "no-run-benchmarks" <>
                           help "Disable running of benchmarks. (Benchmarks will still be built.)" <>
                              hide))
    where hide = hideMods hide0

src/Stack/Options/TestParser.hs

@@ -27,12 +27,12 @@ testOptsParser hide0 =
                          help "Arguments passed in to the test suite program" <>
                          hide)))
         <*> optionalFirst
-                (switch
+                (flag' True
                     (long "coverage" <>
                      help "Generate a code coverage report" <>
                      hide))
         <*> optionalFirst
-                (switch
+                (flag' True
                     (long "no-run-tests" <>
                      help "Disable running of tests. (Tests will still be built.)" <>
                      hide))

src/Stack/PackageIndex.hs

@@ -39,7 +39,6 @@ import qualified Data.ByteString.Lazy as L
 import           Data.Conduit.Zlib (ungzip)
 import qualified Data.List.NonEmpty as NE
 import qualified Data.HashMap.Strict as HashMap
-import qualified Data.Set as Set
 import           Data.Store.Version
 import           Data.Store.VersionTagged
 import qualified Data.Text as T
@@ -380,12 +379,17 @@ deleteCache indexName' = do
 -- | Get the known versions for a given package from the package caches.
 --
 -- See 'getPackageCaches' for performance notes.
-getPackageVersions :: HasCabalLoader env => PackageName -> RIO env (Set Version)
+getPackageVersions :: HasCabalLoader env => PackageName -> RIO env (HashMap Version (Maybe CabalHash))
 getPackageVersions pkgName = lookupPackageVersions pkgName <$> getPackageCaches
 
-lookupPackageVersions :: PackageName -> PackageCache index -> Set Version
+lookupPackageVersions :: PackageName -> PackageCache index -> HashMap Version (Maybe CabalHash)
 lookupPackageVersions pkgName (PackageCache m) =
-    maybe Set.empty (Set.fromList . HashMap.keys) $ HashMap.lookup pkgName m
+    maybe HashMap.empty (HashMap.map extractOrigRevHash) $ HashMap.lookup pkgName m
+  where
+    -- Extract the original cabal file hash (the first element of the one or two
+    -- element list currently representing the cabal file hashes).
+    extractOrigRevHash (_,_, neRevHashesAndOffsets) =
+      listToMaybe $ fst (NE.last neRevHashesAndOffsets)
 
 -- | Load the package caches, or create the caches if necessary.
 --

src/Stack/Types/PackageIndex.hs

@@ -42,6 +42,17 @@ import           Data.List.NonEmpty (NonEmpty)
 -- file revision indicates the hash of the contents of the cabal file,
 -- and the offset into the index tarball.
 --
+-- The reason for each 'Version' mapping to a two element list of
+-- 'CabalHash'es is because some older Stackage snapshots have CRs in
+-- their cabal files. For compatibility with these older snapshots,
+-- both hashes are stored: the first element of the two element list
+-- being the original hash, and the (potential) second element with
+-- the CRs stripped. [Note: This is was initially stored as a two
+-- element list, and cannot be easily packed into more explict ADT or
+-- newtype because of some template-haskell that would need to be
+-- modified as well: the 'versionedDecodeOrLoad' function call found
+-- in the 'getPackageCaches' function in 'Stack.PackageIndex'.]
+--
 -- It's assumed that cabal files appear in the index tarball in the
 -- correct revision order.
 newtype PackageCache index = PackageCache

src/Stack/Upload.hs

@@ -99,28 +99,24 @@ loadCreds config = do
 
       when (configSaveHackageCreds config) $ do
         let prompt = "Save hackage credentials to file at " ++ fp ++ " [y/n]? "
-        putStr prompt
         input <- loopPrompt prompt
         putStrLn "NOTE: Avoid this prompt in the future by using: save-hackage-creds: false"
-        hFlush stdout
-        case input of
-          "y" -> do
-            L.writeFile fp (encode hc)
-            putStrLn "Saved!"
-            hFlush stdout
-          _ -> return ()
+        when input $ do
+          L.writeFile fp (encode hc)
+          putStrLn "Saved!"
+          hFlush stdout
 
       return hc
 
-    loopPrompt :: String -> IO String
+    loopPrompt :: String -> IO Bool
     loopPrompt p = do
+      putStr p
+      hFlush stdout
       input <- TIO.getLine
       case input of
-        "y" -> return "y"
-        "n" -> return "n"
-        _   -> do
-          putStr p
-          loopPrompt p
+        "y" -> return True
+        "n" -> return False
+        _   -> loopPrompt p
 
 credsFile :: Config -> IO FilePath
 credsFile config = do

test/integration/tests/3959-order-of-flags/Main.hs

@@ -0,0 +1,21 @@
+import StackTest
+
+import Control.Monad (unless)
+import Data.List (isInfixOf)
+
+-- Integration test for https://github.com/commercialhaskell/stack/issues/3959
+main :: IO ()
+main = do
+  checkFlagsBeforeCommand
+  checkFlagsAfterCommand
+
+checkFlagsBeforeCommand :: IO ()
+checkFlagsBeforeCommand = stackCheckStderr ["--test", "--no-run-tests", "build"] checker
+
+checkFlagsAfterCommand :: IO ()
+checkFlagsAfterCommand = stackCheckStderr ["build", "--test", "--no-run-tests"] checker
+
+checker :: String -> IO ()
+checker output = do
+  let testsAreDisabled = any (\ln -> "Test running disabled by" `isInfixOf` ln) (lines output)
+  unless testsAreDisabled $ fail "Tests should not be run"

test/integration/tests/3959-order-of-flags/files/package.yaml

@@ -0,0 +1,10 @@
+name: issue3959
+version: 0.1.0.0
+
+dependencies:
+- base
+
+tests:
+  test:
+    main:                Spec.hs
+    source-dirs:         test

test/integration/tests/3959-order-of-flags/files/stack.yaml

@@ -0,0 +1 @@
+resolver: lts-11.6

test/integration/tests/3959-order-of-flags/files/test/Spec.hs

@@ -0,0 +1,2 @@
+main :: IO ()
+main = fail "this always fails for the test"