Refactor haskell#3082 to reduce code duplication and improve Haddock …

…comment.
grayjay · Jan 29, 2016 · 0e4112a · 0e4112a
1 parent c036b79
commit 0e4112a
Show file tree

Hide file tree

Showing 2 changed files with 11 additions and 19 deletions.
diff --git a/Cabal/src/Distribution/PackageDescription/Configuration.hs b/Cabal/src/Distribution/PackageDescription/Configuration.hs
@@ -22,7 +22,7 @@ module Distribution.PackageDescription.Configuration (
     -- Utils
     parseCondition,
     freeVars,
-    extractCondition,
+    addBuildableCondition,
     mapCondTree,
     mapTreeData,
     mapTreeConds,
@@ -277,8 +277,10 @@ resolveWithFlags dom os arch impl constrs trees checkDeps =
     pdTaggedBuildInfo (Bench _ b) = benchmarkBuildInfo b
     pdTaggedBuildInfo PDNull = mempty
 
--- | Tries to determine under which condition the condition tree
--- is buildable, and will add an additional condition on top accordingly.
+-- | Transforms a 'CondTree' by putting the input under the "then" branch of a
+-- conditional that is True when Buildable is True. If 'addBuildableCondition'
+-- can determine that Buildable is always True, it returns the input unchanged.
+-- If Buildable is always False, it returns the empty 'CondTree'.
 addBuildableCondition :: (Eq v, Monoid a, Monoid c) => (a -> BuildInfo)
                       -> CondTree v c a
                       -> CondTree v c a

diff --git a/cabal-install/Distribution/Client/Dependency/Modular/IndexConversion.hs b/cabal-install/Distribution/Client/Dependency/Modular/IndexConversion.hs
@@ -103,11 +103,15 @@ convSP os arch cinfo strfl (SourcePackage (PackageIdentifier pn pv) gpd _ _pl) =
 -- | Convert a generic package description to a solver-specific 'PInfo'.
 convGPD :: OS -> Arch -> CompilerInfo -> Bool ->
            PI PN -> GenericPackageDescription -> PInfo
-convGPD os arch comp strfl pi
+convGPD os arch cinfo strfl pi
         (GenericPackageDescription pkg flags libs exes tests benchs) =
   let
     fds  = flagInfo strfl flags
-    conv = convBuildableCondTree os arch comp pi fds
+
+    conv :: Monoid a => Component -> (a -> BuildInfo) ->
+            CondTree ConfVar [Dependency] a -> FlaggedDeps Component PN
+    conv comp getInfo = convCondTree os arch cinfo pi fds comp getInfo .
+                        PDC.addBuildableCondition getInfo
   in
     PInfo
       (maybe []    (conv ComponentLib                     libBuildInfo         ) libs    ++
@@ -129,20 +133,6 @@ prefix f fds = [f (concat fds)]
 flagInfo :: Bool -> [PD.Flag] -> FlagInfo
 flagInfo strfl = M.fromList . L.map (\ (MkFlag fn _ b m) -> (fn, FInfo b m (not (strfl || m))))
 
--- | Convert a condition tree to flagged dependencies.
---
--- In addition, tries to determine under which condition the condition tree
--- is buildable, and will add an additional condition on top accordingly.
-convBuildableCondTree :: OS -> Arch -> CompilerInfo -> PI PN -> FlagInfo ->
-                         Component ->
-                         (a -> BuildInfo) ->
-                         CondTree ConfVar [Dependency] a -> FlaggedDeps Component PN
-convBuildableCondTree os arch cinfo pi fds comp getInfo t =
-  case PDC.extractCondition (buildable . getInfo) t of
-    Lit True  -> convCondTree os arch cinfo pi fds comp getInfo t
-    Lit False -> []
-    c         -> convBranch os arch cinfo pi fds comp getInfo (c, t, Nothing)
-
 -- | Convert condition trees to flagged dependencies.
 convCondTree :: OS -> Arch -> CompilerInfo -> PI PN -> FlagInfo ->
                 Component ->