From 4a1f73c1a17e696f07b6e34ed5ce13f831efcc4c Mon Sep 17 00:00:00 2001 From: Phil de Joux Date: Wed, 20 Mar 2024 11:26:44 -0400 Subject: [PATCH] Show abbreviated mixed versions with suffix - Use independent package name in doctest - Add changelog entry - Still use showOption when linked - Typo, package is cabal-install-solver - Rename showIsOrVs to showOptions - Add linked doctests for showOptions --- .../Distribution/Solver/Modular/Message.hs | 79 ++++++++----------- .../Distribution/Solver/Modular/Solver.hs | 2 +- changelog.d/pr-9824 | 10 +++ 3 files changed, 42 insertions(+), 49 deletions(-) create mode 100644 changelog.d/pr-9824 diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs index 2d78790f1de..e097d3e081c 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs @@ -7,13 +7,12 @@ module Distribution.Solver.Modular.Message ( showMessages ) where -import Data.Maybe (isJust) import qualified Data.List as L import Data.Map (Map) import qualified Data.Map as M import Data.Set (Set) import qualified Data.Set as S -import Data.Maybe (catMaybes, mapMaybe) +import Data.Maybe (catMaybes, mapMaybe, isJust) import Prelude hiding (pi) import Distribution.Pretty (prettyShow) -- from Cabal @@ -236,7 +235,7 @@ blurbOption :: ProgressAction -> QPN -> POption -> String blurbOption a q p = blurb a ++ showOption q p blurbOptions :: ProgressAction -> QPN -> [POption] -> String -blurbOptions a q ps = blurb a ++ showIsOrVs q (tryVs ps) +blurbOptions a q ps = blurb a ++ showOptions q ps showOption :: QPN -> POption -> String showOption qpn@(Q _pp pn) (POption i linkedTo) = @@ -244,53 +243,33 @@ showOption qpn@(Q _pp pn) (POption i linkedTo) = Nothing -> showPI (PI qpn i) -- Consistent with prior to POption Just pp' -> showQPN qpn ++ "~>" ++ showPI (PI (Q pp' pn) i) --- | A list of versions, or a list of instances. -data IsOrVs = Is [POption] | Vs [Ver] deriving Show - --- | Try to convert a list of options to a list of versions, or a list of --- instances if any of the options is linked or installed. Singleton lists or --- empty lists are always converted to Is. --- >>> tryVs [v0, v1] --- Vs [mkVersion [0],mkVersion [1]] --- >>> tryVs [v0] --- Is [POption (I (mkVersion [0]) InRepo) Nothing] --- >>> tryVs [i0, i1] --- Is [POption (I (mkVersion [0]) (Inst (UnitId "foo-bar-0-inplace"))) Nothing,POption (I (mkVersion [1]) (Inst (UnitId "foo-bar-1-inplace"))) Nothing] --- >>> tryVs [i0, v1] --- Is [POption (I (mkVersion [0]) (Inst (UnitId "foo-bar-0-inplace"))) Nothing,POption (I (mkVersion [1]) InRepo) Nothing] --- >>> tryVs [v0, i1] --- Is [POption (I (mkVersion [0]) InRepo) Nothing,POption (I (mkVersion [1]) (Inst (UnitId "foo-bar-1-inplace"))) Nothing] --- >>> tryVs [i0] --- Is [POption (I (mkVersion [0]) (Inst (UnitId "foo-bar-0-inplace"))) Nothing] --- >>> tryVs [] --- Is [] -tryVs :: [POption] -> IsOrVs -tryVs xs@[] = Is xs -tryVs xs@[_] = Is xs -tryVs xs - | any (\(POption (instI -> b0) (isJust -> b1)) -> b0 || b1) xs = Is xs - | otherwise = - let (vs, is) = L.partition ((== InRepo) . snd) [(v, l) | POption i _ <- xs, let I v l = i] - in if null is then Vs (fst `map` vs) else Is xs - --- | Shows a list of versions in a human-friendly way, abbreviated. Shows a list --- of instances in full. --- >>> showIsOrVs foobarQPN $ tryVs [v0, v1] +-- | Shows a mixed list of instances and versions in a human-friendly way, +-- abbreviated. +-- >>> showOptions foobarQPN [v0, v1] -- "foo-bar; 0, 1" --- >>> showIsOrVs foobarQPN $ tryVs [v0] +-- >>> showOptions foobarQPN [v0] -- "foo-bar-0" --- >>> showIsOrVs foobarQPN $ tryVs [i0, i1] --- "foo-bar-0/installed-inplace, foo-bar-1/installed-inplace" --- >>> showIsOrVs foobarQPN $ tryVs [i0, v1] --- "foo-bar-0/installed-inplace, foo-bar-1" --- >>> showIsOrVs foobarQPN $ tryVs [v0, i1] --- "foo-bar-0, foo-bar-1/installed-inplace" --- >>> showIsOrVs foobarQPN $ tryVs [] +-- >>> showOptions foobarQPN [i0, i1] +-- "foo-bar; 0/installed-inplace, 1/installed-inplace" +-- >>> showOptions foobarQPN [i0, v1] +-- "foo-bar; 0/installed-inplace, 1" +-- >>> showOptions foobarQPN [v0, i1] +-- "foo-bar; 0, 1/installed-inplace" +-- >>> showOptions foobarQPN [] -- "unexpected empty list of versions" -showIsOrVs :: QPN -> IsOrVs -> String -showIsOrVs _ (Is []) = "unexpected empty list of versions" -showIsOrVs q (Is xs) = L.intercalate ", " (showOption q `map` xs) -showIsOrVs q (Vs xs) = showQPN q ++ "; " ++ L.intercalate ", " (showVer `map` xs) +-- >>> showOptions foobarQPN [k1, k2] +-- "foo-bar; foo-bar~>bazqux.foo-bar-1, foo-bar~>bazqux.foo-bar-2" +-- >>> showOptions foobarQPN [v0, i1, k2] +-- "foo-bar; 0, 1/installed-inplace, foo-bar~>bazqux.foo-bar-2" +showOptions :: QPN -> [POption] -> String +showOptions _ [] = "unexpected empty list of versions" +showOptions q [x] = showOption q x +showOptions q xs = showQPN q ++ "; " ++ (L.intercalate ", " + [if isJust linkedTo + then showOption q x + else showI i -- Don't show the package, just the version + | x@(POption i linkedTo) <- xs + ]) showGR :: QGoalReason -> String showGR UserGoal = " (user goal)" @@ -356,8 +335,12 @@ showConflictingDep (ConflictingDep dr (PkgComponent qpn comp) ci) = -- >>> import Distribution.Solver.Types.PackagePath -- >>> import Distribution.Types.Version -- >>> import Distribution.Types.UnitId --- >>> let foobarQPN = Q (PackagePath DefaultNamespace QualToplevel) (mkPackageName "foo-bar") +-- >>> let foobarPN = PackagePath DefaultNamespace QualToplevel +-- >>> let bazquxPN = PackagePath (Independent $ mkPackageName "bazqux") QualToplevel +-- >>> let foobarQPN = Q foobarPN (mkPackageName "foo-bar") -- >>> let v0 = POption (I (mkVersion [0]) InRepo) Nothing -- >>> let v1 = POption (I (mkVersion [1]) InRepo) Nothing -- >>> let i0 = POption (I (mkVersion [0]) (Inst $ mkUnitId "foo-bar-0-inplace")) Nothing -- >>> let i1 = POption (I (mkVersion [1]) (Inst $ mkUnitId "foo-bar-1-inplace")) Nothing +-- >>> let k1 = POption (I (mkVersion [1]) InRepo) (Just bazquxPN) +-- >>> let k2 = POption (I (mkVersion [2]) InRepo) (Just bazquxPN) diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs index d32bc85dc15..a1f5eed3c62 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs @@ -961,7 +961,7 @@ tests = , Right $ exAv "B" 1 [ExFix "A" 4] ] rejecting = "rejecting: A-3.0.0/installed-3.0.0" - skipping = "skipping: A-2.0.0/installed-2.0.0, A-1.0.0/installed-1.0.0" + skipping = "skipping: A; 2.0.0/installed-2.0.0, 1.0.0/installed-1.0.0" in mkTest db "show skipping versions list, installed" ["B"] $ solverFailure (\msg -> rejecting `isInfixOf` msg && skipping `isInfixOf` msg) ] diff --git a/changelog.d/pr-9824 b/changelog.d/pr-9824 new file mode 100644 index 00000000000..168b9c98e64 --- /dev/null +++ b/changelog.d/pr-9824 @@ -0,0 +1,10 @@ +synopsis: Abbrevate solver rejection messages with installed versions +packages: cabal-install-solver +prs: #9824 +issues: #9823 + +description: { + +Abbreviate solver rejection messages even in the presence of installed versions. + +}