[commit: Cabal] master: when printing the install plan, show non-default flag assignments (0fec5de)

[Ian Lynagh]

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

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/0fec5de846707111285eaaa5994909759ca380f2

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

commit 0fec5de846707111285eaaa5994909759ca380f2
Author: Andres Loeh <andres at well-typed.com>
Date:   Sat Oct 29 12:15:15 2011 +0000

    when printing the install plan, show non-default flag assignments

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

 cabal-install/Distribution/Client/Install.hs |   23 ++++++++++++++++++++---
 1 files changed, 20 insertions(+), 3 deletions(-)

diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs
index a4a0874..5644b72 100644
--- a/cabal-install/Distribution/Client/Install.hs
+++ b/cabal-install/Distribution/Client/Install.hs
@@ -19,7 +19,7 @@ module Distribution.Client.Install (
   ) where
 
 import Data.List
-         ( unfoldr, find, nub, sort )
+         ( unfoldr, find, nub, sort, (\\) )
 import Data.Maybe
          ( isJust, fromMaybe, maybeToList )
 import Control.Exception as Exception
@@ -102,7 +102,7 @@ import Distribution.Package
 import qualified Distribution.PackageDescription as PackageDescription
 import Distribution.PackageDescription
          ( Benchmark(..), PackageDescription, GenericPackageDescription(..)
-         , TestSuite(..) )
+         , TestSuite(..), Flag(..), FlagName(..), FlagAssignment )
 import Distribution.PackageDescription.Configuration
          ( finalizePackageDescription, mapTreeData )
 import Distribution.Version
@@ -433,7 +433,8 @@ printDryRun verbosity plan = case plan of
         "In order, the following would be installed (use -v for more details):"
       : map (display . packageId) (map fst pkgs)
   where
-    showPkgAndReason (pkg', pr) = display (packageId pkg') ++ " " ++
+    showPkgAndReason (pkg', pr) = display (packageId pkg') ++
+          showFlagAssignment (nonDefaultFlags pkg') ++ " " ++
           case pr of
             NewPackage   -> "(new package)"
             NewVersion _ -> "(new version)"
@@ -441,6 +442,22 @@ printDryRun verbosity plan = case plan of
                 []   -> ""
                 diff -> " changes: "  ++ intercalate ", " (map change diff)
 
+    toFlagAssignment :: [Flag] -> FlagAssignment
+    toFlagAssignment = map (\ f -> (flagName f, flagDefault f))
+
+    nonDefaultFlags :: ConfiguredPackage -> FlagAssignment
+    nonDefaultFlags (ConfiguredPackage spkg fa _) =
+      let defaultAssignment =
+            toFlagAssignment
+             (genPackageFlags (Source.packageDescription spkg))
+      in  fa \\ defaultAssignment
+
+    -- FIXME: this should be a proper function in a proper place
+    showFlagAssignment = concatMap ((' ' :) . showFlagValue)
+    showFlagValue (f, True)   = '+' : showFlagName f
+    showFlagValue (f, False)  = '-' : showFlagName f
+    showFlagName (FlagName f) = f
+
     change (OnlyInLeft pkgid)        = display pkgid ++ " removed"
     change (InBoth     pkgid pkgid') = display pkgid ++ " -> "
                                     ++ display (packageVersion pkgid')