mirror of
https://github.com/commercialhaskell/stackage.git
synced 2026-01-11 23:08:30 +01:00
Better condition checking
This commit is contained in:
parent
bcabc00040
commit
d8571ea0f0
@ -8,6 +8,12 @@ import Distribution.System (OS (..), buildOS)
|
|||||||
import Distribution.Text (simpleParse)
|
import Distribution.Text (simpleParse)
|
||||||
import Stackage.Types
|
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
|
-- | Packages which are shipped with GHC but are not included in the
|
||||||
-- Haskell Platform list of core packages.
|
-- Haskell Platform list of core packages.
|
||||||
extraCore :: Set PackageName
|
extraCore :: Set PackageName
|
||||||
|
|||||||
@ -12,12 +12,17 @@ import Distribution.Package (Dependency (Dependency))
|
|||||||
import Distribution.PackageDescription (condExecutables,
|
import Distribution.PackageDescription (condExecutables,
|
||||||
condLibrary,
|
condLibrary,
|
||||||
condTestSuites,
|
condTestSuites,
|
||||||
condTreeConstraints)
|
condBenchmarks,
|
||||||
|
condTreeConstraints, condTreeComponents, ConfVar (..), Condition(..), flagName, flagDefault, genPackageFlags)
|
||||||
import Distribution.PackageDescription.Parse (ParseResult (ParseOk),
|
import Distribution.PackageDescription.Parse (ParseResult (ParseOk),
|
||||||
parsePackageDescription)
|
parsePackageDescription)
|
||||||
import Distribution.Version (withinRange)
|
import Distribution.Version (withinRange)
|
||||||
import Stackage.Types
|
import Stackage.Types
|
||||||
import Stackage.Util
|
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.
|
-- | Load the raw package database.
|
||||||
--
|
--
|
||||||
@ -64,11 +69,30 @@ loadPackageDB core deps = do
|
|||||||
parseDeps lbs =
|
parseDeps lbs =
|
||||||
case parsePackageDescription $ L8.unpack lbs of
|
case parsePackageDescription $ L8.unpack lbs of
|
||||||
ParseOk _ gpd -> mconcat
|
ParseOk _ gpd -> mconcat
|
||||||
[ maybe mempty go $ condLibrary gpd
|
[ maybe mempty (go gpd) $ condLibrary gpd
|
||||||
, mconcat $ map (go . snd) $ condExecutables gpd
|
, mconcat $ map (go gpd . snd) $ condExecutables gpd
|
||||||
, mconcat $ map (go . snd) $ condTestSuites gpd
|
, mconcat $ map (go gpd . snd) $ condTestSuites gpd
|
||||||
-- , mconcat $ map (go . snd) $ condBenchmarks gpd
|
, mconcat $ map (go gpd . snd) $ condBenchmarks gpd
|
||||||
]
|
]
|
||||||
_ -> mempty
|
_ -> mempty
|
||||||
where
|
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
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user