[commit: Cabal] master: make test and bench available as user constraints (7fada5a)

[Ian Lynagh]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/7fada5a6ae8feaf208551351a23de8f29c2fa004

>---------------------------------------------------------------

commit 7fada5a6ae8feaf208551351a23de8f29c2fa004
Author: Andres Loeh <andres at well-typed.com>
Date:   Mon Feb 13 08:16:41 2012 +0000

    make test and bench available as user constraints
    
    Saying
    
      cabal install foo --enable-tests
    
    is now equivalent to saying
    
      cabal install foo --constraint="foo test"
    
    The constraint syntax in addition allows to enable tests and benchmarks
    for packages that are further down in the dependency chain.

>---------------------------------------------------------------

 .../Distribution/Client/Dependency/TopDown.hs      |    2 +-
 cabal-install/Distribution/Client/Targets.hs       |   16 +++++++++++++++-
 2 files changed, 16 insertions(+), 2 deletions(-)

diff --git a/cabal-install/Distribution/Client/Dependency/TopDown.hs b/cabal-install/Distribution/Client/Dependency/TopDown.hs
index 88aca39..fea86fb 100644
--- a/cabal-install/Distribution/Client/Dependency/TopDown.hs
+++ b/cabal-install/Distribution/Client/Dependency/TopDown.hs
@@ -440,7 +440,7 @@ annotateSourcePackages constraints dfsNumber sourcePkgIndex =
       [ (name, flags)
       | PackageConstraintFlags name flags <- constraints ]
     stanzasFor = fromMaybe [] . flip Map.lookup stanzasMap
-    stanzasMap = Map.fromList
+    stanzasMap = Map.fromListWith (++)
         [ (name, stanzas)
         | PackageConstraintStanzas name stanzas <- constraints ]
 
diff --git a/cabal-install/Distribution/Client/Targets.hs b/cabal-install/Distribution/Client/Targets.hs
index 23c95e6..2863cbb 100644
--- a/cabal-install/Distribution/Client/Targets.hs
+++ b/cabal-install/Distribution/Client/Targets.hs
@@ -49,7 +49,7 @@ import Distribution.Package
          , PackageIdentifier(..), packageName, packageVersion
          , Dependency(Dependency) )
 import Distribution.Client.Types
-         ( SourcePackage(..), PackageLocation(..) )
+         ( SourcePackage(..), PackageLocation(..), OptionalStanza(..) )
 import Distribution.Client.Dependency.Types
          ( PackageConstraint(..) )
 
@@ -673,6 +673,7 @@ data UserConstraint =
    | UserConstraintInstalled PackageName
    | UserConstraintSource    PackageName
    | UserConstraintFlags     PackageName FlagAssignment
+   | UserConstraintStanzas   PackageName [OptionalStanza]
   deriving (Show,Eq)
 
 
@@ -683,6 +684,7 @@ userToPackageConstraint uc = case uc of
   UserConstraintInstalled name       -> PackageConstraintInstalled  name
   UserConstraintSource    name       -> PackageConstraintSource     name
   UserConstraintFlags     name flags -> PackageConstraintFlags      name flags
+  UserConstraintStanzas   name stanzas -> PackageConstraintStanzas  name stanzas
 
 renamePackageConstraint :: PackageName -> PackageConstraint -> PackageConstraint
 renamePackageConstraint name pc = case pc of
@@ -714,6 +716,12 @@ instance Text UserConstraint where
       dispFlagValue (f, False)  = Disp.char '-' <> dispFlagName f
       dispFlagName (FlagName f) = Disp.text f
 
+  disp (UserConstraintStanzas   pkgname stanzas)  = disp pkgname <+> dispStanzas stanzas
+    where
+      dispStanzas = Disp.hsep . map dispStanza
+      dispStanza TestStanzas  = Disp.text "test"
+      dispStanza BenchStanzas = Disp.text "bench"
+
   parse = parse >>= parseConstraint
     where
       spaces = Parse.satisfy isSpace >> Parse.skipSpaces
@@ -726,6 +734,12 @@ instance Text UserConstraint where
         +++ (do spaces
                 _ <- Parse.string "source"
                 return (UserConstraintSource pkgname))
+        +++ (do spaces
+                _ <- Parse.string "test"
+                return (UserConstraintStanzas pkgname [TestStanzas]))
+        +++ (do spaces
+                _ <- Parse.string "bench"
+                return (UserConstraintStanzas pkgname [BenchStanzas]))
         <++ (parseFlagAssignment >>= (return . UserConstraintFlags pkgname))
 
       parseFlagAssignment = Parse.many1 (spaces >> parseFlagValue)