From 55e44d0629da90b10c9e1008b49a5ac59e3a2061 Mon Sep 17 00:00:00 2001 From: tdietert Date: Wed, 6 Jun 2018 22:16:41 +0100 Subject: [PATCH 1/3] Add cabal-hash revision info when failing to construct buildplan --- src/Stack/Build/ConstructPlan.hs | 47 ++++++++++++++++++++------------ src/Stack/Build/Target.hs | 3 +- src/Stack/PackageIndex.hs | 17 +++++++++--- src/Stack/Types/PackageIndex.hs | 11 ++++++++ 4 files changed, 55 insertions(+), 23 deletions(-) diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs index a6080651ea..ac46181805 100644 --- a/src/Stack/Build/ConstructPlan.hs +++ b/src/Stack/Build/ConstructPlan.hs @@ -22,7 +22,9 @@ 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.List.NonEmpty as NE import qualified Data.Map.Strict as M import qualified Data.Map.Strict as Map import qualified Data.Set as Set @@ -135,7 +137,7 @@ data Ctx = Ctx , ctxEnvConfig :: !EnvConfig , callStack :: ![PackageName] , extraToBuild :: !(Set PackageName) - , getVersions :: !(PackageName -> IO (Set Version)) + , getVersions :: !(PackageName -> IO (HashMap Version (NE.NonEmpty CabalHash))) , wanted :: !(Set PackageName) , localNames :: !(Set PackageName) } @@ -623,9 +625,14 @@ 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 = NE.head <$> HashMap.lookup lappVer vsAndRevs + pure $ (lappVer,) <$> mlappRev case eres of Left e -> do addParent depname range Nothing @@ -633,7 +640,7 @@ addPackageDeps treatAsDep package = do 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 +684,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 +946,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 +985,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 +1012,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 +1102,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' diff --git a/src/Stack/Build/Target.hs b/src/Stack/Build/Target.hs index b5c314bcb5..64b2a22ded 100644 --- a/src/Stack/Build/Target.hs +++ b/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 diff --git a/src/Stack/PackageIndex.hs b/src/Stack/PackageIndex.hs index 2b147b0b4b..b641eb6266 100644 --- a/src/Stack/PackageIndex.hs +++ b/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,22 @@ 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 (NE.NonEmpty CabalHash)) getPackageVersions pkgName = lookupPackageVersions pkgName <$> getPackageCaches -lookupPackageVersions :: PackageName -> PackageCache index -> Set Version +lookupPackageVersions :: PackageName -> PackageCache index -> HashMap Version (NE.NonEmpty CabalHash) lookupPackageVersions pkgName (PackageCache m) = - maybe Set.empty (Set.fromList . HashMap.keys) $ HashMap.lookup pkgName m + maybe HashMap.empty (HashMap.map extractRevisionHashes) $ HashMap.lookup pkgName m + where + extractRevisionHashes (_,_, neRevHashesAndOffsets) = + NE.map (extractOrigCabalHash . fst) neRevHashesAndOffsets + + -- Warning: This function turns a list of one or two cabal file hashes into a + -- NonEmpty list value. Practically, the list is "guaranteed" to have at + -- least one element (see 'Stack.Types.PackageIndex.PackageCache') + extractOrigCabalHash :: [CabalHash] -> CabalHash + extractOrigCabalHash = NE.head . NE.fromList + -- | Load the package caches, or create the caches if necessary. -- diff --git a/src/Stack/Types/PackageIndex.hs b/src/Stack/Types/PackageIndex.hs index b103684d20..4320ef2297 100644 --- a/src/Stack/Types/PackageIndex.hs +++ b/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 From e308397520041f0909c5fef2c64f1b4f5b285f90 Mon Sep 17 00:00:00 2001 From: tdietert Date: Thu, 7 Jun 2018 05:41:22 +0100 Subject: [PATCH 2/3] Account for cabal revision hashes potentially not existing (in the types) --- src/Stack/Build/ConstructPlan.hs | 5 ++--- src/Stack/PackageIndex.hs | 19 +++++++------------ 2 files changed, 9 insertions(+), 15 deletions(-) diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs index ac46181805..52bdb1649f 100644 --- a/src/Stack/Build/ConstructPlan.hs +++ b/src/Stack/Build/ConstructPlan.hs @@ -24,7 +24,6 @@ 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.List.NonEmpty as NE import qualified Data.Map.Strict as M import qualified Data.Map.Strict as Map import qualified Data.Set as Set @@ -137,7 +136,7 @@ data Ctx = Ctx , ctxEnvConfig :: !EnvConfig , callStack :: ![PackageName] , extraToBuild :: !(Set PackageName) - , getVersions :: !(PackageName -> IO (HashMap Version (NE.NonEmpty CabalHash))) + , getVersions :: !(PackageName -> IO (HashMap Version (Maybe CabalHash))) , wanted :: !(Set PackageName) , localNames :: !(Set PackageName) } @@ -631,7 +630,7 @@ addPackageDeps treatAsDep package = do case latestApplicableVersion range vs of Nothing -> pure Nothing Just lappVer -> do - let mlappRev = NE.head <$> HashMap.lookup lappVer vsAndRevs + let mlappRev = join (HashMap.lookup lappVer vsAndRevs) pure $ (lappVer,) <$> mlappRev case eres of Left e -> do diff --git a/src/Stack/PackageIndex.hs b/src/Stack/PackageIndex.hs index b641eb6266..47ddcb117f 100644 --- a/src/Stack/PackageIndex.hs +++ b/src/Stack/PackageIndex.hs @@ -379,22 +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 (HashMap Version (NE.NonEmpty CabalHash)) +getPackageVersions :: HasCabalLoader env => PackageName -> RIO env (HashMap Version (Maybe CabalHash)) getPackageVersions pkgName = lookupPackageVersions pkgName <$> getPackageCaches -lookupPackageVersions :: PackageName -> PackageCache index -> HashMap Version (NE.NonEmpty CabalHash) +lookupPackageVersions :: PackageName -> PackageCache index -> HashMap Version (Maybe CabalHash) lookupPackageVersions pkgName (PackageCache m) = - maybe HashMap.empty (HashMap.map extractRevisionHashes) $ HashMap.lookup pkgName m + maybe HashMap.empty (HashMap.map extractOrigRevHash) $ HashMap.lookup pkgName m where - extractRevisionHashes (_,_, neRevHashesAndOffsets) = - NE.map (extractOrigCabalHash . fst) neRevHashesAndOffsets - - -- Warning: This function turns a list of one or two cabal file hashes into a - -- NonEmpty list value. Practically, the list is "guaranteed" to have at - -- least one element (see 'Stack.Types.PackageIndex.PackageCache') - extractOrigCabalHash :: [CabalHash] -> CabalHash - extractOrigCabalHash = NE.head . NE.fromList - + -- 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. -- From 51d84ac17f49dc1ad59f2089b15cda097c582c5e Mon Sep 17 00:00:00 2001 From: tdietert Date: Thu, 7 Jun 2018 15:22:49 +0100 Subject: [PATCH 3/3] Update Changelog.md with PR changes --- ChangeLog.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/ChangeLog.md b/ChangeLog.md index e1f13fde4e..b89a6a4e0b 100644 --- a/ChangeLog.md +++ b/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: