Commit efd5543d authored by Erik de Castro Lopo's avatar Erik de Castro Lopo

cabal-install: Use NubList for list fields of SavedConfig.

User config fields like 'remote-repo', 'extra-prog-path' and 'build-summary'
were lists, which mean that when two SavedConfig types were concatentated
the lists for these fields were concatenated, resulting in duplicate entries.
Duplicated entries in these fields simply don't make sense, so we swicth to
NubList for these fields.

Closes: #2160
parent f9381a60
......@@ -44,6 +44,7 @@ module Distribution.Simple.Configure (configure,
import Distribution.Compiler
( CompilerId(..) )
import Distribution.Utils.NubList
import Distribution.Simple.Compiler
( CompilerFlavor(..), Compiler(..), compilerFlavor, compilerVersion
, showCompilerId, unsupportedLanguages, unsupportedExtensions
......@@ -577,7 +578,7 @@ configure (pkg_descr0, pbi) cfg
CompilerId GHC _ ->
-- If ghc is non-dynamic, then ghci needs object files,
-- so we build one by default.
--
--
-- Technically, archive files should be sufficient for ghci,
-- but because of GHC bug #8942, it has never been safe to
-- rely on them. By the time that bug was fixed, ghci had
......@@ -680,7 +681,7 @@ mkProgramsConfig cfg initialProgramsConfig = programsConfig
. setProgramSearchPath searchpath
$ initialProgramsConfig
searchpath = getProgramSearchPath (initialProgramsConfig)
++ map ProgramSearchPathDir (configProgramPathExtra cfg)
++ map ProgramSearchPathDir (fromNubList $ configProgramPathExtra cfg)
-- -----------------------------------------------------------------------------
-- Configuring package dependencies
......@@ -1269,7 +1270,7 @@ resolveModuleReexports installedPackages srcpkgid externalPkgDeps lib =
let filterForSpecificPackage =
case moriginalPackageName of
Nothing -> id
Just originalPackageName ->
Just originalPackageName ->
filter (\(pkgname, _, _) -> pkgname == originalPackageName)
matches = filterForSpecificPackage
......
......@@ -352,14 +352,14 @@ prefixRelativeInstallDirs pkgId pkg_key compilerId platform dirs =
-- | An abstract path, possibly containing variables that need to be
-- substituted for to get a real 'FilePath'.
--
newtype PathTemplate = PathTemplate [PathComponent] deriving (Generic)
newtype PathTemplate = PathTemplate [PathComponent] deriving (Eq, Generic, Ord)
instance Binary PathTemplate
data PathComponent =
Ordinary FilePath
| Variable PathTemplateVariable
deriving (Eq, Generic)
deriving (Eq, Ord, Generic)
instance Binary PathComponent
......@@ -384,7 +384,7 @@ data PathTemplateVariable =
| TestSuiteResultVar -- ^ The result of the test suite being run, eg
-- @pass@, @fail@, or @error@.
| BenchmarkNameVar -- ^ The name of the benchmark being run
deriving (Eq, Generic)
deriving (Eq, Ord, Generic)
instance Binary PathTemplateVariable
......
......@@ -95,6 +95,7 @@ import Distribution.Simple.InstallDirs
( InstallDirs(..), CopyDest(..),
PathTemplate, toPathTemplate, fromPathTemplate )
import Distribution.Verbosity
import Distribution.Utils.NubList
import Control.Monad (liftM)
import Data.Binary (Binary)
......@@ -258,7 +259,7 @@ data ConfigFlags = ConfigFlags {
configProgramPaths :: [(String, FilePath)], -- ^user specified programs paths
configProgramArgs :: [(String, [String])], -- ^user specified programs args
configProgramPathExtra :: [FilePath], -- ^Extend the $PATH
configProgramPathExtra :: NubList FilePath, -- ^Extend the $PATH
configHcFlavor :: Flag CompilerFlavor, -- ^The \"flavor\" of the
-- compiler, such as GHC or
-- Hugs.
......@@ -506,7 +507,7 @@ configureOptions showOrParseArgs =
,option "" ["extra-prog-path"]
"A list of directories to search for required programs (in addition to the normal search locations)"
configProgramPathExtra (\v flags -> flags {configProgramPathExtra = v})
(reqArg' "PATH" (\x -> [x]) id)
(reqArg' "PATH" (\x -> toNubList [x]) fromNubList)
,option "" ["constraint"]
"A list of additional constraints on the dependencies."
......
......@@ -47,6 +47,8 @@ import Distribution.Client.Setup
, UploadFlags(..), uploadCommand
, ReportFlags(..), reportCommand
, showRepo, parseRepo )
import Distribution.Utils.NubList
( fromNubList, toNubList)
import Distribution.Simple.Compiler
( OptimisationLevel(..) )
......@@ -217,14 +219,14 @@ initialSavedConfig = do
return mempty {
savedGlobalFlags = mempty {
globalCacheDir = toFlag cacheDir,
globalRemoteRepos = [defaultRemoteRepo],
globalRemoteRepos = toNubList [defaultRemoteRepo],
globalWorldFile = toFlag worldFile
},
savedConfigureFlags = mempty {
configProgramPathExtra = extraPath
configProgramPathExtra = toNubList extraPath
},
savedInstallFlags = mempty {
installSummaryFile = [toPathTemplate (logsDir </> "build.log")],
installSummaryFile = toNubList [toPathTemplate (logsDir </> "build.log")],
installBuildReports= toFlag AnonymousReports,
installNumJobs = toFlag Nothing
}
......@@ -456,7 +458,8 @@ deprecatedFieldDescriptions =
[ liftGlobalFlag $
listField "repos"
(Disp.text . showRepo) parseRepo
globalRemoteRepos (\rs cfg -> cfg { globalRemoteRepos = rs })
(fromNubList . globalRemoteRepos)
(\rs cfg -> cfg { globalRemoteRepos = toNubList rs })
, liftGlobalFlag $
simpleField "cachedir"
(Disp.text . fromFlagOrDefault "") (optional parseFilePathQ)
......
......@@ -99,6 +99,7 @@ import qualified Distribution.InstalledPackageInfo as Installed
import Distribution.Client.Compat.ExecutablePath
import Distribution.Client.JobControl
import Distribution.Utils.NubList
import Distribution.Simple.Compiler
( CompilerId(..), Compiler(compilerId), compilerFlavor
, PackageDB(..), PackageDBStack )
......@@ -674,7 +675,7 @@ reportPlanningFailure verbosity
++ intercalate "," (map display pkgids)
-- Save reports
BuildReports.storeLocal (installSummaryFile installFlags) buildReports platform
BuildReports.storeLocal (fromNubList $ installSummaryFile installFlags) buildReports platform
-- Save solver log
case logFile of
......@@ -739,7 +740,7 @@ postInstallActions verbosity
| UserTargetNamed dep <- targets ]
let buildReports = BuildReports.fromInstallPlan installPlan
BuildReports.storeLocal (installSummaryFile installFlags) buildReports
BuildReports.storeLocal (fromNubList $ installSummaryFile installFlags) buildReports
(InstallPlan.planPlatform installPlan)
when (reportingLevel >= AnonymousReports) $
BuildReports.storeAnonymous buildReports
......
......@@ -54,6 +54,8 @@ import Distribution.Client.Install ( InstallArgs,
makeInstallContext,
makeInstallPlan,
processInstallPlan )
import Distribution.Utils.NubList ( fromNubList )
import Distribution.Client.Sandbox.PackageEnvironment
( PackageEnvironment(..), IncludeComments(..), PackageEnvironmentType(..)
, createPackageEnvironmentFile, classifyPackageEnvironment
......@@ -197,7 +199,7 @@ tryGetIndexFilePath config = tryGetIndexFilePath' (savedGlobalFlags config)
-- 'SavedConfig'.
tryGetIndexFilePath' :: GlobalFlags -> IO FilePath
tryGetIndexFilePath' globalFlags = do
let paths = globalLocalRepos globalFlags
let paths = fromNubList $ globalLocalRepos globalFlags
case paths of
[] -> die $ "Distribution.Client.Sandbox.tryGetIndexFilePath: " ++
"no local repos found. " ++ checkConfiguration
......
......@@ -39,6 +39,7 @@ import Distribution.Client.ParseUtils ( parseFields, ppFields, ppSection )
import Distribution.Client.Setup ( GlobalFlags(..), ConfigExFlags(..)
, InstallFlags(..)
, defaultSandboxLocation )
import Distribution.Utils.NubList ( toNubList )
import Distribution.Simple.Compiler ( Compiler, PackageDB(..)
, compilerFlavor, showCompilerId )
import Distribution.Simple.InstallDirs ( InstallDirs(..), PathTemplate
......@@ -200,12 +201,12 @@ initialPackageEnvironment sandboxDir compiler platform = do
savedUserInstallDirs = installDirs,
savedGlobalInstallDirs = installDirs,
savedGlobalFlags = (savedGlobalFlags initialConfig) {
globalLocalRepos = [sandboxDir </> "packages"]
globalLocalRepos = toNubList [sandboxDir </> "packages"]
},
savedConfigureFlags = setPackageDB sandboxDir compiler platform
(savedConfigureFlags initialConfig),
savedInstallFlags = (savedInstallFlags initialConfig) {
installSummaryFile = [toPathTemplate (sandboxDir </>
installSummaryFile = toNubList [toPathTemplate (sandboxDir </>
"logs" </> "build.log")]
}
}
......
......@@ -52,6 +52,8 @@ import qualified Distribution.Client.Init.Types as IT
( InitFlags(..), PackageType(..) )
import Distribution.Client.Targets
( UserConstraint, readUserConstraint )
import Distribution.Utils.NubList
( NubList, toNubList, fromNubList)
import Distribution.Simple.Compiler (PackageDB)
import Distribution.Simple.Program
......@@ -111,9 +113,9 @@ data GlobalFlags = GlobalFlags {
globalNumericVersion :: Flag Bool,
globalConfigFile :: Flag FilePath,
globalSandboxConfigFile :: Flag FilePath,
globalRemoteRepos :: [RemoteRepo], -- ^ Available Hackage servers.
globalRemoteRepos :: NubList RemoteRepo, -- ^ Available Hackage servers.
globalCacheDir :: Flag FilePath,
globalLocalRepos :: [FilePath],
globalLocalRepos :: NubList FilePath,
globalLogsDir :: Flag FilePath,
globalWorldFile :: Flag FilePath,
globalRequireSandbox :: Flag Bool,
......@@ -187,7 +189,7 @@ globalCommand = CommandUI {
,option [] ["remote-repo"]
"The name and url for a remote repository"
globalRemoteRepos (\v flags -> flags { globalRemoteRepos = v })
(reqArg' "NAME:URL" (maybeToList . readRepo) (map showRepo))
(reqArg' "NAME:URL" (toNubList . maybeToList . readRepo) (map showRepo . fromNubList))
,option [] ["remote-repo-cache"]
"The location where downloads from all remote repos are cached"
......@@ -197,7 +199,7 @@ globalCommand = CommandUI {
,option [] ["local-repo"]
"The location of a local repository"
globalLocalRepos (\v flags -> flags { globalLocalRepos = v })
(reqArg' "DIR" (\x -> [x]) id)
(reqArg' "DIR" (\x -> toNubList [x]) fromNubList)
,option [] ["logs-dir"]
"The location to put log files"
......@@ -245,12 +247,12 @@ globalRepos globalFlags = remoteRepos ++ localRepos
where
remoteRepos =
[ Repo (Left remote) cacheDir
| remote <- globalRemoteRepos globalFlags
| remote <- fromNubList $ globalRemoteRepos globalFlags
, let cacheDir = fromFlag (globalCacheDir globalFlags)
</> remoteRepoName remote ]
localRepos =
[ Repo (Right LocalRepo) local
| local <- globalLocalRepos globalFlags ]
| local <- fromNubList $ globalLocalRepos globalFlags ]
-- ------------------------------------------------------------
-- * Config flags
......@@ -284,7 +286,7 @@ filterConfigureFlags flags cabalLibVersion
flags_1_19_0 = flags_1_19_1 { configDependencies = []
, configConstraints = configConstraints flags }
-- Cabal < 1.18.0 doesn't know about --extra-prog-path and --sysconfdir.
flags_1_18_0 = flags_1_19_0 { configProgramPathExtra = []
flags_1_18_0 = flags_1_19_0 { configProgramPathExtra = toNubList []
, configInstallDirs = configInstallDirs_1_18_0}
configInstallDirs_1_18_0 = (configInstallDirs flags) { sysconfdir = NoFlag }
-- Cabal < 1.14.0 doesn't know about '--disable-benchmarks'.
......@@ -971,7 +973,7 @@ data InstallFlags = InstallFlags {
installOnly :: Flag Bool,
installOnlyDeps :: Flag Bool,
installRootCmd :: Flag String,
installSummaryFile :: [PathTemplate],
installSummaryFile :: NubList PathTemplate,
installLogFile :: Flag PathTemplate,
installBuildReports :: Flag ReportLevel,
installReportPlanningFailure :: Flag Bool,
......@@ -1164,7 +1166,7 @@ installOptions showOrParseArgs =
, option [] ["build-summary"]
"Save build summaries to file (name template can use $pkgid, $compiler, $os, $arch)"
installSummaryFile (\v flags -> flags { installSummaryFile = v })
(reqArg' "TEMPLATE" (\x -> [toPathTemplate x]) (map fromPathTemplate))
(reqArg' "TEMPLATE" (\x -> toNubList [toPathTemplate x]) (map fromPathTemplate . fromNubList))
, option [] ["build-log"]
"Log all builds to file (name template can use $pkgid, $compiler, $os, $arch)"
......
......@@ -193,7 +193,7 @@ data RemoteRepo = RemoteRepo {
remoteRepoName :: String,
remoteRepoURI :: URI
}
deriving (Show,Eq)
deriving (Show,Eq,Ord)
data Repo = Repo {
repoKind :: Either RemoteRepo LocalRepo,
......
Markdown is supported
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