haskell/stackage
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage.git synced 2026-01-11 23:08:30 +01:00
Code Issues Actions 1 Packages Projects Releases Wiki Activity

Better condition checking

Browse Source
This commit is contained in:
Michael Snoyman 2012-11-23 11:00:15 +02:00
parent bcabc00040
commit d8571ea0f0
2 changed files with 36 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
Stackage/Config.hs
View File

@ -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

36
Stackage/LoadDatabase.hs
View File

@ -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