Refactor goal sorting in the solver DSL.

Now DSL.exResolve takes a goal-ordering function, which is more flexible
than a list of sorted goals.

cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs

@@ -41,8 +41,6 @@ import Distribution.Client.Compat.Prelude
 
 -- base
 import Data.Either (partitionEithers)
-import Data.List (elemIndex)
-import Data.Ord (comparing)
 import qualified Data.Map as Map
 
 -- Cabal
@@ -600,13 +598,13 @@ exResolve :: ExampleDb
           -> ReorderGoals
           -> AllowBootLibInstalls
           -> EnableBackjumping
-          -> Maybe [ExampleVar]
+          -> Maybe (Variable P.QPN -> Variable P.QPN -> Ordering)
           -> [ExConstraint]
           -> [ExPreference]
           -> EnableAllTests
           -> Progress String String CI.SolverInstallPlan.SolverInstallPlan
 exResolve db exts langs pkgConfigDb targets mbj countConflicts indepGoals
-          reorder allowBootLibInstalls enableBj vars constraints prefs
+          reorder allowBootLibInstalls enableBj goalOrder constraints prefs
           enableAllTests
     = resolveDependencies C.buildPlatform compiler pkgConfigDb Modular params
   where
@@ -650,32 +648,6 @@ exResolve db exts langs pkgConfigDb targets mbj countConflicts indepGoals
     toPref (ExPkgPref n v)          = PackageVersionPreference (C.mkPackageName n) v
     toPref (ExStanzaPref n stanzas) = PackageStanzasPreference (C.mkPackageName n) stanzas
 
-    goalOrder :: Maybe (Variable P.QPN -> Variable P.QPN -> Ordering)
-    goalOrder = (orderFromList . map toVariable) `fmap` vars
-
-    -- Sort elements in the list ahead of elements not in the list. Otherwise,
-    -- follow the order in the list.
-    orderFromList :: Eq a => [a] -> a -> a -> Ordering
-    orderFromList xs =
-        comparing $ \x -> let i = elemIndex x xs in (isNothing i, i)
-
-    toVariable :: ExampleVar -> Variable P.QPN
-    toVariable (P q pn)        = PackageVar (toQPN q pn)
-    toVariable (F q pn fn)     = FlagVar    (toQPN q pn) (C.mkFlagName fn)
-    toVariable (S q pn stanza) = StanzaVar  (toQPN q pn) stanza
-
-    toQPN :: ExampleQualifier -> ExamplePkgName -> P.QPN
-    toQPN q pn = P.Q pp (C.mkPackageName pn)
-      where
-        pp = case q of
-               None           -> P.PackagePath P.DefaultNamespace P.QualToplevel
-               Indep p        -> P.PackagePath (P.Independent $ C.mkPackageName p)
-                                               P.QualToplevel
-               Setup s        -> P.PackagePath P.DefaultNamespace
-                                               (P.QualSetup (C.mkPackageName s))
-               IndepSetup p s -> P.PackagePath (P.Independent $ C.mkPackageName p)
-                                               (P.QualSetup (C.mkPackageName s))
-
 extractInstallPlan :: CI.SolverInstallPlan.SolverInstallPlan
                    -> [(ExamplePkgName, ExamplePkgVersion)]
 extractInstallPlan = catMaybes . map confPkg . CI.SolverInstallPlan.toList

cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL/TestCaseUtils.hs

@@ -21,21 +21,30 @@ module UnitTests.Distribution.Solver.Modular.DSL.TestCaseUtils (
   , runTest
   ) where
 
+import Prelude ()
+import Distribution.Client.Compat.Prelude
+
+import Data.List (elemIndex)
+import Data.Ord (comparing)
+
 -- test-framework
 import Test.Tasty as TF
 import Test.Tasty.HUnit (testCase, assertEqual, assertBool)
 
 -- Cabal
+import qualified Distribution.PackageDescription as C
+import qualified Distribution.Types.PackageName as C
 import Language.Haskell.Extension (Extension(..), Language(..))
 
 -- cabal-install
+import qualified Distribution.Solver.Types.PackagePath as P
 import Distribution.Solver.Types.PkgConfigDb (PkgConfigDb, pkgConfigDbFromList)
 import Distribution.Solver.Types.Settings
+import Distribution.Solver.Types.Variable
 import Distribution.Client.Dependency (foldProgress)
 import UnitTests.Distribution.Solver.Modular.DSL
 import UnitTests.Options
 
-import Control.Monad (when)
 -- | Combinator to turn on --independent-goals behavior, i.e. solve
 -- for the goals as if we were solving for each goal independently.
 independentGoals :: SolverTest -> SolverTest
@@ -180,8 +189,8 @@ runTest SolverTest{..} = askOption $ \(OptionShowSolverLog showSolverLog) ->
                      testSupportedLangs testPkgConfigDb testTargets
                      Nothing (CountConflicts True) testIndepGoals
                      (ReorderGoals False) testAllowBootLibInstalls
-                     testEnableBackjumping testGoalOrder testConstraints
-                     testSoftConstraints testEnableAllTests
+                     testEnableBackjumping (sortGoals <$> testGoalOrder)
+                     testConstraints testSoftConstraints testEnableAllTests
           printMsg msg = when showSolverLog $ putStrLn msg
           msgs = foldProgress (:) (const []) (const []) progress
       assertBool ("Unexpected solver log:\n" ++ unlines msgs) $
@@ -200,3 +209,30 @@ runTest SolverTest{..} = askOption $ \(OptionShowSolverLog showSolverLog) ->
         case resultErrorMsgPredicateOrPlan result of
           Left f  -> f msg
           Right _ -> False
+
+    sortGoals :: [ExampleVar]
+              -> Variable P.QPN -> Variable P.QPN -> Ordering
+    sortGoals = orderFromList . map toVariable
+
+    -- Sort elements in the list ahead of elements not in the list. Otherwise,
+    -- follow the order in the list.
+    orderFromList :: Eq a => [a] -> a -> a -> Ordering
+    orderFromList xs =
+        comparing $ \x -> let i = elemIndex x xs in (isNothing i, i)
+
+    toVariable :: ExampleVar -> Variable P.QPN
+    toVariable (P q pn)        = PackageVar (toQPN q pn)
+    toVariable (F q pn fn)     = FlagVar    (toQPN q pn) (C.mkFlagName fn)
+    toVariable (S q pn stanza) = StanzaVar  (toQPN q pn) stanza
+
+    toQPN :: ExampleQualifier -> ExamplePkgName -> P.QPN
+    toQPN q pn = P.Q pp (C.mkPackageName pn)
+      where
+        pp = case q of
+               None           -> P.PackagePath P.DefaultNamespace P.QualToplevel
+               Indep p        -> P.PackagePath (P.Independent $ C.mkPackageName p)
+                                               P.QualToplevel
+               Setup s        -> P.PackagePath P.DefaultNamespace
+                                               (P.QualSetup (C.mkPackageName s))
+               IndepSetup p s -> P.PackagePath (P.Independent $ C.mkPackageName p)
+                                               (P.QualSetup (C.mkPackageName s))