Simplify representation of test suites in the solver DSL

This commit removes the 'ExTest' constructor from 'ExampleDependency'.
Test dependencies are now represented using the same
'ExampleDependency' constructors as library dependencies.  The only
difference between dependencies of different components is that they
are placed under different keys in 'D.C.ComponentDeps.ComponentDeps'.

cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs

@@ -3,6 +3,7 @@
 module UnitTests.Distribution.Client.Dependency.Modular.DSL (
     ExampleDependency(..)
   , Dependencies(..)
+  , ExTest(..)
   , ExPreference(..)
   , ExampleDb
   , ExampleVersionRange
@@ -18,6 +19,8 @@ module UnitTests.Distribution.Client.Dependency.Modular.DSL (
   , exResolve
   , extractInstallPlan
   , withSetupDeps
+  , withTest
+  , withTests
   ) where
 
 -- base
@@ -111,9 +114,6 @@ data ExampleDependency =
     -- | Dependencies indexed by a flag
   | ExFlag ExampleFlagName Dependencies Dependencies
 
-    -- | Dependency if tests are enabled
-  | ExTest ExampleTestName [ExampleDependency]
-
     -- | Dependency on a language extension
   | ExExt Extension
 
@@ -124,6 +124,8 @@ data ExampleDependency =
   | ExPkg (ExamplePkgName, ExamplePkgVersion)
   deriving Show
 
+data ExTest = ExTest ExampleTestName [ExampleDependency]
+
 exFlag :: ExampleFlagName -> [ExampleDependency] -> [ExampleDependency]
        -> ExampleDependency
 exFlag n t e = ExFlag n (Buildable t) (Buildable e)
@@ -155,6 +157,15 @@ withSetupDeps ex setupDeps = ex {
       exAvDeps = exAvDeps ex <> CD.fromSetupDeps setupDeps
     }
 
+withTest :: ExampleAvailable -> ExTest -> ExampleAvailable
+withTest ex test = withTests ex [test]
+
+withTests :: ExampleAvailable -> [ExTest] -> ExampleAvailable
+withTests ex tests =
+  let testCDs = CD.fromList [(CD.ComponentTest name, deps)
+                            | ExTest name deps <- tests]
+  in ex { exAvDeps = exAvDeps ex <> testCDs }
+
 -- | An installed package in 'ExampleDb'; construct me with 'exInst'.
 data ExampleInstalled = ExInst {
     exInstName         :: ExamplePkgName
@@ -195,7 +206,8 @@ exDbPkgs = map (either exInstName exAvName)
 
 exAvSrcPkg :: ExampleAvailable -> UnresolvedSourcePackage
 exAvSrcPkg ex =
-    let (libraryDeps, testSuites, exts, mlang, pcpkgs) = splitTopLevel (CD.libraryDeps (exAvDeps ex))
+    let (libraryDeps, exts, mlang, pcpkgs) = splitTopLevel (CD.libraryDeps (exAvDeps ex))
+        testSuites = [(name, deps) | (CD.ComponentTest name, deps) <- CD.toList (exAvDeps ex)]
     in SourcePackage {
            packageInfoId        = exAvPkgId ex
          , packageSource        = LocalTarballPackage "<<path>>"
@@ -212,8 +224,8 @@ exAvSrcPkg ex =
                        C.setupDepends = mkSetupDeps (CD.setupDeps (exAvDeps ex))
                      }
                  }
-             , C.genPackageFlags = nub $ concatMap extractFlags
-                                   (CD.libraryDeps (exAvDeps ex))
+             , C.genPackageFlags = nub $ concatMap extractFlags $
+                                   CD.libraryDeps (exAvDeps ex) ++ concatMap snd testSuites
              , C.condLibraries   = [(exAvName ex, mkCondTree (extsLib exts <> langLib mlang <> pcpkgLib pcpkgs)
                                                      disableLib
                                                      (Buildable libraryDeps))]
@@ -229,29 +241,25 @@ exAvSrcPkg ex =
     -- the dependencies of the test suites and extensions.
     splitTopLevel :: [ExampleDependency]
                   -> ( [ExampleDependency]
-                     , [(ExampleTestName, [ExampleDependency])]
                      , [Extension]
                      , Maybe Language
                      , [(ExamplePkgName, ExamplePkgVersion)] -- pkg-config
                      )
     splitTopLevel [] =
-        ([], [], [], Nothing, [])
-    splitTopLevel (ExTest t a:deps) =
-      let (other, testSuites, exts, lang, pcpkgs) = splitTopLevel deps
-      in (other, (t, a):testSuites, exts, lang, pcpkgs)
+        ([], [], Nothing, [])
     splitTopLevel (ExExt ext:deps) =
-      let (other, testSuites, exts, lang, pcpkgs) = splitTopLevel deps
-      in (other, testSuites, ext:exts, lang, pcpkgs)
+      let (other, exts, lang, pcpkgs) = splitTopLevel deps
+      in (other, ext:exts, lang, pcpkgs)
     splitTopLevel (ExLang lang:deps) =
         case splitTopLevel deps of
-            (other, testSuites, exts, Nothing, pcpkgs) -> (other, testSuites, exts, Just lang, pcpkgs)
+            (other, exts, Nothing, pcpkgs) -> (other, exts, Just lang, pcpkgs)
             _ -> error "Only 1 Language dependency is supported"
     splitTopLevel (ExPkg pkg:deps) =
-      let (other, testSuites, exts, lang, pcpkgs) = splitTopLevel deps
-      in (other, testSuites, exts, lang, pkg:pcpkgs)
+      let (other, exts, lang, pcpkgs) = splitTopLevel deps
+      in (other, exts, lang, pkg:pcpkgs)
     splitTopLevel (dep:deps) =
-      let (other, testSuites, exts, lang, pcpkgs) = splitTopLevel deps
-      in (dep:other, testSuites, exts, lang, pcpkgs)
+      let (other, exts, lang, pcpkgs) = splitTopLevel deps
+      in (dep:other, exts, lang, pcpkgs)
 
     -- Extract the total set of flags used
     extractFlags :: ExampleDependency -> [C.Flag]
@@ -268,7 +276,6 @@ exAvSrcPkg ex =
         deps :: Dependencies -> [ExampleDependency]
         deps NotBuildable = []
         deps (Buildable ds) = ds
-    extractFlags (ExTest _ a)   = concatMap extractFlags a
     extractFlags (ExExt _)      = []
     extractFlags (ExLang _)     = []
     extractFlags (ExPkg _)      = []
@@ -326,8 +333,6 @@ exAvSrcPkg ex =
     splitDeps (ExFlag f a b:deps) =
       let (directDeps, flaggedDeps) = splitDeps deps
       in (directDeps, (f, a, b):flaggedDeps)
-    splitDeps (ExTest _ _:_) =
-      error "Unexpected nested test"
     splitDeps (_:deps) = splitDeps deps
 
     -- Currently we only support simple setup dependencies

cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/QuickCheck.hs

@@ -168,6 +168,7 @@ arbitraryExInst pn v pkgs = do
 arbitraryComponentDeps :: TestDb -> Gen (ComponentDeps [ExampleDependency])
 arbitraryComponentDeps (TestDb []) = return $ CD.fromList []
 arbitraryComponentDeps db =
+    -- CD.fromList combines duplicate components.
     CD.fromList <$> boundedListOf 3 (arbitraryComponentDep db)
 
 arbitraryComponentDep :: TestDb -> Gen (ComponentDep [ExampleDependency])
@@ -175,20 +176,18 @@ arbitraryComponentDep db = do
   comp <- arbitrary
   deps <- case comp of
             ComponentSetup -> smallListOf (arbitraryExDep db Setup)
-            _              -> boundedListOf 5 (arbitraryExDep db TopLevel)
+            _              -> boundedListOf 5 (arbitraryExDep db NonSetup)
   return (comp, deps)
 
 -- | Location of an 'ExampleDependency'. It determines which values are valid.
-data ExDepLocation = TopLevel | Nested | Setup
+data ExDepLocation = Setup | NonSetup
 
 arbitraryExDep :: TestDb -> ExDepLocation -> Gen ExampleDependency
 arbitraryExDep db@(TestDb pkgs) level =
-  let test = ExTest <$> arbitraryTestName
-                    <*> smallListOf (arbitraryExDep db Nested)
-      flag = ExFlag <$> arbitraryFlagName
+  let flag = ExFlag <$> arbitraryFlagName
                     <*> arbitraryDeps db
                     <*> arbitraryDeps db
-      nonNested = [
+      other = [
             ExAny . unPN <$> elements (map getName pkgs)
 
           -- existing version
@@ -200,19 +199,15 @@ arbitraryExDep db@(TestDb pkgs) level =
           ]
   in oneof $
       case level of
-        TopLevel -> test : flag : nonNested
-        Nested -> flag : nonNested
-        Setup -> nonNested
+        NonSetup -> flag : other
+        Setup -> other
 
 arbitraryDeps :: TestDb -> Gen Dependencies
 arbitraryDeps db = frequency
     [ (1, return NotBuildable)
-    , (20, Buildable <$> smallListOf (arbitraryExDep db Nested))
+    , (20, Buildable <$> smallListOf (arbitraryExDep db NonSetup))
     ]
 
-arbitraryTestName :: Gen String
-arbitraryTestName = (:[]) <$> elements ['A'..'E']
-
 arbitraryFlagName :: Gen String
 arbitraryFlagName = (:[]) <$> elements ['A'..'E']
 
@@ -268,8 +263,6 @@ instance Arbitrary ExampleDependency where
 
   shrink (ExAny _) = []
   shrink (ExFix pn _) = [ExAny pn]
-  shrink (ExTest testName deps) =
-      deps ++ [ExTest testName deps' | deps' <- shrink deps]
   shrink (ExFlag flag th el) =
          deps th ++ deps el
       ++ [ExFlag flag th' el | th' <- shrink th]

cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs

@@ -325,11 +325,11 @@ db5 = [
     Right $ exAv "A" 1 []
   , Right $ exAv "A" 2 []
   , Right $ exAv "B" 1 []
-  , Right $ exAv "C" 1 [ExTest "testC" [ExAny "A"]]
-  , Right $ exAv "D" 1 [ExTest "testD" [ExFix "B" 2]]
-  , Right $ exAv "E" 1 [ExFix "A" 1, ExTest "testE" [ExAny "A"]]
-  , Right $ exAv "F" 1 [ExFix "A" 1, ExTest "testF" [ExFix "A" 2]]
-  , Right $ exAv "G" 1 [ExFix "A" 2, ExTest "testG" [ExAny "A"]]
+  , Right $ exAv "C" 1 [] `withTest` ExTest "testC" [ExAny "A"]
+  , Right $ exAv "D" 1 [] `withTest` ExTest "testD" [ExFix "B" 2]
+  , Right $ exAv "E" 1 [ExFix "A" 1] `withTest` ExTest "testE" [ExAny "A"]
+  , Right $ exAv "F" 1 [ExFix "A" 1] `withTest` ExTest "testF" [ExFix "A" 2]
+  , Right $ exAv "G" 1 [ExFix "A" 2] `withTest` ExTest "testG" [ExAny "A"]
   ]
 
 -- Now the _dependencies_ have test suites
@@ -344,7 +344,7 @@ db6 :: ExampleDb
 db6 = [
     Right $ exAv "A" 1 []
   , Right $ exAv "A" 2 []
-  , Right $ exAv "B" 1 [ExTest "testA" [ExAny "A"]]
+  , Right $ exAv "B" 1 [] `withTest` ExTest "testA" [ExAny "A"]
   , Right $ exAv "C" 1 [ExFix "A" 1, ExAny "B"]
   , Right $ exAv "D" 1 [ExAny "B"]
   ]
@@ -504,13 +504,13 @@ testBuildable testName unavailableDep =
   where
     expected = Just [("false-dep", 1), ("pkg", 1)]
     db = [
-        Right $ exAv "pkg" 1 [
-                   unavailableDep
-                 , ExFlag "enable-lib" (Buildable []) NotBuildable
-                 , ExTest "test" [exFlag "enable-lib"
-                                      [ExAny "true-dep"]
-                                      [ExAny "false-dep"]]
-                 ]
+        Right $ exAv "pkg" 1
+            [ unavailableDep
+            , ExFlag "enable-lib" (Buildable []) NotBuildable ]
+         `withTest`
+            ExTest "test" [exFlag "enable-lib"
+                              [ExAny "true-dep"]
+                              [ExAny "false-dep"]]
       , Right $ exAv "true-dep" 1 []
       , Right $ exAv "false-dep" 1 []
       ]
@@ -522,8 +522,9 @@ dbBuildable1 = [
     Right $ exAv "pkg" 1
         [ ExAny "unknown"
         , ExFlag "flag1" (Buildable []) NotBuildable
-        , ExFlag "flag2" (Buildable []) NotBuildable
-        , ExTest "optional-test"
+        , ExFlag "flag2" (Buildable []) NotBuildable]
+     `withTests`
+        [ ExTest "optional-test"
               [ ExAny "unknown"
               , ExFlag "flag1"
                     (Buildable [])