Print latest version of packages on conflicts #450

commercialhaskell · Jun 30, 2015 · b0b18e7 · b0b18e7
1 parent 112e8c2
commit b0b18e7
Show file tree

Hide file tree

Showing 3 changed files with 17 additions and 13 deletions.
diff --git a/ChangeLog.md b/ChangeLog.md
@@ -5,6 +5,7 @@
 * Add `--force` flag to `init` command
 * exec style commands accept the `--package` option (see [Reddit discussion](http://www.reddit.com/r/haskell/comments/3bd66h/stack_runghc_turtle_as_haskell_script_solution/))
 * `stack upload` without arguments doesn't do anything [#439](https://github.com/commercialhaskell/stack/issues/439)
+* Print latest version of packages on conflicts [#450](https://github.com/commercialhaskell/stack/issues/450)
 
 ## 0.1.1.0
 

diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs
@@ -336,16 +336,16 @@ addPackageDeps package = do
     deps' <- packageDepsWithTools package
     deps <- forM (Map.toList deps') $ \(depname, range) -> do
         eres <- addDep depname
+        let mlatest = Map.lookup depname $ latestVersions ctx
         case eres of
             Left e ->
                 let bd =
                         case e of
-                            UnknownPackage name ->
-                                NotInBuildPlan $ Map.lookup name $ latestVersions ctx
+                            UnknownPackage name -> assert (name == depname) NotInBuildPlan
                             _ -> Couldn'tResolveItsDependencies
-                 in return $ Left (depname, (range, bd))
+                 in return $ Left (depname, (range, mlatest, bd))
             Right adr | not $ adrVersion adr `withinRange` range ->
-                return $ Left (depname, (range, DependencyMismatch $ adrVersion adr))
+                return $ Left (depname, (range, mlatest, DependencyMismatch $ adrVersion adr))
             Right (ADRToInstall task) -> return $ Right
                 (Set.singleton $ taskProvides task, Set.empty, taskLocation task)
             Right (ADRFound loc _ (Executable _)) -> return $ Right

diff --git a/src/Stack/Build/Types.hs b/src/Stack/Build/Types.hs
@@ -184,7 +184,7 @@ instance Show StackBuildException where
              getExtras (DependencyPlanFailures _ m) =
                 Map.unions $ map go $ Map.toList m
               where
-                go (name, (_range, NotInBuildPlan (Just version))) =
+                go (name, (_range, Just version, NotInBuildPlan)) =
                     Map.singleton name version
                 go _ = Map.empty
      -- Supressing duplicate output
@@ -209,15 +209,17 @@ instance Exception StackBuildException
 
 data ConstructPlanException
     = DependencyCycleDetected [PackageName]
-    | DependencyPlanFailures PackageIdentifier (Map PackageName (VersionRange, BadDependency))
+    | DependencyPlanFailures PackageIdentifier (Map PackageName (VersionRange, LatestVersion, BadDependency))
     | UnknownPackage PackageName -- TODO perhaps this constructor will be removed, and BadDependency will handle it all
     -- ^ Recommend adding to extra-deps, give a helpful version number?
     deriving (Typeable, Eq)
 
+-- | For display purposes only, Nothing if package not found
+type LatestVersion = Maybe Version
+
 -- | Reason why a dependency was not used
 data BadDependency
     = NotInBuildPlan
-        (Maybe Version) -- recommended version, for extra-deps output
     | Couldn'tResolveItsDependencies
     | DependencyMismatch Version
     deriving (Typeable, Eq)
@@ -240,16 +242,17 @@ instance Show ConstructPlanException where
       indent = dropWhileEnd isSpace . unlines . fmap (\line -> "  " ++ line) . lines
       doubleIndent = indent . indent
       appendDeps = foldr (\dep-> (++) ("\n" ++ showDep dep)) ""
-      showDep (name, (range, badDep)) = concat
+      showDep (name, (range, mlatest, badDep)) = concat
         [ show name
         , ": needed ("
         , display range
-        , "), but "
+        , ")"
+        , case mlatest of
+            Nothing -> ""
+            Just latest -> ", latest is " ++ versionString latest
+        , ", but "
         , case badDep of
-            NotInBuildPlan mlatest -> "not present in build plan" ++
-                (case mlatest of
-                    Nothing -> ""
-                    Just latest -> ", latest is " ++ versionString latest)
+            NotInBuildPlan -> "not present in build plan"
             Couldn'tResolveItsDependencies -> "couldn't resolve its dependencies"
             DependencyMismatch version -> versionString version ++ " found"
         ]