Detect resolver change in stack solver

Fixes commercialhaskell#2252.
sjakobi · Jun 22, 2016 · 284dc58 · 284dc58
1 parent 5bd2b36
commit 284dc58
Show file tree

Hide file tree

Showing 2 changed files with 16 additions and 2 deletions.
diff --git a/src/Stack/Solver.hs b/src/Stack/Solver.hs
@@ -33,6 +33,7 @@ import           Data.Aeson.Extended         ( WithJSONWarnings(..), object, (.=
 import qualified Data.ByteString             as S
 import           Data.Char                   (isSpace)
 import           Data.Either
+import           Data.Foldable               (forM_)
 import           Data.Function               (on)
 import qualified Data.HashMap.Strict         as HashMap
 import           Data.List                   ( (\\), isSuffixOf, intercalate
@@ -679,6 +680,8 @@ solveExtraDeps modStackYaml = do
         Nothing -> throwM (SolverGiveUp giveUpMsg)
         Just x -> return x
 
+    moldResolver <- asks (fmap (projectResolver . fst) . configMaybeProject . getConfig)
+
     let
         flags = removeSrcPkgDefaultFlags gpds (fmap snd (Map.union srcs edeps))
         versions = fmap fst edeps
@@ -695,14 +698,14 @@ solveExtraDeps modStackYaml = do
 
         changed =    any (not . Map.null) [newVersions, goneVersions]
                   || any (not . Map.null) [newFlags, goneFlags]
+                  || any (/= resolver') moldResolver
 
     if changed then do
         $logInfo ""
         $logInfo $ "The following changes will be made to "
                    <> T.pack relStackYaml <> ":"
 
-        -- TODO print whether resolver changed from previous
-        $logInfo $ "* Resolver is " <> resolverName resolver
+        printResolver moldResolver resolver'
 
         printFlags newFlags  "* Flags to be added"
         printDeps  newVersions   "* Dependencies to be added"
@@ -723,6 +726,16 @@ solveExtraDeps modStackYaml = do
     where
         indent t = T.unlines $ fmap ("    " <>) (T.lines t)
 
+        printResolver moldRes res = do
+            forM_ moldRes $ \oldRes ->
+                when (res /= oldRes) $ do
+                    $logInfo $ T.concat
+                        [ "* Resolver changes from "
+                        , resolverName oldRes
+                        , " to "
+                        , resolverName res
+                        ]
+
         printFlags fl msg = do
             when ((not . Map.null) fl) $ do
                 $logInfo $ T.pack msg

diff --git a/src/Stack/Types/Config.hs b/src/Stack/Types/Config.hs
@@ -684,6 +684,7 @@ data ResolverThat's (l :: IsLoaded) where
     -- files are stored for the resolver.
     ResolverCustomLoaded :: !Text -> !Text -> !SnapshotHash -> ResolverThat's 'Loaded
 
+deriving instance Eq (ResolverThat's k)
 deriving instance Show (ResolverThat's k)
 
 instance ToJSON (ResolverThat's k) where