Cabal-syntax/src/Distribution/PackageDescription/Configuration.hs

   1 -- -fno-warn-deprecations for use of Map.foldWithKey
   2 {-# OPTIONS_GHC -fno-warn-deprecations #-}
   3
   4 -----------------------------------------------------------------------------
   5
   6 -- |
   7 -- Module      :  Distribution.PackageDescription.Configuration
   8 -- Copyright   :  Thomas Schilling, 2007
   9 -- License     :  BSD3
  10 --
  11 -- Maintainer  :  cabal-devel@haskell.org
  12 -- Portability :  portable
  13 --
  14 -- This is about the cabal configurations feature. It exports
  15 -- 'finalizePD' and 'flattenPackageDescription' which are
  16 -- functions for converting 'GenericPackageDescription's down to
  17 -- 'PackageDescription's. It has code for working with the tree of conditions
  18 -- and resolving or flattening conditions.
  19 module Distribution.PackageDescription.Configuration
  20   ( finalizePD
  21   , flattenPackageDescription
  22   -- Utils
  23   , parseCondition
  24   , freeVars
  25   , extractCondition
  26   , extractConditions
  27   , addBuildableCondition
  28   , mapCondTree
  29   , mapTreeData
  30   , mapTreeConds
  31   , mapTreeConstrs
  32   , transformAllBuildInfos
  33   , transformAllBuildDepends
  34   , transformAllBuildDependsN
  35   , simplifyWithSysParams
  36   ) where
  37
  38 import Distribution.Compat.Prelude
  39 import Prelude ()
  40
  41 -- lens
  42 import qualified Distribution.Types.BuildInfo.Lens as L
  43 import qualified Distribution.Types.GenericPackageDescription.Lens as L
  44 import qualified Distribution.Types.PackageDescription.Lens as L
  45 import qualified Distribution.Types.SetupBuildInfo.Lens as L
  46
  47 import Distribution.Compat.CharParsing hiding (char)
  48 import qualified Distribution.Compat.CharParsing as P
  49 import Distribution.Compat.Lens
  50 import Distribution.Compiler
  51 import Distribution.PackageDescription
  52 import Distribution.PackageDescription.Utils
  53 import Distribution.Parsec
  54 import Distribution.Pretty
  55 import Distribution.System
  56 import Distribution.Types.Component
  57 import Distribution.Types.ComponentRequestedSpec
  58 import Distribution.Types.DependencyMap
  59 import Distribution.Types.PackageVersionConstraint
  60 import Distribution.Utils.Generic
  61 import Distribution.Utils.Path (sameDirectory)
  62 import Distribution.Version
  63
  64 import qualified Data.Map.Lazy as Map
  65 import Data.Tree (Tree (Node))
  66
  67 ------------------------------------------------------------------------------
  68
  69 -- | Simplify a configuration condition using the OS and arch names.  Returns
  70 --   the names of all the flags occurring in the condition.
  71 simplifyWithSysParams
  72   :: OS
  73   -> Arch
  74   -> CompilerInfo
  75   -> Condition ConfVar
  76   -> (Condition FlagName, [FlagName])
  77 simplifyWithSysParams os arch cinfo cond = (cond', flags)
  78   where
  79     (cond', flags) = simplifyCondition cond interp
  80     interp (OS os') = Right $ os' == os
  81     interp (Arch arch') = Right $ arch' == arch
  82     interp (Impl comp vr)
  83       | matchImpl (compilerInfoId cinfo) = Right True
  84       | otherwise = case compilerInfoCompat cinfo of
  85           -- fixme: treat Nothing as unknown, rather than empty list once we
  86           --        support partial resolution of system parameters
  87           Nothing -> Right False
  88           Just compat -> Right (any matchImpl compat)
  89       where
  90         matchImpl (CompilerId c v) = comp == c && v `withinRange` vr
  91     interp (PackageFlag f) = Left f
  92
  93 -- TODO: Add instances and check
  94 --
  95 -- prop_sC_idempotent cond a o = cond' == cond''
  96 --   where
  97 --     cond'  = simplifyCondition cond a o
  98 --     cond'' = simplifyCondition cond' a o
  99 --
 100 -- prop_sC_noLits cond a o = isLit res || not (hasLits res)
 101 --   where
 102 --     res = simplifyCondition cond a o
 103 --     hasLits (Lit _) = True
 104 --     hasLits (CNot c) = hasLits c
 105 --     hasLits (COr l r) = hasLits l || hasLits r
 106 --     hasLits (CAnd l r) = hasLits l || hasLits r
 107 --     hasLits _ = False
 108 --
 109
 110 -- | Parse a configuration condition from a string.
 111 parseCondition :: CabalParsing m => m (Condition ConfVar)
 112 parseCondition = condOr
 113   where
 114     condOr = sepByNonEmpty condAnd (oper "||") >>= return . foldl1 COr
 115     condAnd = sepByNonEmpty cond (oper "&&") >>= return . foldl1 CAnd
 116     -- TODO: try?
 117     cond =
 118       sp
 119         >> ( boolLiteral
 120               <|> inparens condOr
 121               <|> notCond
 122               <|> osCond
 123               <|> archCond
 124               <|> flagCond
 125               <|> implCond
 126            )
 127     inparens = between (P.char '(' >> sp) (sp >> P.char ')' >> sp)
 128     notCond = P.char '!' >> sp >> cond >>= return . CNot
 129     osCond = string "os" >> sp >> inparens osIdent >>= return . Var
 130     archCond = string "arch" >> sp >> inparens archIdent >>= return . Var
 131     flagCond = string "flag" >> sp >> inparens flagIdent >>= return . Var
 132     implCond = string "impl" >> sp >> inparens implIdent >>= return . Var
 133     boolLiteral = fmap Lit parsec
 134     archIdent = fmap Arch parsec
 135     osIdent = fmap OS parsec
 136     flagIdent = fmap (PackageFlag . mkFlagName . lowercase) (munch1 isIdentChar)
 137     isIdentChar c = isAlphaNum c || c == '_' || c == '-'
 138     oper s = sp >> string s >> sp
 139     sp = spaces
 140     implIdent = do
 141       i <- parsec
 142       vr <- sp >> option anyVersion parsec
 143       return $ Impl i vr
 144
 145 ------------------------------------------------------------------------------
 146
 147 -- | Result of dependency test. Isomorphic to @Maybe d@ but renamed for
 148 --   clarity.
 149 data DepTestRslt d = DepOk | MissingDeps d
 150
 151 instance Semigroup d => Monoid (DepTestRslt d) where
 152   mempty = DepOk
 153   mappend = (<>)
 154
 155 instance Semigroup d => Semigroup (DepTestRslt d) where
 156   DepOk <> x = x
 157   x <> DepOk = x
 158   (MissingDeps d) <> (MissingDeps d') = MissingDeps (d <> d')
 159
 160 -- | Try to find a flag assignment that satisfies the constraints of all trees.
 161 --
 162 -- Returns either the missing dependencies, or a tuple containing the
 163 -- resulting data, the associated dependencies, and the chosen flag
 164 -- assignments.
 165 --
 166 -- In case of failure, the union of the dependencies that led to backtracking
 167 -- on all branches is returned.
 168 -- [TODO: Could also be specified with a function argument.]
 169 --
 170 -- TODO: The current algorithm is rather naive.  A better approach would be to:
 171 --
 172 -- * Rule out possible paths, by taking a look at the associated dependencies.
 173 --
 174 -- * Infer the required values for the conditions of these paths, and
 175 --   calculate the required domains for the variables used in these
 176 --   conditions.  Then picking a flag assignment would be linear (I guess).
 177 --
 178 -- This would require some sort of SAT solving, though, thus it's not
 179 -- implemented unless we really need it.
 180 resolveWithFlags
 181   :: [(FlagName, [Bool])]
 182   -- ^ Domain for each flag name, will be tested in order.
 183   -> ComponentRequestedSpec
 184   -> OS
 185   -- ^ OS where the installed artifacts will run (host OS)
 186   -> Arch
 187   -- ^ Arch where the installed artifacts will run (host Arch)
 188   -> CompilerInfo
 189   -- ^ Compiler information
 190   -> [PackageVersionConstraint]
 191   -- ^ Additional constraints
 192   -> [CondTree ConfVar [Dependency] PDTagged]
 193   -> ([Dependency] -> DepTestRslt [Dependency])
 194   -- ^ Dependency test function.
 195   -> Either [Dependency] (TargetSet PDTagged, FlagAssignment)
 196   -- ^ Either the missing dependencies (error case), or a pair of
 197   -- (set of build targets with dependencies, chosen flag assignments)
 198 resolveWithFlags dom enabled os arch impl constrs trees checkDeps =
 199   either (Left . fromDepMapUnion) Right $ explore (build mempty dom)
 200   where
 201     -- simplify trees by (partially) evaluating all conditions and converting
 202     -- dependencies to dependency maps.
 203     simplifiedTrees :: [CondTree FlagName DependencyMap PDTagged]
 204     simplifiedTrees =
 205       map
 206         ( mapTreeConstrs toDepMap -- convert to maps
 207             . addBuildableConditionPDTagged
 208             . mapTreeConds (fst . simplifyWithSysParams os arch impl)
 209         )
 210         trees
 211
 212     -- @explore@ searches a tree of assignments, backtracking whenever a flag
 213     -- introduces a dependency that cannot be satisfied.  If there is no
 214     -- solution, @explore@ returns the union of all dependencies that caused
 215     -- it to backtrack.  Since the tree is constructed lazily, we avoid some
 216     -- computation overhead in the successful case.
 217     explore
 218       :: Tree FlagAssignment
 219       -> Either DepMapUnion (TargetSet PDTagged, FlagAssignment)
 220     explore (Node flags ts) =
 221       let targetSet =
 222             TargetSet $
 223               flip map simplifiedTrees $
 224                 -- apply additional constraints to all dependencies
 225                 first (`constrainBy` constrs)
 226                   . simplifyCondTree (env flags)
 227           deps = overallDependencies enabled targetSet
 228        in case checkDeps (fromDepMap deps) of
 229             DepOk
 230               | null ts -> Right (targetSet, flags)
 231               | otherwise -> tryAll $ map explore ts
 232             MissingDeps mds -> Left (toDepMapUnion mds)
 233
 234     -- Builds a tree of all possible flag assignments.  Internal nodes
 235     -- have only partial assignments.
 236     build :: FlagAssignment -> [(FlagName, [Bool])] -> Tree FlagAssignment
 237     build assigned [] = Node assigned []
 238     build assigned ((fn, vals) : unassigned) =
 239       Node assigned $ map (\v -> build (insertFlagAssignment fn v assigned) unassigned) vals
 240
 241     tryAll :: [Either DepMapUnion a] -> Either DepMapUnion a
 242     tryAll = foldr mp mz
 243
 244     -- special version of `mplus' for our local purposes
 245     mp :: Either DepMapUnion a -> Either DepMapUnion a -> Either DepMapUnion a
 246     mp m@(Right _) _ = m
 247     mp _ m@(Right _) = m
 248     mp (Left xs) (Left ys) = Left (xs <> ys)
 249
 250     -- `mzero'
 251     mz :: Either DepMapUnion a
 252     mz = Left (DepMapUnion Map.empty)
 253
 254     env :: FlagAssignment -> FlagName -> Either FlagName Bool
 255     env flags flag = (maybe (Left flag) Right . lookupFlagAssignment flag) flags
 256
 257 -- | Transforms a 'CondTree' by putting the input under the "then" branch of a
 258 -- conditional that is True when Buildable is True. If 'addBuildableCondition'
 259 -- can determine that Buildable is always True, it returns the input unchanged.
 260 -- If Buildable is always False, it returns the empty 'CondTree'.
 261 addBuildableCondition
 262   :: (Eq v, Monoid a, Monoid c)
 263   => (a -> BuildInfo)
 264   -> CondTree v c a
 265   -> CondTree v c a
 266 addBuildableCondition getInfo t =
 267   case extractCondition (buildable . getInfo) t of
 268     Lit True -> t
 269     Lit False -> CondNode mempty mempty []
 270     c -> CondNode mempty mempty [condIfThen c t]
 271
 272 -- | This is a special version of 'addBuildableCondition' for the 'PDTagged'
 273 -- type.
 274 --
 275 -- It is not simply a specialisation. It is more complicated than it
 276 -- ought to be because of the way the 'PDTagged' monoid instance works. The
 277 -- @mempty = 'PDNull'@ forgets the component type, which has the effect of
 278 -- completely deleting components that are not buildable.
 279 --
 280 -- See <https://github.com/haskell/cabal/pull/4094> for more details.
 281 addBuildableConditionPDTagged
 282   :: (Eq v, Monoid c)
 283   => CondTree v c PDTagged
 284   -> CondTree v c PDTagged
 285 addBuildableConditionPDTagged t =
 286   case extractCondition (buildable . getInfo) t of
 287     Lit True -> t
 288     Lit False -> deleteConstraints t
 289     c -> CondNode mempty mempty [condIfThenElse c t (deleteConstraints t)]
 290   where
 291     deleteConstraints = mapTreeConstrs (const mempty)
 292
 293     getInfo :: PDTagged -> BuildInfo
 294     getInfo (Lib l) = libBuildInfo l
 295     getInfo (SubComp _ c) = componentBuildInfo c
 296     getInfo PDNull = mempty
 297
 298 -- Note: extracting buildable conditions.
 299 -- --------------------------------------
 300 --
 301 -- If the conditions in a cond tree lead to Buildable being set to False, then
 302 -- none of the dependencies for this cond tree should actually be taken into
 303 -- account. On the other hand, some of the flags may only be decided in the
 304 -- solver, so we cannot necessarily make the decision whether a component is
 305 -- Buildable or not prior to solving.
 306 --
 307 -- What we are doing here is to partially evaluate a condition tree in order to
 308 -- extract the condition under which Buildable is True. The predicate determines
 309 -- whether data under a 'CondTree' is buildable.
 310
 311 -- | Extract conditions matched by the given predicate from all cond trees in a
 312 -- 'GenericPackageDescription'.
 313 extractConditions
 314   :: (BuildInfo -> Bool)
 315   -> GenericPackageDescription
 316   -> [Condition ConfVar]
 317 extractConditions f gpkg =
 318   concat
 319     [ extractCondition (f . libBuildInfo) <$> maybeToList (condLibrary gpkg)
 320     , extractCondition (f . libBuildInfo) . snd <$> condSubLibraries gpkg
 321     , extractCondition (f . buildInfo) . snd <$> condExecutables gpkg
 322     , extractCondition (f . testBuildInfo) . snd <$> condTestSuites gpkg
 323     , extractCondition (f . benchmarkBuildInfo) . snd <$> condBenchmarks gpkg
 324     ]
 325
 326 -- | A map of package constraints that combines version ranges using 'unionVersionRanges'.
 327 newtype DepMapUnion = DepMapUnion {unDepMapUnion :: Map PackageName (VersionRange, NonEmptySet LibraryName)}
 328
 329 instance Semigroup DepMapUnion where
 330   DepMapUnion x <> DepMapUnion y =
 331     DepMapUnion $
 332       Map.unionWith unionVersionRanges' x y
 333
 334 unionVersionRanges'
 335   :: (VersionRange, NonEmptySet LibraryName)
 336   -> (VersionRange, NonEmptySet LibraryName)
 337   -> (VersionRange, NonEmptySet LibraryName)
 338 unionVersionRanges' (vr, cs) (vr', cs') = (unionVersionRanges vr vr', cs <> cs')
 339
 340 toDepMapUnion :: [Dependency] -> DepMapUnion
 341 toDepMapUnion ds =
 342   DepMapUnion $ Map.fromListWith unionVersionRanges' [(p, (vr, cs)) | Dependency p vr cs <- ds]
 343
 344 fromDepMapUnion :: DepMapUnion -> [Dependency]
 345 fromDepMapUnion m = [Dependency p vr cs | (p, (vr, cs)) <- Map.toList (unDepMapUnion m)]
 346
 347 freeVars :: CondTree ConfVar c a -> [FlagName]
 348 freeVars t = [f | PackageFlag f <- freeVars' t]
 349   where
 350     freeVars' (CondNode _ _ ifs) = concatMap compfv ifs
 351     compfv (CondBranch c ct mct) = condfv c ++ freeVars' ct ++ maybe [] freeVars' mct
 352     condfv c = case c of
 353       Var v -> [v]
 354       Lit _ -> []
 355       CNot c' -> condfv c'
 356       COr c1 c2 -> condfv c1 ++ condfv c2
 357       CAnd c1 c2 -> condfv c1 ++ condfv c2
 358
 359 ------------------------------------------------------------------------------
 360
 361 -- | A set of targets with their package dependencies
 362 newtype TargetSet a = TargetSet [(DependencyMap, a)]
 363
 364 -- | Combine the target-specific dependencies in a TargetSet to give the
 365 -- dependencies for the package as a whole.
 366 overallDependencies :: ComponentRequestedSpec -> TargetSet PDTagged -> DependencyMap
 367 overallDependencies enabled (TargetSet targets) = mconcat depss
 368   where
 369     (depss, _) = unzip $ filter (removeDisabledSections . snd) targets
 370     removeDisabledSections :: PDTagged -> Bool
 371     -- UGH. The embedded componentName in the 'Component's here is
 372     -- BLANK.  I don't know whose fault this is but I'll use the tag
 373     -- instead. -- ezyang
 374     removeDisabledSections (Lib _) =
 375       componentNameRequested
 376         enabled
 377         (CLibName LMainLibName)
 378     removeDisabledSections (SubComp t c) =
 379       -- Do NOT use componentName
 380       componentNameRequested enabled $
 381         case c of
 382           CLib _ -> CLibName (LSubLibName t)
 383           CFLib _ -> CFLibName t
 384           CExe _ -> CExeName t
 385           CTest _ -> CTestName t
 386           CBench _ -> CBenchName t
 387     removeDisabledSections PDNull = True
 388
 389 -- | Collect up the targets in a TargetSet of tagged targets, storing the
 390 -- dependencies as we go.
 391 flattenTaggedTargets :: TargetSet PDTagged -> (Maybe Library, [(UnqualComponentName, Component)])
 392 flattenTaggedTargets (TargetSet targets) = foldr untag (Nothing, []) targets
 393   where
 394     untag (depMap, pdTagged) accum = case (pdTagged, accum) of
 395       (Lib _, (Just _, _)) -> userBug "Only one library expected"
 396       (Lib l, (Nothing, comps)) -> (Just $ redoBD l, comps)
 397       (SubComp n c, (mb_lib, comps))
 398         | any ((== n) . fst) comps ->
 399             userBug $ "There exist several components with the same name: '" ++ prettyShow n ++ "'"
 400         | otherwise -> (mb_lib, (n, redoBD c) : comps)
 401       (PDNull, x) -> x -- actually this should not happen, but let's be liberal
 402       where
 403         redoBD :: L.HasBuildInfo a => a -> a
 404         redoBD = set L.targetBuildDepends $ fromDepMap depMap
 405
 406 ------------------------------------------------------------------------------
 407 -- Convert GenericPackageDescription to PackageDescription
 408 --
 409
 410 data PDTagged
 411   = Lib Library
 412   | SubComp UnqualComponentName Component
 413   | PDNull
 414   deriving (Show)
 415
 416 instance Monoid PDTagged where
 417   mempty = PDNull
 418   mappend = (<>)
 419
 420 instance Semigroup PDTagged where
 421   PDNull <> x = x
 422   x <> PDNull = x
 423   Lib l <> Lib l' = Lib (l <> l')
 424   SubComp n x <> SubComp n' x' | n == n' = SubComp n (x <> x')
 425   _ <> _ = cabalBug "Cannot combine incompatible tags"
 426
 427 -- | Create a package description with all configurations resolved.
 428 --
 429 -- This function takes a `GenericPackageDescription` and several environment
 430 -- parameters and tries to generate `PackageDescription` by finding a flag
 431 -- assignment that result in satisfiable dependencies.
 432 --
 433 -- It takes as inputs a not necessarily complete specifications of flags
 434 -- assignments, an optional package index as well as platform parameters.  If
 435 -- some flags are not assigned explicitly, this function will try to pick an
 436 -- assignment that causes this function to succeed.  The package index is
 437 -- optional since on some platforms we cannot determine which packages have
 438 -- been installed before.  When no package index is supplied, every dependency
 439 -- is assumed to be satisfiable, therefore all not explicitly assigned flags
 440 -- will get their default values.
 441 --
 442 -- This function will fail if it cannot find a flag assignment that leads to
 443 -- satisfiable dependencies.  (It will not try alternative assignments for
 444 -- explicitly specified flags.)  In case of failure it will return the missing
 445 -- dependencies that it encountered when trying different flag assignments.
 446 -- On success, it will return the package description and the full flag
 447 -- assignment chosen.
 448 --
 449 -- Note that this drops any stanzas which have @buildable: False@.  While
 450 -- this is arguably the right thing to do, it means we give bad error
 451 -- messages in some situations, see #3858.
 452 finalizePD
 453   :: FlagAssignment
 454   -- ^ Explicitly specified flag assignments
 455   -> ComponentRequestedSpec
 456   -> (Dependency -> Bool)
 457   -- ^ Is a given dependency satisfiable from the set of
 458   -- available packages?  If this is unknown then use
 459   -- True.
 460   -> Platform
 461   -- ^ The 'Arch' and 'OS'
 462   -> CompilerInfo
 463   -- ^ Compiler information
 464   -> [PackageVersionConstraint]
 465   -- ^ Additional constraints
 466   -> GenericPackageDescription
 467   -> Either
 468       [Dependency]
 469       (PackageDescription, FlagAssignment)
 470   -- ^ Either missing dependencies or the resolved package
 471   -- description along with the flag assignments chosen.
 472 finalizePD
 473   userflags
 474   enabled
 475   satisfyDep
 476   (Platform arch os)
 477   impl
 478   constraints
 479   (GenericPackageDescription pkg _ver flags mb_lib0 sub_libs0 flibs0 exes0 tests0 bms0) = do
 480     (targetSet, flagVals) <-
 481       resolveWithFlags flagChoices enabled os arch impl constraints condTrees check
 482     let
 483       (mb_lib, comps) = flattenTaggedTargets targetSet
 484       mb_lib' = fmap libFillInDefaults mb_lib
 485       comps' = flip map comps $ \(n, c) ->
 486         foldComponent
 487           ( \l ->
 488               CLib
 489                 (libFillInDefaults l)
 490                   { libName = LSubLibName n
 491                   , libExposed = False
 492                   }
 493           )
 494           (\l -> CFLib (flibFillInDefaults l){foreignLibName = n})
 495           (\e -> CExe (exeFillInDefaults e){exeName = n})
 496           (\t -> CTest (testFillInDefaults t){testName = n})
 497           (\b -> CBench (benchFillInDefaults b){benchmarkName = n})
 498           c
 499       (sub_libs', flibs', exes', tests', bms') = partitionComponents comps'
 500     return
 501       ( pkg
 502           { library = mb_lib'
 503           , subLibraries = sub_libs'
 504           , foreignLibs = flibs'
 505           , executables = exes'
 506           , testSuites = tests'
 507           , benchmarks = bms'
 508           }
 509       , flagVals
 510       )
 511     where
 512       -- Combine lib, exes, and tests into one list of @CondTree@s with tagged data
 513       condTrees =
 514         maybeToList (fmap (mapTreeData Lib) mb_lib0)
 515           ++ map (\(name, tree) -> mapTreeData (SubComp name . CLib) tree) sub_libs0
 516           ++ map (\(name, tree) -> mapTreeData (SubComp name . CFLib) tree) flibs0
 517           ++ map (\(name, tree) -> mapTreeData (SubComp name . CExe) tree) exes0
 518           ++ map (\(name, tree) -> mapTreeData (SubComp name . CTest) tree) tests0
 519           ++ map (\(name, tree) -> mapTreeData (SubComp name . CBench) tree) bms0
 520
 521       flagChoices = map (\(MkPackageFlag n _ d manual) -> (n, d2c manual n d)) flags
 522       d2c manual n b = case lookupFlagAssignment n userflags of
 523         Just val -> [val]
 524         Nothing
 525           | manual -> [b]
 526           | otherwise -> [b, not b]
 527       -- flagDefaults = map (\(n,x:_) -> (n,x)) flagChoices
 528       check ds =
 529         let missingDeps = filter (not . satisfyDep) ds
 530          in if null missingDeps
 531               then DepOk
 532               else MissingDeps missingDeps
 533
 534 {-
 535 let tst_p = (CondNode [1::Int] [Distribution.Package.Dependency "a" AnyVersion] [])
 536 let tst_p2 = (CondNode [1::Int] [Distribution.Package.Dependency "a" (EarlierVersion (Version [1,0] [])), Distribution.Package.Dependency "a" (LaterVersion (Version [2,0] []))] [])
 537
 538 let p_index = Distribution.Simple.PackageIndex.fromList [Distribution.Package.PackageIdentifier "a" (Version [0,5] []), Distribution.Package.PackageIdentifier "a" (Version [2,5] [])]
 539 let look = not . null . Distribution.Simple.PackageIndex.lookupDependency p_index
 540 let looks ds = mconcat $ map (\d -> if look d then DepOk else MissingDeps [d]) ds
 541 resolveWithFlags [] Distribution.System.Linux Distribution.System.I386 (Distribution.Compiler.GHC,Version [6,8,2] []) [tst_p] looks   ===>  Right ...
 542 resolveWithFlags [] Distribution.System.Linux Distribution.System.I386 (Distribution.Compiler.GHC,Version [6,8,2] []) [tst_p2] looks  ===>  Left ...
 543 -}
 544
 545 -- | Flatten a generic package description by ignoring all conditions and just
 546 -- join the field descriptors into on package description.  Note, however,
 547 -- that this may lead to inconsistent field values, since all values are
 548 -- joined into one field, which may not be possible in the original package
 549 -- description, due to the use of exclusive choices (if ... else ...).
 550 --
 551 -- TODO: One particularly tricky case is defaulting.  In the original package
 552 -- description, e.g., the source directory might either be the default or a
 553 -- certain, explicitly set path.  Since defaults are filled in only after the
 554 -- package has been resolved and when no explicit value has been set, the
 555 -- default path will be missing from the package description returned by this
 556 -- function.
 557 flattenPackageDescription :: GenericPackageDescription -> PackageDescription
 558 flattenPackageDescription
 559   (GenericPackageDescription pkg _ _ mlib0 sub_libs0 flibs0 exes0 tests0 bms0) =
 560     pkg
 561       { library = mlib
 562       , subLibraries = reverse sub_libs
 563       , foreignLibs = reverse flibs
 564       , executables = reverse exes
 565       , testSuites = reverse tests
 566       , benchmarks = reverse bms
 567       }
 568     where
 569       mlib = f <$> mlib0
 570         where
 571           f lib = (libFillInDefaults . fst . ignoreConditions $ lib){libName = LMainLibName}
 572       sub_libs = flattenLib <$> sub_libs0
 573       flibs = flattenFLib <$> flibs0
 574       exes = flattenExe <$> exes0
 575       tests = flattenTst <$> tests0
 576       bms = flattenBm <$> bms0
 577       flattenLib (n, t) =
 578         libFillInDefaults $
 579           (fst $ ignoreConditions t)
 580             { libName = LSubLibName n
 581             , libExposed = False
 582             }
 583       flattenFLib (n, t) =
 584         flibFillInDefaults $
 585           (fst $ ignoreConditions t)
 586             { foreignLibName = n
 587             }
 588       flattenExe (n, t) =
 589         exeFillInDefaults $
 590           (fst $ ignoreConditions t)
 591             { exeName = n
 592             }
 593       flattenTst (n, t) =
 594         testFillInDefaults $
 595           (fst $ ignoreConditions t)
 596             { testName = n
 597             }
 598       flattenBm (n, t) =
 599         benchFillInDefaults $
 600           (fst $ ignoreConditions t)
 601             { benchmarkName = n
 602             }
 603
 604 -- This is in fact rather a hack.  The original version just overrode the
 605 -- default values, however, when adding conditions we had to switch to a
 606 -- modifier-based approach.  There, nothing is ever overwritten, but only
 607 -- joined together.
 608 --
 609 -- This is the cleanest way i could think of, that doesn't require
 610 -- changing all field parsing functions to return modifiers instead.
 611 libFillInDefaults :: Library -> Library
 612 libFillInDefaults lib@(Library{libBuildInfo = bi}) =
 613   lib{libBuildInfo = biFillInDefaults bi}
 614
 615 flibFillInDefaults :: ForeignLib -> ForeignLib
 616 flibFillInDefaults flib@(ForeignLib{foreignLibBuildInfo = bi}) =
 617   flib{foreignLibBuildInfo = biFillInDefaults bi}
 618
 619 exeFillInDefaults :: Executable -> Executable
 620 exeFillInDefaults exe@(Executable{buildInfo = bi}) =
 621   exe{buildInfo = biFillInDefaults bi}
 622
 623 testFillInDefaults :: TestSuite -> TestSuite
 624 testFillInDefaults tst@(TestSuite{testBuildInfo = bi}) =
 625   tst{testBuildInfo = biFillInDefaults bi}
 626
 627 benchFillInDefaults :: Benchmark -> Benchmark
 628 benchFillInDefaults bm@(Benchmark{benchmarkBuildInfo = bi}) =
 629   bm{benchmarkBuildInfo = biFillInDefaults bi}
 630
 631 biFillInDefaults :: BuildInfo -> BuildInfo
 632 biFillInDefaults bi =
 633   if null (hsSourceDirs bi)
 634     then bi{hsSourceDirs = [sameDirectory]}
 635     else bi
 636
 637 -- Walk a 'GenericPackageDescription' and apply @onBuildInfo@/@onSetupBuildInfo@
 638 -- to all nested 'BuildInfo'/'SetupBuildInfo' values.
 639 transformAllBuildInfos
 640   :: (BuildInfo -> BuildInfo)
 641   -> (SetupBuildInfo -> SetupBuildInfo)
 642   -> GenericPackageDescription
 643   -> GenericPackageDescription
 644 transformAllBuildInfos onBuildInfo onSetupBuildInfo =
 645   over L.traverseBuildInfos onBuildInfo
 646     . over (L.packageDescription . L.setupBuildInfo . traverse) onSetupBuildInfo
 647
 648 -- | Walk a 'GenericPackageDescription' and apply @f@ to all nested
 649 -- @build-depends@ fields.
 650 transformAllBuildDepends
 651   :: (Dependency -> Dependency)
 652   -> GenericPackageDescription
 653   -> GenericPackageDescription
 654 transformAllBuildDepends f =
 655   over (L.traverseBuildInfos . L.targetBuildDepends . traverse) f
 656     . over (L.packageDescription . L.setupBuildInfo . traverse . L.setupDepends . traverse) f
 657     -- cannot be point-free as normal because of higher rank
 658     . over (\f' -> L.allCondTrees $ traverseCondTreeC f') (map f)
 659
 660 -- | Walk a 'GenericPackageDescription' and apply @f@ to all nested
 661 -- @build-depends@ fields.
 662 transformAllBuildDependsN
 663   :: ([Dependency] -> [Dependency])
 664   -> GenericPackageDescription
 665   -> GenericPackageDescription
 666 transformAllBuildDependsN f =
 667   over (L.traverseBuildInfos . L.targetBuildDepends) f
 668     . over (L.packageDescription . L.setupBuildInfo . traverse . L.setupDepends) f
 669     -- cannot be point-free as normal because of higher rank
 670     . over (\f' -> L.allCondTrees $ traverseCondTreeC f') f