From d8571ea0f02f2b8687a78047d084542fe1e3d63b Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Fri, 23 Nov 2012 11:00:15 +0200 Subject: [PATCH] Better condition checking --- Stackage/Config.hs | 6 ++++++ Stackage/LoadDatabase.hs | 36 ++++++++++++++++++++++++++++++------ 2 files changed, 36 insertions(+), 6 deletions(-) diff --git a/Stackage/Config.hs b/Stackage/Config.hs index fa03e05b..f5d18872 100644 --- a/Stackage/Config.hs +++ b/Stackage/Config.hs @@ -8,6 +8,12 @@ import Distribution.System (OS (..), buildOS) import Distribution.Text (simpleParse) import Stackage.Types +targetCompilerVersion :: Version +targetCompilerVersion = + case simpleParse "7.4.2" of + Nothing -> error "Invalid targetCompilerVersion" + Just v -> v + -- | Packages which are shipped with GHC but are not included in the -- Haskell Platform list of core packages. extraCore :: Set PackageName diff --git a/Stackage/LoadDatabase.hs b/Stackage/LoadDatabase.hs index 362bf08a..cf578ca9 100644 --- a/Stackage/LoadDatabase.hs +++ b/Stackage/LoadDatabase.hs @@ -12,12 +12,17 @@ import Distribution.Package (Dependency (Dependency)) import Distribution.PackageDescription (condExecutables, condLibrary, condTestSuites, - condTreeConstraints) + condBenchmarks, + condTreeConstraints, condTreeComponents, ConfVar (..), Condition(..), flagName, flagDefault, genPackageFlags) import Distribution.PackageDescription.Parse (ParseResult (ParseOk), parsePackageDescription) import Distribution.Version (withinRange) import Stackage.Types import Stackage.Util +import Stackage.Config +import Data.Maybe (mapMaybe) +import Distribution.System (buildOS, buildArch) +import Distribution.Compiler (CompilerFlavor (GHC)) -- | Load the raw package database. -- @@ -64,11 +69,30 @@ loadPackageDB core deps = do parseDeps lbs = case parsePackageDescription $ L8.unpack lbs of ParseOk _ gpd -> mconcat - [ maybe mempty go $ condLibrary gpd - , mconcat $ map (go . snd) $ condExecutables gpd - , mconcat $ map (go . snd) $ condTestSuites gpd - -- , mconcat $ map (go . snd) $ condBenchmarks gpd + [ maybe mempty (go gpd) $ condLibrary gpd + , mconcat $ map (go gpd . snd) $ condExecutables gpd + , mconcat $ map (go gpd . snd) $ condTestSuites gpd + , mconcat $ map (go gpd . snd) $ condBenchmarks gpd ] _ -> mempty where - go = Set.fromList . map (\(Dependency p _) -> p) . condTreeConstraints + go gpd tree + = Set.unions + $ Set.fromList (map (\(Dependency p _) -> p) $ condTreeConstraints tree) + : map (go gpd) (mapMaybe (checkCond gpd) $ condTreeComponents tree) + + checkCond gpd (cond, tree, melse) + | checkCond' cond = Just tree + | otherwise = melse + where + checkCond' (Var (OS os)) = os == buildOS + checkCond' (Var (Arch arch)) = arch == buildArch + checkCond' (Var (Flag flag)) = flag `elem` flags + checkCond' (Var (Impl compiler range)) = + compiler == GHC && withinRange targetCompilerVersion range + checkCond' (Lit b) = b + checkCond' (CNot c) = not $ checkCond' c + checkCond' (COr c1 c2) = checkCond' c1 || checkCond' c2 + checkCond' (CAnd c1 c2) = checkCond' c1 && checkCond' c2 + + flags = map flagName $ filter flagDefault $ genPackageFlags gpd