Commit 2251d56f authored by Mikhail Glushenkov's avatar Mikhail Glushenkov
Browse files

Refactor the '--allow-newer' implementation.

Split the 'onAllBuildDepends' function in three parts and move it to
'Distribution.PackageDescription.Configuration'.
parent 536edf6e
......@@ -28,6 +28,8 @@ module Distribution.PackageDescription.Configuration (
mapTreeData,
mapTreeConds,
mapTreeConstrs,
transformAllBuildInfos,
transformAllBuildDepends,
) where
import Distribution.Package
......@@ -665,3 +667,82 @@ biFillInDefaults bi =
if null (hsSourceDirs bi)
then bi { hsSourceDirs = [currentDir] }
else bi
-- Walk a 'GenericPackageDescription' and apply @onBuildInfo@/@onSetupBuildInfo@
-- to all nested 'BuildInfo'/'SetupBuildInfo' values.
transformAllBuildInfos :: (BuildInfo -> BuildInfo)
-> (SetupBuildInfo -> SetupBuildInfo)
-> GenericPackageDescription
-> GenericPackageDescription
transformAllBuildInfos onBuildInfo onSetupBuildInfo gpd = gpd'
where
onLibrary lib = lib { libBuildInfo = onBuildInfo $ libBuildInfo lib }
onExecutable exe = exe { buildInfo = onBuildInfo $ buildInfo exe }
onTestSuite tst = tst { testBuildInfo = onBuildInfo $ testBuildInfo tst }
onBenchmark bmk = bmk { benchmarkBuildInfo =
onBuildInfo $ benchmarkBuildInfo bmk }
pd = packageDescription gpd
pd' = pd {
library = fmap onLibrary (library pd),
executables = map onExecutable (executables pd),
testSuites = map onTestSuite (testSuites pd),
benchmarks = map onBenchmark (benchmarks pd),
setupBuildInfo = fmap onSetupBuildInfo (setupBuildInfo pd)
}
gpd' = transformAllCondTrees onLibrary onExecutable
onTestSuite onBenchmark id
$ gpd { packageDescription = pd' }
-- | Walk a 'GenericPackageDescription' and apply @f@ to all nested
-- @build-depends@ fields.
transformAllBuildDepends :: (Dependency -> Dependency)
-> GenericPackageDescription
-> GenericPackageDescription
transformAllBuildDepends f gpd = gpd'
where
onBI bi = bi { targetBuildDepends = map f $ targetBuildDepends bi }
onSBI stp = stp { setupDepends = map f $ setupDepends stp }
onPD pd = pd { buildDepends = map f $ buildDepends pd }
pd' = onPD $ packageDescription gpd
gpd' = transformAllCondTrees id id id id (map f)
. transformAllBuildInfos onBI onSBI
$ gpd { packageDescription = pd' }
-- | Walk all 'CondTree's inside a 'GenericPackageDescription' and apply
-- appropriate transformations to all nodes. Helper function used by
-- 'transformAllBuildDepends' and 'transformAllBuildInfos'.
transformAllCondTrees :: (Library -> Library)
-> (Executable -> Executable)
-> (TestSuite -> TestSuite)
-> (Benchmark -> Benchmark)
-> ([Dependency] -> [Dependency])
-> GenericPackageDescription -> GenericPackageDescription
transformAllCondTrees onLibrary onExecutable
onTestSuite onBenchmark onDepends gpd = gpd'
where
gpd' = gpd {
condLibrary = condLib',
condExecutables = condExes',
condTestSuites = condTests',
condBenchmarks = condBenchs'
}
condLib = condLibrary gpd
condExes = condExecutables gpd
condTests = condTestSuites gpd
condBenchs = condBenchmarks gpd
condLib' = fmap (onCondTree onLibrary) condLib
condExes' = map (mapSnd $ onCondTree onExecutable) condExes
condTests' = map (mapSnd $ onCondTree onTestSuite) condTests
condBenchs' = map (mapSnd $ onCondTree onBenchmark) condBenchs
mapSnd :: (a -> b) -> (c,a) -> (c,b)
mapSnd = fmap
onCondTree :: (a -> b) -> CondTree v [Dependency] a
-> CondTree v [Dependency] b
onCondTree g = mapCondTree g onDepends id
......@@ -92,13 +92,11 @@ import Distribution.Package
, Package(..), packageName, packageVersion
, UnitId, Dependency(Dependency))
import qualified Distribution.PackageDescription as PD
( PackageDescription(..), Library(..), Executable(..)
, TestSuite(..), Benchmark(..), SetupBuildInfo(..)
, GenericPackageDescription(..), CondTree
( PackageDescription(..), SetupBuildInfo(..)
, GenericPackageDescription(..)
, Flag(flagName), FlagName(..) )
import Distribution.PackageDescription (BuildInfo(targetBuildDepends))
import Distribution.PackageDescription.Configuration
( mapCondTree, finalizePackageDescription )
( finalizePackageDescription, transformAllBuildDepends )
import Distribution.Client.PackageUtils
( externalBuildDepends )
import Distribution.Version
......@@ -388,59 +386,12 @@ removeUpperBounds allowNewer params =
(removeUpperBound verRange)
| otherwise = d
-- Walk a 'GenericPackageDescription' and apply 'f' to all 'build-depends'
-- fields.
onAllBuildDepends :: (Dependency -> Dependency)
-> SourcePackage -> SourcePackage
onAllBuildDepends f srcPkg = srcPkg'
where
gpd = packageDescription srcPkg
pd = PD.packageDescription gpd
condLib = PD.condLibrary gpd
condExes = PD.condExecutables gpd
condTests = PD.condTestSuites gpd
condBenchs = PD.condBenchmarks gpd
f' = onBuildInfo f
onBuildInfo g bi = bi
{ targetBuildDepends = map g (targetBuildDepends bi) }
onLibrary lib = lib { PD.libBuildInfo = f' $ PD.libBuildInfo lib }
onExecutable exe = exe { PD.buildInfo = f' $ PD.buildInfo exe }
onTestSuite tst = tst { PD.testBuildInfo = f' $ PD.testBuildInfo tst }
onBenchmark bmk = bmk { PD.benchmarkBuildInfo =
f' $ PD.benchmarkBuildInfo bmk }
onSetup stp = stp { PD.setupDepends =
map f $ PD.setupDepends stp }
srcPkg' = srcPkg { packageDescription = gpd' }
gpd' = gpd {
PD.packageDescription = pd',
PD.condLibrary = condLib',
PD.condExecutables = condExes',
PD.condTestSuites = condTests',
PD.condBenchmarks = condBenchs'
}
pd' = pd {
PD.buildDepends = map f (PD.buildDepends pd),
PD.library = fmap onLibrary (PD.library pd),
PD.executables = map onExecutable (PD.executables pd),
PD.testSuites = map onTestSuite (PD.testSuites pd),
PD.benchmarks = map onBenchmark (PD.benchmarks pd),
PD.setupBuildInfo = fmap onSetup (PD.setupBuildInfo pd)
}
condLib' = fmap (onCondTree onLibrary) condLib
condExes' = map (mapSnd $ onCondTree onExecutable) condExes
condTests' = map (mapSnd $ onCondTree onTestSuite) condTests
condBenchs' = map (mapSnd $ onCondTree onBenchmark) condBenchs
mapSnd :: (a -> b) -> (c,a) -> (c,b)
mapSnd = fmap
onCondTree :: (a -> b) -> PD.CondTree v [Dependency] a
-> PD.CondTree v [Dependency] b
onCondTree g = mapCondTree g (map f) id
onAllBuildDepends f srcPkg = srcPkg {
packageDescription = transformAllBuildDepends f
(packageDescription srcPkg)
}
-- | Supply defaults for packages without explicit Setup dependencies
--
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment