{-# OPTIONS -cpp #-}
-- OPTIONS required for ghc-6.4.x compat, and must appear first
{-# LANGUAGE CPP #-}
-- -fno-warn-deprecations for use of Map.foldWithKey
{-# OPTIONS_GHC -cpp -fno-warn-deprecations #-}
{-# OPTIONS_NHC98 -cpp #-}
{-# OPTIONS_JHC -fcpp #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Configuration
-- Copyright   :  Thomas Schilling, 2007
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- This is about the cabal configurations feature. It exports
-- 'finalizePackageDescription' and 'flattenPackageDescription' which are
-- functions for converting 'GenericPackageDescription's down to
-- 'PackageDescription's. It has code for working with the tree of conditions
-- and resolving or flattening conditions.

{- All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:

    * Redistributions of source code must retain the above copyright
      notice, this list of conditions and the following disclaimer.

    * Redistributions in binary form must reproduce the above
      copyright notice, this list of conditions and the following
      disclaimer in the documentation and/or other materials provided
      with the distribution.

    * Neither the name of Isaac Jones nor the names of other
      contributors may be used to endorse or promote products derived
      from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}

module Distribution.PackageDescription.Configuration (
    finalizePackageDescription,
    flattenPackageDescription,

    -- Utils
    parseCondition,
    freeVars,
    mapCondTree,
    mapTreeData,
    mapTreeConds,
    mapTreeConstrs,
  ) where

import Distribution.Package
         ( PackageName, Dependency(..) )
import Distribution.PackageDescription
         ( GenericPackageDescription(..), PackageDescription(..)
         , Library(..), Executable(..), BuildInfo(..)
         , Flag(..), FlagName(..), FlagAssignment
         , CondTree(..), ConfVar(..), Condition(..), TestSuite(..) )
import Distribution.Version
         ( VersionRange, anyVersion, intersectVersionRanges, withinRange )
import Distribution.Compiler
         ( CompilerId(CompilerId) )
import Distribution.System
         ( Platform(..), OS, Arch )
import Distribution.Simple.Utils
         ( currentDir, lowercase )

import Distribution.Text
         ( Text(parse) )
import Distribution.Compat.ReadP as ReadP hiding ( char )
import Control.Arrow (first)
import qualified Distribution.Compat.ReadP as ReadP ( char )

import Data.Char ( isAlphaNum )
import Data.Maybe ( catMaybes, maybeToList )
import Data.Map ( Map, fromListWith, toList )
import qualified Data.Map as Map
import Data.Monoid

#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ < 606)
import qualified Text.Read as R
import qualified Text.Read.Lex as L
#endif

------------------------------------------------------------------------------

-- | Simplify the condition and return its free variables.
simplifyCondition :: Condition c
                  -> (c -> Either d Bool)   -- ^ (partial) variable assignment
                  -> (Condition d, [d])
simplifyCondition cond i = fv :: Condition t -> (Condition t, [t])fv (.) :: (b -> c) -> (a -> b) -> a -> c. walk :: Condition c -> Condition dwalk ($) :: (a -> b) -> a -> b$ cond :: Condition ConfVarcond
  where
    walk cnd = case cnd :: Condition vcnd of
      Var v   -> either :: (a -> c) -> (b -> c) -> Either a b -> ceither Var :: c -> Condition cVar Lit :: Bool -> Condition cLit (i :: c -> Either d Booli v :: Boolv)
      Lit b   -> Lit :: Bool -> Condition cLit b :: Map PackageName VersionRangeb
      CNot c  -> case walk :: Condition c -> Condition dwalk c :: Condition cc of
                   Lit True -> Lit :: Bool -> Condition cLit False :: BoolFalse
                   Lit False -> Lit :: Bool -> Condition cLit True :: BoolTrue
                   c' -> CNot :: Condition c -> Condition cCNot c' :: Condition dc'
      COr c d -> case (walk :: Condition c -> Condition dwalk c :: Condition cc, walk :: Condition c -> Condition dwalk d :: dd) of
                   (Lit False, d') -> d' :: dd'
                   (Lit True, _)   -> Lit :: Bool -> Condition cLit True :: BoolTrue
                   (c', Lit False) -> c' :: Condition dc'
                   (_, Lit True)   -> Lit :: Bool -> Condition cLit True :: BoolTrue
                   (c',d')         -> COr :: Condition c -> Condition c -> Condition cCOr c' :: Condition dc' d' :: dd'
      CAnd c d -> case (walk :: Condition c -> Condition dwalk c :: Condition cc, walk :: Condition c -> Condition dwalk d :: dd) of
                    (Lit False, _) -> Lit :: Bool -> Condition cLit False :: BoolFalse
                    (Lit True, d') -> d' :: dd'
                    (_, Lit False) -> Lit :: Bool -> Condition cLit False :: BoolFalse
                    (c', Lit True) -> c' :: Condition dc'
                    (c',d')        -> CAnd :: Condition c -> Condition c -> Condition cCAnd c' :: Condition dc' d' :: dd'
    -- gather free vars
    fv c = (c :: Condition cc, fv' :: Condition t -> [t]fv' c :: Condition cc)
    fv' c = case c :: Condition cc of
      Var v     -> [v :: Boolv]
      Lit _      -> [] :: [a][]
      CNot c'    -> fv' :: Condition t -> [t]fv' c' :: Condition dc'
      COr c1 c2  -> fv' :: Condition t -> [t]fv' c1 :: Condition tc1 (++) :: [a] -> [a] -> [a]++ fv' :: Condition t -> [t]fv' c2 :: Condition tc2
      CAnd c1 c2 -> fv' :: Condition t -> [t]fv' c1 :: Condition tc1 (++) :: [a] -> [a] -> [a]++ fv' :: Condition t -> [t]fv' c2 :: Condition tc2

-- | Simplify a configuration condition using the os and arch names.  Returns
--   the names of all the flags occurring in the condition.
simplifyWithSysParams :: OS -> Arch -> CompilerId -> Condition ConfVar
                      -> (Condition FlagName, [FlagName])
simplifyWithSysParams os arch (CompilerId comp compVer) cond = (cond' :: Condition FlagNamecond', flags :: [Flag]flags)
  where
    (cond', flags) = simplifyCondition ::
  Condition c -> (c -> Either d Bool) -> (Condition d, [d])simplifyCondition cond :: Condition ConfVarcond interp :: ConfVar -> Either FlagName Boolinterp
    interp (OS os')    = Right :: b -> Either a bRight ($) :: (a -> b) -> a -> b$ os' :: OSos' (==) :: Eq a => a -> a -> Bool== os :: OSos
    interp (Arch arch') = Right :: b -> Either a bRight ($) :: (a -> b) -> a -> b$ arch' :: Archarch' (==) :: Eq a => a -> a -> Bool== arch :: Archarch
    interp (Impl comp' vr) = Right :: b -> Either a bRight ($) :: (a -> b) -> a -> b$ comp' :: CompilerFlavorcomp' (==) :: Eq a => a -> a -> Bool== comp :: CompilerFlavorcomp
                                  (&&) :: Bool -> Bool -> Bool&& compVer :: VersioncompVer withinRange :: Version -> VersionRange -> Bool`withinRange` vr :: VersionRangevr
    interp (Flag  f)   = Left :: a -> Either a bLeft f :: FlagNamef

-- TODO: Add instances and check
--
-- prop_sC_idempotent cond a o = cond' == cond''
--   where
--     cond'  = simplifyCondition cond a o
--     cond'' = simplifyCondition cond' a o
--
-- prop_sC_noLits cond a o = isLit res || not (hasLits res)
--   where
--     res = simplifyCondition cond a o
--     hasLits (Lit _) = True
--     hasLits (CNot c) = hasLits c
--     hasLits (COr l r) = hasLits l || hasLits r
--     hasLits (CAnd l r) = hasLits l || hasLits r
--     hasLits _ = False
--

-- | Parse a configuration condition from a string.
parseCondition :: ReadP r (Condition ConfVar)
parseCondition = condOr :: Parser r Char (Condition ConfVar)condOr
  where
    condOr   = sepBy1 :: ReadP r a -> ReadP r sep -> ReadP r [a]sepBy1 condAnd :: ReadP r (Condition ConfVar)condAnd (oper :: String -> Parser r Char ()oper "||") (>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b>>= return :: Monad m => forall a. a -> m areturn (.) :: (b -> c) -> (a -> b) -> a -> c. foldl1 :: (a -> a -> a) -> [a] -> afoldl1 COr :: Condition c -> Condition c -> Condition cCOr
    condAnd  = sepBy1 :: ReadP r a -> ReadP r sep -> ReadP r [a]sepBy1 cond :: Condition ConfVarcond (oper :: String -> Parser r Char ()oper "&&")(>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b>>= return :: Monad m => forall a. a -> m areturn (.) :: (b -> c) -> (a -> b) -> a -> c. foldl1 :: (a -> a -> a) -> [a] -> afoldl1 CAnd :: Condition c -> Condition c -> Condition cCAnd
    cond     = sp :: ReadP r ()sp (>>) :: Monad m => forall a b. m a -> m b -> m b>> (boolLiteral :: Parser r Char (Condition c)boolLiteral (+++) :: ReadP r a -> ReadP r a -> ReadP r a+++ inparens :: ReadP r a -> ReadP r ainparens condOr :: Parser r Char (Condition ConfVar)condOr (+++) :: ReadP r a -> ReadP r a -> ReadP r a+++ notCond :: ReadP r (Condition ConfVar)notCond (+++) :: ReadP r a -> ReadP r a -> ReadP r a+++ osCond :: Parser r Char (Condition ConfVar)osCond
                      (+++) :: ReadP r a -> ReadP r a -> ReadP r a+++ archCond :: Parser r Char (Condition ConfVar)archCond (+++) :: ReadP r a -> ReadP r a -> ReadP r a+++ flagCond :: Parser r Char (Condition ConfVar)flagCond (+++) :: ReadP r a -> ReadP r a -> ReadP r a+++ implCond :: Parser r Char (Condition ConfVar)implCond )
    inparens   = between :: ReadP r open -> ReadP r close -> ReadP r a -> ReadP r abetween (char :: Char -> ReadP r CharReadP.char '(' (>>) :: Monad m => forall a b. m a -> m b -> m b>> sp :: ReadP r ()sp) (sp :: ReadP r ()sp (>>) :: Monad m => forall a b. m a -> m b -> m b>> char :: Char -> ReadP r CharReadP.char ')' (>>) :: Monad m => forall a b. m a -> m b -> m b>> sp :: ReadP r ()sp)
    notCond  = char :: Char -> ReadP r CharReadP.char '!' (>>) :: Monad m => forall a b. m a -> m b -> m b>> sp :: ReadP r ()sp (>>) :: Monad m => forall a b. m a -> m b -> m b>> cond :: Condition ConfVarcond (>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b>>= return :: Monad m => forall a. a -> m areturn (.) :: (b -> c) -> (a -> b) -> a -> c. CNot :: Condition c -> Condition cCNot
    osCond   = string :: String -> ReadP r Stringstring "os" (>>) :: Monad m => forall a b. m a -> m b -> m b>> sp :: ReadP r ()sp (>>) :: Monad m => forall a b. m a -> m b -> m b>> inparens :: ReadP r a -> ReadP r ainparens osIdent :: Parser r Char ConfVarosIdent (>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b>>= return :: Monad m => forall a. a -> m areturn (.) :: (b -> c) -> (a -> b) -> a -> c. Var :: c -> Condition cVar
    archCond = string :: String -> ReadP r Stringstring "arch" (>>) :: Monad m => forall a b. m a -> m b -> m b>> sp :: ReadP r ()sp (>>) :: Monad m => forall a b. m a -> m b -> m b>> inparens :: ReadP r a -> ReadP r ainparens archIdent :: Parser r Char ConfVararchIdent (>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b>>= return :: Monad m => forall a. a -> m areturn (.) :: (b -> c) -> (a -> b) -> a -> c. Var :: c -> Condition cVar
    flagCond = string :: String -> ReadP r Stringstring "flag" (>>) :: Monad m => forall a b. m a -> m b -> m b>> sp :: ReadP r ()sp (>>) :: Monad m => forall a b. m a -> m b -> m b>> inparens :: ReadP r a -> ReadP r ainparens flagIdent :: Parser r Char ConfVarflagIdent (>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b>>= return :: Monad m => forall a. a -> m areturn (.) :: (b -> c) -> (a -> b) -> a -> c. Var :: c -> Condition cVar
    implCond = string :: String -> ReadP r Stringstring "impl" (>>) :: Monad m => forall a b. m a -> m b -> m b>> sp :: ReadP r ()sp (>>) :: Monad m => forall a b. m a -> m b -> m b>> inparens :: ReadP r a -> ReadP r ainparens implIdent :: Parser r Char ConfVarimplIdent (>>=) :: Monad m => forall a b. m a -> (a -> m b) -> m b>>= return :: Monad m => forall a. a -> m areturn (.) :: (b -> c) -> (a -> b) -> a -> c. Var :: c -> Condition cVar
    boolLiteral   = fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap Lit :: Bool -> Condition cLit  parse :: Text a => forall r. ReadP r aparse
    archIdent     = fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap Arch :: Arch -> ConfVarArch parse :: Text a => forall r. ReadP r aparse
    osIdent       = fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap OS :: OS -> ConfVarOS   parse :: Text a => forall r. ReadP r aparse
    flagIdent     = fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap (Flag :: FlagName -> ConfVarFlag (.) :: (b -> c) -> (a -> b) -> a -> c. FlagName :: String -> FlagNameFlagName (.) :: (b -> c) -> (a -> b) -> a -> c. lowercase :: String -> Stringlowercase) (munch1 :: (Char -> Bool) -> ReadP r Stringmunch1 isIdentChar :: Char -> BoolisIdentChar)
    isIdentChar c = isAlphaNum :: Char -> BoolisAlphaNum c :: Condition cc (||) :: Bool -> Bool -> Bool|| c :: Condition cc (==) :: Eq a => a -> a -> Bool== '_' (||) :: Bool -> Bool -> Bool|| c :: Condition cc (==) :: Eq a => a -> a -> Bool== '-'
    oper s        = sp :: ReadP r ()sp (>>) :: Monad m => forall a b. m a -> m b -> m b>> string :: String -> ReadP r Stringstring s :: Strings (>>) :: Monad m => forall a b. m a -> m b -> m b>> sp :: ReadP r ()sp
    sp            = skipSpaces :: ReadP r ()skipSpaces
    implIdent     = do i <- parse :: Text a => forall r. ReadP r aparse
                       vr <- sp :: ReadP r ()sp (>>) :: Monad m => forall a b. m a -> m b -> m b>> option :: a -> ReadP r a -> ReadP r aoption anyVersion :: VersionRangeanyVersion parse :: Text a => forall r. ReadP r aparse
                       return :: Monad m => forall a. a -> m areturn ($) :: (a -> b) -> a -> b$ Impl :: CompilerFlavor -> VersionRange -> ConfVarImpl i :: c -> Either d Booli vr :: VersionRangevr

------------------------------------------------------------------------------

mapCondTree :: (a -> b) -> (c -> d) -> (Condition v -> Condition w)
            -> CondTree v c a -> CondTree w d b
mapCondTree fa fc fcnd (CondNode a c ifs) =
    CondNode ::
  a
  -> c
  -> [(Condition v, CondTree v c a, Maybe (CondTree v c a))]
  -> CondTree v c aCondNode (fa :: a -> bfa a :: Map PackageName VersionRangea) (fc :: c -> dfc c :: Condition cc) (map :: (a -> b) -> [a] -> [b]map g ::
  (Condition v, CondTree v c a, f (CondTree v c a))
  -> (Condition w, CondTree w d b, f (CondTree w d b))g ifs :: [(Condition v, CondTree v d a, Maybe (CondTree v d a))]ifs)
  where
    g (cnd, t, me) = (fcnd :: Condition v -> Condition wfcnd cnd :: Condition vcnd, mapCondTree ::
  (a -> b)
  -> (c -> d)
  -> (Condition v -> Condition w)
  -> CondTree v c a
  -> CondTree w d bmapCondTree fa :: a -> bfa fc :: c -> dfc fcnd :: Condition v -> Condition wfcnd t :: TestSuitet,
                           fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap (mapCondTree ::
  (a -> b)
  -> (c -> d)
  -> (Condition v -> Condition w)
  -> CondTree v c a
  -> CondTree w d bmapCondTree fa :: a -> bfa fc :: c -> dfc fcnd :: Condition v -> Condition wfcnd) me :: Maybe (CondTree v d a)me)

mapTreeConstrs :: (c -> d) -> CondTree v c a -> CondTree v d a
mapTreeConstrs f = mapCondTree ::
  (a -> b)
  -> (c -> d)
  -> (Condition v -> Condition w)
  -> CondTree v c a
  -> CondTree w d bmapCondTree id :: a -> aid f :: FlagNamef id :: a -> aid

mapTreeConds :: (Condition v -> Condition w) -> CondTree v c a -> CondTree w c a
mapTreeConds f = mapCondTree ::
  (a -> b)
  -> (c -> d)
  -> (Condition v -> Condition w)
  -> CondTree v c a
  -> CondTree w d bmapCondTree id :: a -> aid id :: a -> aid f :: FlagNamef

mapTreeData :: (a -> b) -> CondTree v c a -> CondTree v c b
mapTreeData f = mapCondTree ::
  (a -> b)
  -> (c -> d)
  -> (Condition v -> Condition w)
  -> CondTree v c a
  -> CondTree w d bmapCondTree f :: FlagNamef id :: a -> aid id :: a -> aid

-- | Result of dependency test. Isomorphic to @Maybe d@ but renamed for
--   clarity.
data DepTestRslt d = DepOk | MissingDeps d

instance ($cmappend) ::
  Monoid d => DepTestRslt d -> DepTestRslt d -> DepTestRslt dMonoid d => Monoid (DepTestRslt d) where
    mempty = DepOk :: DepTestRslt dDepOk
    mappend DepOk x = x :: DepTestRslt dx
    mappend x DepOk = x :: DepTestRslt dx
    mappend (MissingDeps d) (MissingDeps d') = MissingDeps :: d -> DepTestRslt dMissingDeps (d :: dd mappend :: Monoid a => a -> a -> a`mappend` d' :: dd')


data BT a = BTN a | BTB (BT a) (BT a)  -- very simple binary tree


-- | Try to find a flag assignment that satisfies the constaints of all trees.
--
-- Returns either the missing dependencies, or a tuple containing the
-- resulting data, the associated dependencies, and the chosen flag
-- assignments.
--
-- In case of failure, the _smallest_ number of of missing dependencies is
-- returned. [TODO: Could also be specified with a function argument.]
--
-- TODO: The current algorithm is rather naive.  A better approach would be to:
--
-- * Rule out possible paths, by taking a look at the associated dependencies.
--
-- * Infer the required values for the conditions of these paths, and
--   calculate the required domains for the variables used in these
--   conditions.  Then picking a flag assignment would be linear (I guess).
--
-- This would require some sort of SAT solving, though, thus it's not
-- implemented unless we really need it.
--
resolveWithFlags ::
     [(FlagName,[Bool])]
        -- ^ Domain for each flag name, will be tested in order.
  -> OS      -- ^ OS as returned by Distribution.System.buildOS
  -> Arch    -- ^ Arch as returned by Distribution.System.buildArch
  -> CompilerId -- ^ Compiler flavour + version
  -> [Dependency]  -- ^ Additional constraints
  -> [CondTree ConfVar [Dependency] PDTagged]
  -> ([Dependency] -> DepTestRslt [Dependency])  -- ^ Dependency test function.
  -> Either [Dependency] (TargetSet PDTagged, FlagAssignment)
       -- ^ Either the missing dependencies (error case), or a pair of
       -- (set of build targets with dependencies, chosen flag assignments)
resolveWithFlags dom os arch impl constrs trees checkDeps =
    case try ::
  [(FlagName, [Bool])]
  -> [(FlagName, Bool)]
  -> Either
       (BT [Dependency]) (TargetSet PDTagged, [(FlagName, Bool)])try dom :: [(FlagName, [Bool])]dom [] :: [a][] of
      Right r -> Right :: b -> Either a bRight r :: [t]r
      Left dbt -> Left :: a -> Either a bLeft ($) :: (a -> b) -> a -> b$ findShortest :: BT [t] -> [t]findShortest dbt :: BT [Dependency]dbt
  where
    extraConstrs = toDepMap :: [Dependency] -> DependencyMaptoDepMap constrs :: [Dependency]constrs

    -- simplify trees by (partially) evaluating all conditions and converting
    -- dependencies to dependency maps.
    simplifiedTrees = map :: (a -> b) -> [a] -> [b]map ( mapTreeConstrs :: (c -> d) -> CondTree v c a -> CondTree v d amapTreeConstrs toDepMap :: [Dependency] -> DependencyMaptoDepMap  -- convert to maps
                          (.) :: (b -> c) -> (a -> b) -> a -> c. mapTreeConds ::
  (Condition v -> Condition w) -> CondTree v c a -> CondTree w c amapTreeConds (fst :: (a, b) -> afst (.) :: (b -> c) -> (a -> b) -> a -> c. simplifyWithSysParams ::
  OS
  -> Arch
  -> CompilerId
  -> Condition ConfVar
  -> (Condition FlagName, [FlagName])simplifyWithSysParams os :: OSos arch :: Archarch impl :: CompilerIdimpl))
                          trees :: [CondTree ConfVar [Dependency] PDTagged]trees

    -- @try@ recursively tries all possible flag assignments in the domain and
    -- either succeeds or returns a binary tree with the missing dependencies
    -- encountered in each run.  Since the tree is constructed lazily, we
    -- avoid some computation overhead in the successful case.
    try [] flags =
        let targetSet = TargetSet :: [(DependencyMap, a)] -> TargetSet aTargetSet ($) :: (a -> b) -> a -> b$ flip :: (a -> b -> c) -> b -> a -> cflip map :: (a -> b) -> [a] -> [b]map simplifiedTrees :: [CondTree FlagName DependencyMap PDTagged]simplifiedTrees ($) :: (a -> b) -> a -> b$
                -- apply additional constraints to all dependencies
                first :: Arrow a => forall b c d. a b c -> a (b, d) (c, d)first (constrainBy :: DependencyMap -> DependencyMap -> DependencyMap`constrainBy` extraConstrs :: DependencyMapextraConstrs) (.) :: (b -> c) -> (a -> b) -> a -> c.
                simplifyCondTree ::
  (Monoid a, Monoid d) =>
  (v -> Either v Bool) -> CondTree v d a -> (d, a)simplifyCondTree (env :: Eq a => [(a, b)] -> a -> Either a benv flags :: [Flag]flags)
            deps = overallDependencies :: TargetSet PDTagged -> DependencyMapoverallDependencies targetSet :: TargetSet PDTaggedtargetSet
        in case checkDeps :: [Dependency] -> DepTestRslt [Dependency]checkDeps (fromDepMap :: DependencyMap -> [Dependency]fromDepMap deps :: DependencyMapdeps) of
             DepOk           -> Right :: b -> Either a bRight (targetSet :: TargetSet PDTaggedtargetSet, flags :: [Flag]flags)
             MissingDeps mds -> Left :: a -> Either a bLeft (BTN :: a -> BT aBTN mds :: [Dependency]mds)

    try ((n, vals):rest) flags =
        tryAll :: [Either (BT [a]) b] -> Either (BT [a]) btryAll ($) :: (a -> b) -> a -> b$ map :: (a -> b) -> [a] -> [b]map (\v -> try ::
  [(FlagName, [Bool])]
  -> [(FlagName, Bool)]
  -> Either
       (BT [Dependency]) (TargetSet PDTagged, [(FlagName, Bool)])try rest :: [(FlagName, [Bool])]rest ((n :: Stringn, v :: Boolv)(:) :: a -> [a] -> [a]:flags :: [Flag]flags)) vals :: [Bool]vals

    tryAll = foldr :: (a -> b -> b) -> b -> [a] -> bfoldr mp :: Either (BT a) b -> Either (BT a) b -> Either (BT a) bmp mz :: Either (BT [a]) bmz

    -- special version of `mplus' for our local purposes
    mp (Left xs)   (Left ys)   = (Left :: a -> Either a bLeft (BTB :: BT a -> BT a -> BT aBTB xs :: BT axs ys :: BT ays))
    mp (Left _)    m@(Right _) = m :: Either (BT a) bm
    mp m@(Right _) _           = m :: Either (BT a) bm

    -- `mzero'
    mz = Left :: a -> Either a bLeft (BTN :: a -> BT aBTN [] :: [a][])

    env flags flag = (maybe :: b -> (a -> b) -> Maybe a -> bmaybe (Left :: a -> Either a bLeft flag :: aflag) Right :: b -> Either a bRight (.) :: (b -> c) -> (a -> b) -> a -> c. lookup :: Eq a => a -> [(a, b)] -> Maybe blookup flag :: aflag) flags :: [Flag]flags

    -- for the error case we inspect our lazy tree of missing dependencies and
    -- pick the shortest list of missing dependencies
    findShortest (BTN x) = x :: DepTestRslt dx
    findShortest (BTB lt rt) =
        let l = findShortest :: BT [t] -> [t]findShortest lt :: BT [t]lt
            r = findShortest :: BT [t] -> [t]findShortest rt :: BT [t]rt
        in case (l :: Libraryl,r :: [t]r) of
             ([], xs) -> xs :: BT axs  -- [] is too short
             (xs, []) -> xs :: BT axs
             ([x], _) -> [x :: DepTestRslt dx] -- single elem is optimum
             (_, [x]) -> [x :: DepTestRslt dx]
             (xs, ys) -> if lazyLengthCmp :: [t] -> [t1] -> BoollazyLengthCmp xs :: BT axs ys :: BT ays
                         then xs :: BT axs else ys :: BT ays
    -- lazy variant of @\xs ys -> length xs <= length ys@
    lazyLengthCmp [] _ = True :: BoolTrue
    lazyLengthCmp _ [] = False :: BoolFalse
    lazyLengthCmp (_:xs) (_:ys) = lazyLengthCmp :: [t] -> [t1] -> BoollazyLengthCmp xs :: BT axs ys :: BT ays

-- | A map of dependencies.  Newtyped since the default monoid instance is not
--   appropriate.  The monoid instance uses 'intersectVersionRanges'.
newtype unDependencyMap :: Map PackageName VersionRangeDependencyMap = DependencyMap { unDependencyMap :: Map PackageName VersionRange }
#if !defined(__GLASGOW_HASKELL__) || (__GLASGOW_HASKELL__ >= 606)
  deriving (D:Show ::
  (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> T:Show aShow, D:Read ::
  (Int -> ReadS a)
  -> ReadS [a]
  -> ReadPrec a
  -> ReadPrec [a]
  -> T:Read aRead)
#else
-- The Show/Read instance for Data.Map in ghc-6.4 is useless
-- so we have to re-implement it here:
instance Show DependencyMap where
  showsPrec d (DependencyMap m) =
      showParen (d > 10) (showString "DependencyMap" . shows (M.toList m))

instance Read DependencyMap where
  readPrec = parens $ R.prec 10 $ do
    R.Ident "DependencyMap" <- R.lexP
    xs <- R.readPrec
    return (DependencyMap (M.fromList xs))
      where parens :: R.ReadPrec a -> R.ReadPrec a
            parens p = optional
             where
               optional  = p R.+++ mandatory
               mandatory = paren optional

            paren :: R.ReadPrec a -> R.ReadPrec a
            paren p = do L.Punc "(" <- R.lexP
                         x          <- R.reset p
                         L.Punc ")" <- R.lexP
                         return x

  readListPrec = R.readListPrecDefault
#endif

instance ($cmappend) ::
  Monoid d => DepTestRslt d -> DepTestRslt d -> DepTestRslt dMonoid DependencyMap where
    mempty = DependencyMap :: Map PackageName VersionRange -> DependencyMapDependencyMap empty :: Map k aMap.empty
    (DependencyMap a) `mappend` (DependencyMap b) =
        DependencyMap :: Map PackageName VersionRange -> DependencyMapDependencyMap (unionWith ::
  Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k aMap.unionWith intersectVersionRanges ::
  VersionRange -> VersionRange -> VersionRangeintersectVersionRanges a :: Map PackageName VersionRangea b :: Map PackageName VersionRangeb)

toDepMap :: [Dependency] -> DependencyMap
toDepMap ds =
  DependencyMap :: Map PackageName VersionRange -> DependencyMapDependencyMap ($) :: (a -> b) -> a -> b$ fromListWith :: Ord k => (a -> a -> a) -> [(k, a)] -> Map k afromListWith intersectVersionRanges ::
  VersionRange -> VersionRange -> VersionRangeintersectVersionRanges [ (p :: PackageNamep,vr :: VersionRangevr) | Dependency p vr <- ds :: [Dependency]ds ]

fromDepMap :: DependencyMap -> [Dependency]
fromDepMap m = [ Dependency :: PackageName -> VersionRange -> DependencyDependency p :: PackageNamep vr :: VersionRangevr | (p,vr) <- toList :: Map k a -> [(k, a)]toList (unDependencyMap :: DependencyMap -> Map PackageName VersionRangeunDependencyMap m :: Either (BT a) bm) ]

simplifyCondTree :: (Monoid a, Monoid d) =>
                    (v -> Either v Bool)
                 -> CondTree v d a
                 -> (d, a)
simplifyCondTree env (CondNode a d ifs) =
    foldr :: (a -> b -> b) -> b -> [a] -> bfoldr mappend :: Monoid a => a -> a -> amappend (d :: dd, a :: Map PackageName VersionRangea) ($) :: (a -> b) -> a -> b$ catMaybes :: [Maybe a] -> [a]catMaybes ($) :: (a -> b) -> a -> b$ map :: (a -> b) -> [a] -> [b]map simplifyIf ::
  (Condition v, CondTree v d a, Maybe (CondTree v d a))
  -> Maybe (d, a)simplifyIf ifs :: [(Condition v, CondTree v d a, Maybe (CondTree v d a))]ifs
  where
    simplifyIf (cnd, t, me) =
        case simplifyCondition ::
  Condition c -> (c -> Either d Bool) -> (Condition d, [d])simplifyCondition cnd :: Condition vcnd env :: Eq a => [(a, b)] -> a -> Either a benv of
          (Lit True, _) -> Just :: a -> Maybe aJust ($) :: (a -> b) -> a -> b$ simplifyCondTree ::
  (Monoid a, Monoid d) =>
  (v -> Either v Bool) -> CondTree v d a -> (d, a)simplifyCondTree env :: Eq a => [(a, b)] -> a -> Either a benv t :: TestSuitet
          (Lit False, _) -> fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap (simplifyCondTree ::
  (Monoid a, Monoid d) =>
  (v -> Either v Bool) -> CondTree v d a -> (d, a)simplifyCondTree env :: Eq a => [(a, b)] -> a -> Either a benv) me :: Maybe (CondTree v d a)me
          _ -> error :: [Char] -> aerror ($) :: (a -> b) -> a -> b$ "Environment not defined for all free vars"

-- | Flatten a CondTree.  This will resolve the CondTree by taking all
--  possible paths into account.  Note that since branches represent exclusive
--  choices this may not result in a \"sane\" result.
ignoreConditions :: (Monoid a, Monoid c) => CondTree v c a -> (a, c)
ignoreConditions (CondNode a c ifs) = (a :: Map PackageName VersionRangea, c :: Condition cc) mappend :: Monoid a => a -> a -> a`mappend` mconcat :: Monoid a => [a] -> amconcat (concatMap :: (a -> [b]) -> [a] -> [b]concatMap f :: FlagNamef ifs :: [(Condition v, CondTree v d a, Maybe (CondTree v d a))]ifs)
  where f (_, t, me) = ignoreConditions ::
  (Monoid a, Monoid c) => CondTree v c a -> (a, c)ignoreConditions t :: TestSuitet
                       (:) :: a -> [a] -> [a]: maybeToList :: Maybe a -> [a]maybeToList (fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap ignoreConditions ::
  (Monoid a, Monoid c) => CondTree v c a -> (a, c)ignoreConditions me :: Maybe (CondTree v d a)me)

freeVars :: CondTree ConfVar c a  -> [FlagName]
freeVars t = [ f :: FlagNamef | Flag f <- freeVars' :: CondTree b t t -> [b]freeVars' t :: TestSuitet ]
  where
    freeVars' (CondNode _ _ ifs) = concatMap :: (a -> [b]) -> [a] -> [b]concatMap compfv ::
  (Condition b, CondTree b t t, Maybe (CondTree b t t)) -> [b]compfv ifs :: [(Condition v, CondTree v d a, Maybe (CondTree v d a))]ifs
    compfv (c, ct, mct) = condfv :: Condition t -> [t]condfv c :: Condition cc (++) :: [a] -> [a] -> [a]++ freeVars' :: CondTree b t t -> [b]freeVars' ct :: CondTree b t tct (++) :: [a] -> [a] -> [a]++ maybe :: b -> (a -> b) -> Maybe a -> bmaybe [] :: [a][] freeVars' :: CondTree b t t -> [b]freeVars' mct :: Maybe (CondTree b t t)mct
    condfv c = case c :: Condition cc of
      Var v      -> [v :: Boolv]
      Lit _      -> [] :: [a][]
      CNot c'    -> condfv :: Condition t -> [t]condfv c' :: Condition dc'
      COr c1 c2  -> condfv :: Condition t -> [t]condfv c1 :: Condition tc1 (++) :: [a] -> [a] -> [a]++ condfv :: Condition t -> [t]condfv c2 :: Condition tc2
      CAnd c1 c2 -> condfv :: Condition t -> [t]condfv c1 :: Condition tc1 (++) :: [a] -> [a] -> [a]++ condfv :: Condition t -> [t]condfv c2 :: Condition tc2


------------------------------------------------------------------------------

-- | A set of targets with their package dependencies
newtype TargetSet a = TargetSet [(DependencyMap, a)]

-- | Combine the target-specific dependencies in a TargetSet to give the
-- dependencies for the package as a whole.
overallDependencies :: TargetSet PDTagged -> DependencyMap
overallDependencies (TargetSet targets) = mconcat :: Monoid a => [a] -> amconcat depss :: [DependencyMap]depss
  where
    (depss, _) = unzip :: [(a, b)] -> ([a], [b])unzip ($) :: (a -> b) -> a -> b$ filter :: (a -> Bool) -> [a] -> [a]filter (removeDisabledTests :: PDTagged -> BoolremoveDisabledTests (.) :: (b -> c) -> (a -> b) -> a -> c. snd :: (a, b) -> bsnd) targets :: [(DependencyMap, PDTagged)]targets
    removeDisabledTests :: PDTagged -> Bool
    removeDisabledTests (Lib _) = True :: BoolTrue
    removeDisabledTests (Exe _ _) = True :: BoolTrue
    removeDisabledTests (Test _ t) = testEnabled :: TestSuite -> BooltestEnabled t :: TestSuitet
    removeDisabledTests PDNull = True :: BoolTrue

-- Apply extra constraints to a dependency map.
-- Combines dependencies where the result will only contain keys from the left
-- (first) map.  If a key also exists in the right map, both constraints will
-- be intersected.
constrainBy :: DependencyMap  -- ^ Input map
            -> DependencyMap  -- ^ Extra constraints
            -> DependencyMap
constrainBy left extra =
    DependencyMap :: Map PackageName VersionRange -> DependencyMapDependencyMap ($) :: (a -> b) -> a -> b$
      foldWithKey :: (k -> a -> b -> b) -> b -> Map k a -> bMap.foldWithKey tightenConstraint ::
  k -> VersionRange -> Map k VersionRange -> Map k VersionRangetightenConstraint (unDependencyMap :: DependencyMap -> Map PackageName VersionRangeunDependencyMap left :: DependencyMapleft)
                                        (unDependencyMap :: DependencyMap -> Map PackageName VersionRangeunDependencyMap extra :: DependencyMapextra)
  where tightenConstraint n c l =
            case lookup :: Ord k => k -> Map k a -> Maybe aMap.lookup n :: Stringn l :: Libraryl of
              Nothing -> l :: Libraryl
              Just vr -> insert :: Ord k => k -> a -> Map k a -> Map k aMap.insert n :: Stringn (intersectVersionRanges ::
  VersionRange -> VersionRange -> VersionRangeintersectVersionRanges vr :: VersionRangevr c :: Condition cc) l :: Libraryl

-- | Collect up the targets in a TargetSet of tagged targets, storing the
-- dependencies as we go.
flattenTaggedTargets :: TargetSet PDTagged ->
        (Maybe Library, [(String, Executable)], [(String, TestSuite)])
flattenTaggedTargets (TargetSet targets) = foldr :: (a -> b -> b) -> b -> [a] -> bfoldr untag ::
  (DependencyMap, PDTagged)
  -> (Maybe Library, [(String, Executable)], [(String, TestSuite)])
  -> (Maybe Library, [(String, Executable)], [(String, TestSuite)])untag (Nothing :: Maybe aNothing, [] :: [a][], [] :: [a][]) targets :: [(DependencyMap, PDTagged)]targets
  where
    untag (_, Lib _) (Just _, _, _) = bug :: String -> abug "Only one library expected"
    untag (deps, Lib l) (Nothing, exes, tests) = (Just :: a -> Maybe aJust l' :: Libraryl', exes :: [(String, Executable)]exes, tests :: [(String, TestSuite)]tests)
      where
        l' = l :: Libraryl {
                libBuildInfo = (libBuildInfo :: Library -> BuildInfolibBuildInfo l :: Libraryl) { targetBuildDepends = fromDepMap :: DependencyMap -> [Dependency]fromDepMap deps :: DependencyMapdeps }
            }
    untag (deps, Exe n e) (mlib, exes, tests)
        | any :: (a -> Bool) -> [a] -> Boolany (((==) :: Eq a => a -> a -> Bool== n :: Stringn) (.) :: (b -> c) -> (a -> b) -> a -> c. fst :: (a, b) -> afst) exes :: [(String, Executable)]exes = bug :: String -> abug "Exe with same name found"
        | any :: (a -> Bool) -> [a] -> Boolany (((==) :: Eq a => a -> a -> Bool== n :: Stringn) (.) :: (b -> c) -> (a -> b) -> a -> c. fst :: (a, b) -> afst) tests :: [(String, TestSuite)]tests = bug :: String -> abug "Test sharing name of exe found"
        | otherwise :: Boolotherwise = (mlib :: Maybe Librarymlib, exes :: [(String, Executable)]exes (++) :: [a] -> [a] -> [a]++ [(n :: Stringn, e' :: Executablee')], tests :: [(String, TestSuite)]tests)
      where
        e' = e :: Executablee {
                buildInfo = (buildInfo :: Executable -> BuildInfobuildInfo e :: Executablee) { targetBuildDepends = fromDepMap :: DependencyMap -> [Dependency]fromDepMap deps :: DependencyMapdeps }
            }
    untag (deps, Test n t) (mlib, exes, tests)
        | any :: (a -> Bool) -> [a] -> Boolany (((==) :: Eq a => a -> a -> Bool== n :: Stringn) (.) :: (b -> c) -> (a -> b) -> a -> c. fst :: (a, b) -> afst) tests :: [(String, TestSuite)]tests = bug :: String -> abug "Test with same name found"
        | any :: (a -> Bool) -> [a] -> Boolany (((==) :: Eq a => a -> a -> Bool== n :: Stringn) (.) :: (b -> c) -> (a -> b) -> a -> c. fst :: (a, b) -> afst) exes :: [(String, Executable)]exes = bug :: String -> abug "Test sharing name of exe found"
        | otherwise :: Boolotherwise = (mlib :: Maybe Librarymlib, exes :: [(String, Executable)]exes, tests :: [(String, TestSuite)]tests (++) :: [a] -> [a] -> [a]++ [(n :: Stringn, t' :: TestSuitet')])
      where
        t' = t :: TestSuitet {
            testBuildInfo = (testBuildInfo :: TestSuite -> BuildInfotestBuildInfo t :: TestSuitet)
                { targetBuildDepends = fromDepMap :: DependencyMap -> [Dependency]fromDepMap deps :: DependencyMapdeps }
            }
    untag (_, PDNull) x = x :: DepTestRslt dx  -- actually this should not happen, but let's be liberal


------------------------------------------------------------------------------
-- Convert GenericPackageDescription to PackageDescription
--

data PDTagged = Lib Library | Exe String Executable | Test String TestSuite | PDNull deriving D:Show ::
  (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> T:Show aShow

instance ($cmappend) ::
  Monoid d => DepTestRslt d -> DepTestRslt d -> DepTestRslt dMonoid PDTagged where
    mempty = PDNull :: PDTaggedPDNull
    PDNull `mappend` x = x :: DepTestRslt dx
    x `mappend` PDNull = x :: DepTestRslt dx
    Lib l `mappend` Lib l' = Lib :: Library -> PDTaggedLib (l :: Libraryl mappend :: Monoid a => a -> a -> a`mappend` l' :: Libraryl')
    Exe n e `mappend` Exe n' e' | n :: Stringn (==) :: Eq a => a -> a -> Bool== n' :: Stringn' = Exe :: String -> Executable -> PDTaggedExe n :: Stringn (e :: Executablee mappend :: Monoid a => a -> a -> a`mappend` e' :: Executablee')
    Test n t `mappend` Test n' t' | n :: Stringn (==) :: Eq a => a -> a -> Bool== n' :: Stringn' = Test :: String -> TestSuite -> PDTaggedTest n :: Stringn (t :: TestSuitet mappend :: Monoid a => a -> a -> a`mappend` t' :: TestSuitet')
    _ `mappend` _ = bug :: String -> abug "Cannot combine incompatible tags"

-- | Create a package description with all configurations resolved.
--
-- This function takes a `GenericPackageDescription` and several environment
-- parameters and tries to generate `PackageDescription` by finding a flag
-- assignment that result in satisfiable dependencies.
--
-- It takes as inputs a not necessarily complete specifications of flags
-- assignments, an optional package index as well as platform parameters.  If
-- some flags are not assigned explicitly, this function will try to pick an
-- assignment that causes this function to succeed.  The package index is
-- optional since on some platforms we cannot determine which packages have
-- been installed before.  When no package index is supplied, every dependency
-- is assumed to be satisfiable, therefore all not explicitly assigned flags
-- will get their default values.
--
-- This function will fail if it cannot find a flag assignment that leads to
-- satisfiable dependencies.  (It will not try alternative assignments for
-- explicitly specified flags.)  In case of failure it will return a /minimum/
-- number of dependencies that could not be satisfied.  On success, it will
-- return the package description and the full flag assignment chosen.
--
finalizePackageDescription ::
     FlagAssignment  -- ^ Explicitly specified flag assignments
  -> (Dependency -> Bool) -- ^ Is a given depenency satisfiable from the set of available packages?
                          -- If this is unknown then use True.
  -> Platform      -- ^ The 'Arch' and 'OS'
  -> CompilerId    -- ^ Compiler + Version
  -> [Dependency]  -- ^ Additional constraints
  -> GenericPackageDescription
  -> Either [Dependency]
            (PackageDescription, FlagAssignment)
             -- ^ Either missing dependencies or the resolved package
             -- description along with the flag assignments chosen.
finalizePackageDescription userflags satisfyDep (Platform arch os) impl constraints
        (GenericPackageDescription pkg flags mlib0 exes0 tests0) =
    case resolveFlags ::
  Either
    [Dependency]
    ((Maybe Library, [Executable], [TestSuite]),
     TargetSet PDTagged,
     FlagAssignment)resolveFlags of
      Right ((mlib, exes', tests'), targetSet, flagVals) ->
        Right :: b -> Either a bRight ( pkg :: PackageDescriptionpkg { library = mlib :: Maybe Librarymlib
                    , executables = exes' :: [Executable]exes'
                    , testSuites = tests' :: [TestSuite]tests'
                    , buildDepends = fromDepMap :: DependencyMap -> [Dependency]fromDepMap (overallDependencies :: TargetSet PDTagged -> DependencyMapoverallDependencies targetSet :: TargetSet PDTaggedtargetSet)
                      --TODO: we need to find a way to avoid pulling in deps
                      -- for non-buildable components. However cannot simply
                      -- filter at this stage, since if the package were not
                      -- available we would have failed already.
                    }
              , flagVals :: FlagAssignmentflagVals )

      Left missing -> Left :: a -> Either a bLeft missing :: [Dependency]missing
  where
    -- Combine lib, exes, and tests into one list of @CondTree@s with tagged data
    condTrees = maybeToList :: Maybe a -> [a]maybeToList (fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap (mapTreeData :: (a -> b) -> CondTree v c a -> CondTree v c bmapTreeData Lib :: Library -> PDTaggedLib) mlib0 :: Maybe (CondTree ConfVar [Dependency] Library)mlib0 )
                (++) :: [a] -> [a] -> [a]++ map :: (a -> b) -> [a] -> [b]map (\(name,tree) -> mapTreeData :: (a -> b) -> CondTree v c a -> CondTree v c bmapTreeData (Exe :: String -> Executable -> PDTaggedExe name :: Stringname) tree :: CondTree ConfVar [Dependency] TestSuitetree) exes0 :: [(String, CondTree ConfVar [Dependency] Executable)]exes0
                (++) :: [a] -> [a] -> [a]++ map :: (a -> b) -> [a] -> [b]map (\(name,tree) -> mapTreeData :: (a -> b) -> CondTree v c a -> CondTree v c bmapTreeData (Test :: String -> TestSuite -> PDTaggedTest name :: Stringname) tree :: CondTree ConfVar [Dependency] TestSuitetree) tests0 :: [(String, CondTree ConfVar [Dependency] TestSuite)]tests0

    resolveFlags =
        case resolveWithFlags ::
  [(FlagName, [Bool])]
  -> OS
  -> Arch
  -> CompilerId
  -> [Dependency]
  -> [CondTree ConfVar [Dependency] PDTagged]
  -> ([Dependency] -> DepTestRslt [Dependency])
  -> Either [Dependency] (TargetSet PDTagged, FlagAssignment)resolveWithFlags flagChoices :: [(FlagName, [Bool])]flagChoices os :: OSos arch :: Archarch impl :: CompilerIdimpl constraints :: [Dependency]constraints condTrees :: [CondTree ConfVar [Dependency] PDTagged]condTrees check :: [Dependency] -> DepTestRslt [Dependency]check of
          Right (targetSet, fs) ->
              let (mlib, exes, tests) = flattenTaggedTargets ::
  TargetSet PDTagged
  -> (Maybe Library, [(String, Executable)], [(String, TestSuite)])flattenTaggedTargets targetSet :: TargetSet PDTaggedtargetSet in
              Right :: b -> Either a bRight ( (fmap :: Functor f => forall a b. (a -> b) -> f a -> f bfmap libFillInDefaults :: Library -> LibrarylibFillInDefaults mlib :: Maybe Librarymlib,
                       map :: (a -> b) -> [a] -> [b]map (\(n,e) -> (exeFillInDefaults :: Executable -> ExecutableexeFillInDefaults e :: Executablee) { exeName = n :: Stringn }) exes :: [(String, Executable)]exes,
                       map :: (a -> b) -> [a] -> [b]map (\(n,t) -> (testFillInDefaults :: TestSuite -> TestSuitetestFillInDefaults t :: TestSuitet) { testName = n :: Stringn }) tests :: [(String, TestSuite)]tests),
                     targetSet :: TargetSet PDTaggedtargetSet, fs :: FlagAssignmentfs)
          Left missing      -> Left :: a -> Either a bLeft missing :: [Dependency]missing

    flagChoices    = map :: (a -> b) -> [a] -> [b]map (\(MkFlag n _ d manual) -> (n :: Stringn, d2c :: Bool -> FlagName -> Bool -> [Bool]d2c manual :: Boolmanual n :: Stringn d :: dd)) flags :: [Flag]flags
    d2c manual n b = case lookup :: Eq a => a -> [(a, b)] -> Maybe blookup n :: Stringn userflags :: FlagAssignmentuserflags of
                     Just val -> [val :: Boolval]
                     Nothing
                      | manual :: Boolmanual -> [b :: Map PackageName VersionRangeb]
                      | otherwise :: Boolotherwise -> [b :: Map PackageName VersionRangeb, not :: Bool -> Boolnot b :: Map PackageName VersionRangeb]
    --flagDefaults = map (\(n,x:_) -> (n,x)) flagChoices
    check ds     = if all :: (a -> Bool) -> [a] -> Boolall satisfyDep :: Dependency -> BoolsatisfyDep ds :: [Dependency]ds
                   then DepOk :: DepTestRslt dDepOk
                   else MissingDeps :: d -> DepTestRslt dMissingDeps ($) :: (a -> b) -> a -> b$ filter :: (a -> Bool) -> [a] -> [a]filter (not :: Bool -> Boolnot (.) :: (b -> c) -> (a -> b) -> a -> c. satisfyDep :: Dependency -> BoolsatisfyDep) ds :: [Dependency]ds

{-
let tst_p = (CondNode [1::Int] [Distribution.Package.Dependency "a" AnyVersion] [])
let tst_p2 = (CondNode [1::Int] [Distribution.Package.Dependency "a" (EarlierVersion (Version [1,0] [])), Distribution.Package.Dependency "a" (LaterVersion (Version [2,0] []))] [])

let p_index = Distribution.Simple.PackageIndex.fromList [Distribution.Package.PackageIdentifier "a" (Version [0,5] []), Distribution.Package.PackageIdentifier "a" (Version [2,5] [])]
let look = not . null . Distribution.Simple.PackageIndex.lookupDependency p_index
let looks ds = mconcat $ map (\d -> if look d then DepOk else MissingDeps [d]) ds
resolveWithFlags [] Distribution.System.Linux Distribution.System.I386 (Distribution.Compiler.GHC,Version [6,8,2] []) [tst_p] looks   ===>  Right ...
resolveWithFlags [] Distribution.System.Linux Distribution.System.I386 (Distribution.Compiler.GHC,Version [6,8,2] []) [tst_p2] looks  ===>  Left ...
-}

-- | Flatten a generic package description by ignoring all conditions and just
-- join the field descriptors into on package description.  Note, however,
-- that this may lead to inconsistent field values, since all values are
-- joined into one field, which may not be possible in the original package
-- description, due to the use of exclusive choices (if ... else ...).
--
-- TODO: One particularly tricky case is defaulting.  In the original package
-- description, e.g., the source directory might either be the default or a
-- certain, explicitly set path.  Since defaults are filled in only after the
-- package has been resolved and when no explicit value has been set, the
-- default path will be missing from the package description returned by this
-- function.
flattenPackageDescription :: GenericPackageDescription -> PackageDescription
flattenPackageDescription (GenericPackageDescription pkg _ mlib0 exes0 tests0) =
    pkg :: PackageDescriptionpkg { library = mlib :: Maybe Librarymlib
        , executables = reverse :: [a] -> [a]reverse exes :: [(String, Executable)]exes
        , testSuites = reverse :: [a] -> [a]reverse tests :: [(String, TestSuite)]tests
        , buildDepends = ldeps :: [Dependency]ldeps (++) :: [a] -> [a] -> [a]++ reverse :: [a] -> [a]reverse edeps :: [Dependency]edeps (++) :: [a] -> [a] -> [a]++ reverse :: [a] -> [a]reverse tdeps :: [Dependency]tdeps
        }
  where
    (mlib, ldeps) = case mlib0 :: Maybe (CondTree ConfVar [Dependency] Library)mlib0 of
        Just lib -> let (l,ds) = ignoreConditions ::
  (Monoid a, Monoid c) => CondTree v c a -> (a, c)ignoreConditions lib :: CondTree ConfVar [Dependency] Librarylib in
                    (Just :: a -> Maybe aJust (libFillInDefaults :: Library -> LibrarylibFillInDefaults l :: Libraryl), ds :: [Dependency]ds)
        Nothing -> (Nothing :: Maybe aNothing, [] :: [a][])
    (exes, edeps) = foldr :: (a -> b -> b) -> b -> [a] -> bfoldr flattenExe ::
  (String, CondTree v [a] Executable)
  -> ([Executable], [a])
  -> ([Executable], [a])flattenExe ([] :: [a][],[] :: [a][]) exes0 :: [(String, CondTree ConfVar [Dependency] Executable)]exes0
    (tests, tdeps) = foldr :: (a -> b -> b) -> b -> [a] -> bfoldr flattenTst ::
  (String, CondTree v [a] TestSuite)
  -> ([TestSuite], [a])
  -> ([TestSuite], [a])flattenTst ([] :: [a][],[] :: [a][]) tests0 :: [(String, CondTree ConfVar [Dependency] TestSuite)]tests0
    flattenExe (n, t) (es, ds) =
        let (e, ds') = ignoreConditions ::
  (Monoid a, Monoid c) => CondTree v c a -> (a, c)ignoreConditions t :: TestSuitet in
        ( (exeFillInDefaults :: Executable -> ExecutableexeFillInDefaults ($) :: (a -> b) -> a -> b$ e :: Executablee { exeName = n :: Stringn }) (:) :: a -> [a] -> [a]: es :: [Executable]es, ds' :: [a]ds' (++) :: [a] -> [a] -> [a]++ ds :: [Dependency]ds )
    flattenTst (n, t) (es, ds) =
        let (e, ds') = ignoreConditions ::
  (Monoid a, Monoid c) => CondTree v c a -> (a, c)ignoreConditions t :: TestSuitet in
        ( (testFillInDefaults :: TestSuite -> TestSuitetestFillInDefaults ($) :: (a -> b) -> a -> b$ e :: Executablee { testName = n :: Stringn }) (:) :: a -> [a] -> [a]: es :: [Executable]es, ds' :: [a]ds' (++) :: [a] -> [a] -> [a]++ ds :: [Dependency]ds )

-- This is in fact rather a hack.  The original version just overrode the
-- default values, however, when adding conditions we had to switch to a
-- modifier-based approach.  There, nothing is ever overwritten, but only
-- joined together.
--
-- This is the cleanest way i could think of, that doesn't require
-- changing all field parsing functions to return modifiers instead.
libFillInDefaults :: Library -> Library
libFillInDefaults lib@(Library { libBuildInfo = bi }) =
    lib :: CondTree ConfVar [Dependency] Librarylib { libBuildInfo = biFillInDefaults :: BuildInfo -> BuildInfobiFillInDefaults bi :: BuildInfobi }

exeFillInDefaults :: Executable -> Executable
exeFillInDefaults exe@(Executable { buildInfo = bi }) =
    exe :: Executableexe { buildInfo = biFillInDefaults :: BuildInfo -> BuildInfobiFillInDefaults bi :: BuildInfobi }

testFillInDefaults :: TestSuite -> TestSuite
testFillInDefaults tst@(TestSuite { testBuildInfo = bi }) =
    tst :: TestSuitetst { testBuildInfo = biFillInDefaults :: BuildInfo -> BuildInfobiFillInDefaults bi :: BuildInfobi }

biFillInDefaults :: BuildInfo -> BuildInfo
biFillInDefaults bi =
    if null :: [a] -> Boolnull (hsSourceDirs :: BuildInfo -> [FilePath]hsSourceDirs bi :: BuildInfobi)
    then bi :: BuildInfobi { hsSourceDirs = [currentDir :: FilePathcurrentDir] }
    else bi :: BuildInfobi

bug :: String -> a
bug msg = error :: [Char] -> aerror ($) :: (a -> b) -> a -> b$ msg :: Stringmsg (++) :: [a] -> [a] -> [a]++ ". Consider this a bug."