From 4e8777e19e160d320cdf5823e47597f862c4e088 Mon Sep 17 00:00:00 2001 From: Kristen Kozak Date: Thu, 28 Jan 2016 15:49:54 -0800 Subject: [PATCH] Refactor #3082 to reduce code duplication and improve Haddock comment. --- .../PackageDescription/Configuration.hs | 8 ++++--- .../Dependency/Modular/IndexConversion.hs | 23 ++++++------------- 2 files changed, 12 insertions(+), 19 deletions(-) diff --git a/Cabal/src/Distribution/PackageDescription/Configuration.hs b/Cabal/src/Distribution/PackageDescription/Configuration.hs index 51042232c2e..4367bd8b326 100644 --- 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 index ab74493e30a..1b26d7fd700 100644 --- a/cabal-install/Distribution/Client/Dependency/Modular/IndexConversion.hs +++ b/cabal-install/Distribution/Client/Dependency/Modular/IndexConversion.hs @@ -5,6 +5,7 @@ module Distribution.Client.Dependency.Modular.IndexConversion import Data.List as L import Data.Map as M import Data.Maybe +import Data.Monoid as Mon import Prelude hiding (pi) import qualified Distribution.Client.PackageIndex as CI @@ -103,11 +104,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 :: Mon.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 +134,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 ->