Skip to content
Snippets Groups Projects
Commit bebbe9e6 authored by Duncan Coutts's avatar Duncan Coutts Committed by Edward Z. Yang
Browse files

Make the $prog-options/location config fields per-package 

We need to be able to specify program options and locations on a
per-pakage basis. Of course we can still specify them for all local
packages.

Note that these options are not actually used yet, which is why this
patch can be so small. Using them is next.
parent ef04b699
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
cabal-install/Distribution/Client/ProjectConfig/Legacy.hs
+ 19
− 12
View file @ bebbe9e6
......@@ -279,9 +279,6 @@ convertLegacyAllPackageFlags globalFlags configFlags
} = globalFlags
ConfigFlags {
configProgramPaths,
configProgramArgs,
configProgramPathExtra = projectConfigProgramPathExtra,
configHcFlavor = projectConfigHcFlavor,
configHcPath = projectConfigHcPath,
configHcPkg = projectConfigHcPkg,
......@@ -290,8 +287,6 @@ convertLegacyAllPackageFlags globalFlags configFlags
--configPackageDBs = projectConfigPackageDBs,
configAllowNewer = projectConfigAllowNewer
} = configFlags
projectConfigProgramPaths = Map.fromList configProgramPaths
projectConfigProgramArgs = Map.fromList configProgramArgs
ConfigExFlags {
configCabalVersion = projectConfigCabalVersion,
......@@ -324,6 +319,9 @@ convertLegacyPerPackageFlags configFlags installFlags haddockFlags =
PackageConfig{..}
where
ConfigFlags {
configProgramPaths,
configProgramArgs,
configProgramPathExtra = packageConfigProgramPathExtra,
configVanillaLib = packageConfigVanillaLib,
configProfLib = packageConfigProfLib,
configSharedLib = packageConfigSharedLib,
......@@ -351,6 +349,8 @@ convertLegacyPerPackageFlags configFlags installFlags haddockFlags =
configDebugInfo = packageConfigDebugInfo,
configRelocatable = packageConfigRelocatable
} = configFlags
packageConfigProgramPaths = MapLast (Map.fromList configProgramPaths)
packageConfigProgramArgs = MapMappend (Map.fromList configProgramArgs)
packageConfigCoverage = coverage <> libcoverage
--TODO: defer this merging to the resolve phase
......@@ -527,9 +527,9 @@ convertToLegacyAllPackageConfig
where
configFlags = ConfigFlags {
configPrograms_ = mempty,
configProgramPaths = Map.toList projectConfigProgramPaths,
configProgramArgs = Map.toList projectConfigProgramArgs,
configProgramPathExtra = projectConfigProgramPathExtra,
configProgramPaths = mempty,
configProgramArgs = mempty,
configProgramPathExtra = mempty,
configHcFlavor = projectConfigHcFlavor,
configHcPath = projectConfigHcPath,
configHcPkg = projectConfigHcPkg,
......@@ -588,9 +588,9 @@ convertToLegacyPerPackageConfig PackageConfig {..} =
where
configFlags = ConfigFlags {
configPrograms_ = configPrograms_ mempty,
configProgramPaths = mempty,
configProgramArgs = mempty,
configProgramPathExtra = mempty,
configProgramPaths = Map.toList (getMapLast packageConfigProgramPaths),
configProgramArgs = Map.toList (getMapMappend packageConfigProgramArgs),
configProgramPathExtra = packageConfigProgramPathExtra,
configHcFlavor = mempty,
configHcPath = mempty,
configHcPkg = mempty,
......@@ -1048,7 +1048,14 @@ packageSpecificOptionsSectionDescr =
configProgramArgs = args
}
}
),
)
++ liftFields
legacyConfigureFlags
(\flags pkgconf -> pkgconf {
legacyConfigureFlags = flags
}
)
programLocationsFieldDescrs,
sectionSubsections = [],
sectionGet = \projconf ->
[ (display pkgname, pkgconf)
......
cabal-install/Distribution/Client/ProjectConfig/Types.hs
+ 3
− 3
View file @ bebbe9e6
......@@ -137,9 +137,6 @@ data ProjectConfigBuildOnly
--
data ProjectConfigShared
= ProjectConfigShared {
projectConfigProgramPaths :: Map String FilePath,
projectConfigProgramArgs :: Map String [String],
projectConfigProgramPathExtra :: NubList FilePath,
projectConfigHcFlavor :: Flag CompilerFlavor,
projectConfigHcPath :: Flag FilePath,
projectConfigHcPkg :: Flag FilePath,
......@@ -185,6 +182,9 @@ data ProjectConfigShared
--
data PackageConfig
= PackageConfig {
packageConfigProgramPaths :: MapLast String FilePath,
packageConfigProgramArgs :: MapMappend String [String],
packageConfigProgramPathExtra :: NubList FilePath,
packageConfigFlagAssignment :: FlagAssignment,
packageConfigVanillaLib :: Flag Bool,
packageConfigSharedLib :: Flag Bool,
......
cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs
+ 62
− 60
View file @ bebbe9e6
......@@ -329,18 +329,11 @@ instance Arbitrary ProjectConfigBuildOnly where
instance Arbitrary ProjectConfigShared where
arbitrary =
ProjectConfigShared
<$> (Map.fromList <$> shortListOf 10
((,) <$> arbitraryProgramName
<*> arbitraryShortToken))
<*> (Map.fromList <$> shortListOf 10
((,) <$> arbitraryProgramName
<*> listOf arbitraryShortToken))
<*> (toNubList <$> listOf arbitraryShortToken)
<*> arbitrary -- 4
<$> arbitrary -- 4
<*> arbitraryFlag arbitraryShortToken
<*> arbitraryFlag arbitraryShortToken
<*> arbitrary
<*> arbitrary -- 8
<*> arbitrary
<*> (toNubList <$> listOf arbitraryShortToken)
<*> arbitraryConstraints
<*> shortListOf 2 arbitrary
......@@ -348,11 +341,6 @@ instance Arbitrary ProjectConfigShared where
<*> arbitrary <*> arbitrary
<*> arbitrary <*> arbitrary
where
arbitraryProgramName :: Gen String
arbitraryProgramName =
elements [ programName prog
| (prog, _) <- knownPrograms (defaultProgramDb) ]
arbitraryConstraints :: Gen [(UserConstraint, ConstraintSource)]
arbitraryConstraints =
map (\uc -> (uc, projectConfigConstraintSource)) <$> arbitrary
......@@ -360,37 +348,20 @@ instance Arbitrary ProjectConfigShared where
shrink (ProjectConfigShared
x00 x01 x02 x03 x04
x05 x06 x07 x08 x09
x10 x11 x12 x13 x14
x15 x16) =
x10 x11 x12 x13) =
[ ProjectConfigShared
(postShrink_Paths x00')
(postShrink_Args x01')
x02' x03'
(fmap getNonEmpty x04')
(fmap getNonEmpty x05')
x06' x07' x08'
(postShrink_Constraints x09')
x10' x11' x12' x13' x14'
x15' x16'
x00' (fmap getNonEmpty x01') (fmap getNonEmpty x02') x03' x04'
x05' (postShrink_Constraints x06') x07' x08' x09'
x10' x11' x12' x13'
| ((x00', x01', x02', x03', x04'),
(x05', x06', x07', x08', x09'),
(x10', x11', x12', x13', x14'),
(x15', x16'))
(x10', x11', x12', x13'))
<- shrink
((preShrink_Paths x00,
preShrink_Args x01,
x02, x03, fmap NonEmpty x04),
(fmap NonEmpty x05, x06, x07, x08, preShrink_Constraints x09),
(x10, x11, x12, x13, x14),
(x15, x16))
((x00, fmap NonEmpty x01, fmap NonEmpty x02, x03, x04),
(x05, preShrink_Constraints x06, x07, x08, x09),
(x10, x11, x12, x13))
]
where
preShrink_Paths = Map.map NonEmpty . Map.mapKeys NoShrink
postShrink_Paths = Map.map getNonEmpty . Map.mapKeys getNoShrink
preShrink_Args = Map.map (NonEmpty . map NonEmpty)
. Map.mapKeys NoShrink
postShrink_Args = Map.map (map getNonEmpty . getNonEmpty)
. Map.mapKeys getNoShrink
preShrink_Constraints = map fst
postShrink_Constraints = map (\uc -> (uc, projectConfigConstraintSource))
......@@ -401,7 +372,14 @@ projectConfigConstraintSource =
instance Arbitrary PackageConfig where
arbitrary =
PackageConfig
<$> arbitrary
<$> (MapLast . Map.fromList <$> shortListOf 10
((,) <$> arbitraryProgramName
<*> arbitraryShortToken))
<*> (MapMappend . Map.fromList <$> shortListOf 10
((,) <$> arbitraryProgramName
<*> listOf arbitraryShortToken))
<*> (toNubList <$> listOf arbitraryShortToken)
<*> arbitrary
<*> arbitrary <*> arbitrary
<*> arbitrary <*> arbitrary
<*> arbitrary <*> arbitrary
......@@ -427,6 +405,11 @@ instance Arbitrary PackageConfig where
<*> arbitrary
<*> arbitraryFlag arbitraryShortToken
<*> arbitrary
where
arbitraryProgramName :: Gen String
arbitraryProgramName =
elements [ programName prog
| (prog, _) <- knownPrograms (defaultProgramDb) ]
shrink (PackageConfig
x00 x01 x02 x03 x04
......@@ -436,19 +419,23 @@ instance Arbitrary PackageConfig where
x20 x21 x22 x23 x24
x25 x26 x27 x28 x29
x30 x31 x32 x33 x34
x35 x36 x37) =
x35 x36 x37 x38 x39
x40) =
[ PackageConfig
x00' x01' x02' x03' x04'
x05' x06' x07' x08' (map getNonEmpty x09')
x10' x11' x12'
(map getNonEmpty x13')
(map getNonEmpty x14')
(map getNonEmpty x15')
x16' x17' x18' x19'
(postShrink_Paths x00')
(postShrink_Args x01') x02' x03' x04'
x05' x06' x07' x08' x09'
x10' x11' (map getNonEmpty x12') x13' x14'
x15' (map getNonEmpty x16')
(map getNonEmpty x17')
(map getNonEmpty x18')
x19'
x20' x21' x22' x23' x24'
x25' x26' x27' x28' x29'
x30' x31' x32' x33' (fmap getNonEmpty x34')
x35' (fmap getNonEmpty x36') x37'
x30' x31' x32' x33' x34'
x35' x36' (fmap getNonEmpty x37') x38'
(fmap getNonEmpty x39')
x40'
| (((x00', x01', x02', x03', x04'),
(x05', x06', x07', x08', x09'),
(x10', x11', x12', x13', x14'),
......@@ -456,20 +443,35 @@ instance Arbitrary PackageConfig where
((x20', x21', x22', x23', x24'),
(x25', x26', x27', x28', x29'),
(x30', x31', x32', x33', x34'),
(x35', x36', x37')))
(x35', x36', x37', x38', x39'),
(x40')))
<- shrink
(((x00, x01, x02, x03, x04),
(x05, x06, x07, x08, map NonEmpty x09),
(x10, x11, x12,
map NonEmpty x13,
map NonEmpty x14),
(map NonEmpty x15,
x16, x17, x18, x19)),
(((preShrink_Paths x00, preShrink_Args x01, x02, x03, x04),
(x05, x06, x07, x08, x09),
(x10, x11, map NonEmpty x12, x13, x14),
(x15, map NonEmpty x16,
map NonEmpty x17,
map NonEmpty x18,
x19)),
((x20, x21, x22, x23, x24),
(x25, x26, x27, x28, x29),
(x30, x31, x32, x33, fmap NonEmpty x34),
(x35, fmap NonEmpty x36, x37)))
(x30, x31, x32, x33, x34),
(x35, x36, fmap NonEmpty x37, x38, fmap NonEmpty x39),
(x40)))
]
where
preShrink_Paths = Map.map NonEmpty
. Map.mapKeys NoShrink
. getMapLast
postShrink_Paths = MapLast
. Map.map getNonEmpty
. Map.mapKeys getNoShrink
preShrink_Args = Map.map (NonEmpty . map NonEmpty)
. Map.mapKeys NoShrink
. getMapMappend
postShrink_Args = MapMappend
. Map.map (map getNonEmpty . getNonEmpty)
. Map.mapKeys getNoShrink
instance Arbitrary SourceRepo where
......
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