From 4660e9068717f8301cc9f80c235ecc34cf9bd917 Mon Sep 17 00:00:00 2001
From: Kristen Kozak <grayjay@wordroute.com>
Date: Wed, 1 Jan 2020 18:01:26 -0800
Subject: [PATCH] Show full ABI hash for installed packages in solver log
 (fixes #5892).

This commit is the same as 96c3bf9121125fd6d316dd97dddd7264cfca736a, but with
the unit tests updated to fix #6495.  The tests check less of the solver output
so that they are less fragile.
---
 .../Distribution/Solver/Modular/Package.hs        | 15 +++++++--------
 .../Distribution/Solver/Modular/Solver.hs         | 12 ++++++++++++
 .../Backpack/Includes2/setup-external.cabal.out   |  2 +-
 cabal-testsuite/Test/Cabal/OutputNormalizer.hs    |  8 +++-----
 4 files changed, 23 insertions(+), 14 deletions(-)

diff --git a/cabal-install/Distribution/Solver/Modular/Package.hs b/cabal-install/Distribution/Solver/Modular/Package.hs
index eb68ab25340..d5226700c32 100644
--- a/cabal-install/Distribution/Solver/Modular/Package.hs
+++ b/cabal-install/Distribution/Solver/Modular/Package.hs
@@ -18,7 +18,8 @@ module Distribution.Solver.Modular.Package
   , unPN
   ) where
 
-import Data.List as L
+import Prelude ()
+import Distribution.Solver.Compat.Prelude
 
 import Distribution.Package -- from Cabal
 import Distribution.Deprecated.Text (display)
@@ -57,14 +58,12 @@ data I = I Ver Loc
 -- | String representation of an instance.
 showI :: I -> String
 showI (I v InRepo)   = showVer v
-showI (I v (Inst uid)) = showVer v ++ "/installed" ++ shortId uid
+showI (I v (Inst uid)) = showVer v ++ "/installed" ++ extractPackageAbiHash uid
   where
-    -- A hack to extract the beginning of the package ABI hash
-    shortId = snip (splitAt 4) (++ "...")
-            . snip ((\ (x, y) -> (reverse x, y)) . break (=='-') . reverse) ('-':)
-            . display
-    snip p f xs = case p xs of
-                    (ys, zs) -> (if L.null zs then id else f) ys
+    extractPackageAbiHash xs =
+      case first reverse $ break (=='-') $ reverse (display xs) of
+        (ys, []) -> ys
+        (ys, _)  -> '-' : ys
 
 -- | Package instance. A package name and an instance.
 data PI qpn = PI qpn I
diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs
index c4405a9974e..a7edbeaacf4 100644
--- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs
+++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs
@@ -708,6 +708,18 @@ tests = [
               "minimize conflict set with --minimize-conflict-set"
         , testNoMinimizeConflictSet
               "show original conflict set with --no-minimize-conflict-set"
+        , runTest $
+              let db = [ Right $ exAv "my-package" 1 [ExFix "other-package" 3]
+                       , Left $ exInst "other-package" 2 "other-package-2.0.0" []]
+                  msg = "rejecting: other-package-2.0.0/installed-2.0.0"
+              in mkTest db "show full installed package version (issue #5892)" ["my-package"] $
+                 solverFailure (isInfixOf msg)
+        , runTest $
+              let db = [ Right $ exAv "my-package" 1 [ExFix "other-package" 3]
+                       , Left $ exInst "other-package" 2 "other-package-AbCdEfGhIj0123456789" [] ]
+                  msg = "rejecting: other-package-2.0.0/installed-AbCdEfGhIj0123456789"
+              in mkTest db "show full installed package ABI hash (issue #5892)" ["my-package"] $
+                 solverFailure (isInfixOf msg)
         ]
     ]
   where
diff --git a/cabal-testsuite/PackageTests/Backpack/Includes2/setup-external.cabal.out b/cabal-testsuite/PackageTests/Backpack/Includes2/setup-external.cabal.out
index e91346a7b78..74ede341052 100644
--- a/cabal-testsuite/PackageTests/Backpack/Includes2/setup-external.cabal.out
+++ b/cabal-testsuite/PackageTests/Backpack/Includes2/setup-external.cabal.out
@@ -101,7 +101,7 @@ Warning: solver failed to find a solution:
 Could not resolve dependencies:
 [__0] trying: exe-0.1.0.0 (user goal)
 [__1] next goal: src (dependency of exe)
-[__1] rejecting: src-<VERSION>/installed-<HASH>... (conflict: src => mylib==0.1.0.0/installed-0.1..., src => mylib==0.1.0.0/installed-0.1...)
+[__1] rejecting: src-<VERSION>/installed-<HASH> (conflict: src => mylib==<VERSION>/installed-<HASH>, src => mylib==<VERSION>/installed-<HASH>)
 [__1] fail (backjumping, conflict set: exe, src)
 After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: exe (2), src (2)
 Trying configure anyway.
diff --git a/cabal-testsuite/Test/Cabal/OutputNormalizer.hs b/cabal-testsuite/Test/Cabal/OutputNormalizer.hs
index da57aa31e47..31fef0f47bd 100644
--- a/cabal-testsuite/Test/Cabal/OutputNormalizer.hs
+++ b/cabal-testsuite/Test/Cabal/OutputNormalizer.hs
@@ -33,13 +33,11 @@ normalizeOutput nenv =
   . resub (posixRegexEscape (normalizerRoot nenv)) "<ROOT>/"
   . resub (posixRegexEscape (normalizerTmpDir nenv)) "<TMPDIR>/"
   . appEndo (F.fold (map (Endo . packageIdRegex) (normalizerKnownPackages nenv)))
-    -- Look for foo-0.1/installed-0d6...
+    -- Look for 0.1/installed-0d6uzW7Ubh1Fb4TB5oeQ3G
     -- These installed packages will vary depending on GHC version
-    -- Makes assumption that installed packages don't have numbers
-    -- in package name segment.
     -- Apply this before packageIdRegex, otherwise this regex doesn't match.
-  . resub "([a-zA-Z]+(-[a-zA-Z])*)-[0-9]+(\\.[0-9]+)*/installed-[A-Za-z0-9.]+"
-          "\\1-<VERSION>/installed-<HASH>..."
+  . resub "[0-9]+(\\.[0-9]+)*/installed-[A-Za-z0-9.+]+"
+          "<VERSION>/installed-<HASH>"
     -- Normalize architecture
   . resub (posixRegexEscape (display (normalizerPlatform nenv))) "<ARCH>"
     -- Some GHC versions are chattier than others