packages feed

cabal-install 3.14.2.0 → 3.16.0.0

raw patch · 104 files changed

+6235/−4218 lines, 104 filesdep +githashdep +silentlydep ~Cabaldep ~Cabal-syntaxdep ~QuickCheckPVP ok

version bump matches the API change (PVP)

Dependencies added: githash, silently

Dependency ranges changed: Cabal, Cabal-syntax, QuickCheck, cabal-install-solver, containers, open-browser, tasty

API changes (from Hackage documentation)

- Distribution.Client.CmdRepl: [replKeepTempFiles] :: ReplFlags -> Flag Bool
- Distribution.Client.ProjectOrchestration: resolveTargets :: forall err. (forall k. TargetSelector -> [AvailableTarget k] -> Either (TargetProblem err) [k]) -> (forall k. SubComponentTarget -> AvailableTarget k -> Either (TargetProblem err) k) -> ElaboratedInstallPlan -> Maybe SourcePackageDb -> [TargetSelector] -> Either [TargetProblem err] TargetsMap
- Distribution.Client.ProjectPlanOutput: createPackageEnvironment :: Verbosity -> FilePath -> ElaboratedInstallPlan -> ElaboratedSharedConfig -> PostBuildProjectStatus -> IO [(String, Maybe String)]
- Distribution.Client.ReplFlags: [replKeepTempFiles] :: ReplFlags -> Flag Bool
+ Distribution.Client.CmdGenBounds: GenBoundsFlags :: GenBoundsFlags
+ Distribution.Client.CmdGenBounds: data GenBoundsFlags
+ Distribution.Client.CmdGenBounds: defaultGenBoundsFlags :: GenBoundsFlags
+ Distribution.Client.CmdGenBounds: genBounds :: Verbosity -> PackageDBStackCWD -> RepoContext -> Compiler -> Platform -> ProgramDb -> GlobalFlags -> FreezeFlags -> IO ()
+ Distribution.Client.CmdGenBounds: genBoundsAction :: NixStyleFlags GenBoundsFlags -> [String] -> GlobalFlags -> IO ()
+ Distribution.Client.CmdGenBounds: genBoundsCommand :: CommandUI (NixStyleFlags GenBoundsFlags)
+ Distribution.Client.CmdOutdated: IgnoreMajorVersionBumpsAll :: IgnoreMajorVersionBumps
+ Distribution.Client.CmdOutdated: IgnoreMajorVersionBumpsNone :: IgnoreMajorVersionBumps
+ Distribution.Client.CmdOutdated: IgnoreMajorVersionBumpsSome :: [PackageName] -> IgnoreMajorVersionBumps
+ Distribution.Client.CmdOutdated: data IgnoreMajorVersionBumps
+ Distribution.Client.CmdOutdated: instance Distribution.Pretty.Pretty (Distribution.Client.CmdOutdated.OutdatedDependencyX ())
+ Distribution.Client.CmdOutdated: instance Distribution.Pretty.Pretty (Distribution.Client.CmdOutdated.OutdatedDependencyX Distribution.Types.Version.Version)
+ Distribution.Client.CmdOutdated: showResult :: Verbosity -> [OutdatedDependency] -> Bool -> IO ()
+ Distribution.Client.CmdTarget: targetAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO ()
+ Distribution.Client.CmdTarget: targetCommand :: CommandUI (NixStyleFlags ())
+ Distribution.Client.Errors: GenBoundsDoesNotSupportScript :: FilePath -> CabalInstallException
+ Distribution.Client.GenBounds: boundsNeededMsg :: String
+ Distribution.Client.GenBounds: showBounds :: Package pkg => Int -> pkg -> String
+ Distribution.Client.JobControl: mapConcurrentWithJobs :: JobControl IO b -> (a -> IO b) -> [a] -> IO [b]
+ Distribution.Client.JobControl: newJobControlFromParStrat :: Verbosity -> Maybe Compiler -> ParStratInstall -> Maybe Int -> IO (JobControl IO a)
+ Distribution.Client.JobControl: withJobControl :: IO (JobControl IO a) -> (JobControl IO a -> IO b) -> IO b
+ Distribution.Client.NixStyleOptions: cfgVerbosity :: Verbosity -> NixStyleFlags a -> Verbosity
+ Distribution.Client.ParseUtils: addFields :: [FieldDescr a] -> [FieldDescr a] -> [FieldDescr a]
+ Distribution.Client.ParseUtils: aliasField :: String -> String -> [FieldDescr a] -> [FieldDescr a]
+ Distribution.Client.ProjectConfig: CabalFileParseError :: FilePath -> ByteString -> NonEmpty PError -> Maybe Version -> [PWarning] -> CabalFileParseError
+ Distribution.Client.ProjectConfig: data CabalFileParseError
+ Distribution.Client.ProjectConfig: maxNumFetchJobs :: Int
+ Distribution.Client.ProjectConfig: readSourcePackageCabalFile :: Verbosity -> FilePath -> ByteString -> IO GenericPackageDescription
+ Distribution.Client.ProjectConfig: readSourcePackageCabalFile' :: (String -> IO ()) -> FilePath -> ByteString -> IO GenericPackageDescription
+ Distribution.Client.ProjectConfig: resolveNumJobsSetting :: Flag Bool -> Flag (Maybe Int) -> ParStratX Int
+ Distribution.Client.ProjectOrchestration: resolveTargetsFromLocalPackages :: (forall k. () => TargetSelector -> [AvailableTarget k] -> Either (TargetProblem err) [k]) -> (forall k. () => SubComponentTarget -> AvailableTarget k -> Either (TargetProblem err) k) -> [PackageSpecifier UnresolvedSourcePackage] -> [TargetSelector] -> Either [TargetProblem err] (TargetsMapX PackageId)
+ Distribution.Client.ProjectOrchestration: resolveTargetsFromSolver :: (forall k. () => TargetSelector -> [AvailableTarget k] -> Either (TargetProblem err) [k]) -> (forall k. () => SubComponentTarget -> AvailableTarget k -> Either (TargetProblem err) k) -> ElaboratedInstallPlan -> Maybe SourcePackageDb -> [TargetSelector] -> Either [TargetProblem err] TargetsMap
+ Distribution.Client.ProjectPlanOutput: createPackageEnvironmentAndArgs :: Verbosity -> FilePath -> ElaboratedInstallPlan -> ElaboratedSharedConfig -> PostBuildProjectStatus -> IO ([String], [(String, Maybe String)])
+ Distribution.Client.ProjectPlanning: [elabConfiguredPrograms] :: ElaboratedConfiguredPackage -> [ConfiguredProgram]
+ Distribution.Client.ProjectPlanning.Types: [elabConfiguredPrograms] :: ElaboratedConfiguredPackage -> [ConfiguredProgram]
+ Distribution.Client.ProjectPlanning.Types: componentTargetName :: ComponentTarget -> ComponentName
+ Distribution.Client.RebuildMonad: rerunConcurrentlyIfChanged :: (Binary a, Structured a, Binary b, Structured b) => Verbosity -> IO (JobControl IO (b, [MonitorFilePath])) -> [(FileMonitor a b, a, Rebuild b)] -> Rebuild [b]
+ Distribution.Client.Setup: [setupKeepTempFiles] :: CommonSetupFlags -> Flag Bool
+ Distribution.Client.Setup: filterBenchmarkFlags :: BenchmarkFlags -> Version -> BenchmarkFlags
+ Distribution.Client.Setup: filterBuildFlags :: BuildFlags -> Version -> BuildFlags
+ Distribution.Client.Setup: filterCopyFlags :: CopyFlags -> Version -> CopyFlags
+ Distribution.Client.Setup: filterRegisterFlags :: RegisterFlags -> Version -> RegisterFlags
+ Distribution.Client.Setup: filterReplFlags :: ReplFlags -> Version -> ReplFlags
+ Distribution.Client.SetupWrapper: [isMainLibOrExeComponent] :: SetupScriptOptions -> Bool
+ Distribution.Client.Version: cabalInstallGitInfo :: String
- Distribution.Client.CmdOutdated: listOutdated :: [PackageVersionConstraint] -> SourcePackageDb -> ListOutdatedSettings -> [(PackageVersionConstraint, Version)]
+ Distribution.Client.CmdOutdated: listOutdated :: [CandidateOutdatedDependency] -> SourcePackageDb -> ListOutdatedSettings -> [OutdatedDependency]
- Distribution.Client.CmdOutdated: outdatedAction :: (ProjectFlags, OutdatedFlags) -> [String] -> GlobalFlags -> IO ()
+ Distribution.Client.CmdOutdated: outdatedAction :: NixStyleFlags OutdatedFlags -> [String] -> GlobalFlags -> IO ()
- Distribution.Client.CmdOutdated: outdatedCommand :: CommandUI (ProjectFlags, OutdatedFlags)
+ Distribution.Client.CmdOutdated: outdatedCommand :: CommandUI (NixStyleFlags OutdatedFlags)
- Distribution.Client.CmdRepl: ReplFlags :: ReplOptions -> EnvFlags -> Flag Bool -> Flag Bool -> ReplFlags
+ Distribution.Client.CmdRepl: ReplFlags :: ReplOptions -> EnvFlags -> Flag Bool -> ReplFlags
- Distribution.Client.Compat.Prelude: class () => Parsec a
+ Distribution.Client.Compat.Prelude: class Parsec a
- Distribution.Client.Compat.Prelude: class () => Pretty a
+ Distribution.Client.Compat.Prelude: class Pretty a
- Distribution.Client.Compat.Prelude: data () => Verbosity
+ Distribution.Client.Compat.Prelude: data Verbosity
- Distribution.Client.Compat.Tar: data () => GenEntries tarPath linkTarget e
+ Distribution.Client.Compat.Tar: data GenEntries tarPath linkTarget e
- Distribution.Client.Compat.Tar: data () => GenEntryContent linkTarget
+ Distribution.Client.Compat.Tar: data GenEntryContent linkTarget
- Distribution.Client.Configure: configureSetupScript :: PackageDBStackCWD -> Compiler -> Platform -> ProgramDb -> SymbolicPath Pkg (Dir Dist) -> VersionRange -> Maybe Lock -> Bool -> InstalledPackageIndex -> Maybe ReadyPackage -> SetupScriptOptions
+ Distribution.Client.Configure: configureSetupScript :: PackageDBStackCWD -> Compiler -> Platform -> ProgramDb -> SymbolicPath Pkg ('Dir Dist) -> VersionRange -> Maybe Lock -> Bool -> InstalledPackageIndex -> Maybe ReadyPackage -> SetupScriptOptions
- Distribution.Client.Dependency: data () => PackageConstraint
+ Distribution.Client.Dependency: data PackageConstraint
- Distribution.Client.Dependency: data () => PackageProperty
+ Distribution.Client.Dependency: data PackageProperty
- Distribution.Client.Dependency: data () => Progress step fail done
+ Distribution.Client.Dependency: data Progress step fail done
- Distribution.Client.Errors: CannotReadCabalFile :: FilePath -> CabalInstallException
+ Distribution.Client.Errors: CannotReadCabalFile :: FilePath -> FilePath -> CabalInstallException
- Distribution.Client.Errors: ReportParseResult :: String -> FilePath -> String -> String -> CabalInstallException
+ Distribution.Client.Errors: ReportParseResult :: String -> FilePath -> String -> Doc -> CabalInstallException
- Distribution.Client.FetchUtils: type AsyncFetchMap = Map UnresolvedPkgLoc (MVar (Either SomeException ResolvedPkgLoc))
+ Distribution.Client.FetchUtils: type AsyncFetchMap = Map UnresolvedPkgLoc MVar Either SomeException ResolvedPkgLoc
- Distribution.Client.FileMonitor: checkFileMonitorChanged :: forall a b. (Binary a, Structured a, Binary b, Structured b) => FileMonitor a b -> FilePath -> a -> IO (MonitorChanged a b)
+ Distribution.Client.FileMonitor: checkFileMonitorChanged :: (Binary a, Structured a, Binary b, Structured b) => FileMonitor a b -> FilePath -> a -> IO (MonitorChanged a b)
- Distribution.Client.Glob: data () => FilePathRoot
+ Distribution.Client.Glob: data FilePathRoot
- Distribution.Client.Glob: data () => Glob
+ Distribution.Client.Glob: data Glob
- Distribution.Client.Glob: data () => GlobPiece
+ Distribution.Client.Glob: data GlobPiece
- Distribution.Client.Glob: data () => RootedGlob
+ Distribution.Client.Glob: data RootedGlob
- Distribution.Client.GlobalFlags: RepoContext :: [Repo] -> IO HttpTransport -> (forall a. Repo -> (forall down. Repository down -> IO a) -> IO a) -> Bool -> RepoContext
+ Distribution.Client.GlobalFlags: RepoContext :: [Repo] -> IO HttpTransport -> (forall a. () => Repo -> (forall (down :: Type -> Type). () => Repository down -> IO a) -> IO a) -> Bool -> RepoContext
- Distribution.Client.GlobalFlags: [repoContextWithSecureRepo] :: RepoContext -> forall a. Repo -> (forall down. Repository down -> IO a) -> IO a
+ Distribution.Client.GlobalFlags: [repoContextWithSecureRepo] :: RepoContext -> forall a. () => Repo -> (forall (down :: Type -> Type). () => Repository down -> IO a) -> IO a
- Distribution.Client.IndexUtils.ActiveRepos: organizeByRepos :: forall a. ActiveRepos -> (a -> RepoName) -> [a] -> Either String [(a, CombineStrategy)]
+ Distribution.Client.IndexUtils.ActiveRepos: organizeByRepos :: ActiveRepos -> (a -> RepoName) -> [a] -> Either String [(a, CombineStrategy)]
- Distribution.Client.Init.Types: class Monad m => Interactive m
+ Distribution.Client.Init.Types: class Monad m => Interactive (m :: Type -> Type)
- Distribution.Client.InstallPlan: completed :: forall ipkg srcpkg. (IsUnit ipkg, IsUnit srcpkg) => GenericInstallPlan ipkg srcpkg -> Processing -> UnitId -> ([GenericReadyPackage srcpkg], Processing)
+ Distribution.Client.InstallPlan: completed :: (IsUnit ipkg, IsUnit srcpkg) => GenericInstallPlan ipkg srcpkg -> Processing -> UnitId -> ([GenericReadyPackage srcpkg], Processing)
- Distribution.Client.InstallPlan: showInstallPlan :: forall ipkg srcpkg. (Package ipkg, Package srcpkg, IsUnit ipkg, IsUnit srcpkg) => GenericInstallPlan ipkg srcpkg -> String
+ Distribution.Client.InstallPlan: showInstallPlan :: (Package ipkg, Package srcpkg, IsUnit ipkg, IsUnit srcpkg) => GenericInstallPlan ipkg srcpkg -> String
- Distribution.Client.InstallPlan: showInstallPlan_gen :: forall ipkg srcpkg. (GenericPlanPackage ipkg srcpkg -> ShowPlanNode) -> GenericInstallPlan ipkg srcpkg -> String
+ Distribution.Client.InstallPlan: showInstallPlan_gen :: (GenericPlanPackage ipkg srcpkg -> ShowPlanNode) -> GenericInstallPlan ipkg srcpkg -> String
- Distribution.Client.InstallPlan: type BuildOutcomes failure result = Map UnitId (Either failure result)
+ Distribution.Client.InstallPlan: type BuildOutcomes failure result = Map UnitId Either failure result
- Distribution.Client.InstallPlan: type InstallPlan = GenericInstallPlan InstalledPackageInfo (ConfiguredPackage UnresolvedPkgLoc)
+ Distribution.Client.InstallPlan: type InstallPlan = GenericInstallPlan InstalledPackageInfo ConfiguredPackage UnresolvedPkgLoc
- Distribution.Client.InstallPlan: type PlanPackage = GenericPlanPackage InstalledPackageInfo (ConfiguredPackage UnresolvedPkgLoc)
+ Distribution.Client.InstallPlan: type PlanPackage = GenericPlanPackage InstalledPackageInfo ConfiguredPackage UnresolvedPkgLoc
- Distribution.Client.JobControl: data JobControl m a
+ Distribution.Client.JobControl: data JobControl (m :: Type -> Type) a
- Distribution.Client.ParseUtils: FGSectionDescr :: String -> g s s -> (a -> [(String, s)]) -> (LineNo -> String -> s -> a -> ParseResult a) -> FGSectionDescr g a
+ Distribution.Client.ParseUtils: FGSectionDescr :: String -> g s s -> (a -> [(String, s)]) -> (LineNo -> String -> s -> a -> ParseResult a) -> FGSectionDescr (g :: Type -> Type -> Type) a
- Distribution.Client.ParseUtils: [fgSectionGet] :: FGSectionDescr g a -> a -> [(String, s)]
+ Distribution.Client.ParseUtils: [fgSectionGet] :: FGSectionDescr (g :: Type -> Type -> Type) a -> a -> [(String, s)]
- Distribution.Client.ParseUtils: [fgSectionGrammar] :: FGSectionDescr g a -> g s s
+ Distribution.Client.ParseUtils: [fgSectionGrammar] :: FGSectionDescr (g :: Type -> Type -> Type) a -> g s s
- Distribution.Client.ParseUtils: [fgSectionName] :: FGSectionDescr g a -> String
+ Distribution.Client.ParseUtils: [fgSectionName] :: FGSectionDescr (g :: Type -> Type -> Type) a -> String
- Distribution.Client.ParseUtils: [fgSectionSet] :: FGSectionDescr g a -> LineNo -> String -> s -> a -> ParseResult a
+ Distribution.Client.ParseUtils: [fgSectionSet] :: FGSectionDescr (g :: Type -> Type -> Type) a -> LineNo -> String -> s -> a -> ParseResult a
- Distribution.Client.ParseUtils: data FGSectionDescr g a
+ Distribution.Client.ParseUtils: data FGSectionDescr (g :: Type -> Type -> Type) a
- Distribution.Client.ProjectBuilding.UnpackedPackage: buildAndInstallUnpackedPackage :: Verbosity -> DistDirLayout -> StoreDirLayout -> Maybe SemaphoreName -> BuildTimeSettings -> Lock -> Lock -> ElaboratedSharedConfig -> ElaboratedInstallPlan -> ElaboratedReadyPackage -> SymbolicPath CWD (Dir Pkg) -> SymbolicPath Pkg (Dir Dist) -> IO BuildResult
+ Distribution.Client.ProjectBuilding.UnpackedPackage: buildAndInstallUnpackedPackage :: Verbosity -> DistDirLayout -> StoreDirLayout -> Maybe SemaphoreName -> BuildTimeSettings -> Lock -> Lock -> ElaboratedSharedConfig -> ElaboratedInstallPlan -> ElaboratedReadyPackage -> SymbolicPath CWD ('Dir Pkg) -> SymbolicPath Pkg ('Dir Dist) -> IO BuildResult
- Distribution.Client.ProjectBuilding.UnpackedPackage: buildAndRegisterUnpackedPackage :: Verbosity -> DistDirLayout -> Maybe SemaphoreName -> BuildTimeSettings -> Lock -> Lock -> ElaboratedSharedConfig -> ElaboratedInstallPlan -> ElaboratedReadyPackage -> SymbolicPath CWD (Dir Pkg) -> SymbolicPath Pkg (Dir Dist) -> Maybe FilePath -> (PackageBuildingPhase -> IO ()) -> IO ()
+ Distribution.Client.ProjectBuilding.UnpackedPackage: buildAndRegisterUnpackedPackage :: Verbosity -> DistDirLayout -> Maybe SemaphoreName -> BuildTimeSettings -> Lock -> Lock -> ElaboratedSharedConfig -> ElaboratedInstallPlan -> ElaboratedReadyPackage -> SymbolicPath CWD ('Dir Pkg) -> SymbolicPath Pkg ('Dir Dist) -> Maybe FilePath -> (PackageBuildingPhase -> IO ()) -> IO ()
- Distribution.Client.ProjectBuilding.UnpackedPackage: buildInplaceUnpackedPackage :: Verbosity -> DistDirLayout -> Maybe SemaphoreName -> BuildTimeSettings -> Lock -> Lock -> ElaboratedSharedConfig -> ElaboratedInstallPlan -> ElaboratedReadyPackage -> BuildStatusRebuild -> SymbolicPath CWD (Dir Pkg) -> SymbolicPath Pkg (Dir Dist) -> IO BuildResult
+ Distribution.Client.ProjectBuilding.UnpackedPackage: buildInplaceUnpackedPackage :: Verbosity -> DistDirLayout -> Maybe SemaphoreName -> BuildTimeSettings -> Lock -> Lock -> ElaboratedSharedConfig -> ElaboratedInstallPlan -> ElaboratedReadyPackage -> BuildStatusRebuild -> SymbolicPath CWD ('Dir Pkg) -> SymbolicPath Pkg ('Dir Dist) -> IO BuildResult
- Distribution.Client.ProjectConfig: fetchAndReadSourcePackages :: Verbosity -> DistDirLayout -> ProjectConfigShared -> ProjectConfigBuildOnly -> [ProjectPackageLocation] -> Rebuild [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
+ Distribution.Client.ProjectConfig: fetchAndReadSourcePackages :: Verbosity -> DistDirLayout -> Maybe Compiler -> ProjectConfigShared -> ProjectConfigBuildOnly -> [ProjectPackageLocation] -> Rebuild [PackageSpecifier (SourcePackage UnresolvedPkgLoc)]
- Distribution.Client.ProjectConfig: reportParseResult :: Verbosity -> String -> FilePath -> ParseResult ProjectConfigSkeleton -> IO ProjectConfigSkeleton
+ Distribution.Client.ProjectConfig: reportParseResult :: Verbosity -> String -> FilePath -> ProjectParseResult ProjectConfigSkeleton -> IO ProjectConfigSkeleton
- Distribution.Client.ProjectConfig.Legacy: instantiateProjectConfigSkeletonFetchingCompiler :: Monad m => m (OS, Arch, CompilerInfo) -> FlagAssignment -> ProjectConfigSkeleton -> m ProjectConfig
+ Distribution.Client.ProjectConfig.Legacy: instantiateProjectConfigSkeletonFetchingCompiler :: Monad m => m (OS, Arch, Compiler) -> FlagAssignment -> ProjectConfigSkeleton -> m (ProjectConfig, Maybe Compiler)
- Distribution.Client.ProjectConfig.Legacy: parseProject :: FilePath -> FilePath -> HttpTransport -> Verbosity -> ProjectConfigToParse -> IO (ParseResult ProjectConfigSkeleton)
+ Distribution.Client.ProjectConfig.Legacy: parseProject :: FilePath -> FilePath -> HttpTransport -> Verbosity -> ProjectConfigToParse -> IO (ProjectParseResult ProjectConfigSkeleton)
- Distribution.Client.ProjectConfig.Types: data () => ParStratX sem
+ Distribution.Client.ProjectConfig.Types: data ParStratX sem
- Distribution.Client.ProjectOrchestration: data () => ComponentName
+ Distribution.Client.ProjectOrchestration: data ComponentName
- Distribution.Client.ProjectOrchestration: type TargetsMap = Map UnitId [(ComponentTarget, NonEmpty TargetSelector)]
+ Distribution.Client.ProjectOrchestration: type TargetsMap = TargetsMapX UnitId
- Distribution.Client.ProjectPlanning: ElaboratedConfiguredPackage :: UnitId -> ComponentId -> Map ModuleName Module -> Map ModuleName OpenModule -> Bool -> PackageId -> ModuleShape -> FlagAssignment -> FlagAssignment -> PackageDescription -> PackageLocation (Maybe FilePath) -> Maybe PackageSourceHash -> Bool -> BuildStyle -> ComponentRequestedSpec -> OptionalStanzaSet -> OptionalStanzaMap (Maybe Bool) -> [Maybe PackageDBCWD] -> PackageDBStackCWD -> PackageDBStackCWD -> PackageDBStackCWD -> PackageDBStackCWD -> PackageDBStackCWD -> PackageDBStackCWD -> Maybe CabalFileText -> BuildOptions -> DumpBuildInfo -> Map String FilePath -> Map String [String] -> [FilePath] -> [String] -> [FilePath] -> [FilePath] -> [FilePath] -> [FilePath] -> Maybe PathTemplate -> Maybe PathTemplate -> InstallDirs FilePath -> Bool -> Bool -> Maybe String -> Bool -> HaddockTarget -> Bool -> Bool -> Bool -> Bool -> Maybe FilePath -> Bool -> Bool -> Maybe FilePath -> Maybe PathTemplate -> Maybe PathTemplate -> Maybe String -> Maybe String -> Maybe FilePath -> Bool -> Maybe PathTemplate -> Maybe PathTemplate -> Maybe TestShowDetails -> Bool -> Maybe FilePath -> Bool -> [PathTemplate] -> [PathTemplate] -> SetupScriptStyle -> Version -> [ComponentTarget] -> [ComponentTarget] -> [ComponentTarget] -> [ComponentTarget] -> [ComponentTarget] -> [ComponentTarget] -> Bool -> ElaboratedPackageOrComponent -> ElaboratedConfiguredPackage
+ Distribution.Client.ProjectPlanning: ElaboratedConfiguredPackage :: UnitId -> ComponentId -> Map ModuleName Module -> Map ModuleName OpenModule -> Bool -> PackageId -> ModuleShape -> FlagAssignment -> FlagAssignment -> PackageDescription -> PackageLocation (Maybe FilePath) -> Maybe PackageSourceHash -> Bool -> BuildStyle -> ComponentRequestedSpec -> OptionalStanzaSet -> OptionalStanzaMap (Maybe Bool) -> [Maybe PackageDBCWD] -> PackageDBStackCWD -> PackageDBStackCWD -> PackageDBStackCWD -> PackageDBStackCWD -> PackageDBStackCWD -> PackageDBStackCWD -> Maybe CabalFileText -> BuildOptions -> DumpBuildInfo -> Map String FilePath -> Map String [String] -> [FilePath] -> [ConfiguredProgram] -> [String] -> [FilePath] -> [FilePath] -> [FilePath] -> [FilePath] -> Maybe PathTemplate -> Maybe PathTemplate -> InstallDirs FilePath -> Bool -> Bool -> Maybe String -> Bool -> HaddockTarget -> Bool -> Bool -> Bool -> Bool -> Maybe FilePath -> Bool -> Bool -> Maybe FilePath -> Maybe PathTemplate -> Maybe PathTemplate -> Maybe String -> Maybe String -> Maybe FilePath -> Bool -> Maybe PathTemplate -> Maybe PathTemplate -> Maybe TestShowDetails -> Bool -> Maybe FilePath -> Bool -> [PathTemplate] -> [PathTemplate] -> SetupScriptStyle -> Version -> [ComponentTarget] -> [ComponentTarget] -> [ComponentTarget] -> [ComponentTarget] -> [ComponentTarget] -> [ComponentTarget] -> Bool -> ElaboratedPackageOrComponent -> ElaboratedConfiguredPackage
- Distribution.Client.ProjectPlanning: setupHsCommonFlags :: Verbosity -> Maybe (SymbolicPath CWD (Dir Pkg)) -> SymbolicPath Pkg (Dir Dist) -> CommonSetupFlags
+ Distribution.Client.ProjectPlanning: setupHsCommonFlags :: Verbosity -> Maybe (SymbolicPath CWD ('Dir Pkg)) -> SymbolicPath Pkg ('Dir Dist) -> Bool -> CommonSetupFlags
- Distribution.Client.ProjectPlanning: setupHsConfigureFlags :: Monad m => (FilePath -> m (SymbolicPath Pkg (Dir PkgDB))) -> ElaboratedInstallPlan -> ElaboratedReadyPackage -> ElaboratedSharedConfig -> CommonSetupFlags -> m ConfigFlags
+ Distribution.Client.ProjectPlanning: setupHsConfigureFlags :: Monad m => (FilePath -> m (SymbolicPath Pkg ('Dir PkgDB))) -> ElaboratedInstallPlan -> ElaboratedReadyPackage -> ElaboratedSharedConfig -> CommonSetupFlags -> m ConfigFlags
- Distribution.Client.ProjectPlanning: setupHsScriptOptions :: ElaboratedReadyPackage -> ElaboratedInstallPlan -> ElaboratedSharedConfig -> DistDirLayout -> SymbolicPath CWD (Dir Pkg) -> SymbolicPath Pkg (Dir Dist) -> Bool -> Lock -> SetupScriptOptions
+ Distribution.Client.ProjectPlanning: setupHsScriptOptions :: ElaboratedReadyPackage -> ElaboratedInstallPlan -> ElaboratedSharedConfig -> DistDirLayout -> SymbolicPath CWD ('Dir Pkg) -> SymbolicPath Pkg ('Dir Dist) -> Bool -> Lock -> SetupScriptOptions
- Distribution.Client.ProjectPlanning.Types: ElaboratedConfiguredPackage :: UnitId -> ComponentId -> Map ModuleName Module -> Map ModuleName OpenModule -> Bool -> PackageId -> ModuleShape -> FlagAssignment -> FlagAssignment -> PackageDescription -> PackageLocation (Maybe FilePath) -> Maybe PackageSourceHash -> Bool -> BuildStyle -> ComponentRequestedSpec -> OptionalStanzaSet -> OptionalStanzaMap (Maybe Bool) -> [Maybe PackageDBCWD] -> PackageDBStackCWD -> PackageDBStackCWD -> PackageDBStackCWD -> PackageDBStackCWD -> PackageDBStackCWD -> PackageDBStackCWD -> Maybe CabalFileText -> BuildOptions -> DumpBuildInfo -> Map String FilePath -> Map String [String] -> [FilePath] -> [String] -> [FilePath] -> [FilePath] -> [FilePath] -> [FilePath] -> Maybe PathTemplate -> Maybe PathTemplate -> InstallDirs FilePath -> Bool -> Bool -> Maybe String -> Bool -> HaddockTarget -> Bool -> Bool -> Bool -> Bool -> Maybe FilePath -> Bool -> Bool -> Maybe FilePath -> Maybe PathTemplate -> Maybe PathTemplate -> Maybe String -> Maybe String -> Maybe FilePath -> Bool -> Maybe PathTemplate -> Maybe PathTemplate -> Maybe TestShowDetails -> Bool -> Maybe FilePath -> Bool -> [PathTemplate] -> [PathTemplate] -> SetupScriptStyle -> Version -> [ComponentTarget] -> [ComponentTarget] -> [ComponentTarget] -> [ComponentTarget] -> [ComponentTarget] -> [ComponentTarget] -> Bool -> ElaboratedPackageOrComponent -> ElaboratedConfiguredPackage
+ Distribution.Client.ProjectPlanning.Types: ElaboratedConfiguredPackage :: UnitId -> ComponentId -> Map ModuleName Module -> Map ModuleName OpenModule -> Bool -> PackageId -> ModuleShape -> FlagAssignment -> FlagAssignment -> PackageDescription -> PackageLocation (Maybe FilePath) -> Maybe PackageSourceHash -> Bool -> BuildStyle -> ComponentRequestedSpec -> OptionalStanzaSet -> OptionalStanzaMap (Maybe Bool) -> [Maybe PackageDBCWD] -> PackageDBStackCWD -> PackageDBStackCWD -> PackageDBStackCWD -> PackageDBStackCWD -> PackageDBStackCWD -> PackageDBStackCWD -> Maybe CabalFileText -> BuildOptions -> DumpBuildInfo -> Map String FilePath -> Map String [String] -> [FilePath] -> [ConfiguredProgram] -> [String] -> [FilePath] -> [FilePath] -> [FilePath] -> [FilePath] -> Maybe PathTemplate -> Maybe PathTemplate -> InstallDirs FilePath -> Bool -> Bool -> Maybe String -> Bool -> HaddockTarget -> Bool -> Bool -> Bool -> Bool -> Maybe FilePath -> Bool -> Bool -> Maybe FilePath -> Maybe PathTemplate -> Maybe PathTemplate -> Maybe String -> Maybe String -> Maybe FilePath -> Bool -> Maybe PathTemplate -> Maybe PathTemplate -> Maybe TestShowDetails -> Bool -> Maybe FilePath -> Bool -> [PathTemplate] -> [PathTemplate] -> SetupScriptStyle -> Version -> [ComponentTarget] -> [ComponentTarget] -> [ComponentTarget] -> [ComponentTarget] -> [ComponentTarget] -> [ComponentTarget] -> Bool -> ElaboratedPackageOrComponent -> ElaboratedConfiguredPackage
- Distribution.Client.RebuildMonad: data () => FilePathRoot
+ Distribution.Client.RebuildMonad: data FilePathRoot
- Distribution.Client.RebuildMonad: data () => Glob
+ Distribution.Client.RebuildMonad: data Glob
- Distribution.Client.RebuildMonad: data () => GlobPiece
+ Distribution.Client.RebuildMonad: data GlobPiece
- Distribution.Client.RebuildMonad: data () => MonitorFilePath
+ Distribution.Client.RebuildMonad: data MonitorFilePath
- Distribution.Client.RebuildMonad: data () => RootedGlob
+ Distribution.Client.RebuildMonad: data RootedGlob
- Distribution.Client.RebuildMonad: delayInitSharedResource :: forall a. IO a -> Rebuild (Rebuild a)
+ Distribution.Client.RebuildMonad: delayInitSharedResource :: IO a -> Rebuild (Rebuild a)
- Distribution.Client.RebuildMonad: delayInitSharedResources :: forall k v. Ord k => (k -> IO v) -> Rebuild (k -> Rebuild v)
+ Distribution.Client.RebuildMonad: delayInitSharedResources :: Ord k => (k -> IO v) -> Rebuild (k -> Rebuild v)
- Distribution.Client.RebuildMonad: findFirstFileMonitored :: forall a. (a -> FilePath) -> [a] -> Rebuild (Maybe a)
+ Distribution.Client.RebuildMonad: findFirstFileMonitored :: (a -> FilePath) -> [a] -> Rebuild (Maybe a)
- Distribution.Client.Reconfigure: reconfigure :: ((ConfigFlags, ConfigExFlags) -> [String] -> GlobalFlags -> IO ()) -> Verbosity -> SymbolicPath Pkg (Dir Dist) -> Flag (Maybe Int) -> Check (ConfigFlags, ConfigExFlags) -> [String] -> GlobalFlags -> SavedConfig -> IO SavedConfig
+ Distribution.Client.Reconfigure: reconfigure :: ((ConfigFlags, ConfigExFlags) -> [String] -> GlobalFlags -> IO ()) -> Verbosity -> SymbolicPath Pkg ('Dir Dist) -> Flag (Maybe Int) -> Check (ConfigFlags, ConfigExFlags) -> [String] -> GlobalFlags -> SavedConfig -> IO SavedConfig
- Distribution.Client.ReplFlags: ReplFlags :: ReplOptions -> EnvFlags -> Flag Bool -> Flag Bool -> ReplFlags
+ Distribution.Client.ReplFlags: ReplFlags :: ReplOptions -> EnvFlags -> Flag Bool -> ReplFlags
- Distribution.Client.Sandbox: findSavedDistPref :: SavedConfig -> Flag (SymbolicPath Pkg (Dir Dist)) -> IO (SymbolicPath Pkg (Dir Dist))
+ Distribution.Client.Sandbox: findSavedDistPref :: SavedConfig -> Flag (SymbolicPath Pkg ('Dir Dist)) -> IO (SymbolicPath Pkg ('Dir Dist))
- Distribution.Client.ScriptUtils: lSrcpkgDescription :: Lens' (SourcePackage loc) GenericPackageDescription
+ Distribution.Client.ScriptUtils: lSrcpkgDescription :: forall loc f. Functor f => LensLike f (SourcePackage loc) (SourcePackage loc) GenericPackageDescription GenericPackageDescription
- Distribution.Client.ScriptUtils: withContextAndSelectors :: AcceptNoTargets -> Maybe ComponentKind -> NixStyleFlags a -> [String] -> GlobalFlags -> CurrentCommand -> (TargetContext -> ProjectBaseContext -> [TargetSelector] -> IO b) -> IO b
+ Distribution.Client.ScriptUtils: withContextAndSelectors :: Verbosity -> AcceptNoTargets -> Maybe ComponentKind -> NixStyleFlags a -> [String] -> GlobalFlags -> CurrentCommand -> (TargetContext -> ProjectBaseContext -> [TargetSelector] -> IO b) -> IO b
- Distribution.Client.Security.HTTP: data () => HttpLib
+ Distribution.Client.Security.HTTP: data HttpLib
- Distribution.Client.Setup: CommonSetupFlags :: !Flag Verbosity -> !Flag (SymbolicPath CWD ('Dir Pkg)) -> !Flag (SymbolicPath Pkg ('Dir Dist)) -> !Flag (SymbolicPath Pkg 'File) -> [String] -> CommonSetupFlags
+ Distribution.Client.Setup: CommonSetupFlags :: !Flag Verbosity -> !Flag (SymbolicPath CWD ('Dir Pkg)) -> !Flag (SymbolicPath Pkg ('Dir Dist)) -> !Flag (SymbolicPath Pkg 'File) -> [String] -> Flag Bool -> CommonSetupFlags
- Distribution.Client.Setup: RepoContext :: [Repo] -> IO HttpTransport -> (forall a. Repo -> (forall down. Repository down -> IO a) -> IO a) -> Bool -> RepoContext
+ Distribution.Client.Setup: RepoContext :: [Repo] -> IO HttpTransport -> (forall a. () => Repo -> (forall (down :: Type -> Type). () => Repository down -> IO a) -> IO a) -> Bool -> RepoContext
- Distribution.Client.Setup: [repoContextWithSecureRepo] :: RepoContext -> forall a. Repo -> (forall down. Repository down -> IO a) -> IO a
+ Distribution.Client.Setup: [repoContextWithSecureRepo] :: RepoContext -> forall a. () => Repo -> (forall (down :: Type -> Type). () => Repository down -> IO a) -> IO a
- Distribution.Client.Setup: data () => BuildFlags
+ Distribution.Client.Setup: data BuildFlags
- Distribution.Client.Setup: data () => CommonSetupFlags
+ Distribution.Client.Setup: data CommonSetupFlags
- Distribution.Client.Setup: data () => ConfigFlags
+ Distribution.Client.Setup: data ConfigFlags
- Distribution.Client.SetupWrapper: SetupScriptOptions :: VersionRange -> Maybe Version -> Maybe Compiler -> Maybe Platform -> PackageDBStackCWD -> Maybe InstalledPackageIndex -> ProgramDb -> SymbolicPath Pkg (Dir Dist) -> Maybe Handle -> Maybe (SymbolicPath CWD (Dir Pkg)) -> [FilePath] -> [(String, Maybe FilePath)] -> Bool -> [(ComponentId, PackageId)] -> Bool -> Bool -> Bool -> Maybe Lock -> Bool -> SetupScriptOptions
+ Distribution.Client.SetupWrapper: SetupScriptOptions :: VersionRange -> Maybe Version -> Maybe Compiler -> Maybe Platform -> PackageDBStackCWD -> Maybe InstalledPackageIndex -> ProgramDb -> SymbolicPath Pkg ('Dir Dist) -> Maybe Handle -> Maybe (SymbolicPath CWD ('Dir Pkg)) -> [FilePath] -> [(String, Maybe FilePath)] -> Bool -> [(ComponentId, PackageId)] -> Bool -> Bool -> Bool -> Maybe Lock -> Bool -> Bool -> SetupScriptOptions
- Distribution.Client.SetupWrapper: [useDistPref] :: SetupScriptOptions -> SymbolicPath Pkg (Dir Dist)
+ Distribution.Client.SetupWrapper: [useDistPref] :: SetupScriptOptions -> SymbolicPath Pkg ('Dir Dist)
- Distribution.Client.SetupWrapper: [useWorkingDir] :: SetupScriptOptions -> Maybe (SymbolicPath CWD (Dir Pkg))
+ Distribution.Client.SetupWrapper: [useWorkingDir] :: SetupScriptOptions -> Maybe (SymbolicPath CWD ('Dir Pkg))
- Distribution.Client.SolverInstallPlan: data () => ResolverPackage loc
+ Distribution.Client.SolverInstallPlan: data ResolverPackage loc
- Distribution.Client.TargetSelector: DirActions :: (FilePath -> m Bool) -> (FilePath -> m Bool) -> (FilePath -> m FilePath) -> m FilePath -> DirActions m
+ Distribution.Client.TargetSelector: DirActions :: (FilePath -> m Bool) -> (FilePath -> m Bool) -> (FilePath -> m FilePath) -> m FilePath -> DirActions (m :: Type -> Type)
- Distribution.Client.TargetSelector: [canonicalizePath] :: DirActions m -> FilePath -> m FilePath
+ Distribution.Client.TargetSelector: [canonicalizePath] :: DirActions (m :: Type -> Type) -> FilePath -> m FilePath
- Distribution.Client.TargetSelector: [doesDirectoryExist] :: DirActions m -> FilePath -> m Bool
+ Distribution.Client.TargetSelector: [doesDirectoryExist] :: DirActions (m :: Type -> Type) -> FilePath -> m Bool
- Distribution.Client.TargetSelector: [doesFileExist] :: DirActions m -> FilePath -> m Bool
+ Distribution.Client.TargetSelector: [doesFileExist] :: DirActions (m :: Type -> Type) -> FilePath -> m Bool
- Distribution.Client.TargetSelector: [getCurrentDirectory] :: DirActions m -> m FilePath
+ Distribution.Client.TargetSelector: [getCurrentDirectory] :: DirActions (m :: Type -> Type) -> m FilePath
- Distribution.Client.TargetSelector: data DirActions m
+ Distribution.Client.TargetSelector: data DirActions (m :: Type -> Type)
- Distribution.Client.Types.PackageLocation: type UnresolvedPkgLoc = PackageLocation (Maybe FilePath)
+ Distribution.Client.Types.PackageLocation: type UnresolvedPkgLoc = PackageLocation Maybe FilePath
- Distribution.Client.Types.ReadyPackage: type ReadyPackage = GenericReadyPackage (ConfiguredPackage UnresolvedPkgLoc)
+ Distribution.Client.Types.ReadyPackage: type ReadyPackage = GenericReadyPackage ConfiguredPackage UnresolvedPkgLoc
- Distribution.Client.Types.SourceRepo: SourceRepositoryPackage :: !RepoType -> !String -> !Maybe String -> !Maybe String -> !f FilePath -> ![String] -> SourceRepositoryPackage f
+ Distribution.Client.Types.SourceRepo: SourceRepositoryPackage :: !RepoType -> !String -> !Maybe String -> !Maybe String -> !f FilePath -> ![String] -> SourceRepositoryPackage (f :: Type -> Type)
- Distribution.Client.Types.SourceRepo: [srpBranch] :: SourceRepositoryPackage f -> !Maybe String
+ Distribution.Client.Types.SourceRepo: [srpBranch] :: SourceRepositoryPackage (f :: Type -> Type) -> !Maybe String
- Distribution.Client.Types.SourceRepo: [srpCommand] :: SourceRepositoryPackage f -> ![String]
+ Distribution.Client.Types.SourceRepo: [srpCommand] :: SourceRepositoryPackage (f :: Type -> Type) -> ![String]
- Distribution.Client.Types.SourceRepo: [srpLocation] :: SourceRepositoryPackage f -> !String
+ Distribution.Client.Types.SourceRepo: [srpLocation] :: SourceRepositoryPackage (f :: Type -> Type) -> !String
- Distribution.Client.Types.SourceRepo: [srpSubdir] :: SourceRepositoryPackage f -> !f FilePath
+ Distribution.Client.Types.SourceRepo: [srpSubdir] :: SourceRepositoryPackage (f :: Type -> Type) -> !f FilePath
- Distribution.Client.Types.SourceRepo: [srpTag] :: SourceRepositoryPackage f -> !Maybe String
+ Distribution.Client.Types.SourceRepo: [srpTag] :: SourceRepositoryPackage (f :: Type -> Type) -> !Maybe String
- Distribution.Client.Types.SourceRepo: [srpType] :: SourceRepositoryPackage f -> !RepoType
+ Distribution.Client.Types.SourceRepo: [srpType] :: SourceRepositoryPackage (f :: Type -> Type) -> !RepoType
- Distribution.Client.Types.SourceRepo: data SourceRepositoryPackage f
+ Distribution.Client.Types.SourceRepo: data SourceRepositoryPackage (f :: Type -> Type)
- Distribution.Client.Types.SourceRepo: sourceRepositoryPackageGrammar :: (FieldGrammar c g, Applicative (g SourceRepoList), c (Identity RepoType), c (List NoCommaFSep FilePathNT String), c (NonEmpty' NoCommaFSep Token String)) => g SourceRepoList SourceRepoList
+ Distribution.Client.Types.SourceRepo: sourceRepositoryPackageGrammar :: forall (c :: Type -> Constraint) g. (FieldGrammar c g, Applicative (g SourceRepoList), c (Identity RepoType), c (List NoCommaFSep FilePathNT String), c (NonEmpty' NoCommaFSep Token String)) => g SourceRepoList SourceRepoList
- Distribution.Client.Types.SourceRepo: srpHoist :: (forall x. f x -> g x) -> SourceRepositoryPackage f -> SourceRepositoryPackage g
+ Distribution.Client.Types.SourceRepo: srpHoist :: (forall x. () => f x -> g x) -> SourceRepositoryPackage f -> SourceRepositoryPackage g
- Distribution.Client.Types.SourceRepo: srpToProxy :: SourceRepositoryPackage f -> SourceRepositoryPackage Proxy
+ Distribution.Client.Types.SourceRepo: srpToProxy :: forall (f :: Type -> Type). SourceRepositoryPackage f -> SourceRepositoryPackage (Proxy :: Type -> Type)
- Distribution.Client.Types.SourceRepo: type SourceRepoProxy = SourceRepositoryPackage Proxy
+ Distribution.Client.Types.SourceRepo: type SourceRepoProxy = SourceRepositoryPackage Proxy :: Type -> Type
- Distribution.Client.Utils: duplicatesBy :: forall a. (a -> a -> Ordering) -> [a] -> [[a]]
+ Distribution.Client.Utils: duplicatesBy :: (a -> a -> Ordering) -> [a] -> [[a]]
- Distribution.Client.Utils: makeRelativeToDirS :: Maybe (SymbolicPath CWD (Dir dir)) -> SymbolicPath CWD to -> IO (SymbolicPath dir to)
+ Distribution.Client.Utils: makeRelativeToDirS :: forall dir (to :: FileOrDir). Maybe (SymbolicPath CWD ('Dir dir)) -> SymbolicPath CWD to -> IO (SymbolicPath dir to)
- Distribution.Client.Utils: mergeBy :: forall a b. (a -> b -> Ordering) -> [a] -> [b] -> [MergeResult a b]
+ Distribution.Client.Utils: mergeBy :: (a -> b -> Ordering) -> [a] -> [b] -> [MergeResult a b]
- Distribution.Client.Utils: tryReadGenericPackageDesc :: Verbosity -> SymbolicPath CWD (Dir Pkg) -> String -> IO GenericPackageDescription
+ Distribution.Client.Utils: tryReadGenericPackageDesc :: Verbosity -> SymbolicPath CWD ('Dir Pkg) -> String -> IO GenericPackageDescription
- Distribution.Client.VCS: SourceRepoRepoTypeUnsupported :: SourceRepositoryPackage Proxy -> RepoType -> SourceRepoProblem
+ Distribution.Client.VCS: SourceRepoRepoTypeUnsupported :: SourceRepositoryPackage (Proxy :: Type -> Type) -> RepoType -> SourceRepoProblem
- Distribution.Client.VCS: cloneSourceRepo :: Verbosity -> VCS ConfiguredProgram -> SourceRepositoryPackage f -> [Char] -> IO ()
+ Distribution.Client.VCS: cloneSourceRepo :: forall (f :: Type -> Type). Verbosity -> VCS ConfiguredProgram -> SourceRepositoryPackage f -> [Char] -> IO ()
- Distribution.Client.VCS: data () => ConfiguredProgram
+ Distribution.Client.VCS: data ConfiguredProgram
- Distribution.Client.VCS: data () => Program
+ Distribution.Client.VCS: data Program
- Distribution.Client.VCS: data () => RepoType
+ Distribution.Client.VCS: data RepoType
- Distribution.Client.VCS: syncSourceRepos :: Verbosity -> VCS ConfiguredProgram -> [(SourceRepositoryPackage f, FilePath)] -> Rebuild ()
+ Distribution.Client.VCS: syncSourceRepos :: forall (f :: Type -> Type). Verbosity -> VCS ConfiguredProgram -> [(SourceRepositoryPackage f, FilePath)] -> Rebuild ()
- Distribution.Client.VCS: validateSourceRepo :: SourceRepositoryPackage f -> Either SourceRepoProblem (SourceRepositoryPackage f, String, RepoType, VCS Program)
+ Distribution.Client.VCS: validateSourceRepo :: forall (f :: Type -> Type). SourceRepositoryPackage f -> Either SourceRepoProblem (SourceRepositoryPackage f, String, RepoType, VCS Program)
- Distribution.Client.VCS: validateSourceRepos :: [SourceRepositoryPackage f] -> Either [(SourceRepositoryPackage f, SourceRepoProblem)] [(SourceRepositoryPackage f, String, RepoType, VCS Program)]
+ Distribution.Client.VCS: validateSourceRepos :: forall (f :: Type -> Type). [SourceRepositoryPackage f] -> Either [(SourceRepositoryPackage f, SourceRepoProblem)] [(SourceRepositoryPackage f, String, RepoType, VCS Program)]

Files

+ ChangeLog.md view
@@ -0,0 +1,607 @@+# Change-log++## 3.16.0.0 [Artem Pelenitsyn](mailto:a@pelenitsyn.top) July 2025++* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.16.0.0.md++## 3.14.2.0 [Mikolaj Konarski](mailto:mikolaj@well-typed.com) April 2025++* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.14.2.0.md++## 3.14.1.0 (Hécate [hecate+github@glitchbra.in](mailto:hecate+github@glitchbra.in) November 2024)++* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.14.1.0.md+++## 3.14.0.0 (Hécate [hecate+github@glitchbra.in](mailto:hecate+github@glitchbra.in) September 2024)++* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.14.0.0.md+++## 3.12.1.0 (Artem Pelenitsyn [a.pelenitsyn@gmail.com](mailto:a.pelenitsyn@gmail.com) June 2024)++* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.12.1.0.md+++## 3.10.3.0 (Hécate [hecate+github@glitchbra.in](mailto:hecate+github@glitchbra.in) January 2024)++* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.10.3.0.md+++## 3.10.2.1 (Hécate [hecate+github@glitchbra.in](mailto:hecate+github@glitchbra.in) November 2023)++* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.10.2.1.md+++## 3.10.2.0 (Hécate [hecate+github@glitchbra.in](mailto:hecate+github@glitchbra.in) November 2023)++* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.10.2.0.md+++## 3.10.1.0 (Mikolaj Konarski [mikolaj@well-typed.com](mailto:mikolaj@well-typed.com) March 2023)++* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.10.1.0.md+++## 3.8.1.0 (Mikolaj Konarski [mikolaj@well-typed.com](mailto:mikolaj@well-typed.com) August 2022)++* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.8.1.0.md+++## 3.6.2.0 (Emily Pillmore [emilypi@cohomolo.gy](mailto:emilypi@cohomolo.gy) October 2021)++* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.6.2.0.md+++## 3.6.0.0 (Emily Pillmore [emilypi@cohomolo.gy](mailto:emilypi@cohomolo.gy) August 2021)++* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.6.0.0.md+++## 3.4.1.0 (Emily Pillmore [emilypi@cohomolo.gy](mailto:emilypi@cohomolo.gy) October 2021)++* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.4.1.0.md+++## 3.4.0.0 (Oleg Grenrus [oleg.grenrus@iki.fi](mailto:oleg.grenrus@iki.fi) February 2021)++* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.4.0.0.md+++## 3.2.0.0 (Herbert Valerio Riedel [hvr@gnu.org](mailto:hvr@gnu.org) April 2020)++* `v2-build` (and other `v2-`prefixed commands) now accept the `--benchmark-option(s)` flags, which pass options to benchmark executables (analogous to how `--test-option(s)` works). (\#6209)+* Add solver optimization to skip a version of a package if it does not resolve any conflicts encountered in the last version, controlled by flag '--fine-grained-conflicts'. (\#5918)+* `cabal v2-exec` doesn't fail in clean package (\#6479)+* Show full ABI hash for installed packages in solver log (\#5892)+* Create incoming directory even for empty packages (\#4130)+* Start GHCi with `main-is` module in scope (\#6311)+* Implement `--benchmark-options` for `v2-bench` (\#6224)+* Fix store-dir in ghc env files generated by `cabal install --lib --package-env` (\#6298)+* `cabal v2-run` works with `.lhs` files (\#6134)+* `subdir` in source-repository-package accepts multiple entries (\#5472)+++## 3.0.1.0 (Herbert Valerio Riedel [hvr@gnu.org](mailto:hvr@gnu.org) April 2020)++* Create store incoming directory (\#4130)+* `fetchRepoTarball` output is not marked (\#6385)+* Update `setupMinCabalVersionConstraint` for GHC-8.8 (\#6217)+* Implement `cabal install --ignore-project` (\#5919)+* `cabal install executable` solver isn't affected by default environment contents (\#6410)+* Use `lukko` for file locking (\#6345)+* Use `hackage-security-0.6` (\#6388)+* Other dependency upgrades+++## 3.0.0.0 (Mikhail Glushenkov [mikhail.glushenkov@gmail.com](mailto:mikhail.glushenkov@gmail.com) August 2019)++* `v2-haddock` fails on `haddock` failures (\#5977)+* `v2-run` works when given `File.lhs` literate file. (\#6134)+* Parse comma-separated lists for extra-prog-path, extra-lib-dirs, extra-framework-dirs, and extra-include-dirs as actual lists. (\#5420)+* `v2-repl` no longer changes directory to a randomized temporary folder when used outside of a project. (\#5544)+* `install-method` and `overwrite-policy` in `.cabal/config` now actually work. (\#5942)+* `v2-install` now reports the error when a package fails to build. (\#5641)+* `v2-install` now has a default when called in a project (\#5978, \#6014, \#6092)+* '--write-ghc-environment-files' now defaults to 'never' (\#4242)+* Fix `sdist`'s output when sent to stdout. (\#5874)+* Allow a list of dependencies to be provided for `repl --build-depends`. (\#5845)+* Legacy commands are now only accessible with the `v1-` prefixes, and the `v2-` commands are the new default. Accordingly, the next version of Cabal will be the start of the 3.x version series. (\#5800)+* New solver flag: '--reject-unconstrained-dependencies'. (\#2568)+* Ported old-style test options to the new-style commands (\#5455).+* Improved error messages for cabal file parse errors. (\#5710)+* Removed support for `.zip` format source distributions (\#5755)+* Add "simple project" initialization option. (\#5707)+* Add '--minimize-conflict-set' flag to try to improve the solver's error message, but with an increase in run time. (\#5647)+* v2-test now succeeds when there are no test suites. (\#5435)+* Add '--lib', '--exe', and '--libandexe' shorthands to init. (\#5759)+* init now generates valid `Main.lhs` files. (\#5577)+* Init improvements: add flag '--application-dir', and when creating a library also create a MyLib.hs module. (\#5740)+* Add support for generating test-suite via cabal init. (\#5761)+* Increase `max-backjumps` default from 2000 to 4000.+* Make v2-install/new-install-specific flags configurable in ~/.cabal/config+* Add --installdir and --install-method=copy flags to v2-install that make it possible to copy the executable instead of symlinking it+* --symlink-bindir no longer controls the symlinking directory of v2-install (installdir controls both symlinking and copying now)+* Default to non-interactive init.+* Add --test-wrapper that allows a prebuild script to set the test environment.+* Add filterTestFlags: filter test-wrapper for Cabal < 3.0.0.+* Cabal now only builds the minimum of a package for `v2-install` (\#5754, \#6091)+++## 2.4.1.0 (Mikhail Glushenkov [mikhail.glushenkov@gmail.com](mailto:mikhail.glushenkov@gmail.com) November 2018)++* Add message to alert user to potential package casing errors. (\#5635)+* new-clean no longer deletes dist-newstyle/src with `-s`. (\#5699)+* 'new-install' now warns when failing to symlink an exe (\#5602)+* Extend 'cabal init' support for 'cabal-version' selection (\#5567)+* 'new-sdist' now generates tarballs with file modification times from a date in 2001. Using the Unix epoch caused problems on Windows. (\#5596)+* Register monolithic packages installed into the store due to a build-tool dependency if they also happen to contain a buildable public lib. (\#5379,\#5604)+* Fixed a Windows bug where cabal-install tried to copy files after moving them (\#5631).+* 'cabal v2-repl' now works for indefinite (in the Backpack sense) components. (\#5619)+* Set data dir environment variable for tarballs and remote repos (\#5469)+* Fix monolithic inplace build tool PATH (\#5633)+* 'cabal init' now supports '-w'/'--with-compiler' flag (\#4936, \#5654)+* Fix ambiguous --builddir on new-install (\#5652)+* Allow relative --storedir (\#5662)+* Respect --dry on new-install (\#5671)+* Warn when new-installing zero exes (\#5666)+* Add 'pkg-cabal-sha256' field to plan.json (\#5695)+* New v2-build flag: '--only-configure'. (\#5578)+* Fixed a 'new-install' failure that manifested when it encountered remote source dependencies in a project. (\#5643)+* New 'v2-[build,configure' flag: '--write-ghc-environment-files' to control the generation of .ghc.environment files. (\#5711)+++## 2.4.0.0 (Mikhail Glushenkov [mikhail.glushenkov@gmail.com](mailto:mikhail.glushenkov@gmail.com) September 2018)++* Bugfix: "cabal new-build --ghc-option '--bogus' --ghc-option '-O1'" no longer ignores all arguments except the last one (\#5512).+* Add the following option aliases for '-dir'-suffixed options: 'storedir', 'logsdir', 'packagedir', 'sourcedir', 'outputdir' (\#5484).+* 'new-run' now allows the user to run scripts that use a special block to define their requirements (as in the executable stanza) in place of a target. This also allows the use of 'cabal' as an interpreter in a shebang line.+* Add aliases for the "new-" commands that won't change when they lose their prefix or are eventually replaced by a third UI paradigm in the future. (\#5429)+* 'outdated' now accepts '--project-file FILE', which will look for bounds from the new-style freeze file named FILE.freeze. This is only available when `--new-freeze-file` has been passed.+* 'new-repl' now accepts a '--build-depends' flag which accepts the same syntax as is used in .cabal files to add additional dependencies to the environment when developing in the REPL. It is now usable outside of projects. (\#5425, \#5454)+* 'new-build' now treats Haddock errors non-fatally. In addition, it attempts to avoid trying to generate Haddocks when there is nothing to generate them from. (\#5232, \#5459)+* 'new-run', 'new-test', and 'new-bench' now will attempt to resolve ambiguous selectors by filtering out selectors that would be invalid. (\#4679, \#5461)+* 'new-install' now supports installing libraries and local components. (\#5399)+* Drop support for GHC 7.4, since it is out of our support window (and has been for over a year!).+* 'new-update' now works outside of projects. (\#5096)+* Extend `plan.json` with `pkg-src` provenance information. (\#5487)+* Add 'new-sdist' command (\#5389). Creates stable archives based on cabal projects in '.zip' and '.tar.gz' formats.+* Add '--repl-options' flag to 'cabal repl' and 'cabal new-repl' commands. Passes its arguments to the invoked repl, bypassing the new-build's cached configurations. This assures they don't trigger useless rebuilds and are always applied within the repl. (\#4247, \#5287)+* Add 'v1-' prefixes for the commands that will be replaced in the new-build universe, in preparation for it becoming the default. (\#5358)+* 'outdated' accepts '--v1-freeze-file' and '--v2-freeze-file' in the same spirit.+* Completed the 'new-clean' command (\#5357). The functionality is equivalent to old-style clean, but for nix-style builds.+* Ensure that each package selected for a build-depends dependency contains a library (\#5304).+* Support packages from local tarballs in the cabal.project file.+* Default changelog generated by 'cabal init' is now named 'CHANGELOG.md' (\#5441).+* Align output of 'new-build' command phases (\#4040).+* Add support for specifying remote VCS dependencies via new 'source-repository-package' stanzas in 'cabal.project' files (\#5351).+++## 2.2.0.0 (Mikhail Glushenkov [mikhail.glushenkov@gmail.com](mailto:mikhail.glushenkov@gmail.com) March 2018)++* '--with-PROG' and '--PROG-options' are applied to all packages and not local packages only (\#5019).+* Completed the 'new-update' command (\#4809), which respects nix-style cabal.project(.local) files and allows to update from multiple repositories when using overlays.+* Completed the 'new-run' command (\#4477). The functionality is the same of the old 'run' command but using nix-style builds. Additionally, it can run executables across packages in a project. Tests and benchmarks are also treated as executables, providing a quick way to pass them arguments.+* Completed the 'new-bench' command (\#3638). Same as above.+* Completed the 'new-exec' command (\#3638). Same as above.+* Added a preliminary 'new-install' command (\#4558, nonlocal exes part) which allows to quickly install executables from Hackage.+* Set symlink-bindir (used by new-install) to .cabal/bin by default on .cabal/config initialization (\#5188).+* 'cabal update' now supports '--index-state' which can be used to roll back the index to an earlier state.+* '--allow-{newer,older}' syntax has been enhanced. Dependency relaxation can be now limited to a specific release of a package, plus there's a new syntax for relaxing only caret-style (i.e. '^>=') dependencies (\#4575, \#4669).+* New config file field: 'cxx-options' to specify which options to be passed to the compiler when compiling C++ sources specified by the 'cxx-sources' field. (\#3700)+* New config file field: 'cxx-sources' to specify C++ files to be compiled separately from C source files. Useful in conjunction with the 'cxx-options' flag to pass different compiler options to C and C++ source files. (\#3700)+* Use [lfxtb] letters to differentiate component kind instead of opaque "c" in dist-dir layout.+* 'cabal configure' now supports '--enable-static', which can be used to build static libraries with GHC via GHC's `-staticlib` flag.+* 'cabal user-config now supports '--augment' which can append additional lines to a new or updated cabal config file.+* Added support for '--enable-tests' and '--enable-benchmarks' to 'cabal fetch' (\#4948).+* Misspelled package-names on CLI will no longer be silently case-corrected (\#4778).+* 'cabal new-configure' now backs up the old 'cabal.project.local' file if it exists (\#4460).+* On macOS, `new-build` will now place dynamic libraries into `store/lib` and aggressively shorten their names in an effort to stay within the load command size limits of macOSs mach-o linker.+* 'new-build' now checks for the existence of executables for build-tools and build-tool-depends dependencies in the solver (\#4884).+* Fixed a spurious warning telling the user to run 'cabal update' when it wasn't necessary (\#4444).+* Packages installed in sandboxes via 'add-source' now have their timestamps updated correctly and so will not be reinstalled unnecessarily if the main install command fails (\#1375).+* Add Windows device path support for copyFile, renameFile. Allows cabal new-build to use temporary store path of up to 32k length (\#3972, \#4914, \#4515).+* When a flag value is specified multiple times on the command line, the last one is now preferred, so e.g. '-f+dev -f-dev' is now equivalent to '-f-dev' (\#4452).+* Removed support for building cabal-install with GHC < 7.10 (\#4870).+* New 'package *' section in 'cabal.project' files that applies options to all packages, not just those local to the project.+* Paths_ autogen modules now compile when `RebindableSyntax` or `OverloadedStrings` is used in `default-extensions`. [stack\#3789](https://github.com/commercialhaskell/stack/issues/3789)+* getDataDir`and other`Paths_autogen`functions now work correctly when compiling a custom`Setup.hs`script using`new-build` (\#5164).+++## 2.0.0.1 (Mikhail Glushenkov [mikhail.glushenkov@gmail.com](mailto:mikhail.glushenkov@gmail.com) December 2017)++* Support for GHC's numeric -g debug levels (\#4673).+* Demoted 'scope' field version check to a warning (\#4714).+* Fixed verbosity flags getting removed before being passed to 'printPlan' (\#4724).+* Added a '--store-dir' option that can be used to configure the location of the build global build store (\#4623).+* Turned `allow-{newer,older}` in `cabal.project` files into an accumulating field to match CLI flag semantics (\#4679).+* Improve success message when `cabal upload`ing documentation (\#4777).+* Documentation fixes.+++## 2.0.0.0 (Mikhail Glushenkov [mikhail.glushenkov@gmail.com](mailto:mikhail.glushenkov@gmail.com) August 2017)++* See http://coldwa.st/e/blog/2017-09-09-Cabal-2-0.html for more detailed release notes.+* Removed the '--root-cmd' parameter of the 'install' command (\#3356).+* Deprecated 'cabal install --global' (\#3356).+* Changed 'cabal upload' to upload a package candidate by default (\#3419). Same applies to uploading documentation.+* Added a new 'cabal upload' flag '--publish' for publishing a package on Hackage instead of uploading a candidate (\#3419).+* Added optional solver output visualisation support via the tracetree package. Mainly intended for debugging (\#3410).+* Removed the '--check' option from 'cabal upload' (\#1823). It was replaced by package candidates.+* Fixed various behaviour differences between network transports (\#3429).+* The bootstrap script now works correctly when run from a Git clone (\#3439).+* Removed the top-down solver (\#3598).+* The '-v/--verbosity' option no longer affects GHC verbosity (except in the case of '-v0'). Use '--ghc-options=-v' to enable verbose GHC output (\#3540, \#3671).+* Changed the default logfile template from '.../$pkgid.log' to '.../$compiler/\$libname.log' (\#3807).+* Added a new command, 'cabal reconfigure', which re-runs 'configure' with the most recently used flags (\#2214).+* Added the '--index-state' flag for requesting a specific version of the package index (\#3893, \#4115).+* Support for building Backpack packages.  See https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst for more details.+* Support the Nix package manager (\#3651).+* Made the 'template-haskell' package non-upgradable again (\#4185).+* Fixed password echoing on MinTTY (\#4128).+* Added a new solver flag, '--allow-boot-library-installs', that allows any package to be installed or upgraded (\#4209).+* New 'cabal-install' command: 'outdated', for listing outdated version bounds in a .cabal file or a freeze file (\#4207).+* Added qualified constraints for setup dependencies. For example, --constraint="setup.bar == 1.0" constrains all setup dependencies on bar, and --constraint="foo:setup.bar == 1.0" constrains foo's setup dependency on bar (part of \#3502).+* Non-qualified constraints, such as --constraint="bar == 1.0", now only apply to top-level dependencies. They don't constrain setup or build-tool dependencies. The new syntax --constraint="any.bar == 1.0" constrains all uses of bar.+* Added a technical preview version of the 'cabal doctest' command (\#4480).+++## 1.24.0.2 (Mikhail Glushenkov [mikhail.glushenkov@gmail.com](mailto:mikhail.glushenkov@gmail.com) December 2016)++* Adapted to the revert of a PVP-noncompliant API change in Cabal 1.24.2.0 (\#4123).+* Bumped the directory upper bound to < 1.4 (\#4158).+++## 1.24.0.1 (Ryan Thomas [ryan@ryant.org](mailto:ryan@ryant.org) October 2016)++* Fixed issue with passing '--enable-profiling' when invoking Setup scripts built with older versions of Cabal (\#3873).+* Fixed various behaviour differences between network transports (\#3429).+* Updated to depend on the latest hackage-security that fixes various issues on Windows.+* Fixed 'new-build' to exit with a non-zero exit code on failure (\#3506).+* Store secure repo index data as 01-index.* (\#3862).+* Added new hackage-security root keys for distribution with cabal-install.+* Fix an issue where 'cabal install' sometimes had to be run twice for packages with build-type: Custom and a custom-setup stanza (\#3723).+* 'cabal sdist' no longer ignores '--builddir' when the package's build-type is Custom (\#3794).+++## 1.24.0.0 (Ryan Thomas [ryan@ryant.org](mailto:ryan@ryant.org) March 2016)++* If there are multiple remote repos, 'cabal update' now updates them in parallel (\#2503).+* New 'cabal upload' option '-P'/'--password-command' for reading Hackage password from arbitrary program output (\#2506).+* Better warning for 'cabal run' (\#2510).+* 'cabal init' now warns if the chosen package name is already registered in the source package index (\#2436).+* New 'cabal install' option: '--offline' (\#2578).+* Accept 'builddir' field in cabal.config (\#2484)+* Read 'builddir' option from 'CABAL_BUILDDIR' environment variable.+* Remote repos may now be configured to use https URLs. This uses either curl or wget or, on Windows, PowerShell, under the hood (\#2687).+* Install target URLs can now use https e.g. 'cabal install https://example.com/foo-1.0.tar.gz'.+* Automatically use https for cabal upload for the main hackage.haskell.org (other repos will use whatever they are configured to use).+* Support for dependencies of custom Setup.hs scripts (see http://www.well-typed.com/blog/2015/07/cabal-setup-deps/).+* 'cabal' program itself now can be used as an external setup method. This fixes an issue when Cabal version mismatch caused unnecessary reconfigures (\#2633).+* Improved error message for unsatisfiable package constraints (\#2727).+* Fixed a space leak in 'cabal update' (\#2826).+* 'cabal exec' and 'sandbox hc-pkg' now use the configured compiler (\#2859).+* New 'cabal haddock' option: '--for-hackage' (\#2852).+* Added a warning when the solver cannot find a dependency (\#2853).+* New 'cabal upload' option: '--doc': upload documentation to hackage (\#2890).+* Improved error handling for 'sandbox delete-source' (\#2943).+* Solver support for extension and language flavours (\#2873).+* Support for secure repos using hackage-security (\#2983).+* Added a log file message similar to one printed by 'make' when building in another directory (\#2642).+* Added new subcommand 'init' to 'cabal user-config'. This subcommand creates a cabal configuration file in either the default location or as specified by --config-file (\#2553).+* The man page for 'cabal-install' is now automatically generated (\#2877).+* The '--allow-newer' option now works as expected when specified multiple times (\#2588).+* New config file field: 'extra-framework-dirs' (extra locations to find OS X frameworks in). Can be also specified as an argument for 'install' and 'configure' commands (\#3158).+* It's now possible to limit the scope of '--allow-newer' to single packages in the install plan (\#2756).+* Full '--allow-newer' syntax is now supported in the config file (that is, 'allow-newer: base, ghc-prim,  some-package:vector') (\#3171).+* Improved performance of '--reorder-goals' (\#3208).+* Fixed space leaks in modular solver (\#2916, \#2914).+* Made the solver aware of pkg-config constraints (\#3023).+* Added a new command: 'gen-bounds' (\#3223). See http://softwaresimply.blogspot.se/2015/08/cabal-gen-bounds-easy-generation-of.html.+* Tech preview of new nix-style isolated project-based builds. Currently provides the commands (new-)build/repl/configure.+++## 1.22.9.0 (Ryan Thomas [ryan@ryant.org](mailto:ryan@ryant.org) March 2016)++* Include Cabal-1.22.8.0+++## 1.22.8.0 (Ryan Thomas [ryan@ryant.org](mailto:ryan@ryant.org) February 2016)++* Only Custom setup scripts should be compiled with '-i -i.'.+* installedCabalVersion: Don't special-case Cabal anymore.+* Bump the HTTP upper bound. See \#3069.+++## 1.22.7.0 (Ryan Thomas [ryan@ryant.org](mailto:ryan@ryant.org) December 2015)++* Remove GZipUtils tests+* maybeDecompress: bail on all errors at the beginning of the stream with zlib < 0.6+* Correct maybeDecompress+++## 1.22.6.0 (Ryan Thomas [ryan@ryant.org](mailto:ryan@ryant.org) June 2015)++* A fix for @ezyang's fix for \#2502. (Mikhail Glushenkov)+++## 1.22.5.0 (Ryan Thomas [ryan@ryant.org](mailto:ryan@ryant.org) June 2015)++* Reduce temporary directory name length, fixes \#2502. (Edward Z. Yang)+++## 1.22.4.0 (Ryan Thomas [ryan@ryant.org](mailto:ryan@ryant.org) May 2015)++* Force cabal upload to always use digest auth and never basic auth.+* Add dependency-graph information to `printPlan` output+* bootstrap.sh: fixes linker matching to avoid cases where tested linker names appear unexpectedly in compiler output (fixes \#2542)+++## 1.22.3.0 (Ryan Thomas [ryan@ryant.org](mailto:ryan@ryant.org) April 2015)++* Fix bash completion for sandbox subcommands - Fixes \#2513 (Mikhail Glushenkov)+* filterConfigureFlags: filter more flags (Mikhail Glushenkov)+++## 1.22.2.0 (Ryan Thomas [ryan@ryant.org](mailto:ryan@ryant.org) March 2015)++* Don't pass '--{en,dis}able-profiling' to old setup exes.+* -Wall police+* Allow filepath 1.4+++## 1.22.0.0 (Johan Tibell [johan.tibell@gmail.com](mailto:johan.tibell@gmail.com) January 2015)++* New command: user-config (\#2159).+* Implement 'cabal repl --only' (\#2016).+* Fix an issue when 'cabal repl' was doing unnecessary compilation (\#1715).+* Prompt the user to specify source directory in 'cabal init' (\#1989).+* Remove the self-upgrade check (\#2090).+* Don't redownload already downloaded packages when bootstrapping (\#2133).+* Support sandboxes in 'bootstrap.sh' (\#2137).+* Install profiling and shared libs by default in 'bootstrap.sh' (\#2009).+++## 1.20.2.0 (Ryan Thomas [ryan@ryant.org](mailto:ryan@ryant.org) February 2016)++* Only Custom setup scripts should be compiled with '-i -i.'.+* installedCabalVersion: Don't special-case Cabal anymore.+++## 1.20.1.0 (Ryan Thomas [ryan@ryant.org](mailto:ryan@ryant.org) May 2015)++* Force cabal upload to always use digest auth and never basic auth.+* bootstrap.sh: install network-uri before HTTP+++## 1.20.0.5 (Johan Tibell [johan.tibell@gmail.com](mailto:johan.tibell@gmail.com) December 2014)++* Support random 1.1.+* Fix bootstrap script after network package split.+* Support network-2.6 in test suite.+++## 1.20.0.3 (Johan Tibell [johan.tibell@gmail.com](mailto:johan.tibell@gmail.com) June 2014)++* Don't attempt to rename dist if it is already named correctly+* Treat all flags of a package as interdependent.+* Allow template-haskell to be upgradable again+++## 1.20.0.2 (Johan Tibell [johan.tibell@gmail.com](mailto:johan.tibell@gmail.com) May 2014)++* Increase max-backjumps to 2000.+* Fix solver bug which led to missed install plans.+* Fix streaming test output.+* Tweak solver heuristics to avoid reinstalls.+++## 1.20.0.1 (Johan Tibell [johan.tibell@gmail.com](mailto:johan.tibell@gmail.com) May 2014)++* Fix cabal repl search path bug on Windows+* Include OS and arch in cabal-install user agent+* Revert --constraint flag behavior in configure to 1.18 behavior+++## 1.20.0.0 (Johan Tibell [johan.tibell@gmail.com](mailto:johan.tibell@gmail.com) April 2014)++* Build only selected executables+* Add -j flag to build/test/bench/run+* Improve install log file+* Don't symlink executables when in a sandbox+* Add --package-db flag to 'list' and 'info'+* Make upload more efficient+* Add --require-sandbox option+* Add experimental Cabal file format command+* Add haddock section to config file+* Add --main-is flag to init+++## 1.18.2.0 (Ryan Thomas [ryan@ryant.org](mailto:ryan@ryant.org) February 2016)++* Only Custom setup scripts should be compiled with '-i -i.'.+* installedCabalVersion: Don't special-case Cabal anymore.+++## 1.18.1.0 (Ryan Thomas [ryan@ryant.org](mailto:ryan@ryant.org) May 2015)++* Force cabal upload to always use digest auth and never basic auth.+* Merge pull request \#2367 from juhp/patch-2+* Fix bootstrap.sh by bumping HTTP to 4000.2.16.1+++## 1.18.0.7 (Johan Tibell [johan.tibell@gmail.com](mailto:johan.tibell@gmail.com) December 2014)++* Support random 1.1.+* Fix bootstrap script after network package split.+* Support network-2.6 in test suite.+++## 1.18.0.5 (Johan Tibell [johan.tibell@gmail.com](mailto:johan.tibell@gmail.com) July 2014)++* Make solver flag resolution more conservative.+++## 1.18.0.4 (Johan Tibell [johan.tibell@gmail.com](mailto:johan.tibell@gmail.com) May 2014)++* Increase max-backjumps to 2000.+* Fix solver bug which led to missed install plans.+* Tweak solver heuristics to avoid reinstalls.+++## 0.14.0 (Andres Loeh [andres@well-typed.com](mailto:andres@well-typed.com) April 2012)++* Works with ghc-7.4+* Completely new modular dependency solver (default in most cases)+* Some tweaks to old topdown dependency solver+* Install plans are now checked for reinstalls that break packages+* Flags --constraint and --preference work for nonexisting packages+* New constraint forms for source and installed packages+* New constraint form for package-specific use flags+* New constraint form for package-specific stanza flags+* Test suite dependencies are pulled in on demand+* No longer install packages on --enable-tests when tests fail+* New "cabal bench" command+* Various "cabal init" tweaks+++## 0.10.0 (Duncan Coutts [duncan@community.haskell.org](mailto:duncan@community.haskell.org) February 2011)++* New package targets: local dirs, local and remote tarballs+* Initial support for a "world" package target+* Partial fix for situation where user packages mask global ones+* Removed cabal upgrade, new --upgrade-dependencies flag+* New cabal install --only-dependencies flag+* New cabal fetch --no-dependencies and --dry-run flags+* Improved output for cabal info+* Simpler and faster bash command line completion+* Fix for broken proxies that decompress wrongly+* Fix for cabal unpack to preserve executable permissions+* Adjusted the output for the -v verbosity level in a few places+++## 0.8.2 (Duncan Coutts [duncan@community.haskell.org](mailto:duncan@community.haskell.org) March 2010)++* Fix for cabal update on Windows+* On windows switch to per-user installs (rather than global)+* Handle intra-package dependencies in dependency planning+* Minor tweaks to cabal init feature+* Fix various -Wall warnings+* Fix for cabal sdist --snapshot+++## 0.8.0 (Duncan Coutts [duncan@haskell.org](mailto:duncan@haskell.org) Dec 2009)++* Works with ghc-6.12+* New "cabal init" command for making initial project .cabal file+* New feature to maintain an index of haddock documentation+++## 0.6.4 (Duncan Coutts [duncan@haskell.org](mailto:duncan@haskell.org) Nov 2009)++* Improve the algorithm for selecting the base package version+* Hackage errors now reported by "cabal upload [--check]"+* Improved format of messages from "cabal check"+* Config file can now be selected by an env var+* Updated tar reading/writing code+* Improve instructions in the README and bootstrap output+* Fix bootstrap.sh on Solaris 9+* Fix bootstrap for systems where network uses parsec 3+* Fix building with ghc-6.6+++## 0.6.2 (Duncan Coutts [duncan@haskell.org](mailto:duncan@haskell.org) Feb 2009)++* The upgrade command has been disabled in this release+* The configure and install commands now have consistent behaviour+* Reduce the tendency to re-install already existing packages+* The --constraint= flag now works for the install command+* New --preference= flag for soft constraints / version preferences+* Improved bootstrap.sh script, smarter and better error checking+* New cabal info command to display detailed info on packages+* New cabal unpack command to download and untar a package+* HTTP-4000 package required, should fix bugs with http proxies+* Now works with authenticated proxies.+* On Windows can now override the proxy setting using an env var+* Fix compatibility with config files generated by older versions+* Warn if the hackage package list is very old+* More helpful --help output, mention config file and examples+* Better documentation in ~/.cabal/config file+* Improved command line interface for logging and build reporting+* Minor improvements to some messages+++## 0.6.0 (Duncan Coutts [duncan@haskell.org](mailto:duncan@haskell.org) Oct 2008)++* Constraint solver can now cope with base 3 and base 4+* Allow use of package version preferences from hackage index+* More detailed output from cabal install --dry-run -v+* Improved bootstrap.sh+++## 0.5.2 (Duncan Coutts [duncan@haskell.org](mailto:duncan@haskell.org) Aug 2008)++* Support building haddock documentation+* Self-reinstall now works on Windows+* Allow adding symlinks to executables into a separate bindir+* New self-documenting config file+* New install --reinstall flag+* More helpful status messages in a couple places+* Upload failures now report full text error message from the server+* Support for local package repositories+* New build logging and reporting+* New command to upload build reports to (a compatible) server+* Allow tilde in hackage server URIs+* Internal code improvements+* Many other minor improvements and bug fixes+++## 0.5.1 (Duncan Coutts [duncan@haskell.org](mailto:duncan@haskell.org) June 2008)++* Restore minimal hugs support in dependency resolver+* Fix for disabled http proxies on Windows+* Revert to global installs on Windows by default+++## 0.5.0 (Duncan Coutts [duncan@haskell.org](mailto:duncan@haskell.org) June 2008)++* New package dependency resolver, solving diamond dep problem+* Integrate cabal-setup functionality+* Integrate cabal-upload functionality+* New cabal update and check commands+* Improved behavior for install and upgrade commands+* Full Windows support+* New command line handling+* Bash command line completion+* Allow case insensitive package names on command line+* New --dry-run flag for install, upgrade and fetch commands+* New --root-cmd flag to allow installing as root+* New --cabal-lib-version flag to select different Cabal lib versions+* Support for HTTP proxies+* Improved cabal list output+* Build other non-dependent packages even when some fail+* Report a summary of all build failures at the end+* Partial support for hugs+* Partial implementation of build reporting and logging+* More consistent logging and verbosity+* Significant internal code restructuring+++## 0.4 (Duncan Coutts [duncan@haskell.org](mailto:duncan@haskell.org) Oct 2007)++* Renamed executable from 'cabal-install' to 'cabal'+* Partial Windows compatibility+* Do per-user installs by default+* cabal install now installs the package in the current directory+* Allow multiple remote servers+* Use zlib lib and internal tar code and rather than external tar+* Reorganised configuration files+* Significant code restructuring+* Cope with packages with conditional dependencies+++## 0.3 and older versions (by Lemmih, Paolo Martini and others 2006-2007)++* Switch from smart-server, dumb-client model to the reverse+* New .tar.gz based index format+* New remote and local package archive format
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2003-2024, Cabal Development Team.+Copyright (c) 2003-2025, Cabal Development Team. See the AUTHORS file for the full list of copyright holders.  See */LICENSE for the copyright holders of the subcomponents.
cabal-install.cabal view
@@ -1,7 +1,7 @@-Cabal-Version:      3.0+Cabal-Version:      3.6  Name:               cabal-install-Version:            3.14.2.0+Version:            3.16.0.0 Synopsis:           The command-line interface for Cabal and Hackage. Description:     The \'cabal\' command-line program simplifies the process of managing@@ -13,14 +13,14 @@ License-File:       LICENSE Author:             Cabal Development Team (see AUTHORS file) Maintainer:         Cabal Development Team <cabal-devel@haskell.org>-Copyright:          2003-2024, Cabal Development Team+Copyright:          2003-2025, Cabal Development Team Category:           Distribution Build-type:         Simple Extra-Source-Files:   bash-completion/cabal extra-doc-files:   README.md-  changelog+  ChangeLog.md  source-repository head   type:     git@@ -36,9 +36,14 @@  Flag lukko   description:  Use @lukko@ for file-locking-  default:      True-  manual:       True+  default:      False+  manual:       False +flag git-rev+  description: include Git revision hash in version+  default: False+  manual: True+ common warnings     ghc-options:       -Wall@@ -52,16 +57,20 @@       ghc-options: -Wnoncanonical-monadfail-instances  common base-dep-    build-depends: base >=4.13 && <4.22+    build-depends:+      , base >=4.13 && <4.22  common cabal-dep-    build-depends: Cabal >=3.14.2 && <3.15+    build-depends:+      , Cabal ^>=3.16  common cabal-syntax-dep-    build-depends: Cabal-syntax ^>=3.14+    build-depends:+      , Cabal-syntax ^>=3.16  common cabal-install-solver-dep-    build-depends: cabal-install-solver ^>=3.14+    build-depends:+      , cabal-install-solver ^>=3.16  library     import: warnings, base-dep, cabal-dep, cabal-syntax-dep, cabal-install-solver-dep@@ -77,6 +86,7 @@         -- this modules are moved from Cabal         -- they are needed for as long until cabal-install moves to parsec parser         Distribution.Deprecated.ParseUtils+        Distribution.Deprecated.ProjectParseUtils         Distribution.Deprecated.ReadP         Distribution.Deprecated.ViewAsFieldDescr @@ -105,8 +115,10 @@         Distribution.Client.CmdRepl         Distribution.Client.CmdRun         Distribution.Client.CmdSdist+        Distribution.Client.CmdTarget         Distribution.Client.CmdTest         Distribution.Client.CmdUpdate+        Distribution.Client.CmdGenBounds         Distribution.Client.Compat.Directory         Distribution.Client.Compat.ExecutablePath         Distribution.Client.Compat.Orphans@@ -219,36 +231,36 @@         Distribution.Client.Win32SelfUpgrade      build-depends:-        async      >= 2.0      && < 2.3,-        array      >= 0.4      && < 0.6,-        base16-bytestring >= 0.1.1 && < 1.1,-        binary     >= 0.7.3    && < 0.9,-        bytestring >= 0.10.6.0 && < 0.13,-        containers >= 0.5.6.2  && < 0.8,-        cryptohash-sha256 >= 0.11 && < 0.12,-        directory  >= 1.3.7.0  && < 1.4,-        echo       >= 0.1.3    && < 0.2,-        edit-distance >= 0.2.2 && < 0.3,-        exceptions >= 0.10.4   && < 0.11,-        filepath   >= 1.4.0.0  && < 1.6,-        HTTP       >= 4000.1.5 && < 4000.5,-        mtl        >= 2.0      && < 2.4,-        network-uri >= 2.6.0.2 && < 2.7,-        pretty     >= 1.1      && < 1.2,-        process    >= 1.2.3.0  && < 1.7,-        random     >= 1.2      && < 1.4,-        stm        >= 2.0      && < 2.6,-        tar        >= 0.5.0.3  && < 0.7,-        time       >= 1.5.0.1  && < 1.15,-        zlib       >= 0.5.3    && < 0.8,-        hackage-security >= 0.6.2.0 && < 0.7,-        text       >= 1.2.3    && < 1.3 || >= 2.0 && < 2.2,-        parsec     >= 3.1.13.0 && < 3.2,-        open-browser >= 0.2.1.0 && < 0.4,-        regex-base  >= 0.94.0.0 && <0.95,-        regex-posix >= 0.96.0.0 && <0.97,-        safe-exceptions >= 0.1.7.0 && < 0.2,-        semaphore-compat >= 1.0.0 && < 1.1+      , async      >= 2.0      && < 2.3+      , array      >= 0.4      && < 0.6+      , base16-bytestring >= 0.1.1 && < 1.1+      , binary     >= 0.7.3    && < 0.9+      , bytestring >= 0.10.6.0 && < 0.13+      , containers >= 0.5.6.2  && < 0.9+      , cryptohash-sha256 >= 0.11 && < 0.12+      , directory  >= 1.3.7.0  && < 1.4+      , echo       >= 0.1.3    && < 0.2+      , edit-distance >= 0.2.2 && < 0.3+      , exceptions >= 0.10.4   && < 0.11+      , filepath   >= 1.4.0.0  && < 1.6+      , HTTP       >= 4000.1.5 && < 4000.5+      , mtl        >= 2.0      && < 2.4+      , network-uri >= 2.6.0.2 && < 2.7+      , pretty     >= 1.1      && < 1.2+      , process    >= 1.2.3.0  && < 1.7+      , random     >= 1.2      && < 1.4+      , stm        >= 2.0      && < 2.6+      , tar        >= 0.5.0.3  && < 0.7+      , time       >= 1.5.0.1  && < 1.15+      , zlib       >= 0.5.3    && < 0.8+      , hackage-security >= 0.6.2.0 && < 0.7+      , text       >= 1.2.3    && < 1.3 || >= 2.0 && < 2.2+      , parsec     >= 3.1.13.0 && < 3.2+      , open-browser >= 0.2.1.0 && < 0.5+      , regex-base  >= 0.94.0.0 && <0.95+      , regex-posix >= 0.96.0.0 && <0.97+      , safe-exceptions >= 0.1.7.0 && < 0.2+      , semaphore-compat >= 1.0.0 && < 1.1      if flag(native-dns)       if os(windows)@@ -258,17 +270,25 @@      if os(windows)       -- newer directory for symlinks-      build-depends: Win32 >= 2.8 && < 3, directory >=1.3.1.0+      build-depends:+        , Win32 >= 2.8 && < 3+        , directory >=1.3.1.0     else-      build-depends: unix >= 2.5 && < 2.8 || >= 2.8.6.0 && < 2.9+      build-depends:+        , unix >= 2.5 && < 2.8 || >= 2.8.6.0 && < 2.9      if flag(lukko)-      build-depends: lukko >= 0.1 && <0.2+      build-depends:+        , lukko >= 0.1 && <0.2      -- pull in process version with fixed waitForProcess error     if impl(ghc >=8.2)-      build-depends: process >= 1.6.15.0+      build-depends:+        , process >= 1.6.15.0 +    if flag(git-rev)+      build-depends: githash ^>= 0.1.7.0+      cpp-options: -DGIT_REV  executable cabal     import: warnings, base-dep@@ -282,6 +302,9 @@     if os(aix)         extra-libraries: bsd +    if flag(git-rev)+      cpp-options: -DGIT_REV+     build-depends:         cabal-install @@ -332,29 +355,28 @@       UnitTests.Options      build-depends:-          array,-          bytestring,-          cabal-install,-          Cabal-tree-diff,-          Cabal-QuickCheck,-          Cabal-tests,-          containers,-          directory,-          filepath,-          mtl,-          network-uri >= 2.6.2.0 && <2.7,-          random,-          tar,-          time,-          zlib,-          tasty >= 1.2.3 && <1.6,-          tasty-golden >=2.3.1.1 && <2.4,-          tasty-quickcheck ^>=0.11,-          tasty-expected-failure,-          tasty-hunit >= 0.10,-          tree-diff,-          QuickCheck >= 2.14.3 && <2.16-+      , array+      , bytestring+      , cabal-install+      , Cabal-tree-diff+      , Cabal-QuickCheck+      , Cabal-tests+      , containers+      , directory+      , filepath+      , mtl+      , network-uri >= 2.6.2.0 && <2.7+      , random+      , tar+      , time+      , zlib+      , tasty >= 1.2.3 && <1.6+      , tasty-golden >=2.3.1.1 && <2.4+      , tasty-quickcheck ^>=0.11+      , tasty-expected-failure+      , tasty-hunit >= 0.10+      , tree-diff+      , QuickCheck >= 2.14.3 && <2.17  -- Tests to run with a limited stack and heap size -- The test suite name must be keep short cause a longer one@@ -376,10 +398,10 @@     UnitTests.Options    build-depends:-        cabal-install,-        containers,-        tasty >= 1.2.3 && <1.6,-        tasty-hunit >= 0.10+    , cabal-install+    , containers+    , tasty >= 1.2.3 && <1.6+    , tasty-hunit >= 0.10   -- Integration tests that use the cabal-install code directly@@ -392,16 +414,21 @@   hs-source-dirs: tests   default-language: Haskell2010 +  other-modules:+    IntegrationTests2.CPP+   build-depends:-        bytestring,-        cabal-install,-        containers,-        directory,-        filepath,-        process,-        tasty >= 1.2.3 && <1.6,-        tasty-hunit >= 0.10,-        tagged+    , bytestring+    , cabal-install+    , containers+    , directory+    , filepath+    , process+    , tasty >= 1.5 && <1.6+    , tasty-hunit >= 0.10+    , tasty-expected-failure+    , silently+    , tagged  test-suite long-tests   import: warnings, base-dep, cabal-dep, cabal-syntax-dep, cabal-install-solver-dep@@ -423,20 +450,20 @@     UnitTests.Options    build-depends:-        Cabal-QuickCheck,-        Cabal-described,-        Cabal-tests,-        cabal-install,-        containers,-        directory,-        filepath,-        mtl,-        network-uri >= 2.6.2.0 && <2.7,-        random,-        tagged,-        tasty >= 1.2.3 && <1.6,-        tasty-expected-failure,-        tasty-hunit >= 0.10,-        tasty-quickcheck <0.12,-        QuickCheck >= 2.14 && <2.16,-        pretty-show >= 1.6.15+    , Cabal-QuickCheck+    , Cabal-described+    , Cabal-tests+    , cabal-install+    , containers+    , directory+    , filepath+    , mtl+    , network-uri >= 2.6.2.0 && <2.7+    , random+    , tagged+    , tasty >= 1.2.3 && <1.6+    , tasty-expected-failure+    , tasty-hunit >= 0.10+    , tasty-quickcheck <0.12+    , QuickCheck >= 2.14 && <2.17+    , pretty-show >= 1.6.15
− changelog 
@@ -1,659 +0,0 @@--*-change-log-*---3.14.2.0 Mikolaj Konarski <mikolaj@well-typed.com> April 2025-	* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.14.2.0.md--3.14.1.0 Hécate <hecate+github@glitchbra.in> November 2024-	* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.14.1.0.md--3.14.0.0 Hécate <hecate+github@glitchbra.in> September 2024-	* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.14.0.0.md--3.12.1.0 Artem Pelenitsyn <a.pelenitsyn@gmail.com> June 2024-	* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.12.1.0.md--3.10.3.0 Hécate <hecate+github@glitchbra.in> January 2024-	* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.10.3.0.md--3.10.2.1 Hécate <hecate+github@glitchbra.in> November 2023-	* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.10.2.1.md--3.10.2.0 Hécate <hecate+github@glitchbra.in> November 2023-	* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.10.2.0.md--3.10.1.0 Mikolaj Konarski <mikolaj@well-typed.com> March 2023-	* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.10.1.0.md--3.8.1.0 Mikolaj Konarski <mikolaj@well-typed.com> August 2022-	* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.8.1.0.md--3.6.2.0 Emily Pillmore <emilypi@cohomolo.gy> October 2021-	* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.6.2.0.md--3.6.0.0 Emily Pillmore <emilypi@cohomolo.gy> August 2021-	* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.6.0.0.md--3.4.1.0 Emily Pillmore <emilypi@cohomolo.gy> October 2021-	* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.4.1.0.md--3.4.0.0 Oleg Grenrus <oleg.grenrus@iki.fi> February 2021-	* See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.4.0.0.md--3.2.0.0 Herbert Valerio Riedel <hvr@gnu.org> April 2020-	* `v2-build` (and other `v2-`prefixed commands) now accept the-	  `--benchmark-option(s)` flags, which pass options to benchmark executables-	  (analogous to how `--test-option(s)` works). (#6209)-	* Add solver optimization to skip a version of a package if it does not resolve-	  any conflicts encountered in the last version, controlled by flag-	  '--fine-grained-conflicts'. (#5918)-	* `cabal v2-exec` doesn't fail in clean package (#6479)-	* Show full ABI hash for installed packages in solver log (#5892)-	* Create incoming directory even for empty packages (#4130)-	* Start GHCi with `main-is` module in scope (#6311)-	* Implement `--benchmark-options` for `v2-bench` (#6224)-	* Fix store-dir in ghc env files generated by `cabal install --lib-	  --package-env` (#6298)-	* `cabal v2-run` works with `.lhs` files (#6134)-	* `subdir` in source-repository-package accepts multiple entries (#5472)--3.0.1.0 Herbert Valerio Riedel <hvr@gnu.org> April 2020-	* Create store incoming directory-	  ([#4130](https://github.com/haskell/cabal/issues/4130))-	* `fetchRepoTarball` output is not marked-	  ([#6385](https://github.com/haskell/cabal/pull/6385))-	* Update `setupMinCabalVersionConstraint` for GHC-8.8-	  ([#6217](https://github.com/haskell/cabal/pull/6217))-	* Implement `cabal install --ignore-project`-	  ([#5919](https://github.com/haskell/cabal/issues/5919))-	* `cabal install executable` solver isn't affected by default-	  environment contents-	  ([#6410](https://github.com/haskell/cabal/issues/6410))-	* Use `lukko` for file locking-	  ([#6345](https://github.com/haskell/cabal/pull/6345))-	* Use `hackage-security-0.6`-	  ([#6388](https://github.com/haskell/cabal/pull/6388))-	* Other dependency upgrades--3.0.0.0 Mikhail Glushenkov <mikhail.glushenkov@gmail.com> August 2019-	* `v2-haddock` fails on `haddock` failures (#5977)-	* `v2-run` works when given `File.lhs` literate file. (#6134)-	* Parse comma-separated lists for extra-prog-path, extra-lib-dirs, extra-framework-dirs,-	  and extra-include-dirs as actual lists. (#5420)-	* `v2-repl` no longer changes directory to a randomized temporary folder-	  when used outside of a project. (#5544)-	* `install-method` and `overwrite-policy` in `.cabal/config` now actually work. (#5942)-	* `v2-install` now reports the error when a package fails to build. (#5641)-	* `v2-install` now has a default when called in a project (#5978, #6014, #6092)-	* '--write-ghc-environment-files' now defaults to 'never' (#4242)-	* Fix `sdist`'s output when sent to stdout. (#5874)-	* Allow a list of dependencies to be provided for `repl --build-depends`. (#5845)-	* Legacy commands are now only accessible with the `v1-` prefixes, and the `v2-`-	  commands are the new default. Accordingly, the next version of Cabal will be-	  the start of the 3.x version series. (#5800)-	* New solver flag: '--reject-unconstrained-dependencies'. (#2568)-	* Ported old-style test options to the new-style commands (#5455).-	* Improved error messages for cabal file parse errors. (#5710)-	* Removed support for `.zip` format source distributions (#5755)-	* Add "simple project" initialization option. (#5707)-	* Add '--minimize-conflict-set' flag to try to improve the solver's-	  error message, but with an increase in run time. (#5647)-	* v2-test now succeeds when there are no test suites. (#5435)-	* Add '--lib', '--exe', and '--libandexe' shorthands to init. (#5759)-	* init now generates valid `Main.lhs` files. (#5577)-	* Init improvements: add flag '--application-dir', and when creating-	  a library also create a MyLib.hs module. (#5740)-	* Add support for generating test-suite via cabal init. (#5761)-	* Increase `max-backjumps` default from 2000 to 4000.-	* Make v2-install/new-install-specific flags configurable in-	  ~/.cabal/config-	* Add --installdir and --install-method=copy flags to v2-install-	  that make it possible to copy the executable instead of symlinking it-	* --symlink-bindir no longer controls the symlinking directory of-	  v2-install (installdir controls both symlinking and copying now)-	* Default to non-interactive init.-	* Add --test-wrapper that allows a prebuild script to set the test environment.-	* Add filterTestFlags: filter test-wrapper for Cabal < 3.0.0.-	* Cabal now only builds the minimum of a package for `v2-install` (#5754, #6091)--2.4.1.0 Mikhail Glushenkov <mikhail.glushenkov@gmail.com> November 2018-	* Add message to alert user to potential package casing errors. (#5635)-	* new-clean no longer deletes dist-newstyle/src with `-s`. (#5699)-	* 'new-install' now warns when failing to symlink an exe (#5602)-	* Extend 'cabal init' support for 'cabal-version' selection (#5567)-	* 'new-sdist' now generates tarballs with file modification-	  times from a date in 2001. Using the Unix epoch caused-	  problems on Windows. (#5596)-	* Register monolithic packages installed into the store due to a-	  build-tool dependency if they also happen to contain a buildable-	  public lib. (#5379,#5604)-	* Fixed a Windows bug where cabal-install tried to copy files-	  after moving them (#5631).-	* 'cabal v2-repl' now works for indefinite (in the Backpack sense) components. (#5619)-	* Set data dir environment variable for tarballs and remote repos (#5469)-	* Fix monolithic inplace build tool PATH (#5633)-	* 'cabal init' now supports '-w'/'--with-compiler' flag (#4936, #5654)-	* Fix ambiguous --builddir on new-install (#5652)-	* Allow relative --storedir (#5662)-	* Respect --dry on new-install (#5671)-	* Warn when new-installing zero exes (#5666)-	* Add 'pkg-cabal-sha256' field to plan.json (#5695)-	* New v2-build flag: '--only-configure'. (#5578)-	* Fixed a 'new-install' failure that manifested when it-	  encountered remote source dependencies in a project. (#5643)-	* New 'v2-[build,configure' flag: '--write-ghc-environment-files'-	  to control the generation of .ghc.environment files. (#5711)--2.4.0.0 Mikhail Glushenkov <mikhail.glushenkov@gmail.com> September 2018-	* Bugfix: "cabal new-build --ghc-option '--bogus' --ghc-option '-O1'"-	  no longer ignores all arguments except the last one (#5512).-	* Add the following option aliases for '-dir'-suffixed options:-	  'storedir', 'logsdir', 'packagedir', 'sourcedir', 'outputdir' (#5484).-	* 'new-run' now allows the user to run scripts that use a special block-	  to define their requirements (as in the executable stanza) in place-	  of a target. This also allows the use of 'cabal' as an interpreter-	  in a shebang line.-	* Add aliases for the "new-" commands that won't change when they-	  lose their prefix or are eventually replaced by a third UI-	  paradigm in the future. (#5429)-	* 'outdated' now accepts '--project-file FILE', which will look for bounds-	  from the new-style freeze file named FILE.freeze. This is only-	  available when `--new-freeze-file` has been passed.-	* 'new-repl' now accepts a '--build-depends' flag which accepts the-	  same syntax as is used in .cabal files to add additional dependencies-	  to the environment when developing in the REPL. It is now usable outside-	  of projects. (#5425, #5454)-	* 'new-build' now treats Haddock errors non-fatally. In addition,-	  it attempts to avoid trying to generate Haddocks when there is-	  nothing to generate them from. (#5232, #5459)-	* 'new-run', 'new-test', and 'new-bench' now will attempt to resolve-	  ambiguous selectors by filtering out selectors that would be invalid.-	  (#4679, #5461)-	* 'new-install' now supports installing libraries and local-	  components. (#5399)-	* Drop support for GHC 7.4, since it is out of our support window-	  (and has been for over a year!).-	* 'new-update' now works outside of projects. (#5096)-	* Extend `plan.json` with `pkg-src` provenance information. (#5487)-	* Add 'new-sdist' command (#5389). Creates stable archives based on-	  cabal projects in '.zip' and '.tar.gz' formats.-	* Add '--repl-options' flag to 'cabal repl' and 'cabal new-repl'-	  commands. Passes its arguments to the invoked repl, bypassing the-	  new-build's cached configurations. This assures they don't trigger-	  useless rebuilds and are always applied within the repl. (#4247, #5287)-	* Add 'v1-' prefixes for the commands that will be replaced in the-	  new-build universe, in preparation for it becoming the default.-	  (#5358)-	* 'outdated' accepts '--v1-freeze-file' and '--v2-freeze-file'-	  in the same spirit.-	* Completed the 'new-clean' command (#5357). The functionality is-	  equivalent to old-style clean, but for nix-style builds.-	* Ensure that each package selected for a build-depends dependency-	  contains a library (#5304).-	* Support packages from local tarballs in the cabal.project file.-	* Default changelog generated by 'cabal init' is now named-	  'CHANGELOG.md' (#5441).-	* Align output of 'new-build' command phases (#4040).-	* Add support for specifying remote VCS dependencies via new-	  'source-repository-package' stanzas in 'cabal.project' files-	  (#5351).--2.2.0.0 Mikhail Glushenkov <mikhail.glushenkov@gmail.com> March 2018-	* '--with-PROG' and '--PROG-options' are applied to all packages-	and not local packages only (#5019).-	* Completed the 'new-update' command (#4809), which respects nix-style-	cabal.project(.local) files and allows to update from-	multiple repositories when using overlays.-	* Completed the 'new-run' command (#4477). The functionality is the-	same of the old 'run' command but using nix-style builds.-	Additionally, it can run executables across packages in a project.-	Tests and benchmarks are also treated as executables, providing a-	quick way to pass them arguments.-	* Completed the 'new-bench' command (#3638). Same as above.-	* Completed the 'new-exec' command (#3638). Same as above.-	* Added a preliminary 'new-install' command (#4558, nonlocal exes-	part) which allows to quickly install executables from Hackage.-	* Set symlink-bindir (used by new-install) to .cabal/bin by default on-	.cabal/config initialization (#5188).-	* 'cabal update' now supports '--index-state' which can be used to-	roll back the index to an earlier state.-	* '--allow-{newer,older}' syntax has been enhanced. Dependency-	relaxation can be now limited to a specific release of a package,-	plus there's a new syntax for relaxing only caret-style (i.e. '^>=')-	dependencies (#4575, #4669).-	* New config file field: 'cxx-options' to specify which options to be-	passed to the compiler when compiling C++ sources specified by the-	'cxx-sources' field. (#3700)-	* New config file field: 'cxx-sources' to specify C++ files to be-	compiled separately from C source files. Useful in conjunction with the-	'cxx-options' flag to pass different compiler options to C and C++-	source files. (#3700)-	* Use [lfxtb] letters to differentiate component kind instead of-	opaque "c" in dist-dir layout.-	* 'cabal configure' now supports '--enable-static', which can be-	used to build static libraries with GHC via GHC's `-staticlib`-	flag.-	* 'cabal user-config now supports '--augment' which can append-	additional lines to a new or updated cabal config file.-	* Added support for '--enable-tests' and '--enable-benchmarks' to-	'cabal fetch' (#4948).-	* Misspelled package-names on CLI will no longer be silently-	case-corrected (#4778).-	* 'cabal new-configure' now backs up the old 'cabal.project.local'-	file if it exists (#4460).-	* On macOS, `new-build` will now place dynamic libraries into-	`store/lib` and aggressively shorten their names in an effort to-	stay within the load command size limits of macOSs mach-o linker.-	* 'new-build' now checks for the existence of executables for-	build-tools and build-tool-depends dependencies in the solver-	(#4884).-	* Fixed a spurious warning telling the user to run 'cabal update'-	when it wasn't necessary (#4444).-	* Packages installed in sandboxes via 'add-source' now have-	their timestamps updated correctly and so will not be reinstalled-	unnecessarily if the main install command fails (#1375).-	* Add Windows device path support for copyFile, renameFile. Allows cabal-	new-build to use temporary store path of up to 32k length-	(#3972, #4914, #4515).-	* When a flag value is specified multiple times on the command-	line, the last one is now preferred, so e.g. '-f+dev -f-dev' is-	now equivalent to '-f-dev' (#4452).-	* Removed support for building cabal-install with GHC < 7.10 (#4870).-	* New 'package *' section in 'cabal.project' files that applies-	options to all packages, not just those local to the project.-	* Paths_ autogen modules now compile when `RebindableSyntax` or-	`OverloadedStrings` is used in `default-extensions`.-	[stack#3789](https://github.com/commercialhaskell/stack/issues/3789)-	* getDataDir` and other `Paths_autogen` functions now work correctly-	when compiling a custom `Setup.hs` script using `new-build` (#5164).--2.0.0.1 Mikhail Glushenkov <mikhail.glushenkov@gmail.com> December 2017-	* Support for GHC's numeric -g debug levels (#4673).-	* Demoted 'scope' field version check to a warning (#4714).-	* Fixed verbosity flags getting removed before being passed to-	'printPlan' (#4724).-	* Added a '--store-dir' option that can be used to configure the-	location of the build global build store (#4623).-	* Turned `allow-{newer,older}` in `cabal.project` files into an-	accumulating field to match CLI flag semantics (#4679).-	* Improve success message when `cabal upload`ing documentation-	(#4777).-	* Documentation fixes.--2.0.0.0 Mikhail Glushenkov <mikhail.glushenkov@gmail.com> August 2017-	* See http://coldwa.st/e/blog/2017-09-09-Cabal-2-0.html-	for more detailed release notes.-	* Removed the '--root-cmd' parameter of the 'install' command-	(#3356).-	* Deprecated 'cabal install --global' (#3356).-	* Changed 'cabal upload' to upload a package candidate by default-	(#3419). Same applies to uploading documentation.-	* Added a new 'cabal upload' flag '--publish' for publishing a-	package on Hackage instead of uploading a candidate (#3419).-	* Added optional solver output visualisation support via the-	tracetree package. Mainly intended for debugging (#3410).-	* Removed the '--check' option from 'cabal upload'-	(#1823). It was replaced by package candidates.-	* Fixed various behaviour differences between network transports-	(#3429).-	* The bootstrap script now works correctly when run from a Git-	clone (#3439).-	* Removed the top-down solver (#3598).-	* The '-v/--verbosity' option no longer affects GHC verbosity-	(except in the case of '-v0'). Use '--ghc-options=-v' to enable-	verbose GHC output (#3540, #3671).-	* Changed the default logfile template from-	'.../$pkgid.log' to '.../$compiler/$libname.log' (#3807).-	* Added a new command, 'cabal reconfigure', which re-runs 'configure'-	with the most recently used flags (#2214).-	* Added the '--index-state' flag for requesting a specific-	version of the package index (#3893, #4115).-	* Support for building Backpack packages.  See-	https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst-	for more details.-	* Support the Nix package manager (#3651).-	* Made the 'template-haskell' package non-upgradable again (#4185).-	* Fixed password echoing on MinTTY (#4128).-	* Added a new solver flag, '--allow-boot-library-installs', that allows-	any package to be installed or upgraded (#4209).-	* New 'cabal-install' command: 'outdated', for listing outdated-	version bounds in a .cabal file or a freeze file (#4207).-	* Added qualified constraints for setup dependencies. For example,-	--constraint="setup.bar == 1.0" constrains all setup dependencies on-	bar, and --constraint="foo:setup.bar == 1.0" constrains foo's setup-	dependency on bar (part of #3502).-	* Non-qualified constraints, such as --constraint="bar == 1.0", now-	only apply to top-level dependencies. They don't constrain setup or-	build-tool dependencies. The new syntax --constraint="any.bar == 1.0"-	constrains all uses of bar.-	* Added a technical preview version of the 'cabal doctest' command-	(#4480).--1.24.0.2 Mikhail Glushenkov <mikhail.glushenkov@gmail.com> December 2016-	* Adapted to the revert of a PVP-noncompliant API change in-	Cabal 1.24.2.0 (#4123).-	* Bumped the directory upper bound to < 1.4 (#4158).--1.24.0.1 Ryan Thomas <ryan@ryant.org> October 2016-	* Fixed issue with passing '--enable-profiling' when invoking-	Setup scripts built with older versions of Cabal (#3873).-	* Fixed various behaviour differences between network transports-	(#3429).-	* Updated to depend on the latest hackage-security that fixes-	various issues on Windows.-	* Fixed 'new-build' to exit with a non-zero exit code on failure-	(#3506).-	* Store secure repo index data as 01-index.* (#3862).-	* Added new hackage-security root keys for distribution with-	cabal-install.-	* Fix an issue where 'cabal install' sometimes had to be run twice-	for packages with build-type: Custom and a custom-setup stanza-	(#3723).-	* 'cabal sdist' no longer ignores '--builddir' when the package's-	build-type is Custom (#3794).--1.24.0.0 Ryan Thomas <ryan@ryant.org> March 2016-	* If there are multiple remote repos, 'cabal update' now updates-	them in parallel (#2503).-	* New 'cabal upload' option '-P'/'--password-command' for reading-	Hackage password from arbitrary program output (#2506).-	* Better warning for 'cabal run' (#2510).-	* 'cabal init' now warns if the chosen package name is already-	registered in the source package index (#2436).-	* New 'cabal install' option: '--offline' (#2578).-	* Accept 'builddir' field in cabal.config (#2484)-	* Read 'builddir' option from 'CABAL_BUILDDIR' environment variable.-	* Remote repos may now be configured to use https URLs. This uses-	either curl or wget or, on Windows, PowerShell, under the hood (#2687).-	* Install target URLs can now use https e.g. 'cabal install-	https://example.com/foo-1.0.tar.gz'.-	* Automatically use https for cabal upload for the main-	hackage.haskell.org (other repos will use whatever they are-	configured to use).-	* Support for dependencies of custom Setup.hs scripts-	(see http://www.well-typed.com/blog/2015/07/cabal-setup-deps/).-	* 'cabal' program itself now can be used as an external setup-	method. This fixes an issue when Cabal version mismatch caused-	unnecessary reconfigures (#2633).-	* Improved error message for unsatisfiable package constraints-	(#2727).-	* Fixed a space leak in 'cabal update' (#2826).-	* 'cabal exec' and 'sandbox hc-pkg' now use the configured-	compiler (#2859).-	* New 'cabal haddock' option: '--for-hackage' (#2852).-	* Added a warning when the solver cannot find a dependency (#2853).-	* New 'cabal upload' option: '--doc': upload documentation to-	hackage (#2890).-	* Improved error handling for 'sandbox delete-source' (#2943).-	* Solver support for extension and language flavours (#2873).-	* Support for secure repos using hackage-security (#2983).-	* Added a log file message similar to one printed by 'make' when-	building in another directory (#2642).-	* Added new subcommand 'init' to 'cabal user-config'. This-	subcommand creates a cabal configuration file in either the-	default location or as specified by --config-file (#2553).-	* The man page for 'cabal-install' is now automatically generated-	(#2877).-	* The '--allow-newer' option now works as expected when specified-	multiple times (#2588).-	* New config file field: 'extra-framework-dirs' (extra locations-	to find OS X frameworks in). Can be also specified as an argument-	for 'install' and 'configure' commands (#3158).-	* It's now possible to limit the scope of '--allow-newer' to-	single packages in the install plan (#2756).-	* Full '--allow-newer' syntax is now supported in the config file-	(that is, 'allow-newer: base, ghc-prim,  some-package:vector')-	(#3171).-	* Improved performance of '--reorder-goals' (#3208).-	* Fixed space leaks in modular solver (#2916, #2914).-	* Made the solver aware of pkg-config constraints (#3023).-	* Added a new command: 'gen-bounds' (#3223). See-	http://softwaresimply.blogspot.se/2015/08/cabal-gen-bounds-easy-generation-of.html.-	* Tech preview of new nix-style isolated project-based builds.-	Currently provides the commands (new-)build/repl/configure.--1.22.9.0 Ryan Thomas <ryan@ryant.org> March 2016-	* Include Cabal-1.22.8.0--1.22.8.0 Ryan Thomas <ryan@ryant.org> February 2016-	* Only Custom setup scripts should be compiled with '-i -i.'.-	* installedCabalVersion: Don't special-case Cabal anymore.-	* Bump the HTTP upper bound. See #3069.--1.22.7.0 Ryan Thomas <ryan@ryant.org> December 2015-	* Remove GZipUtils tests-	* maybeDecompress: bail on all errors at the beginning of the-	stream with zlib < 0.6-	* Correct maybeDecompress--1.22.6.0 Ryan Thomas <ryan@ryant.org> June 2015-	* A fix for @ezyang's fix for #2502. (Mikhail Glushenkov)--1.22.5.0 Ryan Thomas <ryan@ryant.org> June 2015-	* Reduce temporary directory name length, fixes #2502. (Edward Z. Yang)--1.22.4.0 Ryan Thomas <ryan@ryant.org> May 2015-	* Force cabal upload to always use digest auth and never basic auth.-	* Add dependency-graph information to `printPlan` output-	* bootstrap.sh: fixes linker matching to avoid cases where tested-	linker names appear unexpectedly in compiler output (fixes #2542)--1.22.3.0 Ryan Thomas <ryan@ryant.org> April 2015-	* Fix bash completion for sandbox subcommands - Fixes #2513-	(Mikhail Glushenkov)-	* filterConfigureFlags: filter more flags (Mikhail Glushenkov)--1.22.2.0 Ryan Thomas <ryan@ryant.org> March 2015-	* Don't pass '--{en,dis}able-profiling' to old setup exes.-	* -Wall police-	* Allow filepath 1.4--1.22.0.0 Johan Tibell <johan.tibell@gmail.com> January 2015-	* New command: user-config (#2159).-	* Implement 'cabal repl --only' (#2016).-	* Fix an issue when 'cabal repl' was doing unnecessary compilation-	(#1715).-	* Prompt the user to specify source directory in 'cabal init'-	(#1989).-	* Remove the self-upgrade check (#2090).-	* Don't redownload already downloaded packages when bootstrapping-	(#2133).-	* Support sandboxes in 'bootstrap.sh' (#2137).-	* Install profiling and shared libs by default in 'bootstrap.sh'-	(#2009).--1.20.2.0 Ryan Thomas <ryan@ryant.org> February 2016-	* Only Custom setup scripts should be compiled with '-i -i.'.-	* installedCabalVersion: Don't special-case Cabal anymore.--1.20.1.0 Ryan Thomas <ryan@ryant.org> May 2015-	* Force cabal upload to always use digest auth and never basic auth.-	* bootstrap.sh: install network-uri before HTTP--1.20.0.5 Johan Tibell <johan.tibell@gmail.com> December 2014-	* Support random 1.1.-	* Fix bootstrap script after network package split.-	* Support network-2.6 in test suite.--1.20.0.3 Johan Tibell <johan.tibell@gmail.com> June 2014-	* Don't attempt to rename dist if it is already named correctly-	* Treat all flags of a package as interdependent.-	* Allow template-haskell to be upgradable again--1.20.0.2 Johan Tibell <johan.tibell@gmail.com> May 2014-	* Increase max-backjumps to 2000.-	* Fix solver bug which led to missed install plans.-	* Fix streaming test output.-	* Tweak solver heuristics to avoid reinstalls.--1.20.0.1 Johan Tibell <johan.tibell@gmail.com> May 2014-	* Fix cabal repl search path bug on Windows-	* Include OS and arch in cabal-install user agent-	* Revert --constraint flag behavior in configure to 1.18 behavior--1.20.0.0 Johan Tibell <johan.tibell@gmail.com> April 2014-	* Build only selected executables-	* Add -j flag to build/test/bench/run-	* Improve install log file-	* Don't symlink executables when in a sandbox-	* Add --package-db flag to 'list' and 'info'-	* Make upload more efficient-	* Add --require-sandbox option-	* Add experimental Cabal file format command-	* Add haddock section to config file-	* Add --main-is flag to init--1.18.2.0 Ryan Thomas <ryan@ryant.org> February 2016-	* Only Custom setup scripts should be compiled with '-i -i.'.-	* installedCabalVersion: Don't special-case Cabal anymore.--1.18.1.0 Ryan Thomas <ryan@ryant.org> May 2015-	* Force cabal upload to always use digest auth and never basic auth.-	* Merge pull request #2367 from juhp/patch-2-	* Fix bootstrap.sh by bumping HTTP to 4000.2.16.1--1.18.0.7 Johan Tibell <johan.tibell@gmail.com> December 2014-	* Support random 1.1.-	* Fix bootstrap script after network package split.-	* Support network-2.6 in test suite.--1.18.0.5 Johan Tibell <johan.tibell@gmail.com> July 2014-	* Make solver flag resolution more conservative.--1.18.0.4 Johan Tibell <johan.tibell@gmail.com> May 2014-	* Increase max-backjumps to 2000.-	* Fix solver bug which led to missed install plans.-	* Tweak solver heuristics to avoid reinstalls.--0.14.0 Andres Loeh <andres@well-typed.com> April 2012-	* Works with ghc-7.4-	* Completely new modular dependency solver (default in most cases)-	* Some tweaks to old topdown dependency solver-	* Install plans are now checked for reinstalls that break packages-	* Flags --constraint and --preference work for nonexisting packages-	* New constraint forms for source and installed packages-	* New constraint form for package-specific use flags-	* New constraint form for package-specific stanza flags-	* Test suite dependencies are pulled in on demand-	* No longer install packages on --enable-tests when tests fail-	* New "cabal bench" command-	* Various "cabal init" tweaks--0.10.0 Duncan Coutts <duncan@community.haskell.org> February 2011-	* New package targets: local dirs, local and remote tarballs-	* Initial support for a "world" package target-	* Partial fix for situation where user packages mask global ones-	* Removed cabal upgrade, new --upgrade-dependencies flag-	* New cabal install --only-dependencies flag-	* New cabal fetch --no-dependencies and --dry-run flags-	* Improved output for cabal info-	* Simpler and faster bash command line completion-	* Fix for broken proxies that decompress wrongly-	* Fix for cabal unpack to preserve executable permissions-	* Adjusted the output for the -v verbosity level in a few places--0.8.2 Duncan Coutts <duncan@community.haskell.org> March 2010-	* Fix for cabal update on Windows-	* On windows switch to per-user installs (rather than global)-	* Handle intra-package dependencies in dependency planning-	* Minor tweaks to cabal init feature-	* Fix various -Wall warnings-	* Fix for cabal sdist --snapshot--0.8.0 Duncan Coutts <duncan@haskell.org> Dec 2009-	* Works with ghc-6.12-	* New "cabal init" command for making initial project .cabal file-	* New feature to maintain an index of haddock documentation--0.6.4 Duncan Coutts <duncan@haskell.org> Nov 2009-	* Improve the algorithm for selecting the base package version-	* Hackage errors now reported by "cabal upload [--check]"-	* Improved format of messages from "cabal check"-	* Config file can now be selected by an env var-	* Updated tar reading/writing code-	* Improve instructions in the README and bootstrap output-	* Fix bootstrap.sh on Solaris 9-	* Fix bootstrap for systems where network uses parsec 3-	* Fix building with ghc-6.6--0.6.2 Duncan Coutts <duncan@haskell.org> Feb 2009-	* The upgrade command has been disabled in this release-	* The configure and install commands now have consistent behaviour-	* Reduce the tendency to re-install already existing packages-	* The --constraint= flag now works for the install command-	* New --preference= flag for soft constraints / version preferences-	* Improved bootstrap.sh script, smarter and better error checking-	* New cabal info command to display detailed info on packages-	* New cabal unpack command to download and untar a package-	* HTTP-4000 package required, should fix bugs with http proxies-	* Now works with authenticated proxies.-	* On Windows can now override the proxy setting using an env var-	* Fix compatibility with config files generated by older versions-	* Warn if the hackage package list is very old-	* More helpful --help output, mention config file and examples-	* Better documentation in ~/.cabal/config file-	* Improved command line interface for logging and build reporting-	* Minor improvements to some messages--0.6.0 Duncan Coutts <duncan@haskell.org> Oct 2008-	* Constraint solver can now cope with base 3 and base 4-	* Allow use of package version preferences from hackage index-	* More detailed output from cabal install --dry-run -v-	* Improved bootstrap.sh--0.5.2 Duncan Coutts <duncan@haskell.org> Aug 2008-	* Support building haddock documentation-	* Self-reinstall now works on Windows-	* Allow adding symlinks to executables into a separate bindir-	* New self-documenting config file-	* New install --reinstall flag-	* More helpful status messages in a couple places-	* Upload failures now report full text error message from the server-	* Support for local package repositories-	* New build logging and reporting-	* New command to upload build reports to (a compatible) server-	* Allow tilde in hackage server URIs-	* Internal code improvements-	* Many other minor improvements and bug fixes--0.5.1 Duncan Coutts <duncan@haskell.org> June 2008-	* Restore minimal hugs support in dependency resolver-	* Fix for disabled http proxies on Windows-	* Revert to global installs on Windows by default--0.5.0 Duncan Coutts <duncan@haskell.org> June 2008-	* New package dependency resolver, solving diamond dep problem-	* Integrate cabal-setup functionality-	* Integrate cabal-upload functionality-	* New cabal update and check commands-	* Improved behavior for install and upgrade commands-	* Full Windows support-	* New command line handling-	* Bash command line completion-	* Allow case insensitive package names on command line-	* New --dry-run flag for install, upgrade and fetch commands-	* New --root-cmd flag to allow installing as root-	* New --cabal-lib-version flag to select different Cabal lib versions-	* Support for HTTP proxies-	* Improved cabal list output-	* Build other non-dependent packages even when some fail-	* Report a summary of all build failures at the end-	* Partial support for hugs-	* Partial implementation of build reporting and logging-	* More consistent logging and verbosity-	* Significant internal code restructuring--0.4 Duncan Coutts <duncan@haskell.org> Oct 2007-	* Renamed executable from 'cabal-install' to 'cabal'-	* Partial Windows compatibility-	* Do per-user installs by default-	* cabal install now installs the package in the current directory-	* Allow multiple remote servers-	* Use zlib lib and internal tar code and rather than external tar-	* Reorganised configuration files-	* Significant code restructuring-	* Cope with packages with conditional dependencies--0.3 and older versions by Lemmih, Paolo Martini and others 2006-2007-	* Switch from smart-server, dumb-client model to the reverse-	* New .tar.gz based index format-	* New remote and local package archive format
src/Distribution/Client/BuildReports/Storage.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}  -----------------------------------------------------------------------------
src/Distribution/Client/BuildReports/Upload.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE PatternGuards #-}  -- This is a quick hack for uploading build reports to Hackage.
src/Distribution/Client/Check.hs view
@@ -51,7 +51,7 @@       dieWithException verbosity ParseError     Right x -> return (warnings, x) --- | Checks a packge for common errors. Returns @True@ if the package+-- | Checks a package for common errors. Returns @True@ if the package -- is fit to upload to Hackage, @False@ otherwise. -- Note: must be called with the CWD set to the directory containing -- the '.cabal' file.
src/Distribution/Client/CmdBench.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE RecordWildCards #-}- -- | cabal-install CLI command: bench module Distribution.Client.CmdBench   ( -- * The @bench@ CLI and action@@ -29,13 +27,13 @@ import Distribution.Client.Errors import Distribution.Client.NixStyleOptions   ( NixStyleFlags (..)+  , cfgVerbosity   , defaultNixStyleFlags   , nixStyleOptions   ) import Distribution.Client.ProjectOrchestration import Distribution.Client.Setup-  ( ConfigFlags (..)-  , GlobalFlags+  ( GlobalFlags   ) import Distribution.Client.TargetProblem   ( TargetProblem (..)@@ -47,10 +45,6 @@   ( CommandUI (..)   , usageAlternatives   )-import Distribution.Simple.Flag-  ( fromFlagOrDefault-  )-import Distribution.Simple.Setup (CommonSetupFlags (..)) import Distribution.Simple.Utils   ( dieWithException   , warn@@ -111,7 +105,7 @@ -- For more details on how this works, see the module -- "Distribution.Client.ProjectOrchestration" benchAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO ()-benchAction flags@NixStyleFlags{..} targetStrings globalFlags = do+benchAction flags targetStrings globalFlags = do   baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand    targetSelectors <-@@ -132,7 +126,7 @@       -- (as opposed to say build or haddock targets).       targets <-         either (reportTargetProblems verbosity) return $-          resolveTargets+          resolveTargetsFromSolver             selectPackageTargets             selectComponentTarget             elaboratedPlan@@ -151,7 +145,7 @@   buildOutcomes <- runProjectBuildPhase verbosity baseCtx buildCtx   runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes   where-    verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)+    verbosity = cfgVerbosity normal flags     cliConfig =       commandLineFlagsToProjectConfig         globalFlags
src/Distribution/Client/CmdBuild.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE RecordWildCards #-}- -- | cabal-install CLI command: build module Distribution.Client.CmdBuild   ( -- * The @build@ CLI and action@@ -30,6 +28,7 @@ import Distribution.Client.Errors import Distribution.Client.NixStyleOptions   ( NixStyleFlags (..)+  , cfgVerbosity   , defaultNixStyleFlags   , nixStyleOptions   )@@ -40,9 +39,7 @@   , withContextAndSelectors   ) import Distribution.Client.Setup-  ( CommonSetupFlags (..)-  , ConfigFlags (..)-  , GlobalFlags+  ( GlobalFlags   , yesNoOpt   ) import Distribution.Simple.Command@@ -50,7 +47,7 @@   , option   , usageAlternatives   )-import Distribution.Simple.Flag (Flag (..), fromFlag, fromFlagOrDefault, toFlag)+import Distribution.Simple.Flag (Flag, fromFlag, toFlag) import Distribution.Simple.Utils   ( dieWithException   , wrapText@@ -134,8 +131,8 @@ -- For more details on how this works, see the module -- "Distribution.Client.ProjectOrchestration" buildAction :: NixStyleFlags BuildFlags -> [String] -> GlobalFlags -> IO ()-buildAction flags@NixStyleFlags{extraFlags = buildFlags, ..} targetStrings globalFlags =-  withContextAndSelectors RejectNoTargets Nothing flags targetStrings globalFlags BuildCommand $ \targetCtx ctx targetSelectors -> do+buildAction flags@NixStyleFlags{extraFlags = buildFlags} targetStrings globalFlags =+  withContextAndSelectors verbosity RejectNoTargets Nothing flags targetStrings globalFlags BuildCommand $ \targetCtx ctx targetSelectors -> do     -- TODO: This flags defaults business is ugly     let onlyConfigure =           fromFlag@@ -157,7 +154,7 @@         -- (as opposed to say repl or haddock targets).         targets <-           either (reportBuildTargetProblems verbosity) return $-            resolveTargets+            resolveTargetsFromSolver               selectPackageTargets               selectComponentTarget               elaboratedPlan@@ -185,7 +182,7 @@     buildOutcomes <- runProjectBuildPhase verbosity baseCtx buildCtx     runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes   where-    verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)+    verbosity = cfgVerbosity normal flags  -- | This defines what a 'TargetSelector' means for the @bench@ command. -- It selects the 'AvailableTarget's that the 'TargetSelector' refers to,
src/Distribution/Client/CmdClean.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE DataKinds #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-}  module Distribution.Client.CmdClean (cleanCommand, cleanAction) where@@ -38,13 +39,14 @@   , option   ) import Distribution.Simple.Setup-  ( Flag (..)+  ( Flag   , falseArg   , flagToMaybe   , fromFlagOrDefault   , optionDistPref   , optionVerbosity   , toFlag+  , pattern NoFlag   ) import Distribution.Simple.Utils   ( dieWithException@@ -52,6 +54,10 @@   , info   , wrapText   )+import Distribution.System+  ( OS (Windows)+  , buildOS+  ) import Distribution.Utils.Path hiding   ( (<.>)   , (</>)@@ -60,6 +66,9 @@   ( normal   ) +import Control.Exception+  ( throw+  ) import Control.Monad   ( forM   , forM_@@ -74,10 +83,15 @@   , listDirectory   , removeDirectoryRecursive   , removeFile+  , removePathForcibly   ) import System.FilePath   ( (</>)   )+import System.IO.Error+  ( isPermissionError+  )+import qualified System.Process as Process  data CleanFlags = CleanFlags   { cleanSaveConfig :: Flag Bool@@ -168,7 +182,18 @@         let distRoot = distDirectory distLayout          info verbosity ("Deleting dist-newstyle (" ++ distRoot ++ ")")-        handleDoesNotExist () $ removeDirectoryRecursive distRoot+        handleDoesNotExist () $ do+          if buildOS == Windows+            then do+              -- Windows can't delete some git files #10182+              void $+                Process.createProcess_ "attrib" $+                  Process.shell $+                    "attrib -s -h -r " <> distRoot <> "\\*.* /s /d"+              catch+                (removePathForcibly distRoot)+                (\e -> if isPermissionError e then removePathForcibly distRoot else throw e)+            else removeDirectoryRecursive distRoot      removeEnvFiles $ distProjectRootDirectory distLayout
src/Distribution/Client/CmdConfigure.hs view
@@ -22,16 +22,15 @@   ) import Distribution.Client.ProjectOrchestration import Distribution.Simple.Flag-import Distribution.Simple.Setup (CommonSetupFlags (..))  import Distribution.Client.NixStyleOptions   ( NixStyleFlags (..)+  , cfgVerbosity   , defaultNixStyleFlags   , nixStyleOptions   ) import Distribution.Client.Setup   ( ConfigExFlags (..)-  , ConfigFlags (..)   , GlobalFlags   ) import Distribution.Verbosity@@ -117,14 +116,14 @@ -- For more details on how this works, see the module -- "Distribution.Client.ProjectOrchestration" configureAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO ()-configureAction flags@NixStyleFlags{..} extraArgs globalFlags = do+configureAction flags extraArgs globalFlags = do   (baseCtx, projConfig) <- configureAction' flags extraArgs globalFlags    if shouldNotWriteFile baseCtx     then notice v "Config file not written due to flag(s)."     else writeProjectLocalExtraConfig (distDirLayout baseCtx) projConfig   where-    v = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)+    v = cfgVerbosity normal flags  configureAction' :: NixStyleFlags () -> [String] -> GlobalFlags -> IO (ProjectBaseContext, ProjectConfig) configureAction' flags@NixStyleFlags{..} _extraArgs globalFlags = do@@ -165,7 +164,7 @@           return (baseCtx, conf <> cliConfig)         else return (baseCtx, cliConfig)   where-    v = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)+    v = cfgVerbosity normal flags     cliConfig =       commandLineFlagsToProjectConfig         globalFlags
src/Distribution/Client/CmdErrorMessages.hs view
@@ -1,6 +1,4 @@-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE RecordWildCards #-}  -- | Utilities to help format error messages for the various CLI commands. module Distribution.Client.CmdErrorMessages
src/Distribution/Client/CmdExec.hs view
@@ -23,6 +23,7 @@   ) import Distribution.Client.NixStyleOptions   ( NixStyleFlags (..)+  , cfgVerbosity   , defaultNixStyleFlags   , nixStyleOptions   )@@ -46,7 +47,7 @@ import Distribution.Client.ProjectPlanOutput   ( PostBuildProjectStatus   , argsEquivalentOfGhcEnvironmentFile-  , createPackageEnvironment+  , createPackageEnvironmentAndArgs   , updatePostBuildProjectStatus   ) import Distribution.Client.ProjectPlanning@@ -58,15 +59,11 @@   ( dataDirsEnvironmentForPlan   ) import Distribution.Client.Setup-  ( ConfigFlags (configCommonFlags)-  , GlobalFlags+  ( GlobalFlags   ) import Distribution.Simple.Command   ( CommandUI (..)   )-import Distribution.Simple.Flag-  ( fromFlagOrDefault-  ) import Distribution.Simple.GHC   ( GhcImplInfo (supportsPkgEnvFiles)   , getImplInfo@@ -87,7 +84,6 @@   ( programInvocation   , runProgramInvocation   )-import Distribution.Simple.Setup (CommonSetupFlags (..)) import Distribution.Simple.Utils   ( createDirectoryIfMissingVerbose   , dieWithException@@ -144,7 +140,7 @@     }  execAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO ()-execAction flags@NixStyleFlags{..} extraArgs globalFlags = do+execAction flags extraArgs globalFlags = do   baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand    -- To set up the environment, we'd like to select the libraries in our@@ -191,7 +187,7 @@     [] -> dieWithException verbosity SpecifyAnExecutable     exe : args -> do       (program, _) <- requireProgram verbosity (simpleProgram exe) programDb-      let argOverrides =+      let environmentPackageArgs =             argsEquivalentOfGhcEnvironmentFile               compiler               (distDirLayout baseCtx)@@ -201,21 +197,16 @@             matchCompilerPath               (elaboratedShared buildCtx)               program-          argOverrides' =-            if envFilesSupported-              || not programIsConfiguredCompiler-              then []-              else argOverrides        ( if envFilesSupported           then withTempEnvFile verbosity baseCtx buildCtx buildStatus-          else \f -> f []+          else \f -> f environmentPackageArgs []         )-        $ \envOverrides -> do+        $ \argOverrides envOverrides -> do           let program' =                 withOverrides                   envOverrides-                  argOverrides'+                  (if programIsConfiguredCompiler then argOverrides else [])                   program               invocation = programInvocation program' args               dryRun =@@ -226,7 +217,7 @@             then notice verbosity "Running of executable suppressed by flag(s)"             else runProgramInvocation verbosity invocation   where-    verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)+    verbosity = cfgVerbosity normal flags     cliConfig =       commandLineFlagsToProjectConfig         globalFlags@@ -253,7 +244,7 @@   -> ProjectBaseContext   -> ProjectBuildContext   -> PostBuildProjectStatus-  -> ([(String, Maybe String)] -> IO a)+  -> ([String] -> [(String, Maybe String)] -> IO a)   -> IO a withTempEnvFile verbosity baseCtx buildCtx buildStatus action = do   let tmpDirTemplate = distTempDirectory (distDirLayout baseCtx)@@ -263,14 +254,14 @@     tmpDirTemplate     "environment."     ( \tmpDir -> do-        envOverrides <--          createPackageEnvironment+        (argOverrides, envOverrides) <-+          createPackageEnvironmentAndArgs             verbosity             tmpDir             (elaboratedPlanToExecute buildCtx)             (elaboratedShared buildCtx)             buildStatus-        action envOverrides+        action argOverrides envOverrides     )  -- | Get paths to all dependency executables to be included in PATH.
src/Distribution/Client/CmdFreeze.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE PatternSynonyms #-}  -- | cabal-install CLI command: freeze module Distribution.Client.CmdFreeze@@ -17,6 +17,7 @@ import qualified Distribution.Client.InstallPlan as InstallPlan import Distribution.Client.NixStyleOptions   ( NixStyleFlags (..)+  , cfgVerbosity   , defaultNixStyleFlags   , nixStyleOptions   )@@ -40,9 +41,7 @@   )  import Distribution.Client.Setup-  ( CommonSetupFlags (setupVerbosity)-  , ConfigFlags (..)-  , GlobalFlags+  ( GlobalFlags   ) import Distribution.Package   ( PackageName@@ -53,7 +52,7 @@   ( FlagAssignment   , nullFlagAssignment   )-import Distribution.Simple.Flag (Flag (..), fromFlagOrDefault)+import Distribution.Simple.Flag (pattern Flag) import Distribution.Simple.Utils   ( dieWithException   , notice@@ -125,7 +124,7 @@ -- For more details on how this works, see the module -- "Distribution.Client.ProjectOrchestration" freezeAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO ()-freezeAction flags@NixStyleFlags{..} extraArgs globalFlags = do+freezeAction flags extraArgs globalFlags = do   unless (null extraArgs) $     dieWithException verbosity $       FreezeAction extraArgs@@ -160,7 +159,7 @@       notice verbosity $         "Wrote freeze file: " ++ (distProjectFile distDirLayout "freeze")   where-    verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)+    verbosity = cfgVerbosity normal flags     cliConfig =       commandLineFlagsToProjectConfig         globalFlags
+ src/Distribution/Client/CmdGenBounds.hs view
@@ -0,0 +1,255 @@+{-# LANGUAGE NamedFieldPuns #-}++module Distribution.Client.CmdGenBounds+  ( genBounds+  , genBoundsCommand+  , genBoundsAction+  , GenBoundsFlags (..)+  , defaultGenBoundsFlags+  ) where++import Distribution.Client.Compat.Prelude+import Prelude ()++import qualified Data.Map as Map++import Control.Monad (mapM_)++import Distribution.Client.Errors++import Distribution.Client.ProjectPlanning hiding (pruneInstallPlanToTargets)+import Distribution.Client.ProjectPlanning.Types+import Distribution.Client.Types.ConfiguredId (confInstId)+import Distribution.Client.Utils hiding (pvpize)+import Distribution.InstalledPackageInfo (InstalledPackageInfo, installedComponentId)+import Distribution.Package+import Distribution.PackageDescription+import Distribution.Simple.Utils+import Distribution.Version++import Distribution.Client.Setup (GlobalFlags (..))++-- Project orchestration imports++import Distribution.Client.CmdErrorMessages+import Distribution.Client.GenBounds+import qualified Distribution.Client.InstallPlan as InstallPlan+import Distribution.Client.NixStyleOptions+import Distribution.Client.ProjectFlags+import Distribution.Client.ProjectOrchestration+import Distribution.Client.ScriptUtils+import Distribution.Client.TargetProblem+import Distribution.Simple.Command+import Distribution.Types.Component+import Distribution.Verbosity++-- | The data type for gen-bounds command flags+data GenBoundsFlags = GenBoundsFlags {}++-- | Default values for the gen-bounds flags+defaultGenBoundsFlags :: GenBoundsFlags+defaultGenBoundsFlags = GenBoundsFlags{}++-- | The @gen-bounds@ command definition+genBoundsCommand :: CommandUI (NixStyleFlags GenBoundsFlags)+genBoundsCommand =+  CommandUI+    { commandName = "v2-gen-bounds"+    , commandSynopsis = "Generate dependency bounds for packages in the project."+    , commandUsage = usageAlternatives "v2-gen-bounds" ["[TARGETS] [FLAGS]"]+    , commandDescription = Just $ \_ ->+        "Generate PVP-compliant dependency bounds for packages in the project."+    , commandNotes = Just $ \pname ->+        "Examples:\n"+          ++ "  "+          ++ pname+          ++ " v2-gen-bounds\n"+          ++ "    Generate bounds for the package in the current directory "+          ++ "or all packages in the project\n"+          ++ "  "+          ++ pname+          ++ " v2-gen-bounds pkgname\n"+          ++ "    Generate bounds for the package named pkgname in the project\n"+          ++ "  "+          ++ pname+          ++ " v2-gen-bounds ./pkgfoo\n"+          ++ "    Generate bounds for the package in the ./pkgfoo directory\n"+    , commandDefaultFlags = defaultNixStyleFlags defaultGenBoundsFlags+    , commandOptions =+        removeIgnoreProjectOption+          . nixStyleOptions (const [])+    }++-- | The action for the @gen-bounds@ command when used in a project context.+genBoundsAction :: NixStyleFlags GenBoundsFlags -> [String] -> GlobalFlags -> IO ()+genBoundsAction flags targetStrings globalFlags =+  withContextAndSelectors verbosity RejectNoTargets Nothing flags targetStrings globalFlags OtherCommand $ \targetCtx ctx targetSelectors -> do+    baseCtx <- case targetCtx of+      ProjectContext -> return ctx+      GlobalContext -> return ctx+      ScriptContext path _ ->+        dieWithException verbosity $+          GenBoundsDoesNotSupportScript path++    let ProjectBaseContext{distDirLayout, cabalDirLayout, projectConfig, localPackages} = baseCtx++    -- Step 1: Create the install plan for the project.+    (_, elaboratedPlan, _, _, _) <-+      rebuildInstallPlan+        verbosity+        distDirLayout+        cabalDirLayout+        projectConfig+        localPackages+        Nothing++    -- Step 2: Resolve the targets for the gen-bounds command.+    targets <-+      either (reportGenBoundsTargetProblems verbosity) return $+        resolveTargetsFromSolver+          selectPackageTargets+          selectComponentTarget+          elaboratedPlan+          Nothing+          targetSelectors++    -- Step 3: Prune the install plan to the targets.+    let elaboratedPlan' =+          pruneInstallPlanToTargets+            TargetActionBuild+            targets+            elaboratedPlan++    let+      -- Step 4a: Find the local packages from the install plan. These are the+      -- candidates for which we will generate bounds.+      localPkgs :: [ElaboratedConfiguredPackage]+      localPkgs = mapMaybe (InstallPlan.foldPlanPackage (const Nothing) (\p -> Just p)) (InstallPlan.toList elaboratedPlan')++      -- Step 4b: Extract which versions we chose for each package from the pruned install plan.+      pkgVersionMap :: Map.Map ComponentId PackageIdentifier+      pkgVersionMap = Map.fromList (map (InstallPlan.foldPlanPackage externalVersion localVersion) (InstallPlan.toList elaboratedPlan'))++      externalVersion :: InstalledPackageInfo -> (ComponentId, PackageIdentifier)+      externalVersion pkg = (installedComponentId pkg, packageId pkg)++      localVersion :: ElaboratedConfiguredPackage -> (ComponentId, PackageIdentifier)+      localVersion pkg = (elabComponentId pkg, packageId pkg)++    let genBoundsActionForPkg :: ElaboratedConfiguredPackage -> [GenBoundsResult]+        genBoundsActionForPkg pkg =+          -- Step 5: Match up the user specified targets with the local packages.+          case Map.lookup (installedUnitId pkg) targets of+            Nothing -> []+            Just tgts ->+              map (\(tgt, _) -> getBoundsForComponent tgt pkg pkgVersionMap) tgts++    -- Process each package to find the ones needing bounds+    let boundsActions = concatMap genBoundsActionForPkg localPkgs++    if (any isBoundsNeeded boundsActions)+      then do+        notice verbosity boundsNeededMsg+        mapM_ (renderBoundsResult verbosity) boundsActions+      else notice verbosity "All bounds up-to-date"+  where+    verbosity = cfgVerbosity normal flags++data GenBoundsResult = GenBoundsResult PackageIdentifier ComponentTarget (Maybe [PackageIdentifier])++isBoundsNeeded :: GenBoundsResult -> Bool+isBoundsNeeded (GenBoundsResult _ _ Nothing) = False+isBoundsNeeded _ = True++renderBoundsResult :: Verbosity -> GenBoundsResult -> IO ()+renderBoundsResult verbosity (GenBoundsResult pid tgt bounds) =+  case bounds of+    Nothing ->+      notice+        verbosity+        ("Congratulations, all dependencies for " ++ prettyShow (packageName pid) ++ ":" ++ showComponentTarget pid tgt ++ " have upper bounds!")+    Just pkgBounds -> do+      notice verbosity $+        "For component " ++ prettyShow (pkgName pid) ++ ":" ++ showComponentTarget pid tgt ++ ":"+      let padTo = maximum $ map (length . unPackageName . packageName) pkgBounds+      traverse_ (notice verbosity . (++ ",") . showBounds padTo) pkgBounds++-- | Process a single BuildInfo to identify and report missing upper bounds+getBoundsForComponent+  :: ComponentTarget+  -> ElaboratedConfiguredPackage+  -> Map.Map ComponentId PackageIdentifier+  -> GenBoundsResult+getBoundsForComponent tgt pkg pkgVersionMap =+  if null needBounds+    then boundsResult Nothing+    else -- All the things we depend on.++      let componentDeps = elabLibDependencies pkg+          -- Match these up to package names, this is a list of Package name to versions.+          -- Now just match that up with what the user wrote in the build-depends section.+          depsWithVersions = mapMaybe (\cid -> Map.lookup (confInstId $ fst cid) pkgVersionMap) componentDeps+          isNeeded = hasElem needBounds . packageName+       in boundsResult (Just (filter isNeeded depsWithVersions))+  where+    pd = elabPkgDescription pkg+    -- Extract the build-depends for the right part of the cabal file.+    bi = buildInfoForTarget pd tgt++    -- We need to generate bounds if+    -- \* the dependency does not have an upper bound+    -- \* the dependency is not the same package as the one we are processing+    boundFilter dep =+      (not (hasUpperBound (depVerRange dep)))+        && packageName pd /= depPkgName dep++    -- The dependencies that need bounds.+    needBounds = map depPkgName $ filter boundFilter $ targetBuildDepends bi++    boundsResult = GenBoundsResult (packageId pkg) tgt++buildInfoForTarget :: PackageDescription -> ComponentTarget -> BuildInfo+buildInfoForTarget pd (ComponentTarget cname _) = componentBuildInfo $ getComponent pd cname++-- | This defines what a 'TargetSelector' means for the @gen-bounds@ command.+-- Copy of selectPackageTargets from CmdBuild.hs+selectPackageTargets+  :: TargetSelector+  -> [AvailableTarget k]+  -> Either TargetProblem' [k]+selectPackageTargets targetSelector targets+  -- If there are any buildable targets then we select those+  | not (null targetsBuildable) =+      Right targetsBuildable+  -- If there are targets but none are buildable then we report those+  | not (null targets) =+      Left (TargetProblemNoneEnabled targetSelector targets')+  -- If there are no targets at all then we report that+  | otherwise =+      Left (TargetProblemNoTargets targetSelector)+  where+    targets' = forgetTargetsDetail targets+    targetsBuildable =+      selectBuildableTargetsWith+        (buildable targetSelector)+        targets++    -- When there's a target filter like "pkg:tests" then we do select tests,+    -- but if it's just a target like "pkg" then we don't build tests unless+    -- they are requested by default (i.e. by using --enable-tests)+    buildable (TargetPackage _ _ Nothing) TargetNotRequestedByDefault = False+    buildable (TargetAllPackages Nothing) TargetNotRequestedByDefault = False+    buildable _ _ = True++-- | For a 'TargetComponent' 'TargetSelector', check if the component can be+-- selected. Copy of selectComponentTarget from CmdBuild.hs+selectComponentTarget+  :: SubComponentTarget+  -> AvailableTarget k+  -> Either TargetProblem' k+selectComponentTarget = selectComponentTargetBasic++-- | Report target problems for gen-bounds command+reportGenBoundsTargetProblems :: Verbosity -> [TargetProblem'] -> IO a+reportGenBoundsTargetProblems verbosity problems =+  reportTargetProblems verbosity "gen-bounds" problems
src/Distribution/Client/CmdHaddock.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-}  -- | cabal-install CLI command: haddock@@ -19,6 +20,7 @@ import Distribution.Client.CmdErrorMessages import Distribution.Client.NixStyleOptions   ( NixStyleFlags (..)+  , cfgVerbosity   , defaultNixStyleFlags   , nixStyleOptions   )@@ -31,9 +33,7 @@   ( ElaboratedSharedConfig (..)   ) import Distribution.Client.Setup-  ( CommonSetupFlags (..)-  , ConfigFlags (..)-  , GlobalFlags+  ( GlobalFlags   , InstallFlags (..)   ) import Distribution.Client.TargetProblem@@ -47,7 +47,7 @@   , option   , usageAlternatives   )-import Distribution.Simple.Flag (Flag (..))+import Distribution.Simple.Flag (Flag, pattern Flag) import Distribution.Simple.Program.Builtin   ( haddockProgram   )@@ -136,7 +136,8 @@ mkFlagsAbsolute relFlags = do   let relHaddockFlags = haddockFlags relFlags   absHaddockOutputDir <- traverse makeAbsolute (haddockOutputDir relHaddockFlags)-  return (relFlags{haddockFlags = relHaddockFlags{haddockOutputDir = absHaddockOutputDir}})+  absHaddockCss <- traverse makeAbsolute (haddockCss relHaddockFlags)+  return (relFlags{haddockFlags = relHaddockFlags{haddockOutputDir = absHaddockOutputDir, haddockCss = absHaddockCss}})  -- | The @haddock@ command is TODO. --@@ -148,7 +149,7 @@   flags@NixStyleFlags{..} <- mkFlagsAbsolute relFlags    let-    verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)+    verbosity = cfgVerbosity normal flags     installDoc = fromFlagOrDefault True (installDocumentation installFlags)     flags' = flags{installFlags = installFlags{installDocumentation = Flag installDoc}}     cliConfig = commandLineFlagsToProjectConfig globalFlags flags' mempty -- ClientInstallFlags, not needed here@@ -175,7 +176,7 @@       -- haddock targets       targets <-         either (reportBuildDocumentationTargetProblems verbosity) return $-          resolveTargets+          resolveTargetsFromSolver             (selectPackageTargets haddockFlags)             selectComponentTarget             elaboratedPlan
src/Distribution/Client/CmdHaddockProject.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE PatternSynonyms #-}+ module Distribution.Client.CmdHaddockProject   ( haddockProjectCommand   , haddockProjectAction@@ -26,7 +28,7 @@   , ProjectBuildContext (..)   , TargetSelector (..)   , pruneInstallPlanToTargets-  , resolveTargets+  , resolveTargetsFromSolver   , runProjectPreBuildPhase   , selectComponentTargetBasic   )@@ -64,9 +66,10 @@   ( CommandUI (..)   ) import Distribution.Simple.Flag-  ( Flag (..)-  , fromFlag+  ( fromFlag   , fromFlagOrDefault+  , pattern Flag+  , pattern NoFlag   ) import Distribution.Simple.Haddock (createHaddockIndex) import Distribution.Simple.InstallDirs@@ -85,7 +88,6 @@   , HaddockProjectFlags (..)   , HaddockTarget (..)   , Visibility (..)-  , defaultCommonSetupFlags   , defaultHaddockFlags   , haddockProjectCommand   )@@ -119,68 +121,13 @@    warn verbosity "haddock-project command is experimental, it might break in the future" -  -- build all packages with appropriate haddock flags-  let commonFlags =-        defaultCommonSetupFlags-          { setupVerbosity = haddockProjectVerbosity flags-          }-      haddockFlags =-        defaultHaddockFlags-          { haddockCommonFlags = commonFlags-          , haddockHtml = Flag True-          , -- one can either use `--haddock-base-url` or-            -- `--haddock-html-location`.-            haddockBaseUrl =-              if localStyle-                then Flag ".."-                else NoFlag-          , haddockProgramPaths = haddockProjectProgramPaths flags-          , haddockProgramArgs = haddockProjectProgramArgs flags-          , haddockHtmlLocation =-              if fromFlagOrDefault False (haddockProjectHackage flags)-                then Flag "https://hackage.haskell.org/package/$pkg-$version/docs"-                else haddockProjectHtmlLocation flags-          , haddockHoogle = haddockProjectHoogle flags-          , haddockExecutables = haddockProjectExecutables flags-          , haddockTestSuites = haddockProjectTestSuites flags-          , haddockBenchmarks = haddockProjectBenchmarks flags-          , haddockForeignLibs = haddockProjectForeignLibs flags-          , haddockInternal = haddockProjectInternal flags-          , haddockCss = haddockProjectCss flags-          , haddockLinkedSource = Flag True-          , haddockQuickJump = Flag True-          , haddockHscolourCss = haddockProjectHscolourCss flags-          , haddockContents =-              if localStyle-                then Flag (toPathTemplate "../index.html")-                else NoFlag-          , haddockIndex =-              if localStyle-                then Flag (toPathTemplate "../doc-index.html")-                else NoFlag-          , haddockKeepTempFiles = haddockProjectKeepTempFiles flags-          , haddockResourcesDir = haddockProjectResourcesDir flags-          , haddockUseUnicode = haddockProjectUseUnicode flags-          -- NOTE: we don't pass `haddockOutputDir`. If we do, we'll need to-          -- make sure `InstalledPackageInfo` contains the right path to-          -- haddock interfaces.  Instead we build documentation inside-          -- `dist-newstyle` directory and copy it to the output directory.-          }-      nixFlags =-        (commandDefaultFlags CmdHaddock.haddockCommand)-          { NixStyleOptions.haddockFlags = haddockFlags-          , NixStyleOptions.configFlags =-              (NixStyleOptions.configFlags (commandDefaultFlags CmdBuild.buildCommand))-                { configCommonFlags = commonFlags-                }-          }-   --   -- Construct the build plan and infer the list of packages which haddocks   -- we need.   --    withContextAndSelectors+    verbosity     RejectNoTargets     Nothing     (commandDefaultFlags CmdBuild.buildCommand)@@ -200,7 +147,7 @@           -- (as opposed to say repl or haddock targets).           targets <-             either reportTargetProblems return $-              resolveTargets+              resolveTargetsFromSolver                 selectPackageTargets                 selectComponentTargetBasic                 elaboratedPlan@@ -409,7 +356,61 @@         Nothing         flags'   where-    verbosity = fromFlagOrDefault normal (haddockProjectVerbosity flags)+    -- build all packages with appropriate haddock flags+    commonFlags = haddockProjectCommonFlags flags++    verbosity = fromFlagOrDefault normal (setupVerbosity commonFlags)++    haddockFlags =+      defaultHaddockFlags+        { haddockCommonFlags = commonFlags+        , haddockHtml = Flag True+        , -- one can either use `--haddock-base-url` or+          -- `--haddock-html-location`.+          haddockBaseUrl =+            if localStyle+              then Flag ".."+              else NoFlag+        , haddockProgramPaths = haddockProjectProgramPaths flags+        , haddockProgramArgs = haddockProjectProgramArgs flags+        , haddockHtmlLocation =+            if fromFlagOrDefault False (haddockProjectHackage flags)+              then Flag "https://hackage.haskell.org/package/$pkg-$version/docs"+              else haddockProjectHtmlLocation flags+        , haddockHoogle = haddockProjectHoogle flags+        , haddockExecutables = haddockProjectExecutables flags+        , haddockTestSuites = haddockProjectTestSuites flags+        , haddockBenchmarks = haddockProjectBenchmarks flags+        , haddockForeignLibs = haddockProjectForeignLibs flags+        , haddockInternal = haddockProjectInternal flags+        , haddockCss = haddockProjectCss flags+        , haddockLinkedSource = Flag True+        , haddockQuickJump = Flag True+        , haddockHscolourCss = haddockProjectHscolourCss flags+        , haddockContents =+            if localStyle+              then Flag (toPathTemplate "../index.html")+              else NoFlag+        , haddockIndex =+            if localStyle+              then Flag (toPathTemplate "../doc-index.html")+              else NoFlag+        , haddockResourcesDir = haddockProjectResourcesDir flags+        , haddockUseUnicode = haddockProjectUseUnicode flags+        -- NOTE: we don't pass `haddockOutputDir`. If we do, we'll need to+        -- make sure `InstalledPackageInfo` contains the right path to+        -- haddock interfaces.  Instead we build documentation inside+        -- `dist-newstyle` directory and copy it to the output directory.+        }++    nixFlags =+      (commandDefaultFlags CmdHaddock.haddockCommand)+        { NixStyleOptions.haddockFlags = haddockFlags+        , NixStyleOptions.configFlags =+            (NixStyleOptions.configFlags (commandDefaultFlags CmdBuild.buildCommand))+              { configCommonFlags = commonFlags+              }+        }      -- Build a self contained directory which contains haddocks of all     -- transitive dependencies; or depend on `--haddocks-html-location` to
src/Distribution/Client/CmdInstall.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-}@@ -62,6 +63,7 @@   ) import Distribution.Client.NixStyleOptions   ( NixStyleFlags (..)+  , cfgVerbosity   , defaultNixStyleFlags   , nixStyleOptions   )@@ -97,8 +99,7 @@   ( runRebuild   ) import Distribution.Client.Setup-  ( CommonSetupFlags (..)-  , ConfigFlags (..)+  ( ConfigFlags (..)   , GlobalFlags (..)   , InstallFlags (..)   )@@ -162,8 +163,10 @@   , userSpecifyPaths   ) import Distribution.Simple.Setup-  ( Flag (..)+  ( Flag   , installDirsOptions+  , pattern Flag+  , pattern NoFlag   ) import Distribution.Simple.Utils   ( createDirectoryIfMissingVerbose@@ -390,7 +393,7 @@   -- NOTE: CmdInstall and project local packages.   --   -- CmdInstall always installs packages from a source distribution that, in case of unpackage-  -- pacakges, is created automatically. This is implemented in getSpecsAndTargetSelectors.+  -- packages, is created automatically. This is implemented in getSpecsAndTargetSelectors.   --   -- This has the inconvenience that the planner will consider all packages as non-local   -- (see `ProjectPlanning.shouldBeLocal`) and that any project or cli configuration will@@ -467,6 +470,7 @@         fetchAndReadSourcePackages           verbosity           distDirLayout+          (Just compiler)           (projectConfigShared config)           (projectConfigBuildOnly config)           [ProjectPackageRemoteTarball uri | uri <- uris]@@ -542,7 +546,7 @@           traverseInstall (installCheckUnitExes InstallCheckInstall) installCfg   where     configFlags' = disableTestsBenchsByDefault . ignoreProgramAffixes $ configFlags-    verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags')+    verbosity = cfgVerbosity normal flags     ignoreProject = flagIgnoreProject projectFlags     cliConfig =       commandLineFlagsToProjectConfig@@ -824,7 +828,7 @@   -> IO (TargetsMap, [PackageName]) partitionToKnownTargetsAndHackagePackages verbosity pkgDb elaboratedPlan targetSelectors = do   let mTargets =-        resolveTargets+        resolveTargetsFromSolver           selectPackageTargets           selectComponentTarget           elaboratedPlan@@ -864,7 +868,7 @@       -- removed (or we've given up).       targets <-         either (reportBuildTargetProblems verbosity) return $-          resolveTargets+          resolveTargetsFromSolver             selectPackageTargets             selectComponentTarget             elaboratedPlan@@ -884,7 +888,7 @@     -- Interpret the targets on the command line as build targets     targets <-       either (reportBuildTargetProblems verbosity) return $-        resolveTargets+        resolveTargetsFromSolver           selectPackageTargets           selectComponentTarget           elaboratedPlan@@ -1030,7 +1034,7 @@  -- See ticket #8894. This is safe to include any nonreinstallable boot pkg, -- but the particular package users will always expect to be in scope without specific installation--- is base, so that they can access prelude, regardles of if they specifically asked for it.+-- is base, so that they can access prelude, regardless of if they specifically asked for it. globalPackages :: [PackageName] globalPackages = mkPackageName <$> ["base"]
src/Distribution/Client/CmdInstall/ClientInstallFlags.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PatternSynonyms #-}  module Distribution.Client.CmdInstall.ClientInstallFlags   ( InstallMethod (..)@@ -22,10 +22,11 @@   , reqArg   ) import Distribution.Simple.Setup-  ( Flag (..)+  ( Flag   , flagToList   , toFlag   , trueArg+  , pattern Flag   )  import Distribution.Client.Types.InstallMethod
src/Distribution/Client/CmdLegacy.hs view
@@ -2,7 +2,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ViewPatterns #-}  module Distribution.Client.CmdLegacy (legacyCmd, legacyWrapperCmd, newCmd) where
src/Distribution/Client/CmdListBin.hs view
@@ -1,8 +1,4 @@-{-# LANGUAGE MultiWayIf #-}-{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TupleSections #-}  module Distribution.Client.CmdListBin   ( listbinCommand@@ -33,10 +29,12 @@ import Distribution.Client.DistDirLayout (DistDirLayout (..)) import Distribution.Client.NixStyleOptions   ( NixStyleFlags (..)+  , cfgVerbosity   , defaultNixStyleFlags   , nixStyleOptions   )-import Distribution.Client.ProjectOrchestration+import Distribution.Client.ProjectOrchestration hiding (distDirLayout, targetsMap)+import qualified Distribution.Client.ProjectOrchestration as Orchestration (distDirLayout, targetsMap) import Distribution.Client.ProjectPlanning.Types import Distribution.Client.ScriptUtils   ( AcceptNoTargets (..)@@ -49,7 +47,6 @@ import Distribution.Client.TargetProblem (TargetProblem (..)) import Distribution.Simple.BuildPaths (dllExtension, exeExtension) import Distribution.Simple.Command (CommandUI (..))-import Distribution.Simple.Setup (configCommonFlags, fromFlagOrDefault, setupVerbosity) import Distribution.Simple.Utils (dieWithException, withOutputMarker, wrapText) import Distribution.System (Platform) import Distribution.Types.ComponentName (showComponentName)@@ -89,7 +86,7 @@ -------------------------------------------------------------------------------  listbinAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO ()-listbinAction flags@NixStyleFlags{..} args globalFlags = do+listbinAction flags args globalFlags = do   -- fail early if multiple target selectors specified   target <- case args of     [] -> dieWithException verbosity NoTargetProvided@@ -97,7 +94,7 @@     _ -> dieWithException verbosity OneTargetRequired    -- configure and elaborate target selectors-  withContextAndSelectors RejectNoTargets (Just ExeKind) flags [target] globalFlags OtherCommand $ \targetCtx ctx targetSelectors -> do+  withContextAndSelectors verbosity RejectNoTargets (Just ExeKind) flags [target] globalFlags OtherCommand $ \targetCtx ctx targetSelectors -> do     baseCtx <- case targetCtx of       ProjectContext -> return ctx       GlobalContext -> return ctx@@ -109,7 +106,7 @@         -- (as opposed to say repl or haddock targets).         targets <-           either (reportTargetProblems verbosity) return $-            resolveTargets+            resolveTargetsFromSolver               selectPackageTargets               selectComponentTarget               elaboratedPlan@@ -143,7 +140,7 @@       singleComponentOrElse         ( dieWithException verbosity ThisIsABug         )-        $ targetsMap buildCtx+        $ Orchestration.targetsMap buildCtx      printPlan verbosity baseCtx buildCtx @@ -153,7 +150,7 @@         return $           IP.foldPlanPackage             (const []) -- IPI don't have executables-            (elaboratedPackage (distDirLayout baseCtx) (elaboratedShared buildCtx) selectedComponent)+            (elaboratedPackage (Orchestration.distDirLayout baseCtx) (elaboratedShared buildCtx) selectedComponent)             gpp      case binfiles of@@ -173,7 +170,7 @@       _ -> dieWithException verbosity MultipleTargetsFound   where     defaultVerbosity = verboseStderr silent-    verbosity = fromFlagOrDefault defaultVerbosity (setupVerbosity $ configCommonFlags configFlags)+    verbosity = cfgVerbosity defaultVerbosity flags      -- this is copied from     elaboratedPackage
src/Distribution/Client/CmdOutdated.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE RecordWildCards #-}  -- |@@ -13,44 +14,22 @@   , outdatedAction   , ListOutdatedSettings (..)   , listOutdated+  , IgnoreMajorVersionBumps (..)+  , showResult   ) where  import Distribution.Client.Compat.Prelude-import Distribution.Compat.Lens-  ( _1-  , _2-  ) import Prelude () +import qualified Data.Set as Set import Distribution.Client.Config   ( SavedConfig       ( savedConfigureExFlags-      , savedConfigureFlags-      , savedGlobalFlags       )   )-import Distribution.Client.DistDirLayout-  ( DistDirLayout (distProjectFile, distProjectRootDirectory)-  , defaultDistDirLayout-  )-import Distribution.Client.IndexUtils as IndexUtils+import qualified Distribution.Client.IndexUtils as IndexUtils import Distribution.Client.ProjectConfig-import Distribution.Client.ProjectConfig.Legacy-  ( instantiateProjectConfigSkeletonWithCompiler-  )-import Distribution.Client.ProjectFlags-  ( ProjectFlags (..)-  , defaultProjectFlags-  , projectFlagsOptions-  , removeIgnoreProjectOption-  )-import Distribution.Client.RebuildMonad-  ( runRebuild-  )-import Distribution.Client.Sandbox-  ( loadConfigOrSandboxConfig-  ) import Distribution.Client.Sandbox.PackageEnvironment   ( loadUserConfig   )@@ -60,80 +39,11 @@   , userToPackageConstraint   ) import Distribution.Client.Types.SourcePackageDb as SourcePackageDb-import Distribution.Solver.Types.PackageConstraint-  ( packageConstraintToDependency-  )-import Distribution.Utils.Generic-  ( safeLast-  , wrapText-  )--import Distribution.Client.HttpUtils import qualified Distribution.Compat.CharParsing as P-import Distribution.Package-  ( PackageName-  , packageVersion-  ) import Distribution.PackageDescription-  ( allBuildDepends-  ) import Distribution.PackageDescription.Configuration-  ( finalizePD-  )-import Distribution.ReadE-  ( parsecToReadE-  )-import Distribution.Simple.Command-  ( CommandUI (..)-  , OptionField-  , ShowOrParseArgs-  , liftOptionL-  , optArg-  , option-  , reqArg-  )-import Distribution.Simple.Compiler-  ( Compiler-  , compilerInfo-  )-import Distribution.Simple.Flag-  ( Flag (..)-  , flagToMaybe-  , fromFlagOrDefault-  , toFlag-  )-import Distribution.Simple.PackageDescription-  ( readGenericPackageDescription-  )-import Distribution.Simple.Setup-  ( optionVerbosity-  , trueArg-  )-import Distribution.Simple.Utils-  ( debug-  , dieWithException-  , notice-  , tryFindPackageDesc-  )-import Distribution.System-  ( Platform (..)-  )-import Distribution.Types.ComponentRequestedSpec-  ( ComponentRequestedSpec (..)-  )-import Distribution.Types.Dependency-  ( Dependency (..)-  )-import Distribution.Types.PackageVersionConstraint-  ( PackageVersionConstraint (..)-  , simplifyPackageVersionConstraint-  )-import Distribution.Utils.NubList-  ( fromNubList-  )-import Distribution.Verbosity-  ( normal-  , silent+import Distribution.Solver.Types.PackageConstraint+  ( packageConstraintToDependency   ) import Distribution.Version   ( LowerBound (..)@@ -146,21 +56,44 @@   )  import qualified Data.Set as S-import Distribution.Client.Errors-import Distribution.Utils.Path (relativeSymbolicPath)+import Distribution.Client.NixStyleOptions import System.Directory-  ( doesFileExist-  , getCurrentDirectory+  ( getCurrentDirectory   ) +import Distribution.Client.ProjectOrchestration++import Control.Monad+import Distribution.Client.ScriptUtils+import Distribution.Package+import Distribution.ReadE+import Distribution.Simple.Command+import Distribution.Simple.Flag+import Distribution.Simple.Setup hiding (GlobalFlags (..))+import Distribution.Simple.Utils+import Distribution.Types.PackageVersionConstraint+import Distribution.Verbosity++import qualified Data.Map.Strict as Map+import Distribution.Client.CmdErrorMessages+import Distribution.Client.ProjectPlanning.Types+import Distribution.Client.TargetProblem+import Distribution.Client.Types.PackageSpecifier+import Distribution.Solver.Types.ConstraintSource+import Distribution.Solver.Types.SourcePackage+import Distribution.Types.Component+import qualified Text.PrettyPrint as PP++import Distribution.Client.Errors+ ------------------------------------------------------------------------------- -- Command ------------------------------------------------------------------------------- -outdatedCommand :: CommandUI (ProjectFlags, OutdatedFlags)+outdatedCommand :: CommandUI (NixStyleFlags OutdatedFlags) outdatedCommand =   CommandUI-    { commandName = "outdated"+    { commandName = "v2-outdated"     , commandSynopsis = "Check for outdated dependencies."     , commandDescription = Just $ \_ ->         wrapText $@@ -169,12 +102,9 @@     , commandNotes = Nothing     , commandUsage = \pname ->         "Usage: " ++ pname ++ " outdated [FLAGS] [PACKAGES]\n"-    , commandDefaultFlags = (defaultProjectFlags, defaultOutdatedFlags)-    , commandOptions = \showOrParseArgs ->-        map-          (liftOptionL _1)-          (removeIgnoreProjectOption (projectFlagsOptions showOrParseArgs))-          ++ map (liftOptionL _2) (outdatedOptions showOrParseArgs)+    , commandDefaultFlags = defaultNixStyleFlags defaultOutdatedFlags+    , commandOptions = nixStyleOptions $ \showOrParseArgs ->+        outdatedOptions showOrParseArgs     }  -------------------------------------------------------------------------------@@ -199,8 +129,7 @@     IgnoreMajorVersionBumpsSome (a ++ b)  data OutdatedFlags = OutdatedFlags-  { outdatedVerbosity :: Flag Verbosity-  , outdatedFreezeFile :: Flag Bool+  { outdatedFreezeFile :: Flag Bool   , outdatedNewFreezeFile :: Flag Bool   , outdatedSimpleOutput :: Flag Bool   , outdatedExitCode :: Flag Bool@@ -212,8 +141,7 @@ defaultOutdatedFlags :: OutdatedFlags defaultOutdatedFlags =   OutdatedFlags-    { outdatedVerbosity = toFlag normal-    , outdatedFreezeFile = mempty+    { outdatedFreezeFile = mempty     , outdatedNewFreezeFile = mempty     , outdatedSimpleOutput = mempty     , outdatedExitCode = mempty@@ -224,10 +152,7 @@  outdatedOptions :: ShowOrParseArgs -> [OptionField OutdatedFlags] outdatedOptions _showOrParseArgs =-  [ optionVerbosity-      outdatedVerbosity-      (\v flags -> flags{outdatedVerbosity = v})-  , option+  [ option       []       ["freeze-file", "v1-freeze-file"]       "Act on the freeze file"@@ -236,8 +161,8 @@       trueArg   , option       []-      ["v2-freeze-file", "new-freeze-file"]-      "Act on the new-style freeze file (default: cabal.project.freeze)"+      ["project-context", "v2-freeze-file", "new-freeze-file"]+      "Check for outdated dependencies in the project context, for example, dependencies specified in cabal.project orcabal.project.freeze."       outdatedNewFreezeFile       (\v flags -> flags{outdatedNewFreezeFile = v})       trueArg@@ -304,54 +229,54 @@ -- Action ------------------------------------------------------------------------------- --- | Entry point for the 'outdated' command.-outdatedAction :: (ProjectFlags, OutdatedFlags) -> [String] -> GlobalFlags -> IO ()-outdatedAction (ProjectFlags{flagProjectDir, flagProjectFile}, OutdatedFlags{..}) _targetStrings globalFlags = do-  config <- loadConfigOrSandboxConfig verbosity globalFlags-  let globalFlags' = savedGlobalFlags config `mappend` globalFlags-      configFlags = savedConfigureFlags config-  withRepoContext verbosity globalFlags' $ \repoContext -> do-    when (not newFreezeFile && (isJust mprojectDir || isJust mprojectFile)) $-      dieWithException verbosity OutdatedAction+getSourcePackages :: Verbosity -> ProjectConfig -> IO SourcePackageDb+getSourcePackages verbosity projectConfig =+  projectConfigWithSolverRepoContext+    verbosity+    (projectConfigShared projectConfig)+    (projectConfigBuildOnly projectConfig)+    (\ctx -> IndexUtils.getSourcePackages verbosity ctx) -    sourcePkgDb <- IndexUtils.getSourcePackages verbosity repoContext-    (comp, platform, _progdb) <- configCompilerAux' configFlags-    deps <--      if freezeFile-        then depsFromFreezeFile verbosity-        else-          if newFreezeFile-            then do-              httpTransport <--                configureTransport-                  verbosity-                  (fromNubList . globalProgPathExtra $ globalFlags)-                  (flagToMaybe . globalHttpTransport $ globalFlags)-              depsFromNewFreezeFile verbosity httpTransport comp platform mprojectDir mprojectFile-            else do-              depsFromPkgDesc verbosity comp platform-    debug verbosity $-      "Dependencies loaded: "-        ++ intercalate ", " (map prettyShow deps)-    let outdatedDeps =-          listOutdated-            deps-            sourcePkgDb-            (ListOutdatedSettings ignorePred minorPred)-    when (not quiet) $-      showResult verbosity outdatedDeps simpleOutput-    if exitCode && (not . null $ outdatedDeps)-      then exitFailure-      else return ()+outdatedAction :: NixStyleFlags OutdatedFlags -> [String] -> GlobalFlags -> IO ()+outdatedAction flags targetStrings globalFlags =+  withContextAndSelectors+    verbosity+    AcceptNoTargets+    Nothing+    flags+    targetStrings+    globalFlags+    OtherCommand+    $ \_targetCtx ctx targetSelectors -> do+      deps <-+        if+            | freezeFile -> depsFromFreezeFile verbosity+            | newFreezeFile -> depsFromProjectContext verbosity (projectConfig ctx)+            | otherwise -> depsFromLocalPackages verbosity ctx targetSelectors++      debug verbosity $+        "Dependencies loaded: "+          ++ intercalate ", " (map prettyShow deps)++      sourcePkgDb <- getSourcePackages verbosity (projectConfig ctx)+      let outdatedDeps =+            listOutdated+              deps+              sourcePkgDb+              (ListOutdatedSettings ignorePred minorPred)+      when (not quiet) $+        showResult verbosity outdatedDeps simpleOutput+      if exitCode && (not . null $ outdatedDeps)+        then exitFailure+        else return ()   where+    OutdatedFlags{..} = extraFlags flags     verbosity =       if quiet         then silent-        else fromFlagOrDefault normal outdatedVerbosity+        else fromFlagOrDefault normal (setupVerbosity (configCommonFlags (configFlags flags)))     freezeFile = fromFlagOrDefault False outdatedFreezeFile     newFreezeFile = fromFlagOrDefault False outdatedNewFreezeFile-    mprojectDir = flagToMaybe flagProjectDir-    mprojectFile = flagToMaybe flagProjectFile     simpleOutput = fromFlagOrDefault False outdatedSimpleOutput     quiet = fromFlagOrDefault False outdatedQuiet     exitCode = fromFlagOrDefault quiet outdatedExitCode@@ -366,93 +291,153 @@         let minorSet = S.fromList pkgs          in \pkgname -> pkgname `S.member` minorSet +reportOutdatedTargetProblem :: Verbosity -> [TargetProblem'] -> IO a+reportOutdatedTargetProblem verbosity problems =+  reportTargetProblems verbosity "check outdated dependencies for" problems+ -- | Print either the list of all outdated dependencies, or a message -- that there are none.-showResult :: Verbosity -> [(PackageVersionConstraint, Version)] -> Bool -> IO ()+showResult :: Verbosity -> [OutdatedDependency] -> Bool -> IO () showResult verbosity outdatedDeps simpleOutput =   if not . null $ outdatedDeps     then do       when (not simpleOutput) $         notice verbosity "Outdated dependencies:"-      for_ outdatedDeps $ \(d@(PackageVersionConstraint pn _), v) ->-        let outdatedDep =-              if simpleOutput-                then prettyShow pn-                else prettyShow d ++ " (latest: " ++ prettyShow v ++ ")"-         in notice verbosity outdatedDep+      if simpleOutput+        then -- Simple output just prints package names, one per line+          outputSimple+        else -- Hierarchical output grouped by package and component+          outputStructured     else notice verbosity "All dependencies are up to date."+  where+    -- Group dependencies by package and component+    groupByPackage :: [OutdatedDependency] -> [(String, [(String, [OutdatedDependency])])]+    groupByPackage deps =+      let+        -- First, create a list of (package, component, dependency) tuples+        pkgCompDeps =+          [ (extractPackageName src, extractComponentName src, dep)+          | dep@(OutdatedDependency _ _ src) <- deps+          ]+        -- Group by package+        pkgGroups =+          Map.fromListWith+            (Map.unionWith (++))+            [ (pkg, (Map.singleton comp [d]))+            | (pkg, comp, d) <- pkgCompDeps+            ]+       in+        Map.toList (Map.map Map.toList pkgGroups) +    -- Extract package name from the source+    extractPackageName :: OutdatedDependencySource -> String+    extractPackageName (ConfigSource _) = "project-config"+    extractPackageName (ComponentSource pkgId _) = prettyShow (pkgName pkgId)++    -- Extract component name from the source+    extractComponentName :: OutdatedDependencySource -> String+    extractComponentName (ConfigSource src) = showConstraintSource src+    extractComponentName (ComponentSource pkgId ctarget) = showComponentTarget pkgId ctarget++    getConstraintPackageName :: PackageVersionConstraint -> PackageName+    getConstraintPackageName (PackageVersionConstraint pn _) = pn++    outputSimple =+      let pns = sortNub $ map (getConstraintPackageName . outdatedDependency) outdatedDeps+       in for_ pns $ \pn ->+            noticeNoWrap verbosity (prettyShow pn)++    outputStructured =+      let+        -- Group by package name, then by component+        packageGroups = groupByPackage outdatedDeps+       in+        for_ packageGroups $ \(pkgName, componentGroups) -> do+          noticeNoWrap verbosity $ "* " ++ pkgName+          for_ componentGroups $ \(compName, deps) -> do+            noticeNoWrap verbosity $ "  - " ++ compName+            for_ (sortBy (comparing (getConstraintPackageName . outdatedDependency)) deps) $+              \(OutdatedDependency d v _) ->+                noticeNoWrap verbosity $ "    * " ++ prettyShow d ++ " (latest: " ++ prettyShow v ++ ")"++data OutdatedDependencyX v = OutdatedDependency+  { outdatedDependency :: PackageVersionConstraint+  , _outdatedVersion :: v+  , _outdatedSource :: OutdatedDependencySource+  }++instance Pretty (OutdatedDependencyX Version) where+  pretty (OutdatedDependency dep ver src) =+    pretty dep+      <+> PP.text "(latest:"+      <+> pretty ver+      <+> PP.text ","+      <+> PP.text "from:"+      <+> PP.text (prettyOutdatedDependencySource src)+      <+> PP.text ")"++instance Pretty (OutdatedDependencyX ()) where+  pretty (OutdatedDependency dep _ src) =+    pretty dep <+> PP.text "(from:" <+> PP.text (prettyOutdatedDependencySource src) `mappend` PP.text ")"++data OutdatedDependencySource = ConfigSource ConstraintSource | ComponentSource PackageId ComponentTarget++-- | Pretty print an 'OutdatedDependencySource'.+prettyOutdatedDependencySource :: OutdatedDependencySource -> String+prettyOutdatedDependencySource (ConfigSource src) = showConstraintSource src+prettyOutdatedDependencySource (ComponentSource pkgId ctarget) = prettyShow pkgId ++ ":" ++ showComponentTarget pkgId ctarget++type CandidateOutdatedDependency = OutdatedDependencyX ()++mkCandidateOutdatedDependency :: PackageVersionConstraint -> OutdatedDependencySource -> CandidateOutdatedDependency+mkCandidateOutdatedDependency dep src = OutdatedDependency dep () src++type OutdatedDependency = OutdatedDependencyX Version+ -- | Convert a list of 'UserConstraint's to a 'Dependency' list.-userConstraintsToDependencies :: [UserConstraint] -> [PackageVersionConstraint]+userConstraintsToDependencies :: [(UserConstraint, ConstraintSource)] -> [CandidateOutdatedDependency] userConstraintsToDependencies ucnstrs =-  mapMaybe (packageConstraintToDependency . userToPackageConstraint) ucnstrs+  mapMaybe (\(uc, src) -> fmap (flip mkCandidateOutdatedDependency (ConfigSource src)) (packageConstraintToDependency . userToPackageConstraint $ uc)) ucnstrs  -- | Read the list of dependencies from the freeze file.-depsFromFreezeFile :: Verbosity -> IO [PackageVersionConstraint]+depsFromFreezeFile :: Verbosity -> IO [CandidateOutdatedDependency] depsFromFreezeFile verbosity = do   cwd <- getCurrentDirectory   userConfig <- loadUserConfig verbosity cwd Nothing   let ucnstrs =-        map fst . configExConstraints . savedConfigureExFlags $+        configExConstraints . savedConfigureExFlags $           userConfig       deps = userConstraintsToDependencies ucnstrs   debug verbosity "Reading the list of dependencies from the freeze file"   return deps --- | Read the list of dependencies from the new-style freeze file.-depsFromNewFreezeFile :: Verbosity -> HttpTransport -> Compiler -> Platform -> Maybe FilePath -> Maybe FilePath -> IO [PackageVersionConstraint]-depsFromNewFreezeFile verbosity httpTransport compiler (Platform arch os) mprojectDir mprojectFile = do-  projectRoot <--    either throwIO return-      =<< findProjectRoot verbosity mprojectDir mprojectFile-  let distDirLayout =-        defaultDistDirLayout-          projectRoot-          {- TODO: Support dist dir override -} Nothing-          Nothing-  projectConfig <- runRebuild (distProjectRootDirectory distDirLayout) $ do-    pcs <- readProjectLocalFreezeConfig verbosity httpTransport distDirLayout-    pure $ instantiateProjectConfigSkeletonWithCompiler os arch (compilerInfo compiler) mempty pcs-  let ucnstrs =-        map fst . projectConfigConstraints . projectConfigShared $-          projectConfig+-- | Read the list of dependencies from the cabal.project context.+-- This will get dependencies from+--  * cabal.project.freeze+--  * cabal.project.local+--  * cabal.project+-- files+depsFromProjectContext :: Verbosity -> ProjectConfig -> IO [CandidateOutdatedDependency]+depsFromProjectContext verbosity projectConfig = do+  let ucnstrs = projectConfigConstraints $ projectConfigShared projectConfig       deps = userConstraintsToDependencies ucnstrs-      freezeFile = distProjectFile distDirLayout "freeze"-  freezeFileExists <- doesFileExist freezeFile--  unless freezeFileExists $-    dieWithException verbosity $-      FreezeFileExistsErr freezeFile-+      provenance = projectConfigProvenance projectConfig   debug verbosity $-    "Reading the list of dependencies from the new-style freeze file " ++ freezeFile+    "Reading the list of dependencies from the project files: "+      ++ intercalate ", " [prettyShow p | Explicit p <- Set.toList provenance]   return deps  -- | Read the list of dependencies from the package description.-depsFromPkgDesc :: Verbosity -> Compiler -> Platform -> IO [PackageVersionConstraint]-depsFromPkgDesc verbosity comp platform = do-  path <- tryFindPackageDesc verbosity Nothing-  gpd <- readGenericPackageDescription verbosity Nothing (relativeSymbolicPath path)-  let cinfo = compilerInfo comp-      epd =-        finalizePD-          mempty-          (ComponentRequestedSpec True True)-          (const True)-          platform-          cinfo-          []-          gpd-  case epd of-    Left _ -> dieWithException verbosity FinalizePDFailed-    Right (pd, _) -> do-      let bd = allBuildDepends pd-      debug-        verbosity-        "Reading the list of dependencies from the package description"-      return $ map toPVC bd+depsFromPkgDesc :: Verbosity -> PackageId -> GenericPackageDescription -> ComponentTarget -> IO [CandidateOutdatedDependency]+depsFromPkgDesc verbosity pkgId gpd t@(ComponentTarget cname _subtarget) = do+  let pd = flattenPackageDescription gpd+      bd = targetBuildDepends (componentBuildInfo (getComponent pd cname))+  debug+    verbosity+    "Reading the list of dependencies from the package description"+  return $ map toPVC bd   where-    toPVC (Dependency pn vr _) = PackageVersionConstraint pn vr+    toPVC (Dependency pn vr _) = mkCandidateOutdatedDependency (PackageVersionConstraint pn vr) (ComponentSource pkgId t)  -- | Various knobs for customising the behaviour of 'listOutdated'. data ListOutdatedSettings = ListOutdatedSettings@@ -464,20 +449,22 @@  -- | Find all outdated dependencies. listOutdated-  :: [PackageVersionConstraint]+  :: [CandidateOutdatedDependency]   -> SourcePackageDb   -> ListOutdatedSettings-  -> [(PackageVersionConstraint, Version)]+  -> [OutdatedDependency] listOutdated deps sourceDb (ListOutdatedSettings ignorePred minorPred) =-  mapMaybe isOutdated $ map simplifyPackageVersionConstraint deps+  mapMaybe isOutdated deps   where-    isOutdated :: PackageVersionConstraint -> Maybe (PackageVersionConstraint, Version)-    isOutdated dep@(PackageVersionConstraint pname vr)+    isOutdated :: CandidateOutdatedDependency -> Maybe OutdatedDependency+    isOutdated (OutdatedDependency dep () src)       | ignorePred pname = Nothing       | otherwise =           let this = map packageVersion $ SourcePackageDb.lookupDependency sourceDb pname vr               latest = lookupLatest dep-           in (\v -> (dep, v)) `fmap` isOutdated' this latest+           in (\v -> OutdatedDependency dep v src) `fmap` isOutdated' this latest+      where+        PackageVersionConstraint pname vr = simplifyPackageVersionConstraint dep      isOutdated' :: [Version] -> [Version] -> Maybe Version     isOutdated' [] _ = Nothing@@ -503,3 +490,50 @@           case upper of             NoUpperBound -> vr             UpperBound _v1 _ -> majorBoundVersion v0++-- | For the outdated command, when a whole package is specified we want+-- to select all buildable components.+selectPackageTargetsForOutdated+  :: TargetSelector+  -> [AvailableTarget k]+  -> Either (TargetProblem') [k]+selectPackageTargetsForOutdated targetSelector targets+  -- No targets available at all is an error+  | null targets = Left (TargetProblemNoTargets targetSelector)+  -- We select all buildable components for a package+  | otherwise = Right $ selectBuildableTargets targets++-- | For the outdated command, when a specific component is specified+-- we simply select that component.+selectComponentTargetForOutdated+  :: SubComponentTarget+  -> AvailableTarget k+  -> Either (TargetProblem') k+selectComponentTargetForOutdated subtarget target =+  selectComponentTargetBasic subtarget target++-- | Read the list of dependencies from local packages+depsFromLocalPackages :: Verbosity -> ProjectBaseContext -> [TargetSelector] -> IO [CandidateOutdatedDependency]+depsFromLocalPackages verbosity ctx targetSelectors = do+  when (null targetSelectors) $+    dieWithException verbosity TargetSelectorNoTargetsInCwdTrue+  targets <-+    either (reportOutdatedTargetProblem verbosity) return $+      resolveTargetsFromLocalPackages+        selectPackageTargetsForOutdated+        selectComponentTargetForOutdated+        (localPackages ctx)+        targetSelectors+  fmap concat <$> forM (localPackages ctx) $ \pkg -> case pkg of+    SpecificSourcePackage pkg' -> do+      -- Find the package in the resolved targets+      let pkgId = packageId pkg'+      let pkgTargets =+            case Map.lookup pkgId targets of+              Just componentTargets -> map fst componentTargets+              Nothing -> []+      -- If no specific components were targeted, use the whole package+      -- Get dependencies for each targeted component+      fmap concat <$> forM pkgTargets $ \target ->+        depsFromPkgDesc verbosity pkgId (srcpkgDescription pkg') target+    _ -> return []
src/Distribution/Client/CmdPath.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE PatternSynonyms #-}  -- | -- Module      :  Distribution.Client.CmdPath@@ -31,6 +30,7 @@ import Distribution.Client.GlobalFlags import Distribution.Client.NixStyleOptions   ( NixStyleFlags (..)+  , cfgVerbosity   , defaultNixStyleFlags   , nixStyleOptions   )@@ -44,8 +44,7 @@ import Distribution.Client.RebuildMonad (runRebuild) import Distribution.Client.ScriptUtils import Distribution.Client.Setup-  ( ConfigFlags (..)-  , yesNoOpt+  ( yesNoOpt   ) import Distribution.Client.Utils.Json   ( (.=)@@ -67,9 +66,11 @@   ) import Distribution.Simple.Compiler import Distribution.Simple.Flag-  ( Flag (..)+  ( Flag   , flagToList   , fromFlagOrDefault+  , pattern Flag+  , pattern NoFlag   ) import Distribution.Simple.Program import Distribution.Simple.Utils@@ -90,7 +91,7 @@ pathCommand =   CommandUI     { commandName = "path"-    , commandSynopsis = "Query for simple project information"+    , commandSynopsis = "Query for simple project information."     , commandDescription = Just $ \_ ->         wrapText $           "Query for configuration and project information such as project GHC.\n"@@ -224,7 +225,7 @@  -- | Entry point for the 'path' command. pathAction :: NixStyleFlags PathFlags -> [String] -> GlobalFlags -> IO ()-pathAction flags@NixStyleFlags{extraFlags = pathFlags', ..} cliTargetStrings globalFlags = withContextAndSelectors AcceptNoTargets Nothing flags [] globalFlags OtherCommand $ \_ baseCtx _ -> do+pathAction flags@NixStyleFlags{extraFlags = pathFlags'} cliTargetStrings globalFlags = withContextAndSelectors verbosity AcceptNoTargets Nothing flags [] globalFlags OtherCommand $ \_ baseCtx _ -> do   let pathFlags =         if pathCompiler pathFlags' == NoFlag && pathDirectories pathFlags' == NoFlag           then -- if not a single key to query is given, query everything!@@ -266,7 +267,7 @@    putStr $ withOutputMarker verbosity output   where-    verbosity = fromFlagOrDefault normal (configVerbosity configFlags)+    verbosity = cfgVerbosity normal flags  -- | Find the FilePath location for common configuration paths. --
src/Distribution/Client/CmdRepl.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeApplications #-} @@ -42,6 +43,7 @@ import qualified Distribution.Client.InstallPlan as InstallPlan import Distribution.Client.NixStyleOptions   ( NixStyleFlags (..)+  , cfgVerbosity   , defaultNixStyleFlags   , nixStyleOptions   )@@ -99,21 +101,22 @@   ) import Distribution.Simple.Compiler   ( Compiler+  , PackageDBX (..)   , compilerCompatVersion   )+import Distribution.Simple.Program.GHC import Distribution.Simple.Setup   ( ReplOptions (..)-  , setupVerbosity+  , commonSetupTempFileOptions   ) import Distribution.Simple.Utils-  ( TempFileOptions (..)-  , debugNoWrap+  ( debugNoWrap   , dieWithException   , withTempDirectoryEx   , wrapText   ) import Distribution.Solver.Types.ConstraintSource-  ( ConstraintSource (ConstraintSourceMultiRepl)+  ( ConstraintSource (ConstraintSourceMultiRepl, ConstraintSourceWithRepl)   ) import Distribution.Solver.Types.PackageConstraint   ( PackageProperty (PackagePropertyVersion)@@ -177,16 +180,10 @@   , topReplOptions   ) import Distribution.Compat.Binary (decode)-import Distribution.Simple.Flag (Flag (Flag), fromFlagOrDefault)+import Distribution.Simple.Flag (flagToMaybe, fromFlagOrDefault, pattern Flag) import Distribution.Simple.Program.Builtin (ghcProgram) import Distribution.Simple.Program.Db (requireProgram)-import Distribution.Simple.Program.Run-  ( programInvocation-  , runProgramInvocation-  ) import Distribution.Simple.Program.Types-  ( ConfiguredProgram (programOverrideEnv)-  ) import System.Directory   ( doesFileExist   , getCurrentDirectory@@ -285,7 +282,7 @@ -- "Distribution.Client.ProjectOrchestration" replAction :: NixStyleFlags ReplFlags -> [String] -> GlobalFlags -> IO () replAction flags@NixStyleFlags{extraFlags = r@ReplFlags{..}, ..} targetStrings globalFlags =-  withContextAndSelectors AcceptNoTargets (Just LibKind) flags targetStrings globalFlags ReplCommand $ \targetCtx ctx targetSelectors -> do+  withContextAndSelectors verbosity AcceptNoTargets (Just LibKind) flags targetStrings globalFlags ReplCommand $ \targetCtx ctx targetSelectors -> do     when (buildSettingOnlyDeps (buildSettings ctx)) $       dieWithException verbosity ReplCommandDoesn'tSupport     let projectRoot = distProjectRootDirectory $ distDirLayout ctx@@ -326,16 +323,35 @@     -- We need to do this before solving, but the compiler version is only known     -- after solving (phaseConfigureCompiler), so instead of using     -- multiReplDecision we just check the flag.-    let baseCtx' =-          if fromFlagOrDefault False $+    let multiReplEnabled =+          fromFlagOrDefault False $             projectConfigMultiRepl (projectConfigShared $ projectConfig baseCtx)               <> replUseMulti++        withReplEnabled =+          isJust $ flagToMaybe $ replWithRepl configureReplOptions++        addConstraintWhen cond constraint base_ctx =+          if cond             then-              baseCtx+              base_ctx                 & lProjectConfig . lProjectConfigShared . lProjectConfigConstraints-                  %~ (multiReplCabalConstraint :)-            else baseCtx+                  %~ (constraint :)+            else base_ctx +        -- This is the constraint setup.Cabal>=3.11. 3.11 is when Cabal options+        -- used for multi-repl were introduced.+        -- Idelly we'd apply this constraint only on the closure of repl targets,+        -- but that would require another solver run for marginal advantages that+        -- will further shrink as 3.11 is adopted.+        addMultiReplConstraint = addConstraintWhen multiReplEnabled $ requireCabal [3, 11] ConstraintSourceMultiRepl++        -- Similarly, if you use `--with-repl` then your version of `Cabal` needs to+        -- support the `--with-repl` flag.+        addWithReplConstraint = addConstraintWhen withReplEnabled $ requireCabal [3, 15] ConstraintSourceWithRepl++        baseCtx' = addMultiReplConstraint $ addWithReplConstraint baseCtx+     (originalComponent, baseCtx'') <-       if null (envPackages replEnvFlags)         then return (Nothing, baseCtx')@@ -363,7 +379,7 @@     -- In addition, to avoid a *third* trip through the solver, we are     -- replicating the second half of 'runProjectPreBuildPhase' by hand     -- here.-    (buildCtx, compiler, replOpts', targets) <- withInstallPlan verbosity baseCtx'' $+    (buildCtx, compiler, platform, replOpts', targets) <- withInstallPlan verbosity baseCtx'' $       \elaboratedPlan elaboratedShared' -> do         let ProjectBaseContext{..} = baseCtx'' @@ -400,18 +416,18 @@               , targetsMap = targets               } -          ElaboratedSharedConfig{pkgConfigCompiler = compiler} = elaboratedShared'+          ElaboratedSharedConfig{pkgConfigCompiler = compiler, pkgConfigPlatform = platform} = elaboratedShared'            repl_flags = case originalComponent of             Just oci -> generateReplFlags includeTransitive elaboratedPlan' oci             Nothing -> [] -        return (buildCtx, compiler, configureReplOptions & lReplOptionsFlags %~ (++ repl_flags), targets)+        return (buildCtx, compiler, platform, configureReplOptions & lReplOptionsFlags %~ (++ repl_flags), targets) -    -- Multi Repl implemention see: https://well-typed.com/blog/2023/03/cabal-multi-unit/ for+    -- Multi Repl implementation see: https://well-typed.com/blog/2023/03/cabal-multi-unit/ for     -- a high-level overview about how everything fits together.     if Set.size (distinctTargetComponents targets) > 1-      then withTempDirectoryEx verbosity (TempFileOptions keepTempFiles) distDir "multi-out" $ \dir' -> do+      then withTempDirectoryEx verbosity tempFileOptions distDir "multi-out" $ \dir' -> do         -- multi target repl         dir <- makeAbsolute dir'         -- Modify the replOptions so that the ./Setup repl command will write options@@ -440,14 +456,14 @@         let sp = intercalate [searchPathSeparator] (map fst (sortBy (comparing @Int snd) $ Map.toList (combine_search_paths all_paths)))         -- HACK: Just combine together all env overrides, placing the most common things last -        -- ghc program with overriden PATH+        -- ghc program with overridden PATH         (ghcProg, _) <- requireProgram verbosity ghcProgram (pkgConfigCompilerProgs (elaboratedShared buildCtx'))         let ghcProg' = ghcProg{programOverrideEnv = [("PATH", Just sp)]}          -- Find what the unit files are, and start a repl based on all the response         -- files which have been created in the directory.         -- unit files for components-        unit_files <- listDirectory dir+        unit_files <- (filter (/= "paths")) <$> listDirectory dir          -- Order the unit files so that the find target becomes the active unit         let active_unit_fp :: Maybe FilePath@@ -468,26 +484,21 @@                in -- GHC considers the last unit passed to be the active one                   other_units ++ active_unit_files -            render_j Serial = "1"-            render_j (UseSem n) = show @Int n-            render_j (NumJobs mn) = maybe "" (show @Int) mn+            convertParStrat :: ParStratX Int -> ParStratX String+            convertParStrat Serial = Serial+            convertParStrat (UseSem n) = NumJobs (Just n)+            convertParStrat (NumJobs mn) = NumJobs mn -        -- run ghc --interactive with-        runProgramInvocation verbosity $-          programInvocation ghcProg' $-            concat $-              [ "--interactive"-              , "-package-env"-              , "-" -- to ignore ghc.environment.* files-              , "-j"-              , render_j (buildSettingNumJobs (buildSettings ctx))-              ]-                : [ ["-unit", "@" ++ dir </> unit]-                  | unit <- unit_files_ordered-                  , unit /= "paths"-                  ]+        let ghc_opts =+              mempty+                { ghcOptMode = Flag GhcModeInteractive+                , ghcOptUnitFiles = map (dir </>) unit_files_ordered+                , ghcOptNumJobs = Flag (convertParStrat (buildSettingNumJobs (buildSettings ctx)))+                , ghcOptPackageDBs = [GlobalPackageDB]+                } -        pure ()+        -- run ghc --interactive with+        runReplProgram (flagToMaybe $ replWithRepl replOpts') tempFileOptions verbosity ghcProg' compiler platform Nothing ghc_opts       else do         -- single target repl         replOpts'' <- case targetCtx of@@ -506,8 +517,8 @@         go m ("PATH", Just s) = foldl' (\m' f -> Map.insertWith (+) f 1 m') m (splitSearchPath s)         go m _ = m -    verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)-    keepTempFiles = fromFlagOrDefault False replKeepTempFiles+    verbosity = cfgVerbosity normal flags+    tempFileOptions = commonSetupTempFileOptions $ configCommonFlags configFlags      validatedTargets ctx compiler elaboratedPlan targetSelectors = do       let multi_repl_enabled = multiReplDecision ctx compiler r@@ -515,7 +526,7 @@       -- (as opposed to say build or haddock targets).       targets <-         either (reportTargetProblems verbosity) return $-          resolveTargets+          resolveTargetsFromSolver             (selectPackageTargets multi_repl_enabled)             selectComponentTarget             elaboratedPlan@@ -532,17 +543,16 @@        return targets -    -- This is the constraint setup.Cabal>=3.11. 3.11 is when Cabal options-    -- used for multi-repl were introduced.-    -- Idelly we'd apply this constraint only on the closure of repl targets,-    -- but that would require another solver run for marginal advantages that-    -- will further shrink as 3.11 is adopted.-    multiReplCabalConstraint =-      ( UserConstraint-          (UserAnySetupQualifier (mkPackageName "Cabal"))-          (PackagePropertyVersion $ orLaterVersion $ mkVersion [3, 11])-      , ConstraintSourceMultiRepl-      )+-- | Create a constraint which requires a later version of Cabal.+-- This is used for commands which require a specific feature from the Cabal library+-- such as multi-repl or the --with-repl flag.+requireCabal :: [Int] -> ConstraintSource -> (UserConstraint, ConstraintSource)+requireCabal version source =+  ( UserConstraint+      (UserAnySetupQualifier (mkPackageName "Cabal"))+      (PackagePropertyVersion $ orLaterVersion $ mkVersion version)+  , source+  )  -- | First version of GHC which supports multiple home packages minMultipleHomeUnitsVersion :: Version
src/Distribution/Client/CmdRun.hs view
@@ -1,7 +1,4 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections #-}  -- | cabal-install CLI command: run@@ -45,6 +42,7 @@   ) import Distribution.Client.NixStyleOptions   ( NixStyleFlags (..)+  , cfgVerbosity   , defaultNixStyleFlags   , nixStyleOptions   )@@ -52,7 +50,8 @@   ( ProjectConfig (projectConfigShared)   , ProjectConfigShared (projectConfigProgPathExtra)   )-import Distribution.Client.ProjectOrchestration+import Distribution.Client.ProjectOrchestration hiding (targetsMap)+import qualified Distribution.Client.ProjectOrchestration as Orchestration (targetsMap) import Distribution.Client.ProjectPlanning   ( ElaboratedConfiguredPackage (..)   , ElaboratedInstallPlan@@ -72,9 +71,7 @@   , withContextAndSelectors   ) import Distribution.Client.Setup-  ( CommonSetupFlags (setupVerbosity)-  , ConfigFlags (..)-  , GlobalFlags (..)+  ( GlobalFlags (..)   ) import Distribution.Client.TargetProblem   ( TargetProblem (..)@@ -91,9 +88,6 @@   ( CommandUI (..)   , usageAlternatives   )-import Distribution.Simple.Flag-  ( fromFlagOrDefault-  ) import Distribution.Simple.Program.Find   ( ProgramSearchPathEntry (ProgramSearchPathDir)   , defaultProgramSearchPath@@ -117,7 +111,7 @@ import Distribution.Types.ComponentName   ( componentNameRaw   )-import Distribution.Types.Executable as PD+import qualified Distribution.Types.Executable as PD   ( buildInfo   , exeName   )@@ -207,14 +201,14 @@ -- For more details on how this works, see the module -- "Distribution.Client.ProjectOrchestration" runAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO ()-runAction flags@NixStyleFlags{..} targetAndArgs globalFlags =-  withContextAndSelectors RejectNoTargets (Just ExeKind) flags targetStr globalFlags OtherCommand $ \targetCtx ctx targetSelectors -> do+runAction flags targetAndArgs globalFlags =+  withContextAndSelectors (cfgVerbosity normal flags) RejectNoTargets (Just ExeKind) flags targetStr globalFlags OtherCommand $ \targetCtx ctx targetSelectors -> do     (baseCtx, defaultVerbosity) <- case targetCtx of       ProjectContext -> return (ctx, normal)       GlobalContext -> return (ctx, normal)       ScriptContext path exemeta -> (,silent) <$> updateContextAndWriteProjectFile ctx path exemeta -    let verbosity = fromFlagOrDefault defaultVerbosity (setupVerbosity $ configCommonFlags configFlags)+    let verbosity = cfgVerbosity defaultVerbosity flags      buildCtx <-       runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do@@ -230,7 +224,7 @@         -- (as opposed to say repl or haddock targets).         targets <-           either (reportTargetProblems verbosity) return $-            resolveTargets+            resolveTargetsFromSolver               selectPackageTargets               selectComponentTarget               elaboratedPlan@@ -264,7 +258,7 @@       singleExeOrElse         ( dieWithException verbosity RunPhaseReached         )-        $ targetsMap buildCtx+        $ Orchestration.targetsMap buildCtx      printPlan verbosity baseCtx buildCtx
src/Distribution/Client/CmdSdist.hs view
@@ -1,10 +1,8 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE MultiWayIf #-}-{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE ViewPatterns #-}  module Distribution.Client.CmdSdist   ( sdistCommand@@ -100,7 +98,7 @@   ( knownSuffixHandlers   ) import Distribution.Simple.Setup-  ( Flag (..)+  ( Flag   , flagToList   , flagToMaybe   , fromFlagOrDefault@@ -108,6 +106,7 @@   , optionVerbosity   , toFlag   , trueArg+  , pattern Flag   ) import Distribution.Simple.SrcDist   ( listPackageSourcesWithDie
+ src/Distribution/Client/CmdTarget.hs view
@@ -0,0 +1,224 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Distribution.Client.CmdTarget+  ( targetCommand+  , targetAction+  ) where++import Distribution.Client.Compat.Prelude+import Prelude ()++import qualified Data.Map as Map+import Distribution.Client.CmdBuild (selectComponentTarget, selectPackageTargets)+import Distribution.Client.CmdErrorMessages+import Distribution.Client.InstallPlan+import qualified Distribution.Client.InstallPlan as InstallPlan+import Distribution.Client.NixStyleOptions+  ( NixStyleFlags (..)+  , defaultNixStyleFlags+  , nixStyleOptions+  )+import Distribution.Client.ProjectOrchestration+import Distribution.Client.ProjectPlanning+import Distribution.Client.Setup+  ( ConfigFlags (..)+  , GlobalFlags+  )+import Distribution.Client.TargetProblem+  ( TargetProblem'+  )+import Distribution.Package+import Distribution.Simple.Command+  ( CommandUI (..)+  , usageAlternatives+  )+import Distribution.Simple.Flag (fromFlagOrDefault)+import Distribution.Simple.Utils+  ( noticeDoc+  , safeHead+  , wrapText+  )+import Distribution.Verbosity+  ( normal+  )+import Text.PrettyPrint+import qualified Text.PrettyPrint as Pretty++-------------------------------------------------------------------------------+-- Command+-------------------------------------------------------------------------------++targetCommand :: CommandUI (NixStyleFlags ())+targetCommand =+  CommandUI+    { commandName = "v2-target"+    , commandSynopsis = "Target a subset of all targets."+    , commandUsage = usageAlternatives "v2-target" ["[TARGETS]"]+    , commandDescription =+        Just . const . render $+          vcat+            [ intro+            , vcat $ punctuate (text "\n") [targetForms, ctypes, Pretty.empty]+            , caution+            , unique+            ]+    , commandNotes = Just $ \pname -> render $ examples pname+    , commandDefaultFlags = defaultNixStyleFlags ()+    , commandOptions = nixStyleOptions (const [])+    }+  where+    intro =+      text . wrapText $+        "Discover targets in a project for use with other commands taking [TARGETS].\n\n"+          ++ "This command, like many others, takes [TARGETS]. Taken together, these will"+          ++ " select for a set of targets in the project. When none are supplied, the"+          ++ " command acts as if 'all' was supplied."+          ++ " Targets in the returned subset are shown sorted and fully-qualified."++    targetForms =+      vcat+        [ text "A [TARGETS] item can be one of these target forms:"+        , nest 1 . vcat $+            (char '-' <+>)+              <$> [ text "a package target (e.g. [pkg:]package)"+                  , text "a component target (e.g. [package:][ctype:]component)"+                  , text "all packages (e.g. all)"+                  , text "components of a particular type (e.g. package:ctypes or all:ctypes)"+                  , text "a module target: (e.g. [package:][ctype:]module)"+                  , text "a filepath target: (e.g. [package:][ctype:]filepath)"+                  ]+        ]++    ctypes =+      vcat+        [ text "The ctypes, in short form and (long form), can be one of:"+        , nest 1 . vcat $+            (char '-' <+>)+              <$> [ "libs" <+> parens "libraries"+                  , "exes" <+> parens "executables"+                  , "tests"+                  , "benches" <+> parens "benchmarks"+                  , "flibs" <+> parens "foreign-libraries"+                  ]+        ]++    caution =+      text . wrapText $+        "WARNING: For a package, all, module or filepath target, cabal target [TARGETS] \+        \ will only show 'libs' and 'exes' of the [TARGETS] by default. To also show \+        \ tests and benchmarks, enable them with '--enable-tests' and \+        \ '--enable-benchmarks'."++    unique =+      text . wrapText $+        "NOTE: For commands expecting a unique TARGET, a fully-qualified target is the safe \+        \ way to go but it may be convenient to type out a shorter TARGET. For example, if the \+        \ set of 'cabal target all:exes' has one item then 'cabal list-bin all:exes' will \+        \ work too."++    examples pname =+      vcat+        [ text "Examples" Pretty.<> colon+        , nest 2 $+            vcat+              [ vcat+                  [ text pname <+> text "v2-target all"+                  , nest 2 $ text "Targets of the package in the current directory or all packages in the project"+                  ]+              , vcat+                  [ text pname <+> text "v2-target pkgname"+                  , nest 2 $ text "Targets of the package named pkgname in the project"+                  ]+              , vcat+                  [ text pname <+> text "v2-target ./pkgfoo"+                  , nest 2 $ text "Targets of the package in the ./pkgfoo directory"+                  ]+              , vcat+                  [ text pname <+> text "v2-target cname"+                  , nest 2 $ text "Targets of the component named cname in the project"+                  ]+              ]+        ]++-------------------------------------------------------------------------------+-- Action+-------------------------------------------------------------------------------++targetAction :: NixStyleFlags () -> [String] -> GlobalFlags -> IO ()+targetAction flags@NixStyleFlags{..} ts globalFlags = do+  ProjectBaseContext+    { distDirLayout+    , cabalDirLayout+    , projectConfig+    , localPackages+    } <-+    establishProjectBaseContext verbosity cliConfig OtherCommand++  (_, elaboratedPlan, _, _, _) <-+    rebuildInstallPlan+      verbosity+      distDirLayout+      cabalDirLayout+      projectConfig+      localPackages+      Nothing++  targetSelectors <-+    either (reportTargetSelectorProblems verbosity) return+      =<< readTargetSelectors localPackages Nothing targetStrings++  targets :: TargetsMap <-+    either (reportBuildTargetProblems verbosity) return $+      resolveTargetsFromSolver+        selectPackageTargets+        selectComponentTarget+        elaboratedPlan+        Nothing+        targetSelectors++  printTargetForms verbosity targetStrings targets elaboratedPlan+  where+    verbosity = fromFlagOrDefault normal (configVerbosity configFlags)+    targetStrings = if null ts then ["all"] else ts+    cliConfig =+      commandLineFlagsToProjectConfig+        globalFlags+        flags+        mempty++reportBuildTargetProblems :: Verbosity -> [TargetProblem'] -> IO a+reportBuildTargetProblems verbosity = reportTargetProblems verbosity "target"++printTargetForms :: Verbosity -> [String] -> TargetsMap -> ElaboratedInstallPlan -> IO ()+printTargetForms verbosity targetStrings targets elaboratedPlan =+  noticeDoc verbosity $+    vcat+      [ text "Fully qualified target forms" Pretty.<> colon+      , nest 1 $ vcat [text "-" <+> text tf | tf <- targetForms]+      , found+      ]+  where+    found =+      let n = length targets+          t = if n == 1 then "target" else "targets"+          query = intercalate ", " targetStrings+       in text "Found" <+> int n <+> text t <+> text "matching" <+> text query Pretty.<> char '.'++    localPkgs =+      [x | Configured x@ElaboratedConfiguredPackage{elabLocalToProject = True} <- InstallPlan.toList elaboratedPlan]++    targetForm ct x =+      let pkgId@PackageIdentifier{pkgName = n} = elabPkgSourceId x+       in render $ pretty n Pretty.<> colon Pretty.<> text (showComponentTarget pkgId ct)++    targetForms =+      sort $+        catMaybes+          [ targetForm ct <$> pkg+          | (u :: UnitId, xs) <- Map.toAscList targets+          , let pkg = safeHead $ filter ((== u) . elabUnitId) localPkgs+          , (ct :: ComponentTarget, _) <- xs+          ]
src/Distribution/Client/CmdTest.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-}  -- | cabal-install CLI command: test@@ -28,14 +29,13 @@   ) import Distribution.Client.NixStyleOptions   ( NixStyleFlags (..)+  , cfgVerbosity   , defaultNixStyleFlags   , nixStyleOptions   ) import Distribution.Client.ProjectOrchestration import Distribution.Client.Setup-  ( CommonSetupFlags (..)-  , ConfigFlags (..)-  , GlobalFlags (..)+  ( GlobalFlags (..)   ) import Distribution.Client.TargetProblem   ( TargetProblem (..)@@ -48,11 +48,11 @@   , usageAlternatives   ) import Distribution.Simple.Flag-  ( Flag (..)+  ( Flag+  , pattern Flag   ) import Distribution.Simple.Setup   ( TestFlags (..)-  , fromFlagOrDefault   ) import Distribution.Simple.Utils   ( dieWithException@@ -144,7 +144,7 @@       -- (as opposed to say build or haddock targets).       targets <-         either (reportTargetProblems verbosity failWhenNoTestSuites) return $-          resolveTargets+          resolveTargetsFromSolver             selectPackageTargets             selectComponentTarget             elaboratedPlan@@ -164,7 +164,7 @@   runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes   where     failWhenNoTestSuites = testFailWhenNoTestSuites testFlags-    verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)+    verbosity = cfgVerbosity normal flags     cliConfig = commandLineFlagsToProjectConfig globalFlags flags mempty -- ClientInstallFlags  -- | This defines what a 'TargetSelector' means for the @test@ command.
src/Distribution/Client/CmdUpdate.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-}-{-# LANGUAGE ViewPatterns #-}  -- | cabal-install CLI command: update module Distribution.Client.CmdUpdate@@ -38,6 +37,7 @@   ) import Distribution.Client.NixStyleOptions   ( NixStyleFlags (..)+  , cfgVerbosity   , defaultNixStyleFlags   , nixStyleOptions   )@@ -53,9 +53,7 @@   ) import Distribution.Client.ProjectOrchestration import Distribution.Client.Setup-  ( CommonSetupFlags (..)-  , ConfigFlags (..)-  , GlobalFlags+  ( GlobalFlags   , RepoContext (..)   , UpdateFlags   , defaultUpdateFlags@@ -67,9 +65,6 @@   , repoName   , unRepoName   )-import Distribution.Simple.Flag-  ( fromFlagOrDefault-  ) import Distribution.Simple.Utils   ( dieWithException   , notice@@ -221,7 +216,7 @@           reposToUpdate         traverse_ (\_ -> collectJob jobCtrl) reposToUpdate   where-    verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)+    verbosity = cfgVerbosity normal flags     cliConfig = commandLineFlagsToProjectConfig globalFlags flags mempty -- ClientInstallFlags, not needed here     globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig)
src/Distribution/Client/Compat/ExecutablePath.hs view
@@ -123,7 +123,7 @@  # if defined(i386_HOST_ARCH) #  define WINDOWS_CCONV stdcall-# elif defined(x86_64_HOST_ARCH)+# elif defined(x86_64_HOST_ARCH) || defined(aarch64_HOST_ARCH) #  define WINDOWS_CCONV ccall # else #  error Unknown mingw32 arch
src/Distribution/Client/Compat/Orphans.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE BangPatterns #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-}  module Distribution.Client.Compat.Orphans () where
src/Distribution/Client/Compat/Prelude.hs view
@@ -1,5 +1,5 @@ -- to suppress WARNING in "Distribution.Compat.Prelude.Internal"-{-# OPTIONS_GHC -fno-warn-deprecations #-}+{-# OPTIONS_GHC -Wno-deprecations #-}  -- | This module does two things: --
src/Distribution/Client/Compat/Tar.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-}  {- FOURMOLU_DISABLE -} module Distribution.Client.Compat.Tar
src/Distribution/Client/Config.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE PatternSynonyms #-}  ----------------------------------------------------------------------------- @@ -160,6 +161,7 @@ import Distribution.Parsec (ParsecParser, parsecFilePath, parsecOptCommaList, parsecToken) import Distribution.Simple.Command   ( CommandUI (commandOptions)+  , OptionField   , ShowOrParseArgs (..)   , commandDefaultFlags   )@@ -180,7 +182,7 @@   ( BenchmarkFlags (..)   , CommonSetupFlags (..)   , ConfigFlags (..)-  , Flag (..)+  , Flag   , HaddockFlags (..)   , TestFlags (..)   , configureOptions@@ -196,6 +198,8 @@   , programDbOptions   , programDbPaths'   , toFlag+  , pattern Flag+  , pattern NoFlag   ) import Distribution.Simple.Utils   ( cabalVersion@@ -470,6 +474,7 @@           , setupCabalFilePath = combine setupCabalFilePath           , setupVerbosity = combine setupVerbosity           , setupTargets = lastNonEmpty setupTargets+          , setupKeepTempFiles = combine setupKeepTempFiles           }         where           lastNonEmpty = lastNonEmpty' which@@ -630,7 +635,6 @@           , haddockQuickJump = combine haddockQuickJump           , haddockHscolourCss = combine haddockHscolourCss           , haddockContents = combine haddockContents-          , haddockKeepTempFiles = combine haddockKeepTempFiles           , haddockIndex = combine haddockIndex           , haddockBaseUrl = combine haddockBaseUrl           , haddockResourcesDir = combine haddockResourcesDir@@ -1315,6 +1319,19 @@             ParseArgs        ]   where+    toSavedConfig+      :: (FieldDescr a -> FieldDescr SavedConfig)+      -- Lifting function.+      -> [OptionField a]+      -- Option fields.+      -> [String]+      -- Fields to exclude, by name.+      -> [FieldDescr a]+      -- Field replacements.+      --+      -- If an option is found with the same name as one of these replacement+      -- fields, the replacement field is used instead of the option.+      -> [FieldDescr SavedConfig]     toSavedConfig lift options exclusions replacements =       [ lift (fromMaybe field replacement)       | opt <- options@@ -1836,7 +1853,7 @@   , name `notElem` exclusions   ]   where-    exclusions = ["verbose", "builddir", "for-hackage"]+    exclusions = ["verbose", "builddir", "cabal-file", "for-hackage"]  -- | Fields for the 'init' section. initFlagsFields :: [FieldDescr IT.InitFlags]
src/Distribution/Client/Configure.hs view
@@ -111,6 +111,9 @@ import Distribution.System   ( Platform   )+import Distribution.Types.DependencySatisfaction+  ( DependencySatisfaction (..)+  ) import Distribution.Types.GivenComponent   ( GivenComponent (..)   )@@ -296,6 +299,7 @@       , useDependenciesExclusive = not defaultSetupDeps && isJust explicitSetupDeps       , useVersionMacros = not defaultSetupDeps && isJust explicitSetupDeps       , isInteractive = False+      , isMainLibOrExeComponent = True       }     where       -- When we are compiling a legacy setup script without an explicit@@ -550,7 +554,7 @@       pkg = case finalizePD         flags         (enableStanzas stanzas)-        (const True)+        (const Satisfied)         platform         comp         []
src/Distribution/Client/Dependency.hs view
@@ -127,6 +127,9 @@   ( Platform   ) import Distribution.Types.Dependency+import Distribution.Types.DependencySatisfaction+  ( DependencySatisfaction (..)+  ) import Distribution.Verbosity   ( normal   )@@ -1092,7 +1095,7 @@         case finalizePD           specifiedFlags           compSpec-          (const True)+          (const Satisfied)           platform           cinfo           []
src/Distribution/Client/Errors.hs view
@@ -1,9 +1,7 @@ {-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE InstanceSigs #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}  ----------------------------------------------------------------------------- @@ -26,8 +24,8 @@ import qualified Data.ByteString.Char8 as BS8 import Data.List (groupBy) import Distribution.Client.IndexUtils.Timestamp-import Distribution.Client.Types.Repo-import Distribution.Client.Types.RepoName (RepoName (..))+import qualified Distribution.Client.Types.Repo as Repo+import qualified Distribution.Client.Types.RepoName as RepoName import Distribution.Compat.Prelude import Distribution.Deprecated.ParseUtils (PWarning, showPWarning) import Distribution.Package@@ -35,6 +33,8 @@ import Distribution.Simple (VersionRange) import Distribution.Simple.Utils import Network.URI+import Text.PrettyPrint hiding (render, (<>))+import qualified Text.PrettyPrint as PP import Text.Regex.Posix.ByteString (WrapError)  data CabalInstallException@@ -72,7 +72,7 @@   | ReportTargetProblems String   | ListBinTargetException String   | ResolveWithoutDependency String-  | CannotReadCabalFile FilePath+  | CannotReadCabalFile FilePath FilePath   | ErrorUpdatingIndex FilePath IOException   | InternalError FilePath   | ReadIndexCache FilePath@@ -114,7 +114,7 @@   | ParseExtraLinesFailedErr String String   | ParseExtraLinesOkError [PWarning]   | FetchPackageErr-  | ReportParseResult String FilePath String String+  | ReportParseResult String FilePath String Doc   | ReportSourceRepoProblems String   | BenchActionException   | RenderBenchTargetProblem [String]@@ -182,10 +182,11 @@   | FreezeException String   | PkgSpecifierException [String]   | CorruptedIndexCache String-  | UnusableIndexState RemoteRepo Timestamp Timestamp-  | MissingPackageList RemoteRepo+  | UnusableIndexState Repo.RemoteRepo Timestamp Timestamp+  | MissingPackageList Repo.RemoteRepo   | CmdPathAcceptsNoTargets   | CmdPathCommandDoesn'tSupportDryRun+  | GenBoundsDoesNotSupportScript FilePath   deriving (Show)  exceptionCodeCabalInstall :: CabalInstallException -> Int@@ -338,6 +339,7 @@   MissingPackageList{} -> 7160   CmdPathAcceptsNoTargets{} -> 7161   CmdPathCommandDoesn'tSupportDryRun -> 7163+  GenBoundsDoesNotSupportScript{} -> 7164  exceptionMessageCabalInstall :: CabalInstallException -> String exceptionMessageCabalInstall e = case e of@@ -392,7 +394,11 @@   ReportTargetProblems problemsMsg -> problemsMsg   ListBinTargetException errorStr -> errorStr   ResolveWithoutDependency errorStr -> errorStr-  CannotReadCabalFile file -> "Cannot read .cabal file inside " ++ file+  CannotReadCabalFile expect file ->+    "Failed to read "+      ++ expect+      ++ " from archive "+      ++ file   ErrorUpdatingIndex name ioe -> "Error while updating index for " ++ name ++ " repository " ++ show ioe   InternalError msg ->     "internal error when reading package index: "@@ -493,13 +499,12 @@   ParseExtraLinesOkError ws -> unlines (map (showPWarning "Error parsing additional config lines") ws)   FetchPackageErr -> "fetchPackage: source repos not supported"   ReportParseResult filetype filename line msg ->-    "Error parsing "-      ++ filetype-      ++ " "-      ++ filename-      ++ line-      ++ ":\n"-      ++ msg+    PP.render $+      vcat+        -- NOTE: As given to us, the line number string is prefixed by a colon.+        [ text "Error parsing" <+> text filetype <+> text filename PP.<> text line PP.<> colon+        , nest 1 $ text "-" <+> msg+        ]   ReportSourceRepoProblems errorStr -> errorStr   BenchActionException ->     "The bench command does not support '--only-dependencies'. "@@ -841,7 +846,7 @@   CorruptedIndexCache str -> str   UnusableIndexState repoRemote maxFound requested ->     "Latest known index-state for '"-      ++ unRepoName (remoteRepoName repoRemote)+      ++ RepoName.unRepoName (Repo.remoteRepoName repoRemote)       ++ "' ("       ++ prettyShow maxFound       ++ ") is older than the requested index-state ("@@ -851,12 +856,14 @@       ++ "."   MissingPackageList repoRemote ->     "The package list for '"-      ++ unRepoName (remoteRepoName repoRemote)+      ++ RepoName.unRepoName (Repo.remoteRepoName repoRemote)       ++ "' does not exist. Run 'cabal update' to download it."   CmdPathAcceptsNoTargets ->     "The 'path' command accepts no target arguments."   CmdPathCommandDoesn'tSupportDryRun ->     "The 'path' command doesn't support the flag '--dry-run'."+  GenBoundsDoesNotSupportScript{} ->+    "The 'gen-bounds' command does not support script targets."  instance Exception (VerboseException CabalInstallException) where   displayException :: VerboseException CabalInstallException -> [Char]
src/Distribution/Client/FileMonitor.hs view
@@ -4,7 +4,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-}  -- | An abstraction to help with re-running actions when files or other -- input values they depend on have changed.
src/Distribution/Client/GenBounds.hs view
@@ -10,6 +10,8 @@ -- The cabal gen-bounds command for generating PVP-compliant version bounds. module Distribution.Client.GenBounds   ( genBounds+  , boundsNeededMsg+  , showBounds   ) where  import Distribution.Client.Compat.Prelude@@ -57,6 +59,9 @@   ( defaultComponentRequestedSpec   ) import Distribution.Types.Dependency+import Distribution.Types.DependencySatisfaction+  ( DependencySatisfaction (..)+  ) import Distribution.Utils.Path (relativeSymbolicPath) import Distribution.Version   ( LowerBound (..)@@ -128,7 +133,7 @@         finalizePD           mempty           defaultComponentRequestedSpec-          (const True)+          (const Satisfied)           platform           cinfo           []
src/Distribution/Client/Get.hs view
@@ -1,6 +1,4 @@-------------------------------------------------------------------------------------------------------------------------------------------------------------+{-# LANGUAGE PatternSynonyms #-}  -- | -- Module      :  Distribution.Client.Get@@ -39,10 +37,10 @@   ( programName   ) import Distribution.Simple.Setup-  ( Flag (..)-  , flagToMaybe+  ( flagToMaybe   , fromFlag   , fromFlagOrDefault+  , pattern NoFlag   ) import Distribution.Simple.Utils   ( dieWithException
src/Distribution/Client/Glob.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE DeriveGeneric #-}- module Distribution.Client.Glob   ( -- * cabal-install globbing features     RootedGlob (..)
src/Distribution/Client/GlobalFlags.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -28,9 +29,10 @@   , unRepoName   ) import Distribution.Simple.Setup-  ( Flag (..)+  ( Flag   , flagToMaybe   , fromFlag+  , pattern Flag   ) import Distribution.Simple.Utils   ( info
src/Distribution/Client/HttpUtils.hs view
@@ -467,7 +467,6 @@   where     gethttp verbosity uri etag destPath reqHeaders = do       withTempFile-        (takeDirectory destPath)         "curl-headers.txt"         $ \tmpFile tmpHandle -> do           hClose tmpHandle@@ -675,10 +674,9 @@      posthttpfile verbosity uri path auth =       withTempFile-        (takeDirectory path)         (takeFileName path)         $ \tmpFile tmpHandle ->-          withTempFile (takeDirectory path) "response" $+          withTempFile "response" $             \responseFile responseHandle -> do               hClose responseHandle               (body, boundary) <- generateMultipartBody path@@ -702,7 +700,7 @@                 evaluate $ force (code, resp)      puthttpfile verbosity uri path auth headers =-      withTempFile (takeDirectory path) "response" $+      withTempFile "response" $         \responseFile responseHandle -> do           hClose responseHandle           let args =@@ -824,7 +822,6 @@      posthttpfile verbosity uri path auth =       withTempFile-        (takeDirectory path)         (takeFileName path)         $ \tmpFile tmpHandle -> do           (body, boundary) <- generateMultipartBody path
src/Distribution/Client/IndexUtils.hs view
@@ -61,6 +61,10 @@ import Distribution.Parsec (simpleParsecBS) import Distribution.Verbosity +import Distribution.Client.ProjectConfig+  ( CabalFileParseError+  , readSourcePackageCabalFile'+  ) import Distribution.Client.Setup   ( RepoContext (..)   )@@ -92,6 +96,7 @@   , fromUTF8LBS   , info   , warn+  , warnError   ) import Distribution.Types.Dependency import Distribution.Types.PackageName (PackageName)@@ -875,14 +880,22 @@         where           cabalPath = prettyShow pkgid ++ ".cabal"       Just pkgId -> do+        let tarFile = localDir </> file         -- check for the right named .cabal file in the compressed tarball-        tarGz <- BS.readFile (localDir </> file)+        tarGz <- BS.readFile tarFile         let tar = GZip.decompress tarGz             entries = Tar.read tar+            expectFilename = prettyShow pkgId FilePath.</> prettyShow (packageName pkgId) ++ ".cabal" -        case Tar.foldEntries (readCabalEntry pkgId) Nothing (const Nothing) entries of+        tarballPackageDescription <-+          Tar.foldEntries+            (readCabalEntry tarFile expectFilename)+            (pure Nothing)+            (handleTarFormatError tarFile)+            entries+        case tarballPackageDescription of           Just ce -> return (Just ce)-          Nothing -> dieWithException verbosity $ CannotReadCabalFile file+          Nothing -> dieWithException verbosity $ CannotReadCabalFile expectFilename tarFile    let (prefs, gpds) =         partitionEithers $@@ -913,16 +926,55 @@      stripSuffix sfx str = fmap reverse (stripPrefix (reverse sfx) (reverse str)) -    -- look for <pkgid>/<pkgname>.cabal inside the tarball-    readCabalEntry :: PackageIdentifier -> Tar.Entry -> Maybe NoIndexCacheEntry -> Maybe NoIndexCacheEntry-    readCabalEntry pkgId entry Nothing-      | filename == Tar.entryPath entry-      , Tar.NormalFile contents _ <- Tar.entryContent entry =-          let bs = BS.toStrict contents-           in ((`CacheGPD` bs) <$> parseGenericPackageDescriptionMaybe bs)-      where-        filename = prettyShow pkgId FilePath.</> prettyShow (packageName pkgId) ++ ".cabal"-    readCabalEntry _ _ x = x+    handleTarFormatError :: FilePath -> Tar.FormatError -> IO (Maybe NoIndexCacheEntry)+    handleTarFormatError tarFile formatError = do+      -- This is printed at warning-level because malformed `.tar.gz`s in+      -- indexes are unexpected and we want users to tell us about them.+      warnError verbosity $+        "Failed to parse "+          <> tarFile+          <> ": "+          <> displayException formatError+      pure Nothing++    -- look for `expectFilename` inside the tarball+    readCabalEntry+      :: FilePath+      -> FilePath+      -> Tar.Entry+      -> IO (Maybe NoIndexCacheEntry)+      -> IO (Maybe NoIndexCacheEntry)+    readCabalEntry tarFile expectFilename entry previous' = do+      previous <- previous'+      case previous of+        Just _entry -> pure previous+        Nothing -> do+          if expectFilename /= Tar.entryPath entry+            then pure Nothing+            else case Tar.entryContent entry of+              Tar.NormalFile contents _fileSize -> do+                let bytes = BS.toStrict contents+                maybePackageDescription+                  :: Either CabalFileParseError GenericPackageDescription <-+                  -- Warnings while parsing `.cabal` files are only shown in+                  -- verbose mode because people are allowed to upload packages+                  -- with warnings to Hackage (and we may _add_ warnings by+                  -- shipping new versions of Cabal). You probably don't care+                  -- if there's a warning in some random package in your+                  -- transitive dependency tree, as long as it's not causing+                  -- issues. If it is causing issues, you can add `-v` to see+                  -- the warnings!+                  try $ readSourcePackageCabalFile' (info verbosity) expectFilename bytes+                case maybePackageDescription of+                  Left exception -> do+                    -- Here we show the _failure_ to parse the `.cabal` file as+                    -- a warning. This will impact which versions/packages are+                    -- available in your index, so users should know!+                    warn verbosity $ "In " <> tarFile <> ": " <> displayException exception+                    pure Nothing+                  Right genericPackageDescription ->+                    pure $ Just $ CacheGPD genericPackageDescription bytes+              _ -> pure Nothing withIndexEntries verbosity index callback _ = do   -- non-secure repositories   withFile (indexFile index) ReadMode $ \h -> do
src/Distribution/Client/IndexUtils/ActiveRepos.hs view
@@ -168,7 +168,7 @@   -> [a]   -> Either String [(a, CombineStrategy)] organizeByRepos (ActiveRepos xs0) sel ys0 =-  -- here we use lazyness to do only one traversal+  -- here we use laziness to do only one traversal   let (rest, result) = case go rest xs0 ys0 of         Right (rest', result') -> (rest', Right result')         Left err -> ([], Left err)
src/Distribution/Client/Init/Defaults.hs view
@@ -165,7 +165,7 @@  myExeHs :: [String] myExeHs =-  [ "module Main where"+  [ "module Main (main) where"   , ""   , "main :: IO ()"   , "main = putStrLn \"Hello, Haskell!\""@@ -173,7 +173,7 @@  myLibExeHs :: [String] myLibExeHs =-  [ "module Main where"+  [ "module Main (main) where"   , ""   , "import qualified MyLib (someFunc)"   , ""
src/Distribution/Client/Init/FileCreators.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}  -----------------------------------------------------------------------------
src/Distribution/Client/Init/FlagExtractors.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PatternSynonyms #-}  module Distribution.Client.Init.FlagExtractors   ( -- * Flag extractors@@ -51,7 +52,7 @@ import Distribution.FieldGrammar.Newtypes (SpecLicense) import Distribution.ModuleName (ModuleName) import Distribution.Simple.Flag (flagElim)-import Distribution.Simple.Setup (Flag (..), flagToMaybe, fromFlagOrDefault)+import Distribution.Simple.Setup (Flag, flagToMaybe, fromFlagOrDefault, pattern Flag, pattern NoFlag) import Distribution.Types.Dependency (Dependency (..)) import Distribution.Types.PackageName (PackageName) import Distribution.Version (Version)
src/Distribution/Client/Init/Interactive/Command.hs view
@@ -1,5 +1,5 @@-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE PatternSynonyms #-}  ----------------------------------------------------------------------------- @@ -59,7 +59,7 @@ import Distribution.FieldGrammar.Newtypes (SpecLicense (..)) import qualified Distribution.SPDX as SPDX import Distribution.Simple.PackageIndex (InstalledPackageIndex)-import Distribution.Simple.Setup (Flag (..), fromFlagOrDefault)+import Distribution.Simple.Setup (fromFlagOrDefault, pattern Flag, pattern NoFlag) import Distribution.Solver.Types.PackageIndex (elemByPackageName) import Distribution.Types.PackageName (PackageName, unPackageName) import Distribution.Version (Version)
src/Distribution/Client/Init/NonInteractive/Command.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PatternSynonyms #-}  module Distribution.Client.Init.NonInteractive.Command   ( genPkgDescription@@ -51,7 +51,7 @@ import Distribution.Client.Types (SourcePackageDb (..)) import Distribution.ModuleName (ModuleName, components) import Distribution.Simple.PackageIndex (InstalledPackageIndex)-import Distribution.Simple.Setup (Flag (..), fromFlagOrDefault)+import Distribution.Simple.Setup (fromFlagOrDefault, pattern Flag, pattern NoFlag) import Distribution.Solver.Types.PackageIndex (elemByPackageName) import Distribution.Types.Dependency (Dependency (..)) import Distribution.Types.PackageName (PackageName, unPackageName)
src/Distribution/Client/Init/Simple.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE PatternSynonyms #-}+ module Distribution.Client.Init.Simple   ( -- * Project creation     createProject@@ -16,7 +18,7 @@ import Distribution.Client.Init.Types import Distribution.Client.Init.Utils (currentDirPkgName, fixupDocFiles, mkPackageNameDep) import Distribution.Client.Types.SourcePackageDb (SourcePackageDb (..))-import Distribution.Simple.Flag (Flag (..), flagElim, fromFlagOrDefault)+import Distribution.Simple.Flag (flagElim, fromFlagOrDefault, pattern Flag, pattern NoFlag) import Distribution.Simple.PackageIndex import Distribution.Types.Dependency import Distribution.Types.PackageName (unPackageName)
src/Distribution/Client/Init/Types.hs view
@@ -80,7 +80,7 @@ import Distribution.Fields.Pretty import Distribution.ModuleName import qualified Distribution.Package as P-import Distribution.Simple.Setup (Flag (..))+import Distribution.Simple.Setup (Flag) import Distribution.Verbosity (silent) import Distribution.Version import Language.Haskell.Extension (Extension, Language (..))
src/Distribution/Client/Init/Utils.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-}  module Distribution.Client.Init.Utils@@ -42,7 +43,7 @@ import Distribution.ModuleName (ModuleName) import qualified Distribution.Package as P import Distribution.Simple.PackageIndex (InstalledPackageIndex, moduleNameIndex)-import Distribution.Simple.Setup (Flag (..))+import Distribution.Simple.Setup (pattern Flag, pattern NoFlag) import Distribution.Types.Dependency (Dependency, mkDependency) import Distribution.Types.LibraryName import Distribution.Types.PackageName@@ -64,7 +65,6 @@ knownSuffixHandlers :: CabalSpecVersion -> String -> String knownSuffixHandlers v s   | v < CabalSpecV3_0 = case s of-      ".gc" -> "greencard"       ".chs" -> "chs"       ".hsc" -> "hsc2hs"       ".x" -> "alex"@@ -73,7 +73,6 @@       ".cpphs" -> "cpp"       _ -> ""   | otherwise = case s of-      ".gc" -> "greencard:greencard"       ".chs" -> "chs:chs"       ".hsc" -> "hsc2hs:hsc2hs"       ".x" -> "alex:alex"
src/Distribution/Client/Install.hs view
@@ -142,6 +142,7 @@ import Distribution.Solver.Types.Settings import Distribution.Solver.Types.SourcePackage as SourcePackage +import Distribution.Client.ProjectConfig import Distribution.Client.Utils   ( MergeResult (..)   , ProgressPhase (..)@@ -244,6 +245,9 @@   , buildOS   , buildPlatform   )+import Distribution.Types.DependencySatisfaction+  ( DependencySatisfaction (..)+  ) import Distribution.Types.Flag   ( FlagAssignment   , PackageFlag (..)@@ -1440,7 +1444,7 @@       if parallelInstall         then newParallelJobControl numJobs         else newSerialJobControl-    fetchLimit <- newJobLimit (min numJobs numFetchJobs)+    fetchLimit <- newJobLimit (min numJobs maxNumFetchJobs)     installLock <- newLock -- serialise installation     cacheLock <- newLock -- serialise access to setup exe cache     executeInstallPlan@@ -1483,7 +1487,6 @@       cinfo = compilerInfo comp        numJobs = determineNumJobs (installNumJobs installFlags)-      numFetchJobs = 2       parallelInstall = numJobs >= 2       keepGoing = fromFlag (installKeepGoing installFlags)       distPref =@@ -1676,7 +1679,7 @@       pkg = case finalizePD         flags         (enableStanzas stanzas)-        (const True)+        (const Satisfied)         platform         cinfo         []
src/Distribution/Client/InstallSymlink.hs view
@@ -68,6 +68,9 @@ import Distribution.System   ( Platform   )+import Distribution.Types.DependencySatisfaction+  ( DependencySatisfaction (..)+  ) import Distribution.Types.UnqualComponentName  import System.Directory@@ -199,7 +202,7 @@           case finalizePD             flags             (enableStanzas stanzas)-            (const True)+            (const Satisfied)             platform             cinfo             []
src/Distribution/Client/JobControl.hs view
@@ -31,6 +31,11 @@   , Lock   , newLock   , criticalSection++    -- * Higher level utils+  , newJobControlFromParStrat+  , withJobControl+  , mapConcurrentWithJobs   ) where  import Distribution.Client.Compat.Prelude@@ -40,11 +45,14 @@ import Control.Concurrent.MVar import Control.Concurrent.STM (STM, TVar, atomically, modifyTVar', newTVarIO, readTVar) import Control.Concurrent.STM.TChan-import Control.Exception (bracket_, mask_, try)+import Control.Exception (bracket, bracket_, mask_, try) import Control.Monad (forever, replicateM_) import Distribution.Client.Compat.Semaphore+import Distribution.Client.Utils (numberOfProcessors) import Distribution.Compat.Stack+import Distribution.Simple.Compiler import Distribution.Simple.Utils+import Distribution.Types.ParStrat import System.Semaphore  -- | A simple concurrency abstraction. Jobs can be spawned and can complete@@ -166,7 +174,7 @@         Nothing -> return (reverse xs)         Just x -> go (x : xs) --- | Make a 'JobControl' where the parallism is controlled by a semaphore.+-- | Make a 'JobControl' where the parallelism is controlled by a semaphore. -- -- This uses the GHC -jsem option to allow GHC to take additional semaphore slots -- if we are not using them all.@@ -176,7 +184,7 @@       error $ "newParallelJobControl: not a sensible number of jobs: " ++ show n newSemaphoreJobControl verbosity maxJobLimit = do   sem <- freshSemaphore "cabal_semaphore" maxJobLimit-  notice verbosity $+  info verbosity $     "Created semaphore called "       ++ getSemaphoreName (semaphoreName sem)       ++ " with "@@ -262,3 +270,46 @@  criticalSection :: Lock -> IO a -> IO a criticalSection (Lock lck) act = bracket_ (takeMVar lck) (putMVar lck ()) act++--------------------------------------------------------------------------------+-- More high level utils+--------------------------------------------------------------------------------++newJobControlFromParStrat+  :: Verbosity+  -> Maybe Compiler+  -- ^ The compiler, used to determine whether Jsem is supported.+  -- When Nothing, Jsem is assumed to be unsupported.+  -> ParStratInstall+  -- ^ The parallel strategy+  -> Maybe Int+  -- ^ A cap on the number of jobs (e.g. to force a maximum of 2 concurrent downloads despite a -j8 parallel strategy)+  -> IO (JobControl IO a)+newJobControlFromParStrat verbosity mcompiler parStrat numJobsCap = case parStrat of+  Serial -> newSerialJobControl+  NumJobs n -> newParallelJobControl (capJobs (fromMaybe numberOfProcessors n))+  UseSem n ->+    case mcompiler of+      Just compiler+        | jsemSupported compiler ->+            newSemaphoreJobControl verbosity (capJobs n)+        | otherwise ->+            do+              warn verbosity "-jsem is not supported by the selected compiler, falling back to normal parallelism control."+              newParallelJobControl (capJobs n)+      Nothing ->+        -- Don't warn in the Nothing case, as there isn't really a "selected" compiler.+        newParallelJobControl (capJobs n)+  where+    capJobs n = min (fromMaybe maxBound numJobsCap) n++withJobControl :: IO (JobControl IO a) -> (JobControl IO a -> IO b) -> IO b+withJobControl mkJC = bracket mkJC cleanupJobControl++-- | Concurrently execute actions on a list using the given JobControl.+-- The maximum number of concurrent jobs is tied to the JobControl instance.+-- The resulting list does /not/ preserve the original order!+mapConcurrentWithJobs :: JobControl IO b -> (a -> IO b) -> [a] -> IO [b]+mapConcurrentWithJobs jobControl f xs = do+  traverse_ (spawnJob jobControl . f) xs+  traverse (const $ collectJob jobControl) xs
src/Distribution/Client/Main.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-}  -- |@@ -74,7 +75,7 @@   ( BenchmarkFlags (..)   , CleanFlags (..)   , CopyFlags (..)-  , Flag (..)+  , Flag   , HaddockFlags (..)   , HaddockTarget (..)   , HscolourFlags (..)@@ -87,6 +88,8 @@   , fromFlagOrDefault   , hscolourCommand   , toFlag+  , pattern Flag+  , pattern NoFlag   )  import Distribution.Client.Compat.Prelude hiding (get)@@ -120,6 +123,7 @@ import qualified Distribution.Client.CmdConfigure as CmdConfigure import qualified Distribution.Client.CmdExec as CmdExec import qualified Distribution.Client.CmdFreeze as CmdFreeze+import qualified Distribution.Client.CmdGenBounds as CmdGenBounds import qualified Distribution.Client.CmdHaddock as CmdHaddock import qualified Distribution.Client.CmdHaddockProject as CmdHaddockProject import qualified Distribution.Client.CmdInstall as CmdInstall@@ -130,6 +134,7 @@ import qualified Distribution.Client.CmdRepl as CmdRepl import qualified Distribution.Client.CmdRun as CmdRun import qualified Distribution.Client.CmdSdist as CmdSdist+import qualified Distribution.Client.CmdTarget as CmdTarget import qualified Distribution.Client.CmdTest as CmdTest import qualified Distribution.Client.CmdUpdate as CmdUpdate @@ -168,7 +173,8 @@   , relaxEncodingErrors   ) import Distribution.Client.Version-  ( cabalInstallVersion+  ( cabalInstallGitInfo+  , cabalInstallVersion   )  import Distribution.Package (packageId)@@ -222,7 +228,8 @@ import Distribution.Simple.Program.Db (reconfigurePrograms) import qualified Distribution.Simple.Setup as Cabal import Distribution.Simple.Utils-  ( cabalVersion+  ( cabalGitInfo+  , cabalVersion   , createDirectoryIfMissingVerbose   , dieNoVerbosity   , dieWithException@@ -231,6 +238,7 @@   , notice   , topHandler   , tryFindPackageDesc+  , warn   ) import Distribution.Text   ( display@@ -408,9 +416,16 @@       putStrLn $         "cabal-install version "           ++ display cabalInstallVersion+          ++ " "+          ++ cabalInstallGitInfo           ++ "\ncompiled using version "           ++ display cabalVersion           ++ " of the Cabal library "+          ++ cabalGitInfo'+      where+        cabalGitInfo'+          | cabalGitInfo == cabalInstallGitInfo = "(in-tree)"+          | otherwise = cabalGitInfo      commands = map commandFromSpec commandSpecs     commandSpecs =@@ -425,8 +440,6 @@       , regularCmd initCommand initAction       , regularCmd userConfigCommand userConfigAction       , regularCmd CmdPath.pathCommand CmdPath.pathAction-      , regularCmd genBoundsCommand genBoundsAction-      , regularCmd CmdOutdated.outdatedCommand CmdOutdated.outdatedAction       , wrapperCmd hscolourCommand hscolourCommonFlags       , hiddenCmd formatCommand formatAction       , hiddenCmd actAsSetupCommand actAsSetupAction@@ -450,7 +463,11 @@           , newCmd CmdExec.execCommand CmdExec.execAction           , newCmd CmdClean.cleanCommand CmdClean.cleanAction           , newCmd CmdSdist.sdistCommand CmdSdist.sdistAction+          , newCmd CmdTarget.targetCommand CmdTarget.targetAction+          , newCmd CmdGenBounds.genBoundsCommand CmdGenBounds.genBoundsAction+          , newCmd CmdOutdated.outdatedCommand CmdOutdated.outdatedAction           , legacyCmd configureExCommand configureAction+          , legacyCmd genBoundsCommand genBoundsAction           , legacyCmd buildCommand buildAction           , legacyCmd replCommand replAction           , legacyCmd freezeCommand freezeAction@@ -1338,6 +1355,7 @@ formatAction :: Flag Verbosity -> [String] -> Action formatAction verbosityFlag extraArgs _globalFlags = do   let verbosity = fromFlag verbosityFlag+  warn verbosity "This command is not a full formatter yet"   path <- case extraArgs of     [] -> relativeSymbolicPath <$> tryFindPackageDesc verbosity Nothing     (p : _) -> return $ makeSymbolicPath p
src/Distribution/Client/ManpageFlags.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE LambdaCase #-}  module Distribution.Client.ManpageFlags   ( ManpageFlags (..)@@ -10,7 +9,7 @@ import Distribution.Client.Compat.Prelude  import Distribution.Simple.Command (OptionField (..), ShowOrParseArgs (..), option)-import Distribution.Simple.Setup (Flag (..), optionVerbosity, toFlag, trueArg)+import Distribution.Simple.Setup (Flag, optionVerbosity, toFlag, trueArg) import Distribution.Verbosity (normal)  data ManpageFlags = ManpageFlags
src/Distribution/Client/Nix.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE ViewPatterns #-}  module Distribution.Client.Nix   ( findNixExpr
src/Distribution/Client/NixStyleOptions.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE StandaloneDeriving #-}- -- | Command line options for nix-style / v2 commands. -- -- The commands take a lot of the same options, which affect how install plan@@ -9,6 +7,7 @@   , nixStyleOptions   , defaultNixStyleFlags   , updNixStyleCommonSetupFlags+  , cfgVerbosity   ) where  import Distribution.Client.Compat.Prelude@@ -20,6 +19,7 @@   , CommonSetupFlags (..)   , HaddockFlags (..)   , TestFlags (testCommonFlags)+  , fromFlagOrDefault   ) import Distribution.Solver.Types.ConstraintSource (ConstraintSource (..)) @@ -156,3 +156,6 @@             common = benchmarkCommonFlags flags          in flags{benchmarkCommonFlags = setFlag common}     }++cfgVerbosity :: Verbosity -> NixStyleFlags a -> Verbosity+cfgVerbosity v flags = fromFlagOrDefault v (setupVerbosity . configCommonFlags $ configFlags flags)
src/Distribution/Client/PackageHash.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-}
src/Distribution/Client/ParseUtils.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}  ----------------------------------------------------------------------------- @@ -17,6 +18,8 @@     FieldDescr (..)   , liftField   , liftFields+  , addFields+  , aliasField   , filterFields   , mapFieldNames   , commandOptionToField@@ -51,6 +54,7 @@   ( Field (..)   , FieldDescr (..)   , LineNo+  , PError (..)   , ParseResult (..)   , liftField   , lineNo@@ -103,9 +107,15 @@  -- | Given a collection of field descriptions, keep only a given list of them, -- identified by name.+--+-- TODO: This makes it easy to footgun by providing a non-existent field name. filterFields :: [String] -> [FieldDescr a] -> [FieldDescr a] filterFields includeFields = filter ((`elem` includeFields) . fieldName) +-- | Given a collection of field descriptions, get a field with a given name.+getField :: String -> [FieldDescr a] -> Maybe (FieldDescr a)+getField name = find ((== name) . fieldName)+ -- | Apply a name mangling function to the field names of all the field -- descriptions. The typical use case is to apply some prefix. mapFieldNames :: (String -> String) -> [FieldDescr a] -> [FieldDescr a]@@ -120,6 +130,30 @@ commandOptionsToFields :: [OptionField a] -> [FieldDescr a] commandOptionsToFields = map viewAsFieldDescr +-- | Add fields to a field list.+addFields+  :: [FieldDescr a]+  -> ([FieldDescr a] -> [FieldDescr a])+addFields = (++)++-- | Add a new field which is identical to an existing field but with a+-- different name.+aliasField+  :: String+  -- ^ The existing field name.+  -> String+  -- ^ The new field name.+  -> [FieldDescr a]+  -> [FieldDescr a]+aliasField oldName newName fields =+  let fieldToRename = getField oldName fields+   in case fieldToRename of+        -- TODO: Should this throw?+        Nothing -> fields+        Just fieldToRename' ->+          let newField = fieldToRename'{fieldName = newName}+           in newField : fields+ ------------------------------------------ -- SectionDescr definition and utilities --@@ -260,13 +294,16 @@     setField a (F line name value) =       case Map.lookup name fieldMap of         Just (FieldDescr _ _ set) -> set line value a-        Nothing -> do-          warning $-            "Unrecognized field '"-              ++ name-              ++ "' on line "-              ++ show line-          return a+        Nothing ->+          case Left <$> Map.lookup name sectionMap <|> Right <$> Map.lookup name fgSectionMap of+            Just _ -> ParseFailed $ FieldShouldBeStanza name line+            Nothing -> do+              warning $+                "Unrecognized field '"+                  ++ name+                  ++ "' on line "+                  ++ show line+              return a     setField a (Section line name param fields) =       case Left <$> Map.lookup name sectionMap <|> Right <$> Map.lookup name fgSectionMap of         Just (Left (SectionDescr _ fieldDescrs' sectionDescrs' _ set sectionEmpty)) -> do
src/Distribution/Client/ProjectBuilding.hs view
@@ -87,7 +87,7 @@  import qualified Text.PrettyPrint as Disp -import Control.Exception (assert, bracket, handle)+import Control.Exception (assert, handle) import System.Directory (doesDirectoryExist, doesFileExist, renameDirectory) import System.FilePath (makeRelative, normalise, takeDirectory, (<.>), (</>)) import System.Semaphore (SemaphoreName (..))@@ -97,7 +97,6 @@  import Distribution.Client.ProjectBuilding.PackageFileMonitor import Distribution.Client.ProjectBuilding.UnpackedPackage (annotateFailureNoLog, buildAndInstallUnpackedPackage, buildInplaceUnpackedPackage)-import Distribution.Client.Utils (numberOfProcessors)  ------------------------------------------------------------------------------ @@ -354,17 +353,6 @@     }     | fromFlagOrDefault False (projectConfigOfflineMode config) && not (null packagesToDownload) = return offlineError     | otherwise = do-        -- Concurrency control: create the job controller and concurrency limits-        -- for downloading, building and installing.-        mkJobControl <- case buildSettingNumJobs of-          Serial -> newSerialJobControl-          NumJobs n -> newParallelJobControl (fromMaybe numberOfProcessors n)-          UseSem n ->-            if jsemSupported compiler-              then newSemaphoreJobControl verbosity n-              else do-                warn verbosity "-jsem is not supported by the selected compiler, falling back to normal parallelism control."-                newParallelJobControl n         registerLock <- newLock -- serialise registration         cacheLock <- newLock -- serialise access to setup exe cache         -- TODO: [code cleanup] eliminate setup exe cache@@ -379,7 +367,9 @@         createDirectoryIfMissingVerbose verbosity True distTempDirectory         traverse_ (createPackageDBIfMissing verbosity compiler progdb) packageDBsToUse -        bracket (pure mkJobControl) cleanupJobControl $ \jobControl -> do+        -- Concurrency control: create the job controller and concurrency limits+        -- for downloading, building and installing.+        withJobControl (newJobControlFromParStrat verbosity (Just compiler) buildSettingNumJobs Nothing) $ \jobControl -> do           -- Before traversing the install plan, preemptively find all packages that           -- will need to be downloaded and start downloading them.           asyncDownloadPackages@@ -390,7 +380,7 @@             $ \downloadMap ->               -- For each package in the plan, in dependency order, but in parallel...               InstallPlan.execute-                mkJobControl+                jobControl                 keepGoing                 (BuildFailure Nothing . DependentFailed . packageId)                 installPlan
src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs view
@@ -44,10 +44,14 @@ import Distribution.Client.JobControl import Distribution.Client.Setup   ( CommonSetupFlags-  , filterCommonFlags+  , filterBenchmarkFlags+  , filterBuildFlags   , filterConfigureFlags+  , filterCopyFlags   , filterHaddockArgs   , filterHaddockFlags+  , filterRegisterFlags+  , filterReplFlags   , filterTestFlags   ) import Distribution.Client.SetupWrapper@@ -169,7 +173,7 @@   verbosity   distDirLayout@DistDirLayout{distTempDirectory}   maybe_semaphore-  buildTimeSettings@BuildTimeSettings{buildSettingNumJobs}+  buildTimeSettings@BuildTimeSettings{buildSettingNumJobs, buildSettingKeepTempFiles}   registerLock   cacheLock   pkgshared@ElaboratedSharedConfig@@ -272,9 +276,7 @@         | otherwise = return ()        mbWorkDir = useWorkingDir scriptOptions-      commonFlags v =-        flip filterCommonFlags v $-          setupHsCommonFlags verbosity mbWorkDir builddir+      commonFlags = setupHsCommonFlags verbosity mbWorkDir builddir buildSettingKeepTempFiles        configureCommand = Cabal.configureCommand defaultProgramDb       configureFlags v =@@ -284,19 +286,26 @@             plan             rpkg             pkgshared-            (commonFlags v)+            commonFlags       configureArgs _ = setupHsConfigureArgs pkg        buildCommand = Cabal.buildCommand defaultProgramDb-      buildFlags v = setupHsBuildFlags comp_par_strat pkg pkgshared $ commonFlags v+      buildFlags v =+        flip filterBuildFlags v $+          setupHsBuildFlags+            comp_par_strat+            pkg+            pkgshared+            commonFlags       buildArgs _ = setupHsBuildArgs pkg        copyFlags destdir v =-        setupHsCopyFlags-          pkg-          pkgshared-          (commonFlags v)-          destdir+        flip filterCopyFlags v $+          setupHsCopyFlags+            pkg+            pkgshared+            commonFlags+            destdir       -- In theory, we could want to copy less things than those that were       -- built, but instead, we simply copy the targets that were built.       copyArgs = buildArgs@@ -306,23 +315,25 @@         flip filterTestFlags v $           setupHsTestFlags             pkg-            (commonFlags v)+            commonFlags       testArgs _ = setupHsTestArgs pkg        benchCommand = Cabal.benchmarkCommand       benchFlags v =-        setupHsBenchFlags-          pkg-          pkgshared-          (commonFlags v)+        flip filterBenchmarkFlags v $+          setupHsBenchFlags+            pkg+            pkgshared+            commonFlags       benchArgs _ = setupHsBenchArgs pkg        replCommand = Cabal.replCommand defaultProgramDb       replFlags v =-        setupHsReplFlags-          pkg-          pkgshared-          (commonFlags v)+        flip filterReplFlags v $+          setupHsReplFlags+            pkg+            pkgshared+            commonFlags       replArgs _ = setupHsReplArgs pkg        haddockCommand = Cabal.haddockCommand@@ -332,7 +343,7 @@             pkg             pkgshared             buildTimeSettings-            (commonFlags v)+            commonFlags       haddockArgs v =         flip filterHaddockArgs v $           setupHsHaddockArgs pkg@@ -394,11 +405,12 @@           distTempDirectory           $ \pkgConfDest -> do             let registerFlags v =-                  setupHsRegisterFlags-                    pkg-                    pkgshared-                    (commonFlags v)-                    pkgConfDest+                  flip filterRegisterFlags v $+                    setupHsRegisterFlags+                      pkg+                      pkgshared+                      commonFlags+                      pkgConfDest             setup (Cabal.registerCommand) Cabal.registerCommonFlags (\v -> return (registerFlags v)) (const [])        withLogging :: (Maybe Handle -> IO r) -> IO r
src/Distribution/Client/ProjectConfig.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeApplications #-} @@ -36,6 +37,9 @@   , writeProjectConfigFile   , commandLineFlagsToProjectConfig   , onlyTopLevelProvenance+  , readSourcePackageCabalFile+  , readSourcePackageCabalFile'+  , CabalFileParseError (..)      -- * Packages within projects   , ProjectPackageLocation (..)@@ -53,19 +57,34 @@   , resolveSolverSettings   , BuildTimeSettings (..)   , resolveBuildTimeSettings+  , resolveNumJobsSetting      -- * Checking configuration   , checkBadPerPackageCompilerPaths   , BadPerPackageCompilerPaths (..)++    -- * Globals+  , maxNumFetchJobs   ) where -import Distribution.Client.Compat.Prelude-import Text.PrettyPrint (nest, render, text, vcat)+import Distribution.Client.Compat.Prelude hiding (empty)+import Distribution.Simple.Utils+  ( createDirectoryIfMissingVerbose+  , dieWithException+  , maybeExit+  , notice+  , noticeDoc+  , ordNub+  , rawSystemIOWithEnv+  , warn+  )+import Text.PrettyPrint (cat, colon, comma, empty, hsep, nest, quotes, render, text, vcat) import Prelude ()  import Distribution.Client.Glob   ( isTrivialRootedGlob   )+import Distribution.Client.JobControl import Distribution.Client.ProjectConfig.Legacy import Distribution.Client.ProjectConfig.Types import Distribution.Client.RebuildMonad@@ -128,10 +147,12 @@   ( determineNumJobs   ) import qualified Distribution.Deprecated.ParseUtils as OldParser-  ( ParseResult (..)-  , locatedErrorMsg+  ( locatedErrorMsg   , showPWarning   )+import qualified Distribution.Deprecated.ProjectParseUtils as OldParser+  ( ProjectParseResult (..)+  ) import Distribution.Fields   ( PError   , PWarning@@ -157,21 +178,13 @@   ( ConfiguredProgram (..)   ) import Distribution.Simple.Setup-  ( Flag (Flag)+  ( Flag   , flagToList   , flagToMaybe   , fromFlag   , fromFlagOrDefault   , toFlag-  )-import Distribution.Simple.Utils-  ( createDirectoryIfMissingVerbose-  , dieWithException-  , info-  , maybeExit-  , notice-  , rawSystemIOWithEnv-  , warn+  , pattern Flag   ) import Distribution.System   ( Platform@@ -233,6 +246,7 @@   , withBinaryFile   ) +import Distribution.Deprecated.ProjectParseUtils (ProjectParseError (..), ProjectParseWarning) import Distribution.Solver.Types.ProjectConfigPath  ----------------------------------------@@ -432,12 +446,7 @@       -- buildSettingLogVerbosity  -- defined below, more complicated       buildSettingBuildReports = fromFlag projectConfigBuildReports       buildSettingSymlinkBinDir = flagToList projectConfigSymlinkBinDir-      buildSettingNumJobs =-        if fromFlag projectConfigUseSemaphore-          then UseSem (determineNumJobs projectConfigNumJobs)-          else case (determineNumJobs projectConfigNumJobs) of-            1 -> Serial-            n -> NumJobs (Just n)+      buildSettingNumJobs = resolveNumJobsSetting projectConfigUseSemaphore projectConfigNumJobs       buildSettingKeepGoing = fromFlag projectConfigKeepGoing       buildSettingOfflineMode = fromFlag projectConfigOfflineMode       buildSettingKeepTempFiles = fromFlag projectConfigKeepTempFiles@@ -533,6 +542,20 @@         | isParallelBuild buildSettingNumJobs = False         | otherwise = False +-- | Determine the number of jobs (ParStrat) from the project config+resolveNumJobsSetting+  :: Flag Bool+  -- ^ Whether to use a semaphore (-jsem)+  -> Flag (Maybe Int)+  -- ^ The number of jobs to run concurrently+  -> ParStratX Int+resolveNumJobsSetting projectConfigUseSemaphore projectConfigNumJobs =+  if fromFlag projectConfigUseSemaphore+    then UseSem (determineNumJobs projectConfigNumJobs)+    else case (determineNumJobs projectConfigNumJobs) of+      1 -> Serial+      n -> NumJobs (Just n)+ --------------------------------------------- -- Reading and writing project config files --@@ -858,16 +881,45 @@   monitorFiles [monitorFileHashed configFile]   return (convertLegacyGlobalConfig config) -reportParseResult :: Verbosity -> String -> FilePath -> OldParser.ParseResult ProjectConfigSkeleton -> IO ProjectConfigSkeleton-reportParseResult verbosity _filetype filename (OldParser.ParseOk warnings x) = do+reportProjectParseWarnings :: Verbosity -> FilePath -> [ProjectParseWarning] -> IO ()+reportProjectParseWarnings verbosity projectFile warnings =   unless (null warnings) $-    let msg = unlines (map (OldParser.showPWarning (intercalate ", " $ filename : (projectConfigPathRoot <$> projectSkeletonImports x))) warnings)-     in warn verbosity msg+    let msgs =+          [ OldParser.showPWarning pFilename w+          | (p, w) <- warnings+          , let pFilename = fst $ unconsProjectConfigPath p+          ]+     in noticeDoc verbosity $+          vcat+            [ (text "Warnings found while parsing the project file" <> comma) <+> (text (takeFileName projectFile) <> colon)+            , cat [nest 1 $ text "-" <+> text m | m <- ordNub msgs]+            ]++reportParseResult :: Verbosity -> String -> FilePath -> OldParser.ProjectParseResult ProjectConfigSkeleton -> IO ProjectConfigSkeleton+reportParseResult verbosity _filetype projectFile (OldParser.ProjectParseOk warnings x) = do+  reportProjectParseWarnings verbosity projectFile warnings   return x-reportParseResult verbosity filetype filename (OldParser.ParseFailed err) =+reportParseResult verbosity filetype projectFile (OldParser.ProjectParseFailed (ProjectParseError snippet rootOrImportee err)) = do   let (line, msg) = OldParser.locatedErrorMsg err-      errLineNo = maybe "" (\n -> ':' : show n) line-   in dieWithException verbosity $ ReportParseResult filetype filename errLineNo msg+  let errLineNo = maybe "" (\n -> ':' : show n) line+  let (sourceFile, provenance) =+        maybe+          (projectFile, empty)+          ( \p ->+              ( fst $ unconsProjectConfigPath p+              , if isTopLevelConfigPath p then empty else docProjectConfigPath p+              )+          )+          rootOrImportee+  let doc = case snippet of+        Nothing -> vcat (text <$> lines msg)+        Just s ->+          vcat+            [ provenance+            , text "Failed to parse" <+> quotes (text s) <+> (text "with error" <> colon)+            , nest 2 $ hsep $ text <$> lines msg+            ]+  dieWithException verbosity $ ReportParseResult filetype sourceFile errLineNo doc  --------------------------------------------- -- Finding packages in the project@@ -935,7 +987,7 @@      renderExplicit =       "When using configuration from:\n"-        ++ render (nest 2 . docProjectConfigPaths $ mapMaybe getExplicit (Set.toList provenance))+        ++ render (nest 2 . docProjectConfigFiles $ mapMaybe getExplicit (Set.toList provenance))         ++ "\nThe following errors occurred:\n"         ++ render (nest 2 $ vcat ((text "-" <+>) . text <$> map renderBadPackageLocation bpls)) @@ -1211,6 +1263,7 @@ fetchAndReadSourcePackages   :: Verbosity   -> DistDirLayout+  -> Maybe Compiler   -> ProjectConfigShared   -> ProjectConfigBuildOnly   -> [ProjectPackageLocation]@@ -1218,6 +1271,7 @@ fetchAndReadSourcePackages   verbosity   distDirLayout+  compiler   projectConfigShared   projectConfigBuildOnly   pkgLocations = do@@ -1254,7 +1308,9 @@       syncAndReadSourcePackagesRemoteRepos         verbosity         distDirLayout+        compiler         projectConfigShared+        projectConfigBuildOnly         (fromFlag (projectConfigOfflineMode projectConfigBuildOnly))         [repo | ProjectPackageRemoteRepo repo <- pkgLocations] @@ -1371,16 +1427,23 @@ syncAndReadSourcePackagesRemoteRepos   :: Verbosity   -> DistDirLayout+  -> Maybe Compiler   -> ProjectConfigShared+  -> ProjectConfigBuildOnly   -> Bool   -> [SourceRepoList]   -> Rebuild [PackageSpecifier (SourcePackage UnresolvedPkgLoc)] syncAndReadSourcePackagesRemoteRepos   verbosity   DistDirLayout{distDownloadSrcDirectory}+  compiler   ProjectConfigShared     { projectConfigProgPathExtra     }+  ProjectConfigBuildOnly+    { projectConfigUseSemaphore+    , projectConfigNumJobs+    }   offlineMode   repos = do     repos' <-@@ -1406,10 +1469,15 @@        in configureVCS verbosity progPathExtra vcs      concat-      <$> sequenceA-        [ rerunIfChanged verbosity monitor repoGroup' $ do-          vcs' <- getConfiguredVCS repoType-          syncRepoGroupAndReadSourcePackages vcs' pathStem repoGroup'+      <$> rerunConcurrentlyIfChanged+        verbosity+        (newJobControlFromParStrat verbosity compiler parStrat (Just maxNumFetchJobs))+        [ ( monitor+          , repoGroup'+          , do+              vcs' <- getConfiguredVCS repoType+              syncRepoGroupAndReadSourcePackages vcs' pathStem repoGroup'+          )         | repoGroup@((primaryRepo, repoType) : _) <- Map.elems reposByLocation         , let repoGroup' = map fst repoGroup               pathStem =@@ -1422,6 +1490,7 @@               monitor = newFileMonitor (pathStem <.> "cache")         ]     where+      parStrat = resolveNumJobsSetting projectConfigUseSemaphore projectConfigNumJobs       syncRepoGroupAndReadSourcePackages         :: VCS ConfiguredProgram         -> FilePath@@ -1578,10 +1647,22 @@   -> BS.ByteString   -> IO GenericPackageDescription readSourcePackageCabalFile verbosity pkgfilename content =+  readSourcePackageCabalFile' (warn verbosity) pkgfilename content++-- | Like `readSourcePackageCabalFile`, but the `warn` function is an argument.+--+-- This is used when reading @.cabal@ files in indexes, where warnings should+-- generally be ignored.+readSourcePackageCabalFile'+  :: (String -> IO ())+  -> FilePath+  -> BS.ByteString+  -> IO GenericPackageDescription+readSourcePackageCabalFile' logWarnings pkgfilename content =   case runParseResult (parseGenericPackageDescription content) of     (warnings, Right pkg) -> do       unless (null warnings) $-        info verbosity (formatWarnings warnings)+        logWarnings (formatWarnings warnings)       return pkg     (warnings, Left (mspecVersion, errors)) ->       throwIO $ CabalFileParseError pkgfilename content errors mspecVersion warnings@@ -1757,3 +1838,10 @@ onlyTopLevelProvenance = Set.filter $ \case   Implicit -> False   Explicit ps -> isTopLevelConfigPath ps++-- | The maximum amount of fetch jobs that can run concurrently.+-- For instance, this is used to limit the amount of concurrent downloads from+-- hackage, or the amount of concurrent git clones for+-- source-repository-package stanzas.+maxNumFetchJobs :: Int+maxNumFetchJobs = 2
src/Distribution/Client/ProjectConfig/Legacy.hs view
@@ -1,9 +1,12 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-}  -- | Project configuration, implementation in terms of legacy types.@@ -82,9 +85,11 @@   ) import Distribution.PackageDescription.Configuration (simplifyWithSysParams) import Distribution.Simple.Compiler-  ( CompilerInfo (..)+  ( Compiler (..)+  , CompilerInfo (..)   , DebugInfoLevel (..)   , OptimisationLevel (..)+  , compilerInfo   , interpretPackageDB   ) import Distribution.Simple.InstallDirs (CopyDest (NoCopyDest))@@ -105,7 +110,7 @@   , CommonSetupFlags (..)   , ConfigFlags (..)   , DumpBuildInfo (DumpBuildInfo, NoDumpBuildInfo)-  , Flag (..)+  , Flag   , HaddockFlags (..)   , TestFlags (..)   , benchmarkOptions'@@ -122,10 +127,13 @@   , splitArgs   , testOptions'   , toFlag+  , pattern Flag+  , pattern NoFlag   ) import Distribution.Simple.Utils   ( debug   , lowercase+  , noticeDoc   ) import Distribution.Types.CondTree   ( CondBranch (..)@@ -141,6 +149,7 @@   , overNubList   , toNubList   )+import Distribution.Utils.String (trim)  import Distribution.Client.HttpUtils import Distribution.Client.ParseUtils@@ -159,6 +168,11 @@   , syntaxError   ) import qualified Distribution.Deprecated.ParseUtils as ParseUtils+import Distribution.Deprecated.ProjectParseUtils+  ( ProjectParseResult (..)+  , projectParse+  , projectParseFail+  ) import Distribution.Deprecated.ReadP   ( ReadP   , (+++)@@ -183,6 +197,7 @@   )  import qualified Data.ByteString.Char8 as BS+import Data.Functor ((<&>)) import qualified Data.Map as Map import qualified Data.Set as Set import Network.URI (URI (..), nullURIAuth, parseURI)@@ -206,12 +221,13 @@ singletonProjectConfigSkeleton :: ProjectConfig -> ProjectConfigSkeleton singletonProjectConfigSkeleton x = CondNode x mempty mempty -instantiateProjectConfigSkeletonFetchingCompiler :: Monad m => m (OS, Arch, CompilerInfo) -> FlagAssignment -> ProjectConfigSkeleton -> m ProjectConfig+instantiateProjectConfigSkeletonFetchingCompiler :: Monad m => m (OS, Arch, Compiler) -> FlagAssignment -> ProjectConfigSkeleton -> m (ProjectConfig, Maybe Compiler) instantiateProjectConfigSkeletonFetchingCompiler fetch flags skel-  | null (toListOf traverseCondTreeV skel) = pure $ fst (ignoreConditions skel)+  | null (toListOf traverseCondTreeV skel) = pure (fst (ignoreConditions skel), Nothing)   | otherwise = do-      (os, arch, impl) <- fetch-      pure $ instantiateProjectConfigSkeletonWithCompiler os arch impl flags skel+      (os, arch, comp) <- fetch+      let conf = instantiateProjectConfigSkeletonWithCompiler os arch (compilerInfo comp) flags skel+      pure (conf, Just comp)  instantiateProjectConfigSkeletonWithCompiler :: OS -> Arch -> CompilerInfo -> FlagAssignment -> ProjectConfigSkeleton -> ProjectConfig instantiateProjectConfigSkeletonWithCompiler os arch impl _flags skel = go $ mapTreeConds (fst . simplifyWithSysParams os arch impl) skel@@ -242,12 +258,15 @@   -> Verbosity   -> ProjectConfigToParse   -- ^ The contents of the file to parse-  -> IO (ParseResult ProjectConfigSkeleton)-parseProject rootPath cacheDir httpTransport verbosity configToParse = do-  let (dir, projectFileName) = splitFileName rootPath-  projectDir <- makeAbsolute dir-  projectPath <- canonicalizeConfigPath projectDir (ProjectConfigPath $ projectFileName :| [])-  parseProjectSkeleton cacheDir httpTransport verbosity projectDir projectPath configToParse+  -> IO (ProjectParseResult ProjectConfigSkeleton)+parseProject rootPath cacheDir httpTransport verbosity configToParse =+  do+    let (dir, projectFileName) = splitFileName rootPath+    projectDir <- makeAbsolute dir+    projectPath <- canonicalizeConfigPath projectDir (ProjectConfigPath $ projectFileName :| [])+    parseProjectSkeleton cacheDir httpTransport verbosity projectDir projectPath configToParse+    -- NOTE: Reverse the warnings so they are in line number order.+    <&> \case ProjectParseOk ws x -> ProjectParseOk (reverse ws) x; x -> x  parseProjectSkeleton   :: FilePath@@ -259,29 +278,32 @@   -- ^ The path of the file being parsed, either the root or an import   -> ProjectConfigToParse   -- ^ The contents of the file to parse-  -> IO (ParseResult ProjectConfigSkeleton)+  -> IO (ProjectParseResult ProjectConfigSkeleton) parseProjectSkeleton cacheDir httpTransport verbosity projectDir source (ProjectConfigToParse bs) =-  (sanityWalkPCS False =<<) <$> liftPR (go []) (ParseUtils.readFields bs)+  (sanityWalkPCS False =<<) <$> liftPR source (go []) (ParseUtils.readFields bs)   where-    go :: [ParseUtils.Field] -> [ParseUtils.Field] -> IO (ParseResult ProjectConfigSkeleton)+    go :: [ParseUtils.Field] -> [ParseUtils.Field] -> IO (ProjectParseResult ProjectConfigSkeleton)     go acc (x : xs) = case x of       (ParseUtils.F _ "import" importLoc) -> do         let importLocPath = importLoc `consProjectConfigPath` source          -- Once we canonicalize the import path, we can check for cyclical imports+        normSource <- canonicalizeConfigPath projectDir source         normLocPath <- canonicalizeConfigPath projectDir importLocPath-         debug verbosity $ "\nimport path, normalized\n=======================\n" ++ render (docProjectConfigPath normLocPath)          if isCyclicConfigPath normLocPath-          then pure . parseFail $ ParseUtils.FromString (render $ cyclicalImportMsg normLocPath) Nothing+          then pure . projectParseFail Nothing (Just normSource) $ ParseUtils.FromString (render $ cyclicalImportMsg normLocPath) Nothing           else do-            normSource <- canonicalizeConfigPath projectDir source+            when+              (isUntrimmedUriConfigPath importLocPath)+              (noticeDoc verbosity $ untrimmedUriImportMsg (Disp.text "Warning:") importLocPath)             let fs = (\z -> CondNode z [normLocPath] mempty) <$> fieldsToConfig normSource (reverse acc)             res <- parseProjectSkeleton cacheDir httpTransport verbosity projectDir importLocPath . ProjectConfigToParse =<< fetchImportConfig normLocPath             rest <- go [] xs-            pure . fmap mconcat . sequence $ [fs, res, rest]+            pure . fmap mconcat . sequence $ [projectParse Nothing normSource fs, res, rest]       (ParseUtils.Section l "if" p xs') -> do+        normSource <- canonicalizeConfigPath projectDir source         subpcs <- go [] xs'         let fs = singletonProjectConfigSkeleton <$> fieldsToConfig source (reverse acc)         (elseClauses, rest) <- parseElseClauses xs@@ -289,27 +311,32 @@               (\c pcs e -> CondNode mempty mempty [CondBranch c pcs e])                 <$>                 -- we rewrap as as a section so the readFields lexer of the conditional parser doesn't get confused-                adaptParseError l (parseConditionConfVarFromClause . BS.pack $ "if(" <> p <> ")")+                ( let s = "if(" <> p <> ")"+                   in projectParse (Just s) normSource (adaptParseError l (parseConditionConfVarFromClause $ BS.pack s))+                )                 <*> subpcs                 <*> elseClauses-        pure . fmap mconcat . sequence $ [fs, condNode, rest]+        pure . fmap mconcat . sequence $ [projectParse Nothing normSource fs, condNode, rest]       _ -> go (x : acc) xs     go acc [] = do       normSource <- canonicalizeConfigPath projectDir source-      pure . fmap singletonProjectConfigSkeleton . fieldsToConfig normSource $ reverse acc+      pure . fmap singletonProjectConfigSkeleton . projectParse Nothing normSource . fieldsToConfig normSource $ reverse acc -    parseElseClauses :: [ParseUtils.Field] -> IO (ParseResult (Maybe ProjectConfigSkeleton), ParseResult ProjectConfigSkeleton)+    parseElseClauses :: [ParseUtils.Field] -> IO (ProjectParseResult (Maybe ProjectConfigSkeleton), ProjectParseResult ProjectConfigSkeleton)     parseElseClauses x = case x of       (ParseUtils.Section _l "else" _p xs' : xs) -> do         subpcs <- go [] xs'         rest <- go [] xs         pure (Just <$> subpcs, rest)       (ParseUtils.Section l "elif" p xs' : xs) -> do+        normSource <- canonicalizeConfigPath projectDir source         subpcs <- go [] xs'         (elseClauses, rest) <- parseElseClauses xs         let condNode =               (\c pcs e -> CondNode mempty mempty [CondBranch c pcs e])-                <$> adaptParseError l (parseConditionConfVarFromClause . BS.pack $ "else(" <> p <> ")")+                <$> ( let s = "elif(" <> p <> ")"+                       in projectParse (Just s) normSource (adaptParseError l (parseConditionConfVarFromClause $ BS.pack s))+                    )                 <*> subpcs                 <*> elseClauses         pure (Just <$> condNode, rest)@@ -328,15 +355,16 @@     addProvenance :: ProjectConfigPath -> ProjectConfig -> ProjectConfig     addProvenance sourcePath x = x{projectConfigProvenance = Set.singleton $ Explicit sourcePath} +    adaptParseError :: Show e => ParseUtils.LineNo -> Either e a -> ParseResult a     adaptParseError _ (Right x) = pure x     adaptParseError l (Left e) = parseFail $ ParseUtils.FromString (show e) (Just l) -    liftPR :: (a -> IO (ParseResult b)) -> ParseResult a -> IO (ParseResult b)-    liftPR f (ParseOk ws x) = addWarnings <$> f x+    liftPR :: ProjectConfigPath -> (a -> IO (ProjectParseResult b)) -> ParseResult a -> IO (ProjectParseResult b)+    liftPR p f (ParseOk ws x) = addWarnings <$> f x       where-        addWarnings (ParseOk ws' x') = ParseOk (ws' ++ ws) x'+        addWarnings (ProjectParseOk ws' x') = ProjectParseOk (ws' ++ ((p,) <$> ws)) x'         addWarnings x' = x'-    liftPR _ (ParseFailed e) = pure $ ParseFailed e+    liftPR p _ (ParseFailed e) = pure $ projectParseFail Nothing (Just p) e      fetchImportConfig :: ProjectConfigPath -> IO BS.ByteString     fetchImportConfig (ProjectConfigPath (pci :| _)) = do@@ -344,7 +372,7 @@       fetch pci      fetch :: FilePath -> IO BS.ByteString-    fetch pci = case parseURI pci of+    fetch pci = case parseURI $ trim pci of       Just uri -> do         let fp = cacheDir </> map (\x -> if isPathSeparator x then '_' else x) (makeValid $ show uri)         createDirectoryIfMissing True cacheDir@@ -359,12 +387,14 @@       where         isSet f = f (projectConfigShared pc) /= NoFlag -    sanityWalkPCS :: Bool -> ProjectConfigSkeleton -> ParseResult ProjectConfigSkeleton-    sanityWalkPCS underConditional t@(CondNode d _c comps)-      | underConditional && modifiesCompiler d = parseFail $ ParseUtils.FromString "Cannot set compiler in a conditional clause of a cabal project file" Nothing-      | otherwise = mapM_ sanityWalkBranch comps >> pure t+    sanityWalkPCS :: Bool -> ProjectConfigSkeleton -> ProjectParseResult ProjectConfigSkeleton+    sanityWalkPCS underConditional t@(CondNode d (listToMaybe -> c) comps)+      | underConditional && modifiesCompiler d =+          projectParseFail Nothing c $ ParseUtils.FromString "Cannot set compiler in a conditional clause of a cabal project file" Nothing+      | otherwise =+          mapM_ sanityWalkBranch comps >> pure t -    sanityWalkBranch :: CondBranch ConfVar [ProjectConfigPath] ProjectConfig -> ParseResult ()+    sanityWalkBranch :: CondBranch ConfVar [ProjectConfigPath] ProjectConfig -> ProjectParseResult ()     sanityWalkBranch (CondBranch _c t f) = traverse_ (sanityWalkPCS True) f >> sanityWalkPCS True t >> pure ()  ------------------------------------------------------------------@@ -861,9 +891,9 @@   configFlags   installFlags   clientInstallFlags-  haddockFlags-  _-  _ =+  _haddockFlags+  _testFlags+  _benchmarkFlags =     ProjectConfigBuildOnly{..}     where       projectConfigClientInstallFlags = clientInstallFlags@@ -880,6 +910,7 @@        CommonSetupFlags         { setupVerbosity = projectConfigVerbosity+        , setupKeepTempFiles = projectConfigKeepTempFiles         } = commonFlags        InstallFlags@@ -899,10 +930,6 @@         , installOfflineMode = projectConfigOfflineMode         } = installFlags -      HaddockFlags-        { haddockKeepTempFiles = projectConfigKeepTempFiles -- TODO: this ought to live elsewhere-        } = haddockFlags- convertToLegacyProjectConfig :: ProjectConfig -> LegacyProjectConfig convertToLegacyProjectConfig   projectConfig@ProjectConfig@@ -975,6 +1002,7 @@         mempty           { setupVerbosity = projectConfigVerbosity           , setupDistPref = fmap makeSymbolicPath $ projectConfigDistDir+          , setupKeepTempFiles = projectConfigKeepTempFiles           }        configFlags =@@ -1047,8 +1075,7 @@ convertToLegacyAllPackageConfig :: ProjectConfig -> LegacyPackageConfig convertToLegacyAllPackageConfig   ProjectConfig-    { projectConfigBuildOnly = ProjectConfigBuildOnly{..}-    , projectConfigShared = ProjectConfigShared{..}+    { projectConfigShared = ProjectConfigShared{..}     } =     LegacyPackageConfig       { legacyConfigureFlags = configFlags@@ -1124,8 +1151,6 @@        haddockFlags =         mempty-          { haddockKeepTempFiles = projectConfigKeepTempFiles-          }  convertToLegacyPerPackageConfig :: PackageConfig -> LegacyPackageConfig convertToLegacyPerPackageConfig PackageConfig{..} =@@ -1225,7 +1250,6 @@         , haddockQuickJump = packageConfigHaddockQuickJump         , haddockHscolourCss = packageConfigHaddockHscolourCss         , haddockContents = packageConfigHaddockContents-        , haddockKeepTempFiles = mempty         , haddockIndex = packageConfigHaddockIndex         , haddockBaseUrl = packageConfigHaddockBaseUrl         , haddockResourcesDir = packageConfigHaddockResourcesDir@@ -1408,7 +1432,8 @@               configPackageDBs               (\v conf -> conf{configPackageDBs = v})           ]-        . filterFields (["verbose", "builddir"] ++ map optionName installDirsOptions)+        . aliasField "keep-temp-files" "haddock-keep-temp-files"+        . filterFields (["verbose", "builddir", "keep-temp-files"] ++ map optionName installDirsOptions)         . commandOptionsToFields         $ configureOptions ParseArgs     , liftFields@@ -1541,7 +1566,7 @@             parseTokenQ             configConfigureArgs             (\v conf -> conf{configConfigureArgs = v})-        , simpleFieldParsec+        , monoidFieldParsec             "flags"             dispFlagAssignment             parsecFlagAssignment@@ -1630,7 +1655,6 @@             , "hscolour-css"             , "contents-location"             , "index-location"-            , "keep-temp-files"             , "base-url"             , "resources-dir"             , "output-dir"@@ -2080,9 +2104,3 @@ showTokenQ x@('-' : '-' : _) = Disp.text (show x) showTokenQ x@('.' : []) = Disp.text (show x) showTokenQ x = showToken x---- Handy util-addFields-  :: [FieldDescr a]-  -> ([FieldDescr a] -> [FieldDescr a])-addFields = (++)
src/Distribution/Client/ProjectFlags.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}  module Distribution.Client.ProjectFlags   ( ProjectFlags (..)@@ -20,7 +21,15 @@   , option   , reqArg   )-import Distribution.Simple.Setup (Flag (..), flagToList, flagToMaybe, toFlag, trueArg)+import Distribution.Simple.Setup+  ( Flag+  , flagToList+  , flagToMaybe+  , toFlag+  , trueArg+  , pattern Flag+  , pattern NoFlag+  )  data ProjectFlags = ProjectFlags   { flagProjectDir :: Flag FilePath
src/Distribution/Client/ProjectOrchestration.hs view
@@ -58,7 +58,8 @@     -- ** Selecting what targets we mean   , readTargetSelectors   , reportTargetSelectorProblems-  , resolveTargets+  , resolveTargetsFromSolver+  , resolveTargetsFromLocalPackages   , TargetsMap   , allTargetSelectors   , uniqueTargetSelectors@@ -146,6 +147,7 @@ import Distribution.Solver.Types.PackageIndex   ( lookupPackageName   )+import Distribution.Solver.Types.SourcePackage (SourcePackage (..))  import Distribution.Client.BuildReports.Anonymous (cabalInstallID) import qualified Distribution.Client.BuildReports.Anonymous as BuildReports@@ -169,7 +171,9 @@   , packageNameToUnqualComponentName   ) +import Distribution.PackageDescription.Configuration import Distribution.Solver.Types.OptionalStanza+import Distribution.Types.Component  import Control.Exception (assert) import qualified Data.List.NonEmpty as NE@@ -564,8 +568,10 @@ -- matched this target. Typically this is exactly one, but in general it is -- possible to for different selectors to match the same target. This extra -- information is primarily to help make helpful error messages.-type TargetsMap = Map UnitId [(ComponentTarget, NonEmpty TargetSelector)]+type TargetsMap = TargetsMapX UnitId +type TargetsMapX u = Map u [(ComponentTarget, NonEmpty TargetSelector)]+ -- | Get all target selectors. allTargetSelectors :: TargetsMap -> [TargetSelector] allTargetSelectors = concatMap (NE.toList . snd) . concat . Map.elems@@ -574,6 +580,63 @@ uniqueTargetSelectors :: TargetsMap -> [TargetSelector] uniqueTargetSelectors = ordNub . allTargetSelectors +-- | Resolve targets from a solver result.+--+-- This is a convenience wrapper around 'resolveTargetsFromSolver' that takes an+-- 'ElaboratedInstallPlan' directly, rather than requiring the caller to+-- construct the 'AvailableTargetIndexes' first.+resolveTargetsFromSolver+  :: forall err+   . ( forall k+        . TargetSelector+       -> [AvailableTarget k]+       -> Either (TargetProblem err) [k]+     )+  -> ( forall k+        . SubComponentTarget+       -> AvailableTarget k+       -> Either (TargetProblem err) k+     )+  -> ElaboratedInstallPlan+  -> Maybe (SourcePackageDb)+  -> [TargetSelector]+  -> Either [TargetProblem err] TargetsMap+resolveTargetsFromSolver selectPackageTargets selectComponentTarget installPlan sourceDb targetSelectors =+  resolveTargets+    selectPackageTargets+    selectComponentTarget+    (availableTargetIndexes installPlan)+    sourceDb+    targetSelectors++-- | Resolve targets from local packages.+--+-- This is a convenience wrapper around 'resolveTargets' that takes a list of+-- 'PackageSpecifier's directly, rather than requiring the caller to+-- construct the 'AvailableTargetIndexes' first.+resolveTargetsFromLocalPackages+  :: forall err+   . ( forall k+        . TargetSelector+       -> [AvailableTarget k]+       -> Either (TargetProblem err) [k]+     )+  -> ( forall k+        . SubComponentTarget+       -> AvailableTarget k+       -> Either (TargetProblem err) k+     )+  -> [PackageSpecifier UnresolvedSourcePackage]+  -> [TargetSelector]+  -> Either [TargetProblem err] (TargetsMapX PackageId)+resolveTargetsFromLocalPackages selectPackageTargets selectComponentTarget pkgSpecifiers targetSelectors =+  resolveTargets+    selectPackageTargets+    selectComponentTarget+    (availableTargetIndexesFromSourcePackages pkgSpecifiers)+    Nothing+    targetSelectors+ -- | Given a set of 'TargetSelector's, resolve which 'UnitId's and -- 'ComponentTarget's they ought to refer to. --@@ -606,8 +669,9 @@ -- this commands can use 'selectComponentTargetBasic', either directly or as -- a basis for their own @selectComponentTarget@ implementation. resolveTargets-  :: forall err-   . ( forall k+  :: forall u err+   . Ord u+  => ( forall k         . TargetSelector        -> [AvailableTarget k]        -> Either (TargetProblem err) [k]@@ -617,14 +681,14 @@        -> AvailableTarget k        -> Either (TargetProblem err) k      )-  -> ElaboratedInstallPlan+  -> AvailableTargetIndexes u   -> Maybe (SourcePackageDb)   -> [TargetSelector]-  -> Either [TargetProblem err] TargetsMap+  -> Either [TargetProblem err] (TargetsMapX u) resolveTargets   selectPackageTargets   selectComponentTarget-  installPlan+  AvailableTargetIndexes{..}   mPkgDb =     fmap mkTargetsMap       . either (Left . toList) Right@@ -632,8 +696,8 @@       . map (\ts -> (,) ts <$> checkTarget ts)     where       mkTargetsMap-        :: [(TargetSelector, [(UnitId, ComponentTarget)])]-        -> TargetsMap+        :: [(TargetSelector, [(u, ComponentTarget)])]+        -> TargetsMapX u       mkTargetsMap targets =         Map.map nubComponentTargets $           Map.fromListWith@@ -643,9 +707,7 @@             , (uid, ct) <- cts             ] -      AvailableTargetIndexes{..} = availableTargetIndexes installPlan--      checkTarget :: TargetSelector -> Either (TargetProblem err) [(UnitId, ComponentTarget)]+      checkTarget :: TargetSelector -> Either (TargetProblem err) [(u, ComponentTarget)]        -- We can ask to build any whole package, project-local or a dependency       checkTarget bt@(TargetPackage _ (ordNub -> [pkgid]) mkfilter)@@ -737,19 +799,19 @@         (\(es, xs) -> case es of [] -> Right xs; (e : es') -> Left (e :| es'))           . partitionEithers -data AvailableTargetIndexes = AvailableTargetIndexes+data AvailableTargetIndexes u = AvailableTargetIndexes   { availableTargetsByPackageIdAndComponentName-      :: AvailableTargetsMap (PackageId, ComponentName)+      :: AvailableTargetsMap (PackageId, ComponentName) u   , availableTargetsByPackageId-      :: AvailableTargetsMap PackageId+      :: AvailableTargetsMap PackageId u   , availableTargetsByPackageName-      :: AvailableTargetsMap PackageName+      :: AvailableTargetsMap PackageName u   , availableTargetsByPackageNameAndComponentName-      :: AvailableTargetsMap (PackageName, ComponentName)+      :: AvailableTargetsMap (PackageName, ComponentName) u   , availableTargetsByPackageNameAndUnqualComponentName-      :: AvailableTargetsMap (PackageName, UnqualComponentName)+      :: AvailableTargetsMap (PackageName, UnqualComponentName) u   }-type AvailableTargetsMap k = Map k [AvailableTarget (UnitId, ComponentName)]+type AvailableTargetsMap k u = Map k [AvailableTarget (u, ComponentName)]  -- We define a bunch of indexes to help 'resolveTargets' with resolving -- 'TargetSelector's to specific 'UnitId's.@@ -760,7 +822,7 @@ -- -- They are all constructed lazily because they are not necessarily all used. ---availableTargetIndexes :: ElaboratedInstallPlan -> AvailableTargetIndexes+availableTargetIndexes :: ElaboratedInstallPlan -> AvailableTargetIndexes UnitId availableTargetIndexes installPlan = AvailableTargetIndexes{..}   where     availableTargetsByPackageIdAndComponentName@@ -833,6 +895,86 @@             ElabPackage _ -> null (pkgComponents (elabPkgDescription pkg))         ] +-- | Create available target indexes from source packages.+--+-- This is useful when we need to resolve targets before solver resolution.+availableTargetIndexesFromSourcePackages+  :: [PackageSpecifier UnresolvedSourcePackage] -> AvailableTargetIndexes PackageId+availableTargetIndexesFromSourcePackages pkgSpecifiers = AvailableTargetIndexes{..}+  where+    -- Create a map of available targets from source packages+    availableTargetsByPackageIdAndComponentName+      :: Map (PackageId, ComponentName) [AvailableTarget (PackageId, ComponentName)]+    availableTargetsByPackageIdAndComponentName =+      Map.fromListWith (++) $+        concat+          [ [ ((pkgId, cname), [makeAvailableTarget pkgId cname])+            | let pkgId = packageId pkg+            , cname <- map componentName (pkgComponents $ flattenPackageDescription (srcpkgDescription pkg))+            ]+          | SpecificSourcePackage pkg <- pkgSpecifiers+          ]++    -- Helper to create an available target+    makeAvailableTarget pkgId cname =+      AvailableTarget+        { availableTargetPackageId = pkgId+        , availableTargetComponentName = cname+        , availableTargetStatus = TargetBuildable (pkgId, cname) TargetRequestedByDefault+        , availableTargetLocalToProject = True+        }++    -- Derive other indexes from the main one, just like in availableTargetIndexes+    availableTargetsByPackageId+      :: Map PackageId [AvailableTarget (PackageId, ComponentName)]+    availableTargetsByPackageId =+      Map.mapKeysWith+        (++)+        (\(pkgid, _cname) -> pkgid)+        availableTargetsByPackageIdAndComponentName+        `Map.union` availableTargetsEmptyPackages++    -- Handle empty packages+    availableTargetsEmptyPackages =+      Map.fromList+        [ (packageId pkg, [])+        | SpecificSourcePackage pkg <- pkgSpecifiers+        , null (pkgComponents (flattenPackageDescription (srcpkgDescription pkg)))+        ]++    availableTargetsByPackageName+      :: Map PackageName [AvailableTarget (PackageId, ComponentName)]+    availableTargetsByPackageName =+      Map.mapKeysWith+        (++)+        packageName+        availableTargetsByPackageId++    availableTargetsByPackageNameAndComponentName+      :: Map (PackageName, ComponentName) [AvailableTarget (PackageId, ComponentName)]+    availableTargetsByPackageNameAndComponentName =+      Map.mapKeysWith+        (++)+        (\(pkgid, cname) -> (packageName pkgid, cname))+        availableTargetsByPackageIdAndComponentName++    availableTargetsByPackageNameAndUnqualComponentName+      :: Map (PackageName, UnqualComponentName) [AvailableTarget (PackageId, ComponentName)]+    availableTargetsByPackageNameAndUnqualComponentName =+      Map.mapKeysWith+        (++)+        ( \(pkgid, cname) ->+            let pname = packageName pkgid+                cname' = unqualComponentName pname cname+             in (pname, cname')+        )+        availableTargetsByPackageIdAndComponentName+      where+        unqualComponentName :: PackageName -> ComponentName -> UnqualComponentName+        unqualComponentName pkgname =+          fromMaybe (packageNameToUnqualComponentName pkgname)+            . componentNameString+ -- TODO: [research required] what if the solution has multiple --      versions of this package? --      e.g. due to setup deps or due to multiple independent sets@@ -934,7 +1076,6 @@  ------------------------------------------------------------------------------ -- Displaying what we plan to do---  -- | Print a user-oriented presentation of the install plan, indicating what -- will be built.@@ -946,7 +1087,7 @@ printPlan   verbosity   ProjectBaseContext-    { buildSettings = BuildTimeSettings{buildSettingDryRun}+    { buildSettings = BuildTimeSettings{buildSettingDryRun, buildSettingKeepTempFiles}     , projectConfig =       ProjectConfig         { projectConfigAllPackages =@@ -1048,6 +1189,7 @@                 verbosity                 Nothing -- omit working directory                 (makeSymbolicPath "$builddir")+                buildSettingKeepTempFiles             fullConfigureFlags =               runIdentity $                 ( setupHsConfigureFlags
src/Distribution/Client/ProjectPlanOutput.hs view
@@ -1,8 +1,4 @@-{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -16,7 +12,7 @@     -- | Several outputs rely on having a general overview of   , PostBuildProjectStatus (..)   , updatePostBuildProjectStatus-  , createPackageEnvironment+  , createPackageEnvironmentAndArgs   , writePlanGhcEnvironment   , argsEquivalentOfGhcEnvironmentFile   ) where@@ -113,6 +109,7 @@     , "compiler-id"         J..= (J.String . showCompilerId . pkgConfigCompiler)           elaboratedSharedConfig+    , "compiler-abi" J..= jdisplay (compilerAbiTag (pkgConfigCompiler elaboratedSharedConfig))     , "os" J..= jdisplay os     , "arch" J..= jdisplay arch     , "install-plan" J..= installPlanToJ elaboratedInstallPlan@@ -781,7 +778,7 @@   writeFileAtomic (distProjectCacheFile "up-to-date") $     Binary.encode upToDate --- | Prepare a package environment that includes all the library dependencies+-- | Prepare a package environment and args that includes all the library dependencies -- for a plan. -- -- When running cabal new-exec, we want to set things up so that the compiler@@ -790,14 +787,17 @@ -- temporarily, in case the compiler wants to learn this information via the -- filesystem, and returns any environment variable overrides the compiler -- needs.-createPackageEnvironment+--+-- The function returns both the arguments you need to pass to the compiler and+-- the environment variables you need to set.+createPackageEnvironmentAndArgs   :: Verbosity   -> FilePath   -> ElaboratedInstallPlan   -> ElaboratedSharedConfig   -> PostBuildProjectStatus-  -> IO [(String, Maybe String)]-createPackageEnvironment+  -> IO ([String], [(String, Maybe String)])+createPackageEnvironmentAndArgs   verbosity   path   elaboratedPlan@@ -812,14 +812,14 @@               elaboratedShared               buildStatus           case envFileM of-            Just envFile -> return [("GHC_ENVIRONMENT", Just envFile)]+            Just envFile -> return (["-package-env=" ++ envFile], [("GHC_ENVIRONMENT", Just envFile)])             Nothing -> do               warn verbosity "the configured version of GHC does not support reading package lists from the environment; commands that need the current project's package database are likely to fail"-              return []+              return ([], [])     | otherwise =         do           warn verbosity "package environment configuration is not supported for the currently configured compiler; commands that need the current project's package database are likely to fail"-          return []+          return ([], [])  -- Writing .ghc.environment files --
src/Distribution/Client/ProjectPlanning.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-}@@ -186,6 +185,9 @@ import Distribution.Types.AnnotatedId import Distribution.Types.ComponentInclude import Distribution.Types.ComponentName+import Distribution.Types.DependencySatisfaction+  ( DependencySatisfaction (..)+  ) import Distribution.Types.DumpBuildInfo import Distribution.Types.GivenComponent import Distribution.Types.LibraryName@@ -229,6 +231,7 @@ import qualified Data.Set as Set import Distribution.Client.Errors import Distribution.Solver.Types.ProjectConfigPath+import System.Directory (getCurrentDirectory) import System.FilePath import qualified Text.PrettyPrint as Disp @@ -391,26 +394,21 @@         $ do           liftIO $ info verbosity "Project settings changed, reconfiguring..."           projectConfigSkeleton <- phaseReadProjectConfig+           let fetchCompiler = do                 -- have to create the cache directory before configuring the compiler                 liftIO $ createDirectoryIfMissingVerbose verbosity True distProjectCacheDirectory                 (compiler, Platform arch os, _) <- configureCompiler verbosity distDirLayout (fst (PD.ignoreConditions projectConfigSkeleton) <> cliConfig)-                pure (os, arch, compilerInfo compiler)+                pure (os, arch, compiler) -          projectConfig <- instantiateProjectConfigSkeletonFetchingCompiler fetchCompiler mempty projectConfigSkeleton+          (projectConfig, compiler) <- instantiateProjectConfigSkeletonFetchingCompiler fetchCompiler mempty projectConfigSkeleton           when (projectConfigDistDir (projectConfigShared $ projectConfig) /= NoFlag) $             liftIO $               warn verbosity "The builddir option is not supported in project and config files. It will be ignored."-          localPackages <- phaseReadLocalPackages (projectConfig <> cliConfig)+          localPackages <- phaseReadLocalPackages compiler (projectConfig <> cliConfig)           return (projectConfig, localPackages) -    let configfiles =-          [ text "-" <+> docProjectConfigPath path-          | Explicit path <- Set.toList . (if verbosity >= verbose then id else onlyTopLevelProvenance) $ projectConfigProvenance projectConfig-          ]-    unless (null configfiles) $-      notice (verboseStderr verbosity) . render . vcat $-        text "Configuration is affected by the following files:" : configfiles+    informAboutConfigFiles projectConfig      return (projectConfig <> cliConfig, localPackages)     where@@ -433,9 +431,11 @@       -- NOTE: These are all packages mentioned in the project configuration.       -- Whether or not they will be considered local to the project will be decided by `shouldBeLocal`.       phaseReadLocalPackages-        :: ProjectConfig+        :: Maybe Compiler+        -> ProjectConfig         -> Rebuild [PackageSpecifier UnresolvedSourcePackage]       phaseReadLocalPackages+        compiler         projectConfig@ProjectConfig           { projectConfigShared           , projectConfigBuildOnly@@ -450,10 +450,52 @@           fetchAndReadSourcePackages             verbosity             distDirLayout+            compiler             projectConfigShared             projectConfigBuildOnly             pkgLocations +      informAboutConfigFiles projectConfig = do+        cwd <- getCurrentDirectory+        let out -- output mode is verbose ('notice') if we build outside the project root+              | cwd == distProjectRootDirectory = info+              | otherwise = notice+        unless (null configFiles)+          . out (verboseStderr verbosity)+          . render+          $ message+        where+          -- message formatting depends on |config files| (the number of config files)+          message = case configFilesDoc of+            (_ : _ : _ : _) ->+              -- if |config files| > 2 then use vertical list+              vcat+                [ affectedByMsg <> text "the following files:"+                , configFilesVertList+                , atProjectRootMsg+                ]+            [path1, path2] ->+              affectedByMsg <> path1 <> text " and " <> (path2 <+> atProjectRootMsg)+            [path] ->+              affectedByMsg <> (path <+> atProjectRootMsg)+            [] ->+              error "impossible" -- see `unless (null configFiles)` above+            where+              configFilesDoc = map (quoteUntrimmed . projectConfigPathRoot) configFiles+              configFilesVertList -- if verbose, include provenance ("imported by" stuff)+                | verbosity < verbose = docProjectConfigFiles configFiles+                | otherwise = vcat $ map (\p -> text "- " <> docProjectConfigPath p) configFiles+              affectedByMsg = text "Configuration is affected by "+              atProjectRootMsg = text "at '" <> text distProjectRootDirectory <> text "'."++          configFiles =+            [ path+            | Explicit path <-+                Set.toList+                  . (if verbosity >= verbose then id else onlyTopLevelProvenance)+                  $ projectConfigProvenance projectConfig+            ]+ configureCompiler   :: Verbosity   -> DistDirLayout@@ -482,48 +524,48 @@      progsearchpath <- liftIO $ getSystemSearchPath -    rerunIfChanged-      verbosity-      fileMonitorCompiler-      ( hcFlavor-      , hcPath-      , hcPkg-      , progsearchpath-      , packageConfigProgramPaths-      , packageConfigProgramPathExtra-      )-      $ do-        liftIO $ info verbosity "Compiler settings changed, reconfiguring..."-        progdb <--          liftIO $-            -- Add paths in the global config-            prependProgramSearchPath verbosity (fromNubList projectConfigProgPathExtra) [] defaultProgramDb-              -- Add paths in the local config-              >>= prependProgramSearchPath verbosity (fromNubList packageConfigProgramPathExtra) []-              >>= pure . userSpecifyPaths (Map.toList (getMapLast packageConfigProgramPaths))-        result@(_, _, progdb') <--          liftIO $-            Cabal.configCompilerEx-              hcFlavor-              hcPath-              hcPkg-              progdb-              verbosity-        -- Note that we added the user-supplied program locations and args-        -- for /all/ programs, not just those for the compiler prog and-        -- compiler-related utils. In principle we don't know which programs-        -- the compiler will configure (and it does vary between compilers).-        -- We do know however that the compiler will only configure the-        -- programs it cares about, and those are the ones we monitor here.-        monitorFiles (programsMonitorFiles progdb')--        -- Note: There is currently a bug here: we are dropping unconfigured-        -- programs from the 'ProgramDb' when we re-use the cache created by-        -- 'rerunIfChanged'.-        ---        -- See Note [Caching the result of configuring the compiler]+    (hc, plat, hcProgDb) <-+      rerunIfChanged+        verbosity+        fileMonitorCompiler+        ( hcFlavor+        , hcPath+        , hcPkg+        , progsearchpath+        , packageConfigProgramPaths+        , packageConfigProgramPathExtra+        )+        $ do+          liftIO $ info verbosity "Compiler settings changed, reconfiguring..."+          progdb <-+            liftIO $+              -- Add paths in the global config+              prependProgramSearchPath verbosity (fromNubList projectConfigProgPathExtra) [] defaultProgramDb+                -- Add paths in the local config+                >>= prependProgramSearchPath verbosity (fromNubList packageConfigProgramPathExtra) []+                >>= pure . userSpecifyPaths (Map.toList (getMapLast packageConfigProgramPaths))+          result@(_, _, progdb') <-+            liftIO $+              Cabal.configCompiler+                hcFlavor+                hcPath+                progdb+                verbosity+          -- Note that we added the user-supplied program locations and args+          -- for /all/ programs, not just those for the compiler prog and+          -- compiler-related utils. In principle we don't know which programs+          -- the compiler will configure (and it does vary between compilers).+          -- We do know however that the compiler will only configure the+          -- programs it cares about, and those are the ones we monitor here.+          monitorFiles (programsMonitorFiles progdb')+          return result -        return result+    -- Now, **outside** of the caching logic of 'rerunIfChanged', add on+    -- auxiliary unconfigured programs to the ProgramDb (e.g. hc-pkg, haddock, ar, ld...).+    --+    -- See Note [Caching the result of configuring the compiler]+    finalProgDb <- liftIO $ Cabal.configCompilerProgDb verbosity hc hcProgDb hcPkg+    return (hc, plat, finalProgDb)     where       hcFlavor = flagToMaybe projectConfigHcFlavor       hcPath = flagToMaybe projectConfigHcPath@@ -541,18 +583,19 @@  - On the first run, we will obtain a 'ProgramDb' which may contain several    unconfigured programs. In particular, configuring GHC will add tools such    as `ar` and `ld` as unconfigured programs to the 'ProgramDb', with custom-   logic for finding their location based on the location of the GHC binary.+   logic for finding their location based on the location of the GHC binary+   and its associated settings file.  - On subsequent runs, if we use the cache created by 'rerunIfChanged', we will    deserialise the 'ProgramDb' from disk, which means it won't include any    unconfigured programs, which might mean we are unable to find 'ar' or 'ld'. -This is not currently a huge problem because, in the Cabal library, we eagerly-re-run the configureCompiler step (thus recovering any lost information), but-this is wasted work that we should stop doing in Cabal, given that cabal-install-has already figured out all the necessary information about the compiler.+To solve this, we cache the ProgramDb containing the compiler (which will be+a configured program, hence properly serialised/deserialised), and then+re-compute any attendant unconfigured programs (such as hc-pkg, haddock or build+tools such as ar, ld) using 'configCompilerProgDb'. -To fix this bug, we can't simply eagerly configure all unconfigured programs,-as was originally attempted, for a couple of reasons:+Another idea would be to simply eagerly configure all unconfigured programs,+as was originally attempted. But this doesn't work, for a couple of reasons:   - it does more work than necessary, by configuring programs that we may not    end up needing,@@ -562,8 +605,8 @@    or by package-level `extra-prog-path` arguments.    This lead to bug reports #10633 and #10692. -See #9840 for more information about the problems surrounding the lossly-Binary ProgramDb instance.+See #9840 for more information about the problems surrounding the lossy+'Binary ProgramDb' instance. -}  ------------------------------------------------------------------------------@@ -679,7 +722,7 @@        -- Configuring other programs.       ---      -- Having configred the compiler, now we configure all the remaining+      -- Having configured the compiler, now we configure all the remaining       -- programs. This is to check we can find them, and to monitor them for       -- changes.       --@@ -949,7 +992,7 @@       buildReports       platform   where-    -- TODO may want to handle the projectConfigLogFile paramenter here, or just remove it entirely?+    -- TODO may want to handle the projectConfigLogFile parameter here, or just remove it entirely?      reportFailure = Cabal.fromFlag . projectConfigReportPlanningFailure . projectConfigBuildOnly $ projectConfig     pkgids = mapMaybe theSpecifiedPackage pkgSpecifiers@@ -1706,19 +1749,17 @@           why_not_per_component g =             cuz_buildtype ++ cuz_spec ++ cuz_length ++ cuz_flag             where-              -- We have to disable per-component for now with-              -- Configure-type scripts in order to prevent parallel-              -- invocation of the same `./configure` script.-              -- See https://github.com/haskell/cabal/issues/4548-              ---              -- Moreover, at this point in time, only non-Custom setup scripts-              -- are supported.  Implementing per-component builds with-              -- Custom would require us to create a new 'ElabSetup'-              -- type, and teach all of the code paths how to handle it.+              -- Custom and Hooks are not implemented. Implementing+              -- per-component builds with Custom would require us to create a+              -- new 'ElabSetup' type, and teach all of the code paths how to+              -- handle it.               -- Once you've implemented this, swap it for the code below.               cuz_buildtype =                 case bt of-                  PD.Configure -> [CuzBuildType CuzConfigureBuildType]+                  PD.Configure -> []+                  -- Configure is supported, but we only support configuring the+                  -- main library in cabal. Other components will need to depend+                  -- on the main library for configured data.                   PD.Custom -> [CuzBuildType CuzCustomBuildType]                   PD.Hooks -> [CuzBuildType CuzHooksBuildType]                   PD.Make -> [CuzBuildType CuzMakeBuildType]@@ -2183,7 +2224,7 @@             elabPkgDescription = case PD.finalizePD               flags               elabEnabledSpec-              (const True)+              (const Satisfied)               platform               (compilerInfo compiler)               []@@ -2275,10 +2316,15 @@                 { withVanillaLib = perPkgOptionFlag pkgid True packageConfigVanillaLib -- TODO: [required feature]: also needs to be handled recursively                 , withSharedLib = canBuildSharedLibs && pkgid `Set.member` pkgsUseSharedLibrary                 , withStaticLib = perPkgOptionFlag pkgid False packageConfigStaticLib-                , withDynExe = perPkgOptionFlag pkgid False packageConfigDynExe+                , withDynExe =+                    perPkgOptionFlag pkgid False packageConfigDynExe+                      -- We can't produce a dynamic executable if the user+                      -- wants to enable executable profiling but the+                      -- compiler doesn't support prof+dyn.+                      && (okProfDyn || not profExe)                 , withFullyStaticExe = perPkgOptionFlag pkgid False packageConfigFullyStaticExe                 , withGHCiLib = perPkgOptionFlag pkgid False packageConfigGHCiLib -- TODO: [required feature] needs to default to enabled on windows still-                , withProfExe = perPkgOptionFlag pkgid False packageConfigProf+                , withProfExe = profExe                 , withProfLib = canBuildProfilingLibs && pkgid `Set.member` pkgsUseProfilingLibrary                 , withProfLibShared = canBuildProfilingSharedLibs && pkgid `Set.member` pkgsUseProfilingLibraryShared                 , exeCoverage = perPkgOptionFlag pkgid False packageConfigCoverage@@ -2293,6 +2339,8 @@                 , withProfLibDetail = elabProfExeDetail                 , withProfExeDetail = elabProfLibDetail                 }+            okProfDyn = profilingDynamicSupportedOrUnknown compiler+            profExe = perPkgOptionFlag pkgid False packageConfigProf              ( elabProfExeDetail               , elabProfLibDetail@@ -2328,6 +2376,7 @@                 )                 (perPkgOptionMapMappend pkgid packageConfigProgramArgs)             elabProgramPathExtra = perPkgOptionNubList pkgid packageConfigProgramPathExtra+            elabConfiguredPrograms = configuredPrograms compilerprogdb             elabConfigureScriptArgs = perPkgOptionList pkgid packageConfigConfigureArgs             elabExtraLibDirs = perPkgOptionList pkgid packageConfigExtraLibDirs             elabExtraLibDirsStatic = perPkgOptionList pkgid packageConfigExtraLibDirsStatic@@ -3872,6 +3921,16 @@       , forceExternalSetupMethod = isParallelBuild       , setupCacheLock = Just cacheLock       , isInteractive = False+      , isMainLibOrExeComponent = case elabPkgOrComp of+          -- if it's a package, it's all together, so we have to assume it's+          -- at least a library or executable.+          ElabPackage _ -> True+          -- if it's a component, we have to check if it's a Main Library or Executable+          -- as opposed to SubLib, FLib, Test, Bench, or Setup component.+          ElabComponent (ElaboratedComponent{compSolverName = CD.ComponentLib}) -> True+          ElabComponent (ElaboratedComponent{compSolverName = CD.ComponentExe _}) -> True+          -- everything else is not a main lib or exe component+          ElabComponent _ -> False       }  -- | To be used for the input for elaborateInstallPlan.@@ -4146,14 +4205,16 @@   :: Verbosity   -> Maybe (SymbolicPath CWD (Dir Pkg))   -> SymbolicPath Pkg (Dir Dist)+  -> Bool   -> Cabal.CommonSetupFlags-setupHsCommonFlags verbosity mbWorkDir builddir =+setupHsCommonFlags verbosity mbWorkDir builddir keepTempFiles =   Cabal.CommonSetupFlags     { setupDistPref = toFlag builddir     , setupVerbosity = toFlag verbosity     , setupCabalFilePath = mempty     , setupWorkingDir = maybeToFlag mbWorkDir     , setupTargets = []+    , setupKeepTempFiles = toFlag keepTempFiles     }  setupHsBuildFlags@@ -4282,7 +4343,7 @@ setupHsHaddockFlags   (ElaboratedConfiguredPackage{..})   (ElaboratedSharedConfig{..})-  (BuildTimeSettings{buildSettingKeepTempFiles = keepTmpFiles})+  _buildTimeSettings   common =     Cabal.HaddockFlags       { haddockCommonFlags = common@@ -4310,7 +4371,6 @@       , haddockQuickJump = toFlag elabHaddockQuickJump       , haddockHscolourCss = maybe mempty toFlag elabHaddockHscolourCss       , haddockContents = maybe mempty toFlag elabHaddockContents-      , haddockKeepTempFiles = toFlag keepTmpFiles       , haddockIndex = maybe mempty toFlag elabHaddockIndex       , haddockBaseUrl = maybe mempty toFlag elabHaddockBaseUrl       , haddockResourcesDir = maybe mempty toFlag elabHaddockResourcesDir
src/Distribution/Client/ProjectPlanning/Types.hs view
@@ -3,7 +3,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-}  -- | Types used while planning how to build everything in a project.@@ -58,6 +57,7 @@   , isTestComponentTarget   , isBenchComponentTarget   , componentOptionalStanza+  , componentTargetName      -- * Setup script   , SetupScriptStyle (..)@@ -275,6 +275,7 @@   , elabProgramPaths :: Map String FilePath   , elabProgramArgs :: Map String [String]   , elabProgramPathExtra :: [FilePath]+  , elabConfiguredPrograms :: [ConfiguredProgram]   , elabConfigureScriptArgs :: [String]   , elabExtraLibDirs :: [FilePath]   , elabExtraLibDirsStatic :: [FilePath]@@ -861,6 +862,10 @@  instance Binary ComponentTarget instance Structured ComponentTarget++-- | Extract the component name from a 'ComponentTarget'.+componentTargetName :: ComponentTarget -> ComponentName+componentTargetName (ComponentTarget cname _) = cname  -- | Unambiguously render a 'ComponentTarget', e.g., to pass -- to a Cabal Setup script.
src/Distribution/Client/RebuildMonad.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-}  -- | An abstraction for re-running actions if values or files have changed.@@ -42,6 +43,7 @@   , FileMonitor (..)   , newFileMonitor   , rerunIfChanged+  , rerunConcurrentlyIfChanged      -- * Utils   , delayInitSharedResource@@ -64,11 +66,13 @@ import Distribution.Client.FileMonitor import Distribution.Client.Glob hiding (matchFileGlob) import qualified Distribution.Client.Glob as Glob (matchFileGlob)+import Distribution.Client.JobControl import Distribution.Simple.PreProcess.Types (Suffix (..))  import Distribution.Simple.Utils (debug)  import Control.Concurrent.MVar (MVar, modifyMVar, newMVar)+import Control.Monad import Control.Monad.Reader as Reader import Control.Monad.State as State import qualified Data.Map.Strict as Map@@ -123,39 +127,61 @@   -> Rebuild b   -> Rebuild b rerunIfChanged verbosity monitor key action = do+  -- rerunIfChanged is implemented in terms of rerunConcurrentlyIfChanged, but+  -- nothing concurrent will happen since the list of concurrent actions has a+  -- single value that will be waited for alone.+  rerunConcurrentlyIfChanged verbosity newSerialJobControl [(monitor, key, action)] >>= \case+    [x] -> return x+    _ -> error "rerunIfChanged: impossible!"++-- | Like 'rerunIfChanged' meets 'mapConcurrently': For when we want multiple actions+-- that need to do be re-run-if-changed asynchronously. The function returns+-- when all values have finished computing.+rerunConcurrentlyIfChanged+  :: (Binary a, Structured a, Binary b, Structured b)+  => Verbosity+  -> IO (JobControl IO (b, [MonitorFilePath]))+  -> [(FileMonitor a b, a, Rebuild b)]+  -> Rebuild [b]+rerunConcurrentlyIfChanged verbosity mkJobControl triples = do   rootDir <- askRoot-  changed <- liftIO $ checkFileMonitorChanged monitor rootDir key-  case changed of-    MonitorUnchanged result files -> do-      liftIO $-        debug verbosity $-          "File monitor '"-            ++ monitorName-            ++ "' unchanged."-      monitorFiles files-      return result-    MonitorChanged reason -> do-      liftIO $-        debug verbosity $-          "File monitor '"-            ++ monitorName-            ++ "' changed: "-            ++ showReason reason-      startTime <- liftIO $ beginUpdateFileMonitor-      (result, files) <- liftIO $ unRebuild rootDir action-      liftIO $-        updateFileMonitor-          monitor-          rootDir-          (Just startTime)-          files-          key-          result-      monitorFiles files-      return result-  where-    monitorName = takeFileName (fileMonitorCacheFile monitor)+  dacts <- forM triples $ \(monitor, key, action) -> do+    let monitorName = takeFileName (fileMonitorCacheFile monitor)+    changed <- liftIO $ checkFileMonitorChanged monitor rootDir key+    case changed of+      MonitorUnchanged result files -> do+        liftIO $+          debug verbosity $+            "File monitor '"+              ++ monitorName+              ++ "' unchanged."+        monitorFiles files+        return (return (result, []))+      MonitorChanged reason -> do+        liftIO $+          debug verbosity $+            "File monitor '"+              ++ monitorName+              ++ "' changed: "+              ++ showReason reason+        return $ do+          startTime <- beginUpdateFileMonitor+          (result, files) <- unRebuild rootDir action+          updateFileMonitor+            monitor+            rootDir+            (Just startTime)+            files+            key+            result+          return (result, files) +  (results, files) <- liftIO $+    withJobControl mkJobControl $ \jobControl -> do+      unzip <$> mapConcurrentWithJobs jobControl id dacts+  monitorFiles (concat files)+  return results+  where     showReason (MonitoredFileChanged file) = "file " ++ file     showReason (MonitoredValueChanged _) = "monitor value changed"     showReason MonitorFirstRun = "first run"
src/Distribution/Client/ReplFlags.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE PatternSynonyms #-}+ module Distribution.Client.ReplFlags (EnvFlags (..), ReplFlags (..), topReplOptions, multiReplOption, defaultReplFlags) where  import Distribution.Client.Compat.Prelude@@ -21,13 +23,13 @@   , reqArg   ) import Distribution.Simple.Setup-  ( Flag (..)+  ( Flag   , ReplOptions (..)   , boolOpt   , falseArg   , replOptions   , toFlag-  , trueArg+  , pattern NoFlag   ) import Distribution.Types.Dependency   ( Dependency (..)@@ -55,11 +57,10 @@   { configureReplOptions :: ReplOptions   , replEnvFlags :: EnvFlags   , replUseMulti :: Flag Bool-  , replKeepTempFiles :: Flag Bool   }  instance Semigroup ReplFlags where-  (ReplFlags a1 a2 a3 a4) <> (ReplFlags b1 b2 b3 b4) = ReplFlags (a1 <> b1) (a2 <> b2) (a3 <> b3) (a4 <> b4)+  (ReplFlags a1 a2 a3) <> (ReplFlags b1 b2 b3) = ReplFlags (a1 <> b1) (a2 <> b2) (a3 <> b3)  instance Monoid ReplFlags where   mempty = defaultReplFlags@@ -70,7 +71,6 @@     { configureReplOptions = mempty     , replEnvFlags = defaultEnvFlags     , replUseMulti = NoFlag-    , replKeepTempFiles = NoFlag     }  topReplOptions :: ShowOrParseArgs -> [OptionField ReplFlags]@@ -78,18 +78,6 @@   liftOptions configureReplOptions set1 (replOptions showOrParseArgs)     ++ liftOptions replEnvFlags set2 (envOptions showOrParseArgs)     ++ [ liftOption replUseMulti set3 multiReplOption-       , -- keeping temporary files is important functionality for HLS,-         -- which runs @cabal repl@ with fake GHC to get cli arguments.-         -- It will need the temporary files (incl. multi unit repl response files)-         -- to stay, even after the @cabal repl@ command exits.-         ---         option-          []-          ["keep-temp-files"]-          "Keep temporary files"-          replKeepTempFiles-          (\b flags -> flags{replKeepTempFiles = b})-          trueArg        ]   where     set1 a x = x{configureReplOptions = a}
src/Distribution/Client/Run.hs view
@@ -28,7 +28,7 @@   , TestSuite (..)   ) import Distribution.Simple (PackageDBX (..))-import Distribution.Simple.Build (addInternalBuildToolsFixed)+import Distribution.Simple.Build (addInternalBuildTools) import Distribution.Simple.BuildPaths (exeExtension) import Distribution.Simple.Compiler (CompilerFlavor (..), compilerFlavor) import Distribution.Simple.Flag (fromFlag)@@ -155,8 +155,8 @@           { withPackageDB = withPackageDB lbi ++ [SpecificPackageDB internalPkgDb]           , -- Include any build-tool-depends on build tools internal to the current package.             withPrograms =-              addInternalBuildToolsFixed-                (Just curDir)+              addInternalBuildTools+                curDir                 pkg_descr                 lbi                 (buildInfo exe)
src/Distribution/Client/Sandbox.hs view
@@ -48,7 +48,7 @@ import qualified Distribution.Simple.LocalBuildInfo as LocalBuildInfo import Distribution.Simple.Program (ProgramDb) import Distribution.Simple.Setup-  ( Flag (..)+  ( Flag   , flagToMaybe   , fromFlagOrDefault   )
src/Distribution/Client/Sandbox/PackageEnvironment.hs view
@@ -55,7 +55,7 @@ import Distribution.Simple.InstallDirs (InstallDirs (..), PathTemplate) import Distribution.Simple.Setup   ( ConfigFlags (..)-  , Flag (..)+  , Flag   , HaddockFlags (..)   ) import Distribution.Simple.Utils (debug, warn)
src/Distribution/Client/ScriptUtils.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-}  -- | Utilities to help commands with scripts@@ -75,9 +76,7 @@   ( runRebuild   ) import Distribution.Client.Setup-  ( CommonSetupFlags (..)-  , ConfigFlags (..)-  , GlobalFlags (..)+  ( GlobalFlags (..)   ) import Distribution.Client.TargetSelector   ( TargetSelectorProblem (..)@@ -117,7 +116,6 @@ import Distribution.Simple.Compiler   ( Compiler (..)   , OptimisationLevel (..)-  , compilerInfo   ) import Distribution.Simple.Flag   ( flagToMaybe@@ -127,7 +125,7 @@   ( parseString   ) import Distribution.Simple.Setup-  ( Flag (..)+  ( pattern Flag   ) import Distribution.Simple.Utils   ( createDirectoryIfMissingVerbose@@ -177,9 +175,6 @@ import Distribution.Utils.NubList   ( fromNubList   )-import Distribution.Verbosity-  ( normal-  ) import Language.Haskell.Extension   ( Language (..)   )@@ -281,7 +276,8 @@ -- In the case that the context refers to a temporary directory, -- delete it after the action finishes. withContextAndSelectors-  :: AcceptNoTargets+  :: Verbosity+  -> AcceptNoTargets   -- ^ What your command should do when no targets are found.   -> Maybe ComponentKind   -- ^ A target filter@@ -296,7 +292,7 @@   -> (TargetContext -> ProjectBaseContext -> [TargetSelector] -> IO b)   -- ^ The body of your command action.   -> IO b-withContextAndSelectors noTargets kind flags@NixStyleFlags{..} targetStrings globalFlags cmd act =+withContextAndSelectors verbosity noTargets kind flags@NixStyleFlags{..} targetStrings globalFlags cmd act =   withTemporaryTempDirectory $ \mkTmpDir -> do     (tc, ctx) <-       withProjectOrGlobalConfig@@ -318,13 +314,13 @@           Left (TargetSelectorNoTargetsInCwd{} : _)             | [] <- targetStrings             , AcceptNoTargets <- noTargets ->-                return (tc, ctx, defaultTarget)+                return (tc, ctx, [])           Left err@(TargetSelectorNoTargetsInProject : _)             -- If there are no target selectors and no targets are fine, return             -- the context             | [] <- targetStrings             , AcceptNoTargets <- noTargets ->-                return (tc, ctx, defaultTarget)+                return (tc, ctx, [])             | (script : _) <- targetStrings -> scriptOrError script err           Left err@(TargetSelectorNoSuch t _ : _)             | TargetString1 script <- t -> scriptOrError script err@@ -337,7 +333,6 @@      act tc' ctx' sels   where-    verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags)     ignoreProject = flagIgnoreProject projectFlags     cliConfig = commandLineFlagsToProjectConfig globalFlags flags mempty     globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig)@@ -381,7 +376,7 @@           createDirectoryIfMissingVerbose verbosity True (distProjectCacheDirectory $ distDirLayout ctx)           (compiler, platform@(Platform arch os), _) <- runRebuild projectRoot $ configureCompiler verbosity (distDirLayout ctx) (fst (ignoreConditions projectCfgSkeleton) <> projectConfig ctx) -          projectCfg <- instantiateProjectConfigSkeletonFetchingCompiler (pure (os, arch, compilerInfo compiler)) mempty projectCfgSkeleton+          (projectCfg, _) <- instantiateProjectConfigSkeletonFetchingCompiler (pure (os, arch, compiler)) mempty projectCfgSkeleton            let ctx' = ctx & lProjectConfig %~ (<> projectCfg) @@ -414,8 +409,8 @@       return tmpDir     rmTmp m _ = tryTakeMVar m >>= maybe (return ()) (handleDoesNotExist () . removeDirectoryRecursive) -scriptComponenetName :: IsString s => FilePath -> s-scriptComponenetName scriptPath = fromString cname+scriptComponentName :: IsString s => FilePath -> s+scriptComponentName scriptPath = fromString cname   where     cname = "script-" ++ map censor (takeFileName scriptPath)     censor c@@ -437,7 +432,7 @@     , distParamOptimization = fromFlagOrDefault NormalOptimisation optimization     }   where-    cn = scriptComponenetName scriptPath+    cn = scriptComponentName scriptPath     cid = mkComponentId $ prettyShow fakePackageId <> "-inplace-" <> prettyShow cn     optimization = (packageConfigOptimization . projectConfigLocalPackages . projectConfig) ctx @@ -475,7 +470,7 @@     sourcePackage =       fakeProjectSourcePackage projectRoot         & lSrcpkgDescription . L.condExecutables-          .~ [(scriptComponenetName scriptPath, CondNode executable (targetBuildDepends $ buildInfo executable) [])]+          .~ [(scriptComponentName scriptPath, CondNode executable (targetBuildDepends $ buildInfo executable) [])]     executable =       scriptExecutable         & L.modulePath .~ absScript
src/Distribution/Client/Security/HTTP.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-}-{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-}
src/Distribution/Client/Setup.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RankNTypes #-}-{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}  -----------------------------------------------------------------------------@@ -35,12 +35,15 @@   , defaultConfigExFlags   , buildCommand   , BuildFlags (..)+  , filterBuildFlags   , filterTestFlags   , replCommand+  , filterReplFlags   , testCommand   , benchmarkCommand   , testOptions   , benchmarkOptions+  , filterBenchmarkFlags   , configureExOptions   , reconfigureCommand   , installCommand@@ -87,7 +90,9 @@   , haddockCommand   , cleanCommand   , copyCommand+  , filterCopyFlags   , registerCommand+  , filterRegisterFlags   , liftOptions   , yesNoOpt   ) where@@ -165,7 +170,7 @@   , interpretPackageDbFlags   ) import Distribution.Simple.Flag-  ( Flag (..)+  ( Flag   , flagElim   , flagToList   , flagToMaybe@@ -173,6 +178,8 @@   , maybeToFlag   , mergeListFlag   , toFlag+  , pattern Flag+  , pattern NoFlag   ) import Distribution.Simple.InstallDirs   ( InstallDirs (..)@@ -183,7 +190,7 @@   ) import Distribution.Simple.Program (ProgramDb, defaultProgramDb) import Distribution.Simple.Setup-  ( BenchmarkFlags+  ( BenchmarkFlags (benchmarkCommonFlags)   , BooleanFlag (..)   , BuildFlags (..)   , CleanFlags (..)@@ -192,7 +199,7 @@   , CopyFlags (..)   , HaddockFlags (..)   , RegisterFlags (..)-  , ReplFlags+  , ReplFlags (..)   , TestFlags   , boolOpt   , boolOpt'@@ -278,6 +285,7 @@               , "unpack"               , "init"               , "configure"+              , "target"               , "build"               , "clean"               , "run"@@ -298,6 +306,7 @@               , "path"               , "new-build"               , "new-configure"+              , "new-target"               , "new-repl"               , "new-freeze"               , "new-run"@@ -330,7 +339,8 @@               , "v1-register"               , "v1-reconfigure"               , -- v2 commands, nix-style-                "v2-build"+                "v2-target"+              , "v2-build"               , "v2-configure"               , "v2-repl"               , "v2-freeze"@@ -375,6 +385,7 @@                 , addCmd "gen-bounds"                 , addCmd "outdated"                 , addCmd "path"+                , addCmd "target"                 , par                 , startGroup "project building and installing"                 , addCmd "build"@@ -402,6 +413,7 @@                 , addCmd "hscolour"                 , par                 , startGroup "new-style projects (forwards-compatible aliases)"+                , addCmd "v2-target"                 , addCmd "v2-build"                 , addCmd "v2-configure"                 , addCmd "v2-repl"@@ -647,9 +659,11 @@     flags_latest = flags     flags_3_13_0 =       flags_latest-        { setupWorkingDir = NoFlag+        { -- Cabal < 3.13 does not support the --working-dir flag.+          setupWorkingDir = NoFlag+        , -- Or the --keep-temp-files flag.+          setupKeepTempFiles = NoFlag         }-    -- Cabal < 3.13 does not support the --working-dir flag.     flags_2_1_0 =       flags_3_13_0         { -- Cabal < 2.1 doesn't know about -v +timestamp modifier@@ -1144,6 +1158,21 @@   where     parent = Cabal.buildCommand defaultProgramDb +-- | Given some 'BuildFlags' for the version of @Cabal@ that+-- @cabal-install@ was built with, and a target older 'Version' of+-- @Cabal@ that we want to pass these flags to, convert the+-- flags into a form that will be accepted by the older+-- @Setup@ script.  Generally speaking, this just means filtering+-- out flags that the old @Cabal@ library doesn't understand, but+-- in some cases it may also mean "emulating" a feature using+-- some more legacy flags.+filterBuildFlags :: BuildFlags -> Version -> BuildFlags+filterBuildFlags flags cabalLibVersion =+  flags+    { buildCommonFlags =+        filterCommonFlags (buildCommonFlags flags) cabalLibVersion+    }+ -- ------------------------------------------------------------  -- * Test flags@@ -1236,6 +1265,24 @@   where     parent = Cabal.replCommand defaultProgramDb +-- | Given some 'ReplFlags' for the version of @Cabal@ that+-- @cabal-install@ was built with, and a target older 'Version' of+-- @Cabal@ that we want to pass these flags to, convert the+-- flags into a form that will be accepted by the older+-- @Setup@ script.  Generally speaking, this just means filtering+-- out flags that the old @Cabal@ library doesn't understand, but+-- in some cases it may also mean "emulating" a feature using+-- some more legacy flags.+filterReplFlags :: ReplFlags -> Version -> ReplFlags+filterReplFlags flags cabalLibVersion =+  flags+    { replCommonFlags =+        (filterCommonFlags (replCommonFlags flags) cabalLibVersion)+          { -- `cabal repl` knew about `--keep-temp-files` before other commands did.+            setupKeepTempFiles = setupKeepTempFiles (replCommonFlags flags)+          }+    }+ -- ------------------------------------------------------------  -- * Test command@@ -1331,6 +1378,21 @@     parent = Cabal.benchmarkCommand     progDb = defaultProgramDb +-- | Given some 'BenchmarkFlags' for the version of @Cabal@ that+-- @cabal-install@ was built with, and a target older 'Version' of+-- @Cabal@ that we want to pass these flags to, convert the+-- flags into a form that will be accepted by the older+-- @Setup@ script.  Generally speaking, this just means filtering+-- out flags that the old @Cabal@ library doesn't understand, but+-- in some cases it may also mean "emulating" a feature using+-- some more legacy flags.+filterBenchmarkFlags :: BenchmarkFlags -> Version -> BenchmarkFlags+filterBenchmarkFlags flags cabalLibVersion =+  flags+    { benchmarkCommonFlags =+        filterCommonFlags (benchmarkCommonFlags flags) cabalLibVersion+    }+ -- ------------------------------------------------------------  -- * Fetch command@@ -2404,21 +2466,28 @@     -- Cabal < 2.3 doesn't know about per-component haddock     args_2_3_0 = [] +-- | Given some 'HaddockFlags' for the version of @Cabal@ that+-- @cabal-install@ was built with, and a target older 'Version' of+-- @Cabal@ that we want to pass these flags to, convert the+-- flags into a form that will be accepted by the older+-- @Setup@ script.  Generally speaking, this just means filtering+-- out flags that the old @Cabal@ library doesn't understand, but+-- in some cases it may also mean "emulating" a feature using+-- some more legacy flags. filterHaddockFlags :: HaddockFlags -> Version -> HaddockFlags-filterHaddockFlags flags cabalLibVersion =-  let flags' = filterHaddockFlags' flags cabalLibVersion-   in flags'-        { haddockCommonFlags =-            filterCommonFlags (haddockCommonFlags flags') cabalLibVersion-        }--filterHaddockFlags' :: HaddockFlags -> Version -> HaddockFlags-filterHaddockFlags' flags cabalLibVersion+filterHaddockFlags flags cabalLibVersion   | cabalLibVersion >= mkVersion [2, 3, 0] = flags_latest   | cabalLibVersion < mkVersion [2, 3, 0] = flags_2_3_0   | otherwise = flags_latest   where-    flags_latest = flags+    flags_latest =+      flags+        { haddockCommonFlags =+            (filterCommonFlags (haddockCommonFlags flags) cabalLibVersion)+              { -- `cabal haddock` knew about `--keep-temp-files` before other commands did.+                setupKeepTempFiles = setupKeepTempFiles (haddockCommonFlags flags)+              }+        }      flags_2_3_0 =       flags_latest@@ -2490,6 +2559,9 @@       | "test-" `isPrefixOf` name = name       | otherwise = "test-" ++ name +-- | Options for the @bench@ command.+--+-- Not to be confused with the @benchmarkOptions@ field of the `BenchmarkFlags` record! benchmarkOptions :: ShowOrParseArgs -> [OptionField BenchmarkFlags] benchmarkOptions showOrParseArgs =   [ opt@@ -3315,6 +3387,35 @@ registerCommand =   Cabal.registerCommand     { commandUsage = \pname -> "Usage: " ++ pname ++ " v1-register [FLAGS]\n"+    }++-- | Given some 'RegisterFlags' for the version of @Cabal@ that+-- @cabal-install@ was built with, and a target older 'Version' of+-- @Cabal@ that we want to pass these flags to, convert the+-- flags into a form that will be accepted by the older+-- @Setup@ script.  Generally speaking, this just means filtering+-- out flags that the old @Cabal@ library doesn't understand, but+-- in some cases it may also mean "emulating" a feature using+-- some more legacy flags.+filterRegisterFlags :: RegisterFlags -> Version -> RegisterFlags+filterRegisterFlags flags cabalLibVersion =+  flags+    { registerCommonFlags =+        filterCommonFlags (registerCommonFlags flags) cabalLibVersion+    }++-- | Given some 'CopyFlags' for the version of @Cabal@ that+-- @cabal-install@ was built with, and a target older 'Version' of+-- @Cabal@ that we want to pass these flags to, convert the+-- flags into a form that will be accepted by the older+-- @Setup@ script.  Generally speaking, this just means filtering+-- out flags that the old @Cabal@ library doesn't understand, but+-- in some cases it may also mean "emulating" a feature using+-- some more legacy flags.+filterCopyFlags :: CopyFlags -> Version -> CopyFlags+filterCopyFlags flags cabalLibVersion =+  flags+    { copyCommonFlags = filterCommonFlags (copyCommonFlags flags) cabalLibVersion     }  -- ------------------------------------------------------------
src/Distribution/Client/SetupWrapper.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-} {- FOURMOLU_DISABLE -}  -----------------------------------------------------------------------------@@ -144,7 +145,7 @@   ) import Distribution.Simple.Setup   ( CommonSetupFlags (..)-  , Flag (..)+  , pattern Flag   , GlobalFlags (..)   , globalCommand   )@@ -314,6 +315,12 @@   -- ^ Is the task we are going to run an interactive foreground task,   -- or an non-interactive background task? Based on this flag we   -- decide whether or not to delegate ctrl+c to the spawned task+  , isMainLibOrExeComponent :: Bool+  -- ^ Let the setup script logic know if it is being run to build a main+  -- library or executable component.  This is used to determine if we should+  -- use the configure command, if the build-type is 'Configure'.  For+  -- configure, only the main library and execomponents have 'configure'+  -- support, and thus we can skip running configure for other components.   }  defaultSetupScriptOptions :: SetupScriptOptions@@ -338,6 +345,7 @@     , forceExternalSetupMethod = False     , setupCacheLock = Nothing     , isInteractive = False+    , isMainLibOrExeComponent = True     }  workingDir :: SetupScriptOptions -> FilePath@@ -374,7 +382,14 @@                 (useCabalVersion options)                 (orLaterVersion (mkVersion (cabalSpecMinimumLibraryVersion (specVersion pkg))))           }-      buildType' = buildType pkg+      -- We retain Configure only for the main library and executable components.+      -- For other components, we rewrite the buildType to Simple to skip the+      -- configure step.  This is because the configure step is not supported for+      -- other components.  Configure can only impact MainLib and Exe through+      -- .buildinfo files.+      buildType' = case (buildType pkg, isMainLibOrExeComponent options) of+        (Configure, False) -> Simple+        (bt, _) -> bt   (version, method, options'') <-     getSetupMethod verbosity options' pkg buildType'   return
src/Distribution/Client/Tar.hs view
@@ -1,5 +1,4 @@-{-# LANGUAGE DeriveFunctor #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-}  -----------------------------------------------------------------------------
src/Distribution/Client/TargetSelector.hs view
@@ -1,11 +1,10 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} -- TODO-{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}  -----------------------------------------------------------------------------
src/Distribution/Client/Targets.hs view
@@ -669,7 +669,7 @@  instance Pretty UserConstraint where   pretty (UserConstraint scope prop) =-    dispPackageConstraint $ PackageConstraint (fromUserConstraintScope scope) prop+    pretty $ PackageConstraint (fromUserConstraintScope scope) prop  instance Parsec UserConstraint where   parsec = do
src/Distribution/Client/Types.hs view
@@ -1,8 +1,3 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-}  -----------------------------------------------------------------------------
src/Distribution/Client/Utils.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-}  module Distribution.Client.Utils@@ -69,7 +70,7 @@ import Distribution.Client.Errors import Distribution.Compat.Environment import Distribution.Compat.Time (getModTime)-import Distribution.Simple.Setup (Flag (..))+import Distribution.Simple.Setup (Flag, pattern Flag, pattern NoFlag) import Distribution.Simple.Utils (dieWithException, findPackageDesc, noticeNoWrap) import Distribution.Utils.Path   ( CWD
src/Distribution/Client/VCS.hs view
@@ -64,6 +64,10 @@ import Distribution.Simple.Program.Db   ( prependProgramSearchPath   )+import Distribution.System+  ( OS (Windows)+  , buildOS+  ) import Distribution.Types.SourceRepo   ( KnownRepoType (..)   , RepoType (..)@@ -92,7 +96,9 @@ import qualified Data.Map as Map import System.Directory   ( doesDirectoryExist+  , doesFileExist   , removeDirectoryRecursive+  , removePathForcibly   ) import System.FilePath   ( takeDirectory@@ -100,7 +106,9 @@   ) import System.IO.Error   ( isDoesNotExistError+  , isPermissionError   )+import qualified System.Process as Process  -- | A driver for a version control system, e.g. git, darcs etc. data VCS program = VCS@@ -461,11 +469,18 @@       [programInvocation prog cloneArgs]         -- And if there's a tag, we have to do that in a second step:         ++ [git (resetArgs tag) | tag <- maybeToList (srpTag repo)]-        ++ [ git (["submodule", "sync", "--recursive"] ++ verboseArg)-           , git (["submodule", "update", "--init", "--force", "--recursive"] ++ verboseArg)+        ++ [ whenGitModulesExists $ git $ ["submodule", "sync", "--recursive"] ++ verboseArg+           , whenGitModulesExists $ git $ ["submodule", "update", "--init", "--force", "--recursive"] ++ verboseArg            ]       where         git args = (programInvocation prog args){progInvokeCwd = Just destdir}++        gitModulesPath = destdir </> ".gitmodules"+        whenGitModulesExists invocation =+          invocation+            { progInvokeWhen = doesFileExist gitModulesPath+            }+         cloneArgs =           ["clone", srcuri, destdir]             ++ branchArgs@@ -476,6 +491,9 @@         resetArgs tag = "reset" : verboseArg ++ ["--hard", tag, "--"]         verboseArg = ["--quiet" | verbosity < Verbosity.normal] +    -- Note: No --depth=1 for vcsCloneRepo since that is used for `cabal get -s`,+    -- whereas `vcsSyncRepo` is used for source-repository-package where we do want shallow clones.+     vcsSyncRepos       :: Verbosity       -> ConfiguredProgram@@ -496,6 +514,8 @@           | dir <- (primaryLocalDir : map snd secondaryRepos)           ] +    -- NOTE: Repositories are cloned once, but can be synchronized multiple times.+    -- Therefore, this code has to work with both `git clone` and `git fetch`.     vcsSyncRepo verbosity gitProg SourceRepositoryPackage{..} localDir peer = do       exists <- doesDirectoryExist localDir       if exists@@ -506,14 +526,79 @@       -- is needed because sometimes `git submodule sync` does not actually       -- update the submodule source URL. Detailed description here:       -- https://git.coop/-/snippets/85-      git localDir ["submodule", "deinit", "--force", "--all"]-      let gitModulesDir = localDir </> ".git" </> "modules"-      gitModulesExists <- doesDirectoryExist gitModulesDir-      when gitModulesExists $ removeDirectoryRecursive gitModulesDir-      git localDir resetArgs-      git localDir $ ["submodule", "sync", "--recursive"] ++ verboseArg-      git localDir $ ["submodule", "update", "--force", "--init", "--recursive"] ++ verboseArg-      git localDir $ ["submodule", "foreach", "--recursive"] ++ verboseArg ++ ["git clean -ffxdq"]+      let dotGitModulesPath = localDir </> ".git" </> "modules"+          gitModulesPath = localDir </> ".gitmodules"++      -- Remove any `.git/modules` if they exist.+      dotGitModulesExists <- doesDirectoryExist dotGitModulesPath+      when dotGitModulesExists $ do+        git localDir $ ["submodule", "deinit", "--force", "--all"] ++ verboseArg+        if buildOS == Windows+          then do+            -- Windows can't delete some git files #10182+            void $+              Process.createProcess_ "attrib" $+                Process.shell $+                  "attrib -s -h -r " <> dotGitModulesPath <> "\\*.* /s /d"++            catch+              (removePathForcibly dotGitModulesPath)+              (\e -> if isPermissionError e then removePathForcibly dotGitModulesPath else throw e)+          else removeDirectoryRecursive dotGitModulesPath++      -- If we want a particular branch or tag, fetch it.+      ref <- case srpBranch `mplus` srpTag of+        Nothing -> pure "HEAD"+        Just ref -> do+          -- /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\+          -- /!\            MULTIPLE HOURS HAVE BEEN LOST HERE!!             /!\+          -- /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\ /!\+          --+          -- If you run `git fetch origin MY_TAG`, then the tag _will_ be+          -- fetched, but no local ref (e.g. `refs/tags/MY_TAG`) will be+          -- created.+          --+          -- This means that doing `git fetch origin MY_TAG && git reset --hard+          -- MY_TAG` will fail with a message like `unknown revision MY_TAG`.+          --+          -- There are two ways around this:+          --+          -- 1. Provide a refmap explicitly:+          --+          --        git fetch --refmap="+refs/tags/*:refs/tags/*" origin MYTAG+          --+          --    This tells Git to create local tags matching remote tags. It's+          --    not in the default refmap so you need to set it explicitly.+          --    (You can also set it with `git config set --local+          --    remote.origin.fetch ...`.)+          --+          -- 2. Use `FETCH_HEAD` directly: Git writes a `FETCH_HEAD` ref+          --    containing the commit that was just fetched. This feels a bit+          --    nasty but seems to work reliably, even if nothing was fetched.+          --    (That is, deleting `FETCH_HEAD` and re-running a `git fetch`+          --    command will succesfully recreate the `FETCH_HEAD` ref.)+          --+          -- Option 2 is what Cabal has done historically, and we're keeping it+          -- for now. Option 1 is possible but seems to have little benefit.+          git localDir ("fetch" : verboseArg ++ ["origin", ref])+          pure "FETCH_HEAD"++      -- Then, reset to the appropriate ref.+      git localDir $+        "reset"+          : verboseArg+          ++ [ "--hard"+             , ref+             , "--"+             ]++      -- We need to check if `.gitmodules` exists _after_ the `git reset` call.+      gitModulesExists <- doesFileExist gitModulesPath+      when gitModulesExists $ do+        git localDir $ ["submodule", "sync", "--recursive"] ++ verboseArg+        git localDir $ ["submodule", "update", "--force", "--init", "--recursive"] ++ verboseArg+        git localDir $ ["submodule", "foreach", "--recursive"] ++ verboseArg ++ ["git clean -ffxdq"]+       git localDir $ ["clean", "-ffxdq"]       where         git :: FilePath -> [String] -> IO ()@@ -524,15 +609,14 @@               }          cloneArgs =-          ["clone", "--no-checkout", loc, localDir]+          ["clone", "--depth=1", "--no-checkout", loc, localDir]             ++ case peer of               Nothing -> []               Just peerLocalDir -> ["--reference", peerLocalDir]             ++ verboseArg           where             loc = srpLocation-        resetArgs = "reset" : verboseArg ++ ["--hard", resetTarget, "--"]-        resetTarget = fromMaybe "HEAD" (srpBranch `mplus` srpTag)+         verboseArg = ["--quiet" | verbosity < Verbosity.normal]  gitProgram :: Program
src/Distribution/Client/Version.hs view
@@ -1,13 +1,53 @@+{-# LANGUAGE CPP #-}+#ifdef GIT_REV+{-# LANGUAGE TemplateHaskell #-}+#endif+ -- | Provides the version number of @cabal-install@. module Distribution.Client.Version   ( cabalInstallVersion+  , cabalInstallGitInfo   ) where  import Distribution.Version  import qualified Paths_cabal_install as PackageInfo +#ifdef GIT_REV+import Data.Either (isLeft)+import GitHash+  ( giHash+  , giBranch+  , giCommitDate+  , tGitInfoCwdTry+  )+#endif+ -- | -- This value determines the output of `cabal-install --version`. cabalInstallVersion :: Version cabalInstallVersion = mkVersion' PackageInfo.version++-- |+-- `cabal-install` Git information. Only filled in if built in a Git tree in+-- developmnent mode and Template Haskell is available.+cabalInstallGitInfo :: String+#ifdef GIT_REV+cabalInstallGitInfo = if giHash' == ""+                        then ""+                        else concat [ "(commit "+                                    , giHash'+                                    , branchInfo+                                    , ", "+                                    , either (const "") giCommitDate gi'+                                    , ")"+                                    ]+  where+    gi' = $$tGitInfoCwdTry+    giHash' = take 7 . either (const "") giHash $ gi'+    branchInfo | isLeft gi' = ""+               | either id giBranch gi' == "master" = ""+               | otherwise = " on " <> either id giBranch gi'+#else+cabalInstallGitInfo = ""+#endif
src/Distribution/Client/Win32SelfUpgrade.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE ForeignFunctionInterface #-}  ----------------------------------------------------------------------------- @@ -167,7 +166,7 @@ -- A bunch of functions sadly not provided by the Win32 package.  {- FOURMOLU_DISABLE -}-#ifdef x86_64_HOST_ARCH+#if defined(x86_64_HOST_ARCH) || defined(aarch64_HOST_ARCH) #define CALLCONV ccall #else #define CALLCONV stdcall
src/Distribution/Deprecated/ParseUtils.hs view
@@ -44,6 +44,7 @@   , showFreeText   , field   , simpleField+  , monoidField   , listField   , listFieldWithSep   , spaceListField@@ -52,6 +53,7 @@   , readPToMaybe   , fieldParsec   , simpleFieldParsec+  , monoidFieldParsec   , listFieldParsec   , commaListFieldParsec   , commaNewLineListFieldParsec@@ -90,6 +92,7 @@   = AmbiguousParse String LineNo   | NoParse String LineNo   | TabsError LineNo+  | FieldShouldBeStanza String LineNo   | FromString String (Maybe LineNo)   deriving (Eq, Show) @@ -185,6 +188,10 @@   , "Parse of field '" ++ f ++ "' failed."   ) locatedErrorMsg (TabsError n) = (Just n, "Tab used as indentation.")+locatedErrorMsg (FieldShouldBeStanza name lineNumber) =+  ( Just lineNumber+  , "'" ++ name ++ "' is a stanza, not a field. Remove the trailing ':' to parse a stanza."+  ) locatedErrorMsg (FromString s n) = (n, s)  syntaxError :: LineNo -> String -> ParseResult a@@ -248,6 +255,32 @@   -> FieldDescr b simpleFieldParsec name showF readF get set =   liftField get set $ fieldParsec name showF readF++monoidField+  :: Semigroup a+  => String+  -> (a -> Doc)+  -> ReadP a a+  -> (b -> a)+  -> (a -> b -> b)+  -> FieldDescr b+monoidField name showF readF get set =+  liftField get set' $ field name showF readF+  where+    set' xs b = set (get b <> xs) b++monoidFieldParsec+  :: Semigroup a+  => String+  -> (a -> Doc)+  -> ParsecParser a+  -> (b -> a)+  -> (a -> b -> b)+  -> FieldDescr b+monoidFieldParsec name showF readF get set =+  liftField get set' $ fieldParsec name showF readF+  where+    set' xs b = set (get b <> xs) b  commaListFieldWithSepParsec   :: Separator
+ src/Distribution/Deprecated/ProjectParseUtils.hs view
@@ -0,0 +1,51 @@+{-# OPTIONS_HADDOCK hide #-}++module Distribution.Deprecated.ProjectParseUtils+  ( ProjectParseError (..)+  , ProjectParseWarning+  , ProjectParseResult (..)+  , projectParseFail+  , projectParse+  ) where++import Distribution.Client.Compat.Prelude hiding (get)+import Prelude ()++import qualified Distribution.Deprecated.ParseUtils as Pkg (PError, PWarning, ParseResult (..))+import Distribution.Solver.Types.ProjectConfigPath (ProjectConfigPath)++type ProjectParseWarning = (ProjectConfigPath, Pkg.PWarning)++data ProjectParseError = ProjectParseError+  { projectParseSnippet :: Maybe String+  , projectParseSource :: Maybe ProjectConfigPath+  , projectParseError :: Pkg.PError+  }+  deriving (Show)++data ProjectParseResult a+  = ProjectParseFailed ProjectParseError+  | ProjectParseOk [ProjectParseWarning] a+  deriving (Show)++projectParse :: Maybe String -> ProjectConfigPath -> Pkg.ParseResult a -> ProjectParseResult a+projectParse s path (Pkg.ParseFailed err) = ProjectParseFailed $ ProjectParseError s (Just path) err+projectParse _ path (Pkg.ParseOk ws x) = ProjectParseOk [(path, w) | w <- ws] x++instance Functor ProjectParseResult where+  fmap _ (ProjectParseFailed err) = ProjectParseFailed err+  fmap f (ProjectParseOk ws x) = ProjectParseOk ws $ f x++instance Applicative ProjectParseResult where+  pure = ProjectParseOk []+  (<*>) = ap++instance Monad ProjectParseResult where+  return = pure+  ProjectParseFailed err >>= _ = ProjectParseFailed err+  ProjectParseOk ws x >>= f = case f x of+    ProjectParseFailed err -> ProjectParseFailed err+    ProjectParseOk ws' x' -> ProjectParseOk (ws' ++ ws) x'++projectParseFail :: Maybe String -> Maybe ProjectConfigPath -> Pkg.PError -> ProjectParseResult a+projectParseFail s p e = ProjectParseFailed $ ProjectParseError s p e
tests/IntegrationTests2.hs view
@@ -1,2261 +1,2820 @@-{- FOURMOLU_DISABLE -}-{-# LANGUAGE CPP #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE OverloadedStrings #-}---- For the handy instance IsString PackageIdentifier-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Main where--import Distribution.Client.Compat.Prelude-import Prelude ()--import Distribution.Client.DistDirLayout-import Distribution.Client.ProjectConfig-import Distribution.Client.HttpUtils-import Distribution.Client.TargetSelector hiding (DirActions(..))-import qualified Distribution.Client.TargetSelector as TS (DirActions(..))-import Distribution.Client.ProjectPlanning-import Distribution.Client.ProjectPlanning.Types-import Distribution.Client.ProjectBuilding-import Distribution.Client.ProjectOrchestration-         ( resolveTargets, distinctTargetComponents )-import Distribution.Client.TargetProblem-         ( TargetProblem', TargetProblem (..) )-import Distribution.Client.Types-         ( PackageLocation(..), UnresolvedSourcePackage-         , PackageSpecifier(..) )-import Distribution.Client.Targets-         ( UserConstraint(..), UserConstraintScope(UserAnyQualifier) )-import qualified Distribution.Client.InstallPlan as InstallPlan-import Distribution.Solver.Types.SourcePackage as SP-import Distribution.Solver.Types.ConstraintSource-         ( ConstraintSource(ConstraintSourceUnknown) )-import Distribution.Solver.Types.PackageConstraint-         ( PackageProperty(PackagePropertySource) )--import qualified Distribution.Client.CmdBuild          as CmdBuild-import qualified Distribution.Client.CmdRepl           as CmdRepl-import qualified Distribution.Client.CmdRun            as CmdRun-import qualified Distribution.Client.CmdTest           as CmdTest-import qualified Distribution.Client.CmdBench          as CmdBench-import qualified Distribution.Client.CmdHaddock        as CmdHaddock-import qualified Distribution.Client.CmdListBin        as CmdListBin--import qualified Distribution.Client.CmdHaddockProject as CmdHaddockProject-import Distribution.Client.Config (SavedConfig (savedGlobalFlags), createDefaultConfigFile, loadConfig)-import Distribution.Client.GlobalFlags-  ( GlobalFlags-  , defaultGlobalFlags-  , globalNix-  )-import Distribution.Client.Setup (globalCommand, globalStoreDir)-import Distribution.ModuleName (ModuleName)-import Distribution.Package-import Distribution.PackageDescription-import Distribution.InstalledPackageInfo (InstalledPackageInfo)-import Distribution.Simple.Setup- ( toFlag,- HaddockFlags(..),- defaultHaddockFlags,- HaddockProjectFlags(..),- defaultHaddockProjectFlags )-import Distribution.Simple.Compiler-import Distribution.Simple.Command-import qualified Distribution.Simple.Flag as Flag-import Distribution.System-import Distribution.Version-import Distribution.Text-import Distribution.Utils.Path (unsafeMakeSymbolicPath)--import qualified Data.Map as Map-import qualified Data.Set as Set-import Data.List (isInfixOf)--import Control.Monad-import Control.Concurrent (threadDelay)-import Control.Exception hiding (assert)-import System.FilePath-import System.Directory-import System.Environment (setEnv)-import System.IO (hPutStrLn, stderr)-import System.Process (callProcess)--import Test.Tasty-import Test.Tasty.HUnit-import Test.Tasty.Options-import Data.Tagged (Tagged(..))--import qualified Data.ByteString as BS-import Data.Maybe (fromJust)-import Distribution.Simple.Flag (Flag (Flag, NoFlag))-import Distribution.Types.ParStrat--#if !MIN_VERSION_directory(1,2,7)-removePathForcibly :: FilePath -> IO ()-removePathForcibly = removeDirectoryRecursive-#endif--main :: IO ()-main = do-  -- this is needed to ensure tests aren't affected by the user's cabal config-  cwd <- getCurrentDirectory-  let configDir = cwd </> basedir </> "config" </> "cabal-config"-  setEnv "CABAL_DIR" configDir-  removeDirectoryRecursive configDir <|> return ()-  createDirectoryIfMissing True configDir-  -- sigh-  callProcess "cabal" ["user-config", "init", "-f"]-  callProcess "cabal" ["update"]-  defaultMainWithIngredients-    (defaultIngredients ++ [includingOptions projectConfigOptionDescriptions])-    (withProjectConfig $ \config ->-      testGroup "Integration tests (internal)"-                (tests config))---tests :: ProjectConfig -> [TestTree]-tests config =-    --TODO: tests for:-    -- * normal success-    -- * dry-run tests with changes-  [ testGroup "Discovery and planning" $-    [ testCase "no package"    (testExceptionInFindingPackage config)-    , testCase "no package2"   (testExceptionInFindingPackage2 config)-    , testCase "proj conf1"    (testExceptionInProjectConfig config)-    ]-  , testGroup "Target selectors" $-    [ testCaseSteps "valid"              testTargetSelectors-    , testCase      "bad syntax"         testTargetSelectorBadSyntax-    , testCaseSteps "ambiguous syntax"   testTargetSelectorAmbiguous-    , testCase      "no current pkg"     testTargetSelectorNoCurrentPackage-    , testCase      "no targets"         testTargetSelectorNoTargets-    , testCase      "project empty"      testTargetSelectorProjectEmpty-    , testCase      "canonicalized path" testTargetSelectorCanonicalizedPath-    , testCase      "problems (common)"  (testTargetProblemsCommon config)-    , testCaseSteps "problems (build)"   (testTargetProblemsBuild config)-    , testCaseSteps "problems (repl)"    (testTargetProblemsRepl config)-    , testCaseSteps "problems (run)"     (testTargetProblemsRun config)-    , testCaseSteps "problems (list-bin)" (testTargetProblemsListBin config)-    , testCaseSteps "problems (test)"    (testTargetProblemsTest config)-    , testCaseSteps "problems (bench)"   (testTargetProblemsBench config)-    , testCaseSteps "problems (haddock)" (testTargetProblemsHaddock config)-    ]-  , testGroup "Exceptions during building (local inplace)" $-    [ testCase "configure"   (testExceptionInConfigureStep config)-    , testCase "build"       (testExceptionInBuildStep config)---    , testCase "register"   testExceptionInRegisterStep-    ]-    --TODO: need to repeat for packages for the store-    --TODO: need to check we can build sub-libs, foreign libs and exes-    -- components for non-local packages / packages in the store.--  , testGroup "Successful builds" $-    [ testCaseSteps "Setup script styles" (testSetupScriptStyles config)-    , testCase      "keep-going"          (testBuildKeepGoing config)-#ifndef mingw32_HOST_OS-    -- disabled because https://github.com/haskell/cabal/issues/6272-    , testCase      "local tarball"       (testBuildLocalTarball config)-#endif-    ]--  , testGroup "Regression tests" $-    [ testCase "issue #3324" (testRegressionIssue3324 config)-    , testCase "program options scope all" (testProgramOptionsAll config)-    , testCase "program options scope local" (testProgramOptionsLocal config)-    , testCase "program options scope specific" (testProgramOptionsSpecific config)-    ]-  , testGroup "Flag tests" $-    [-      testCase "Test Nix Flag" testNixFlags,-      testCase "Test Config options for commented options" testConfigOptionComments,-      testCase "Test Ignore Project Flag" testIgnoreProjectFlag-    ]-  , testGroup "haddock-project"-    [ testCase "dependencies" (testHaddockProjectDependencies config)-    ]-  ]--testTargetSelectors :: (String -> IO ()) -> Assertion-testTargetSelectors reportSubCase = do-    (_, _, _, localPackages, _) <- configureProject testdir config-    let readTargetSelectors' = readTargetSelectorsWith (dirActions testdir)-                                                       localPackages-                                                       Nothing--    reportSubCase "cwd"-    do Right ts <- readTargetSelectors' []-       ts @?= [TargetPackage TargetImplicitCwd ["p-0.1"] Nothing]--    reportSubCase "all"-    do Right ts <- readTargetSelectors'-                     ["all", ":all"]-       ts @?= replicate 2 (TargetAllPackages Nothing)--    reportSubCase "filter"-    do Right ts <- readTargetSelectors'-                     [ "libs",  ":cwd:libs"-                     , "flibs", ":cwd:flibs"-                     , "exes",  ":cwd:exes"-                     , "tests", ":cwd:tests"-                     , "benchmarks", ":cwd:benchmarks"]-       zipWithM_ (@?=) ts-         [ TargetPackage TargetImplicitCwd ["p-0.1"] (Just kind)-         | kind <- concatMap (replicate 2) [LibKind .. ]-         ]--    reportSubCase "all:filter"-    do Right ts <- readTargetSelectors'-                     [ "all:libs",  ":all:libs"-                     , "all:flibs", ":all:flibs"-                     , "all:exes",  ":all:exes"-                     , "all:tests", ":all:tests"-                     , "all:benchmarks", ":all:benchmarks"]-       zipWithM_ (@?=) ts-         [ TargetAllPackages (Just kind)-         | kind <- concatMap (replicate 2) [LibKind .. ]-         ]--    reportSubCase "pkg"-    do Right ts <- readTargetSelectors'-                     [       ":pkg:p", ".",  "./",   "p.cabal"-                     , "q",  ":pkg:q", "q/", "./q/", "q/q.cabal"]-       ts @?= replicate 4 (mkTargetPackage "p-0.1")-           ++ replicate 5 (mkTargetPackage "q-0.1")--    reportSubCase "pkg:filter"-    do Right ts <- readTargetSelectors'-                     [ "p:libs",  ".:libs",  ":pkg:p:libs"-                     , "p:flibs", ".:flibs", ":pkg:p:flibs"-                     , "p:exes",  ".:exes",  ":pkg:p:exes"-                     , "p:tests", ".:tests",  ":pkg:p:tests"-                     , "p:benchmarks", ".:benchmarks", ":pkg:p:benchmarks"-                     , "q:libs",  "q/:libs", ":pkg:q:libs"-                     , "q:flibs", "q/:flibs", ":pkg:q:flibs"-                     , "q:exes",  "q/:exes", ":pkg:q:exes"-                     , "q:tests", "q/:tests", ":pkg:q:tests"-                     , "q:benchmarks", "q/:benchmarks", ":pkg:q:benchmarks"]-       zipWithM_ (@?=) ts $-         [ TargetPackage TargetExplicitNamed ["p-0.1"] (Just kind)-         | kind <- concatMap (replicate 3) [LibKind .. ]-         ] ++-         [ TargetPackage TargetExplicitNamed ["q-0.1"] (Just kind)-         | kind <- concatMap (replicate 3) [LibKind .. ]-         ]--    reportSubCase "component"-    do Right ts <- readTargetSelectors'-                     [ "p", "lib:p", "p:lib:p", ":pkg:p:lib:p"-                     ,      "lib:q", "q:lib:q", ":pkg:q:lib:q" ]-       ts @?= replicate 4 (TargetComponent "p-0.1" (CLibName LMainLibName) WholeComponent)-           ++ replicate 3 (TargetComponent "q-0.1" (CLibName LMainLibName) WholeComponent)--    reportSubCase "module"-    do Right ts <- readTargetSelectors'-                     [ "P", "lib:p:P", "p:p:P", ":pkg:p:lib:p:module:P"-                     , "QQ", "lib:q:QQ", "q:q:QQ", ":pkg:q:lib:q:module:QQ"-                     , "pexe:PMain" -- p:P or q:QQ would be ambiguous here-                     , "qexe:QMain" -- package p vs component p-                     ]-       ts @?= replicate 4 (TargetComponent "p-0.1" (CLibName LMainLibName) (ModuleTarget "P"))-           ++ replicate 4 (TargetComponent "q-0.1" (CLibName LMainLibName) (ModuleTarget "QQ"))-           ++ [ TargetComponent "p-0.1" (CExeName "pexe") (ModuleTarget "PMain")-              , TargetComponent "q-0.1" (CExeName "qexe") (ModuleTarget "QMain")-              ]--    reportSubCase "file"-    do Right ts <- readTargetSelectors'-                     [ "./P.hs", "p:P.lhs", "lib:p:P.hsc", "p:p:P.hsc",-                                 ":pkg:p:lib:p:file:P.y"-                     , "q/QQ.hs", "q:QQ.lhs", "lib:q:QQ.hsc", "q:q:QQ.hsc",-                                  ":pkg:q:lib:q:file:QQ.y"-                     , "q/Q.hs", "q:Q.lhs", "lib:q:Q.hsc", "q:q:Q.hsc",-                                  ":pkg:q:lib:q:file:Q.y"-                     , "app/Main.hs", "p:app/Main.hs", "exe:ppexe:app/Main.hs", "p:ppexe:app/Main.hs",-                                  ":pkg:p:exe:ppexe:file:app/Main.hs"-                     , "a p p/Main.hs", "p:a p p/Main.hs", "exe:pppexe:a p p/Main.hs", "p:pppexe:a p p/Main.hs",-                                  ":pkg:p:exe:pppexe:file:a p p/Main.hs"-                     ]-       ts @?= replicate 5 (TargetComponent "p-0.1" (CLibName LMainLibName) (FileTarget "P"))-           ++ replicate 5 (TargetComponent "q-0.1" (CLibName LMainLibName) (FileTarget "QQ"))-           ++ replicate 5 (TargetComponent "q-0.1" (CLibName LMainLibName) (FileTarget "Q"))-           ++ replicate 5 (TargetComponent "p-0.1" (CExeName "ppexe") (FileTarget ("app" </> "Main.hs")))-           ++ replicate 5 (TargetComponent "p-0.1" (CExeName "pppexe") (FileTarget ("a p p" </> "Main.hs")))-       -- Note there's a bit of an inconsistency here: for the single-part-       -- syntax the target has to point to a file that exists, whereas for-       -- all the other forms we don't require that.--    cleanProject testdir-  where-    testdir = "targets/simple"-    config  = mempty---testTargetSelectorBadSyntax :: Assertion-testTargetSelectorBadSyntax = do-    (_, _, _, localPackages, _) <- configureProject testdir config-    let targets = [ "foo:", "foo::bar"-                  , " :foo", "foo: :bar"-                  , "a:b:c:d:e:f", "a:b:c:d:e:f:g:h" ]-    Left errs <- readTargetSelectors localPackages Nothing targets-    zipWithM_ (@?=) errs (map TargetSelectorUnrecognised targets)-    cleanProject testdir-  where-    testdir = "targets/empty"-    config  = mempty---testTargetSelectorAmbiguous :: (String -> IO ()) -> Assertion-testTargetSelectorAmbiguous reportSubCase = do--    -- 'all' is ambiguous with packages and cwd components-    reportSubCase "ambiguous: all vs pkg"-    assertAmbiguous "all"-      [mkTargetPackage "all", mkTargetAllPackages]-      [mkpkg "all" []]--    reportSubCase "ambiguous: all vs cwd component"-    assertAmbiguous "all"-      [mkTargetComponent "other" (CExeName "all"), mkTargetAllPackages]-      [mkpkg "other" [mkexe "all"]]--    -- but 'all' is not ambiguous with non-cwd components, modules or files-    reportSubCase "unambiguous: all vs non-cwd comp, mod, file"-    assertUnambiguous "All"-      mkTargetAllPackages-      [ mkpkgAt "foo" [mkexe "All"] "foo"-      , mkpkg   "bar" [ mkexe "bar" `withModules` ["All"]-                      , mkexe "baz" `withCFiles` ["All"] ]-      ]--    -- filters 'libs', 'exes' etc are ambiguous with packages and-    -- local components-    reportSubCase "ambiguous: cwd-pkg filter vs pkg"-    assertAmbiguous "libs"-      [ mkTargetPackage "libs"-      , TargetPackage TargetImplicitCwd ["libs"] (Just LibKind) ]-      [mkpkg "libs" []]--    reportSubCase "ambiguous: filter vs cwd component"-    assertAmbiguous "exes"-      [ mkTargetComponent "other" (CExeName "exes")-      , TargetPackage TargetImplicitCwd ["other"] (Just ExeKind) ]-      [mkpkg "other" [mkexe "exes"]]--    -- but filters are not ambiguous with non-cwd components, modules or files-    reportSubCase "unambiguous: filter vs non-cwd comp, mod, file"-    assertUnambiguous "Libs"-      (TargetPackage TargetImplicitCwd ["bar"] (Just LibKind))-      [ mkpkgAt "foo" [mkexe "Libs"] "foo"-      , mkpkg   "bar" [ mkexe "bar" `withModules` ["Libs"]-                      , mkexe "baz" `withCFiles` ["Libs"] ]-      ]--    -- local components shadow packages and other components-    reportSubCase "unambiguous: cwd comp vs pkg, non-cwd comp"-    assertUnambiguous "foo"-      (mkTargetComponent "other" (CExeName "foo"))-      [ mkpkg   "other"  [mkexe "foo"]-      , mkpkgAt "other2" [mkexe "foo"] "other2" -- shadows non-local foo-      , mkpkg "foo" [] ]                        -- shadows package foo--    -- local components shadow modules and files-    reportSubCase "unambiguous: cwd comp vs module, file"-    assertUnambiguous "Foo"-      (mkTargetComponent "bar" (CExeName "Foo"))-      [ mkpkg "bar" [mkexe "Foo"]-      , mkpkg "other" [ mkexe "other"  `withModules` ["Foo"]-                      , mkexe "other2" `withCFiles`  ["Foo"] ]-      ]--    -- packages shadow non-local components-    reportSubCase "unambiguous: pkg vs non-cwd comp"-    assertUnambiguous "foo"-      (mkTargetPackage "foo")-      [ mkpkg "foo" []-      , mkpkgAt "other" [mkexe "foo"] "other" -- shadows non-local foo-      ]--    -- packages shadow modules and files-    reportSubCase "unambiguous: pkg vs module, file"-    assertUnambiguous "Foo"-      (mkTargetPackage "Foo")-      [ mkpkgAt "Foo" [] "foo"-      , mkpkg "other" [ mkexe "other"  `withModules` ["Foo"]-                      , mkexe "other2" `withCFiles`  ["Foo"] ]-      ]--    -- File target is ambiguous, part of multiple components-    reportSubCase "ambiguous: file in multiple comps"-    assertAmbiguous "Bar.hs"-      [ mkTargetFile "foo" (CExeName "bar")  "Bar"-      , mkTargetFile "foo" (CExeName "bar2") "Bar"-      ]-      [ mkpkg "foo" [ mkexe "bar"  `withModules` ["Bar"]-                    , mkexe "bar2" `withModules` ["Bar"] ]-      ]-    reportSubCase "ambiguous: file in multiple comps with path"-    assertAmbiguous ("src" </> "Bar.hs")-      [ mkTargetFile "foo" (CExeName "bar")  ("src" </> "Bar")-      , mkTargetFile "foo" (CExeName "bar2") ("src" </> "Bar")-      ]-      [ mkpkg "foo" [ mkexe "bar"  `withModules` ["Bar"] `withHsSrcDirs` ["src"]-                    , mkexe "bar2" `withModules` ["Bar"] `withHsSrcDirs` ["src"] ]-      ]--    -- non-exact case packages and components are ambiguous-    reportSubCase "ambiguous: non-exact-case pkg names"-    assertAmbiguous "Foo"-      [ mkTargetPackage "foo", mkTargetPackage "FOO" ]-      [ mkpkg "foo" [], mkpkg "FOO" [] ]-    reportSubCase "ambiguous: non-exact-case comp names"-    assertAmbiguous "Foo"-      [ mkTargetComponent "bar" (CExeName "foo")-      , mkTargetComponent "bar" (CExeName "FOO") ]-      [ mkpkg "bar" [mkexe "foo", mkexe "FOO"] ]--    -- exact-case Module or File over non-exact case package or component-    reportSubCase "unambiguous: module vs non-exact-case pkg, comp"-    assertUnambiguous "Baz"-      (mkTargetModule "other" (CExeName "other") "Baz")-      [ mkpkg "baz" [mkexe "BAZ"]-      , mkpkg "other" [ mkexe "other"  `withModules` ["Baz"] ]-      ]-    reportSubCase "unambiguous: file vs non-exact-case pkg, comp"-    assertUnambiguous "Baz"-      (mkTargetFile "other" (CExeName "other") "Baz")-      [ mkpkg "baz" [mkexe "BAZ"]-      , mkpkg "other" [ mkexe "other"  `withCFiles` ["Baz"] ]-      ]-  where-    assertAmbiguous :: String-                    -> [TargetSelector]-                    -> [SourcePackage (PackageLocation a)]-                    -> Assertion-    assertAmbiguous str tss pkgs = do-      res <- readTargetSelectorsWith-               fakeDirActions-               (map SpecificSourcePackage pkgs)-               Nothing-               [str]-      case res of-        Left [TargetSelectorAmbiguous _ tss'] ->-          sort (map snd tss') @?= sort tss-        _ -> assertFailure $ "expected Left [TargetSelectorAmbiguous _ _], "-                          ++ "got " ++ show res--    assertUnambiguous :: String-                      -> TargetSelector-                      -> [SourcePackage (PackageLocation a)]-                      -> Assertion-    assertUnambiguous str ts pkgs = do-      res <- readTargetSelectorsWith-               fakeDirActions-               (map SpecificSourcePackage pkgs)-               Nothing-               [str]-      case res of-        Right [ts'] -> ts' @?= ts-        _ -> assertFailure $ "expected Right [Target...], "-                          ++ "got " ++ show res--    fakeDirActions = TS.DirActions {-      TS.doesFileExist       = \_p -> return True,-      TS.doesDirectoryExist  = \_p -> return True,-      TS.canonicalizePath    = \p -> return ("/" </> p), -- FilePath.Unix.</> ?-      TS.getCurrentDirectory = return "/"-    }--    mkpkg :: String -> [Executable] -> SourcePackage (PackageLocation a)-    mkpkg pkgidstr exes = mkpkgAt pkgidstr exes ""--    mkpkgAt :: String -> [Executable] -> FilePath-            -> SourcePackage (PackageLocation a)-    mkpkgAt pkgidstr exes loc =-      SourcePackage {-        srcpkgPackageId = pkgid,-        srcpkgSource = LocalUnpackedPackage loc,-        srcpkgDescrOverride  = Nothing,-        srcpkgDescription = GenericPackageDescription {-          packageDescription = emptyPackageDescription { package = pkgid },-          gpdScannedVersion  = Nothing,-          genPackageFlags    = [],-          condLibrary        = Nothing,-          condSubLibraries   = [],-          condForeignLibs    = [],-          condExecutables    = [ ( exeName exe, CondNode exe [] [] )-                               | exe <- exes ],-          condTestSuites     = [],-          condBenchmarks     = []-        }-      }-      where-        pkgid = fromMaybe (error $ "failed to parse " ++ pkgidstr) $ simpleParse pkgidstr--    mkexe :: String -> Executable-    mkexe name = mempty { exeName = fromString name }--    withModules :: Executable -> [String] -> Executable-    withModules exe mods =-      exe { buildInfo = (buildInfo exe) { otherModules = map fromString mods } }--    withCFiles :: Executable -> [FilePath] -> Executable-    withCFiles exe files =-      exe { buildInfo = (buildInfo exe) { cSources = map unsafeMakeSymbolicPath files } }--    withHsSrcDirs :: Executable -> [FilePath] -> Executable-    withHsSrcDirs exe srcDirs =-      exe { buildInfo = (buildInfo exe) { hsSourceDirs = map unsafeMakeSymbolicPath srcDirs }}---mkTargetPackage :: PackageId -> TargetSelector-mkTargetPackage pkgid =-    TargetPackage TargetExplicitNamed [pkgid] Nothing--mkTargetComponent :: PackageId -> ComponentName -> TargetSelector-mkTargetComponent pkgid cname =-    TargetComponent pkgid cname WholeComponent--mkTargetModule :: PackageId -> ComponentName -> ModuleName -> TargetSelector-mkTargetModule pkgid cname mname =-    TargetComponent pkgid cname (ModuleTarget mname)--mkTargetFile :: PackageId -> ComponentName -> String -> TargetSelector-mkTargetFile pkgid cname fname =-    TargetComponent pkgid cname (FileTarget fname)--mkTargetAllPackages :: TargetSelector-mkTargetAllPackages = TargetAllPackages Nothing--instance IsString PackageIdentifier where-    fromString pkgidstr = pkgid-      where pkgid = fromMaybe (error $ "fromString @PackageIdentifier " ++ show pkgidstr) $ simpleParse pkgidstr---testTargetSelectorNoCurrentPackage :: Assertion-testTargetSelectorNoCurrentPackage = do-    (_, _, _, localPackages, _) <- configureProject testdir config-    let readTargetSelectors' = readTargetSelectorsWith (dirActions testdir)-                                                       localPackages-                                                       Nothing-        targets = [ "libs",  ":cwd:libs"-                  , "flibs", ":cwd:flibs"-                  , "exes",  ":cwd:exes"-                  , "tests", ":cwd:tests"-                  , "benchmarks", ":cwd:benchmarks"]-    Left errs <- readTargetSelectors' targets-    zipWithM_ (@?=) errs-      [ TargetSelectorNoCurrentPackage ts-      | target <- targets-      , let ts = fromMaybe (error $ "failed to parse target string " ++ target) $ parseTargetString target-      ]-    cleanProject testdir-  where-    testdir = "targets/complex"-    config  = mempty---testTargetSelectorNoTargets :: Assertion-testTargetSelectorNoTargets = do-    (_, _, _, localPackages, _) <- configureProject testdir config-    Left errs <- readTargetSelectors localPackages Nothing []-    errs @?= [TargetSelectorNoTargetsInCwd True]-    cleanProject testdir-  where-    testdir = "targets/complex"-    config  = mempty---testTargetSelectorProjectEmpty :: Assertion-testTargetSelectorProjectEmpty = do-    (_, _, _, localPackages, _) <- configureProject testdir config-    Left errs <- readTargetSelectors localPackages Nothing []-    errs @?= [TargetSelectorNoTargetsInProject]-    cleanProject testdir-  where-    testdir = "targets/empty"-    config  = mempty----- | Ensure we don't miss primary package and produce--- TargetSelectorNoTargetsInCwd error due to symlink or--- drive capitalisation mismatch when no targets are given-testTargetSelectorCanonicalizedPath :: Assertion-testTargetSelectorCanonicalizedPath = do-  (_, _, _, localPackages, _) <- configureProject testdir config-  cwd <- getCurrentDirectory-  let virtcwd = cwd </> basedir </> symlink-  -- Check that the symlink is there before running test as on Windows-  -- some versions/configurations of git won't pull down/create the symlink-  canRunTest <- doesDirectoryExist virtcwd-  when canRunTest (do-      let dirActions' = (dirActions symlink) { TS.getCurrentDirectory = return virtcwd }-      Right ts <- readTargetSelectorsWith dirActions' localPackages Nothing []-      ts @?= [TargetPackage TargetImplicitCwd ["p-0.1"] Nothing])-  cleanProject testdir-  where-    testdir = "targets/simple"-    symlink = "targets/symbolic-link-to-simple"-    config = mempty---testTargetProblemsCommon :: ProjectConfig -> Assertion-testTargetProblemsCommon config0 = do-    (_,elaboratedPlan,_) <- planProject testdir config--    let pkgIdMap :: Map.Map PackageName PackageId-        pkgIdMap = Map.fromList-                     [ (packageName p, packageId p)-                     | p <- InstallPlan.toList elaboratedPlan ]--        cases :: [( TargetSelector -> TargetProblem'-                  , TargetSelector-                  )]-        cases =-          [ -- Cannot resolve packages outside of the project-            ( \_ -> TargetProblemNoSuchPackage "foobar"-            , mkTargetPackage "foobar" )--            -- We cannot currently build components like testsuites or-            -- benchmarks from packages that are not local to the project-          , ( \_ -> TargetComponentNotProjectLocal-                      (pkgIdMap Map.! "filepath") (CTestName "filepath-tests")-                      WholeComponent-            , mkTargetComponent (pkgIdMap Map.! "filepath")-                                (CTestName "filepath-tests") )--            -- Components can be explicitly @buildable: False@-          , ( \_ -> TargetComponentNotBuildable "q-0.1" (CExeName "buildable-false") WholeComponent-            , mkTargetComponent "q-0.1" (CExeName "buildable-false") )--            -- Testsuites and benchmarks can be disabled by the solver if it-            -- cannot satisfy deps-          , ( \_ -> TargetOptionalStanzaDisabledBySolver "q-0.1" (CTestName "solver-disabled") WholeComponent-            , mkTargetComponent "q-0.1" (CTestName "solver-disabled") )--            -- Testsuites and benchmarks can be disabled explicitly by the-            -- user via config-          , ( \_ -> TargetOptionalStanzaDisabledByUser-                      "q-0.1" (CBenchName "user-disabled") WholeComponent-            , mkTargetComponent "q-0.1" (CBenchName "user-disabled") )--            -- An unknown package. The target selector resolution should only-            -- produce known packages, so this should not happen with the-            -- output from 'readTargetSelectors'.-          , ( \_ -> TargetProblemNoSuchPackage "foobar"-            , mkTargetPackage "foobar" )--            -- An unknown component of a known package. The target selector-            -- resolution should only produce known packages, so this should-            -- not happen with the output from 'readTargetSelectors'.-          , ( \_ -> TargetProblemNoSuchComponent "q-0.1" (CExeName "no-such")-            , mkTargetComponent "q-0.1" (CExeName "no-such") )-          ]-    assertTargetProblems-      elaboratedPlan-      CmdBuild.selectPackageTargets-      CmdBuild.selectComponentTarget-      cases-  where-    testdir = "targets/complex"-    config  = config0 {-      projectConfigLocalPackages = (projectConfigLocalPackages config0) {-        packageConfigBenchmarks = toFlag False-      }-    , projectConfigShared = (projectConfigShared config0) {-        projectConfigConstraints =-          [( UserConstraint (UserAnyQualifier "filepath") PackagePropertySource-           , ConstraintSourceUnknown )]-      }-    }---testTargetProblemsBuild :: ProjectConfig -> (String -> IO ()) -> Assertion-testTargetProblemsBuild config reportSubCase = do--    reportSubCase "empty-pkg"-    assertProjectTargetProblems-      "targets/empty-pkg" config-      CmdBuild.selectPackageTargets-      CmdBuild.selectComponentTarget-      [ ( TargetProblemNoTargets, mkTargetPackage "p-0.1" )-      ]--    reportSubCase "all-disabled"-    assertProjectTargetProblems-      "targets/all-disabled"-      config {-        projectConfigLocalPackages = (projectConfigLocalPackages config) {-          packageConfigBenchmarks = toFlag False-        }-      }-      CmdBuild.selectPackageTargets-      CmdBuild.selectComponentTarget-      [ ( flip TargetProblemNoneEnabled-               [ AvailableTarget "p-0.1" (CBenchName "user-disabled")-                                 TargetDisabledByUser True-               , AvailableTarget "p-0.1" (CTestName "solver-disabled")-                                 TargetDisabledBySolver True-               , AvailableTarget "p-0.1" (CExeName "buildable-false")-                                 TargetNotBuildable True-               , AvailableTarget "p-0.1" (CLibName LMainLibName)-                                 TargetNotBuildable True-               ]-        , mkTargetPackage "p-0.1" )-      ]--    reportSubCase "enabled component kinds"-    -- When we explicitly enable all the component kinds then selecting the-    -- whole package selects those component kinds too-    do (_,elaboratedPlan,_) <- planProject "targets/variety" config {-           projectConfigLocalPackages = (projectConfigLocalPackages config) {-             packageConfigTests      = toFlag True,-             packageConfigBenchmarks = toFlag True-           }-         }-       assertProjectDistinctTargets-         elaboratedPlan-         CmdBuild.selectPackageTargets-         CmdBuild.selectComponentTarget-         [ mkTargetPackage "p-0.1" ]-         [ ("p-0.1-inplace",             (CLibName LMainLibName))-         , ("p-0.1-inplace-a-benchmark", CBenchName "a-benchmark")-         , ("p-0.1-inplace-a-testsuite", CTestName  "a-testsuite")-         , ("p-0.1-inplace-an-exe",      CExeName   "an-exe")-         , ("p-0.1-inplace-libp",        CFLibName  "libp")-         ]--    reportSubCase "disabled component kinds"-    -- When we explicitly disable all the component kinds then selecting the-    -- whole package only selects the library, foreign lib and exes-    do (_,elaboratedPlan,_) <- planProject "targets/variety" config {-           projectConfigLocalPackages = (projectConfigLocalPackages config) {-             packageConfigTests      = toFlag False,-             packageConfigBenchmarks = toFlag False-           }-         }-       assertProjectDistinctTargets-         elaboratedPlan-         CmdBuild.selectPackageTargets-         CmdBuild.selectComponentTarget-         [ mkTargetPackage "p-0.1" ]-         [ ("p-0.1-inplace",        (CLibName LMainLibName))-         , ("p-0.1-inplace-an-exe", CExeName  "an-exe")-         , ("p-0.1-inplace-libp",   CFLibName "libp")-         ]--    reportSubCase "requested component kinds"-    -- When we selecting the package with an explicit filter then we get those-    -- components even though we did not explicitly enable tests/benchmarks-    do (_,elaboratedPlan,_) <- planProject "targets/variety" config-       assertProjectDistinctTargets-         elaboratedPlan-         CmdBuild.selectPackageTargets-         CmdBuild.selectComponentTarget-         [ TargetPackage TargetExplicitNamed ["p-0.1"] (Just TestKind)-         , TargetPackage TargetExplicitNamed ["p-0.1"] (Just BenchKind)-         ]-         [ ("p-0.1-inplace-a-benchmark", CBenchName "a-benchmark")-         , ("p-0.1-inplace-a-testsuite", CTestName  "a-testsuite")-         ]---testTargetProblemsRepl :: ProjectConfig -> (String -> IO ()) -> Assertion-testTargetProblemsRepl config reportSubCase = do--    reportSubCase "multiple-libs"-    assertProjectTargetProblems-      "targets/multiple-libs" config-      (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False))-      CmdRepl.selectComponentTarget-      [ ( flip (CmdRepl.matchesMultipleProblem (CmdRepl.MultiReplDecision Nothing False))-               [ AvailableTarget "p-0.1" (CLibName LMainLibName)-                   (TargetBuildable () TargetRequestedByDefault) True-               , AvailableTarget "q-0.1" (CLibName LMainLibName)-                   (TargetBuildable () TargetRequestedByDefault) True-               ]-        , mkTargetAllPackages )-      ]--    reportSubCase "multiple-exes"-    assertProjectTargetProblems-      "targets/multiple-exes" config-      (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False))-      CmdRepl.selectComponentTarget-      [ ( flip (CmdRepl.matchesMultipleProblem (CmdRepl.MultiReplDecision Nothing False))-               [ AvailableTarget "p-0.1" (CExeName "p2")-                   (TargetBuildable () TargetRequestedByDefault) True-               , AvailableTarget "p-0.1" (CExeName "p1")-                   (TargetBuildable () TargetRequestedByDefault) True-               ]-        , mkTargetPackage "p-0.1" )-      ]--    reportSubCase "multiple-tests"-    assertProjectTargetProblems-      "targets/multiple-tests" config-      (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False))-      CmdRepl.selectComponentTarget-      [ ( flip (CmdRepl.matchesMultipleProblem (CmdRepl.MultiReplDecision Nothing False))-               [ AvailableTarget "p-0.1" (CTestName "p2")-                   (TargetBuildable () TargetNotRequestedByDefault) True-               , AvailableTarget "p-0.1" (CTestName "p1")-                   (TargetBuildable () TargetNotRequestedByDefault) True-               ]-        , TargetPackage TargetExplicitNamed ["p-0.1"] (Just TestKind) )-      ]--    reportSubCase "multiple targets"-    do (_,elaboratedPlan,_) <- planProject "targets/multiple-exes" config-       assertProjectDistinctTargets-         elaboratedPlan-         (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False))-         CmdRepl.selectComponentTarget-         [ mkTargetComponent "p-0.1" (CExeName "p1")-         , mkTargetComponent "p-0.1" (CExeName "p2")-         ]-         [ ("p-0.1-inplace-p1", CExeName "p1")-         , ("p-0.1-inplace-p2", CExeName "p2")-         ]--    reportSubCase "libs-disabled"-    assertProjectTargetProblems-      "targets/libs-disabled" config-      (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False))-      CmdRepl.selectComponentTarget-      [ ( flip TargetProblemNoneEnabled-               [ AvailableTarget "p-0.1" (CLibName LMainLibName) TargetNotBuildable True ]-        , mkTargetPackage "p-0.1" )-      ]--    reportSubCase "exes-disabled"-    assertProjectTargetProblems-      "targets/exes-disabled" config-      (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False))-      CmdRepl.selectComponentTarget-      [ ( flip TargetProblemNoneEnabled-               [ AvailableTarget "p-0.1" (CExeName "p") TargetNotBuildable True-               ]-        , mkTargetPackage "p-0.1" )-      ]--    reportSubCase "test-only"-    assertProjectTargetProblems-      "targets/test-only" config-      (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False))-      CmdRepl.selectComponentTarget-      [ ( flip TargetProblemNoneEnabled-               [ AvailableTarget "p-0.1" (CTestName "pexe")-                   (TargetBuildable () TargetNotRequestedByDefault) True-               ]-        , mkTargetPackage "p-0.1" )-      ]--    reportSubCase "empty-pkg"-    assertProjectTargetProblems-      "targets/empty-pkg" config-      (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False))-      CmdRepl.selectComponentTarget-      [ ( TargetProblemNoTargets, mkTargetPackage "p-0.1" )-      ]--    reportSubCase "requested component kinds"-    do (_,elaboratedPlan,_) <- planProject "targets/variety" config-       -- by default we only get the lib-       assertProjectDistinctTargets-         elaboratedPlan-         (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False))-         CmdRepl.selectComponentTarget-         [ TargetPackage TargetExplicitNamed ["p-0.1"] Nothing ]-         [ ("p-0.1-inplace", (CLibName LMainLibName)) ]-       -- When we select the package with an explicit filter then we get those-       -- components even though we did not explicitly enable tests/benchmarks-       assertProjectDistinctTargets-         elaboratedPlan-         (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False))-         CmdRepl.selectComponentTarget-         [ TargetPackage TargetExplicitNamed ["p-0.1"] (Just TestKind) ]-         [ ("p-0.1-inplace-a-testsuite", CTestName  "a-testsuite") ]-       assertProjectDistinctTargets-         elaboratedPlan-         (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False))-         CmdRepl.selectComponentTarget-         [ TargetPackage TargetExplicitNamed ["p-0.1"] (Just BenchKind) ]-         [ ("p-0.1-inplace-a-benchmark", CBenchName "a-benchmark") ]--testTargetProblemsListBin :: ProjectConfig -> (String -> IO ()) -> Assertion-testTargetProblemsListBin config reportSubCase = do-    reportSubCase "one-of-each"-    do (_,elaboratedPlan,_) <- planProject "targets/one-of-each" config-       assertProjectDistinctTargets-         elaboratedPlan-         CmdListBin.selectPackageTargets-         CmdListBin.selectComponentTarget-         [ TargetPackage TargetExplicitNamed ["p-0.1"] Nothing-         ]-         [ ("p-0.1-inplace-p1",      CExeName   "p1")-         ]--    reportSubCase "multiple-exes"-    assertProjectTargetProblems-      "targets/multiple-exes" config-      CmdListBin.selectPackageTargets-      CmdListBin.selectComponentTarget-      [ ( flip CmdListBin.matchesMultipleProblem-               [ AvailableTarget "p-0.1" (CExeName "p2")-                   (TargetBuildable () TargetRequestedByDefault) True-               , AvailableTarget "p-0.1" (CExeName "p1")-                   (TargetBuildable () TargetRequestedByDefault) True-               ]-        , mkTargetPackage "p-0.1" )-      ]--    reportSubCase "multiple targets"-    do (_,elaboratedPlan,_) <- planProject "targets/multiple-exes" config-       assertProjectDistinctTargets-         elaboratedPlan-         CmdListBin.selectPackageTargets-         CmdListBin.selectComponentTarget-         [ mkTargetComponent "p-0.1" (CExeName "p1")-         , mkTargetComponent "p-0.1" (CExeName "p2")-         ]-         [ ("p-0.1-inplace-p1", CExeName "p1")-         , ("p-0.1-inplace-p2", CExeName "p2")-         ]--    reportSubCase "exes-disabled"-    assertProjectTargetProblems-      "targets/exes-disabled" config-      CmdListBin.selectPackageTargets-      CmdListBin.selectComponentTarget-      [ ( flip TargetProblemNoneEnabled-               [ AvailableTarget "p-0.1" (CExeName "p") TargetNotBuildable True-               ]-        , mkTargetPackage "p-0.1" )-      ]--    reportSubCase "empty-pkg"-    assertProjectTargetProblems-      "targets/empty-pkg" config-      CmdListBin.selectPackageTargets-      CmdListBin.selectComponentTarget-      [ ( TargetProblemNoTargets, mkTargetPackage "p-0.1" )-      ]--    reportSubCase "lib-only"-    assertProjectTargetProblems-      "targets/lib-only" config-      CmdListBin.selectPackageTargets-      CmdListBin.selectComponentTarget-      [ (CmdListBin.noComponentsProblem, mkTargetPackage "p-0.1" )-      ]--testTargetProblemsRun :: ProjectConfig -> (String -> IO ()) -> Assertion-testTargetProblemsRun config reportSubCase = do-    reportSubCase "one-of-each"-    do (_,elaboratedPlan,_) <- planProject "targets/one-of-each" config-       assertProjectDistinctTargets-         elaboratedPlan-         CmdRun.selectPackageTargets-         CmdRun.selectComponentTarget-         [ TargetPackage TargetExplicitNamed ["p-0.1"] Nothing-         ]-         [ ("p-0.1-inplace-p1",      CExeName   "p1")-         ]--    reportSubCase "multiple-exes"-    assertProjectTargetProblems-      "targets/multiple-exes" config-      CmdRun.selectPackageTargets-      CmdRun.selectComponentTarget-      [ ( flip CmdRun.matchesMultipleProblem-               [ AvailableTarget "p-0.1" (CExeName "p2")-                   (TargetBuildable () TargetRequestedByDefault) True-               , AvailableTarget "p-0.1" (CExeName "p1")-                   (TargetBuildable () TargetRequestedByDefault) True-               ]-        , mkTargetPackage "p-0.1" )-      ]--    reportSubCase "multiple targets"-    do (_,elaboratedPlan,_) <- planProject "targets/multiple-exes" config-       assertProjectDistinctTargets-         elaboratedPlan-         CmdRun.selectPackageTargets-         CmdRun.selectComponentTarget-         [ mkTargetComponent "p-0.1" (CExeName "p1")-         , mkTargetComponent "p-0.1" (CExeName "p2")-         ]-         [ ("p-0.1-inplace-p1", CExeName "p1")-         , ("p-0.1-inplace-p2", CExeName "p2")-         ]--    reportSubCase "exes-disabled"-    assertProjectTargetProblems-      "targets/exes-disabled" config-      CmdRun.selectPackageTargets-      CmdRun.selectComponentTarget-      [ ( flip TargetProblemNoneEnabled-               [ AvailableTarget "p-0.1" (CExeName "p") TargetNotBuildable True-               ]-        , mkTargetPackage "p-0.1" )-      ]--    reportSubCase "empty-pkg"-    assertProjectTargetProblems-      "targets/empty-pkg" config-      CmdRun.selectPackageTargets-      CmdRun.selectComponentTarget-      [ ( TargetProblemNoTargets, mkTargetPackage "p-0.1" )-      ]--    reportSubCase "lib-only"-    assertProjectTargetProblems-      "targets/lib-only" config-      CmdRun.selectPackageTargets-      CmdRun.selectComponentTarget-      [ (CmdRun.noExesProblem, mkTargetPackage "p-0.1" )-      ]---testTargetProblemsTest :: ProjectConfig -> (String -> IO ()) -> Assertion-testTargetProblemsTest config reportSubCase = do--    reportSubCase "disabled by config"-    assertProjectTargetProblems-      "targets/tests-disabled"-      config {-        projectConfigLocalPackages = (projectConfigLocalPackages config) {-          packageConfigTests = toFlag False-        }-      }-      CmdTest.selectPackageTargets-      CmdTest.selectComponentTarget-      [ ( flip TargetProblemNoneEnabled-               [ AvailableTarget "p-0.1" (CTestName "user-disabled")-                                 TargetDisabledByUser True-               , AvailableTarget "p-0.1" (CTestName "solver-disabled")-                                 TargetDisabledByUser True-               ]-        , mkTargetPackage "p-0.1" )-      ]--    reportSubCase "disabled by solver & buildable false"-    assertProjectTargetProblems-      "targets/tests-disabled"-      config-      CmdTest.selectPackageTargets-      CmdTest.selectComponentTarget-      [ ( flip TargetProblemNoneEnabled-               [ AvailableTarget "p-0.1" (CTestName "user-disabled")-                                 TargetDisabledBySolver True-               , AvailableTarget "p-0.1" (CTestName "solver-disabled")-                                 TargetDisabledBySolver True-               ]-        , mkTargetPackage "p-0.1" )--      , ( flip TargetProblemNoneEnabled-               [ AvailableTarget "q-0.1" (CTestName "buildable-false")-                                 TargetNotBuildable True-               ]-        , mkTargetPackage "q-0.1" )-      ]--    reportSubCase "empty-pkg"-    assertProjectTargetProblems-      "targets/empty-pkg" config-      CmdTest.selectPackageTargets-      CmdTest.selectComponentTarget-      [ ( TargetProblemNoTargets, mkTargetPackage "p-0.1" )-      ]--    reportSubCase "no tests"-    assertProjectTargetProblems-      "targets/simple"-      config-      CmdTest.selectPackageTargets-      CmdTest.selectComponentTarget-      [ ( CmdTest.noTestsProblem, mkTargetPackage "p-0.1" )-      , ( CmdTest.noTestsProblem, mkTargetPackage "q-0.1" )-      ]--    reportSubCase "not a test"-    assertProjectTargetProblems-      "targets/variety"-      config-      CmdTest.selectPackageTargets-      CmdTest.selectComponentTarget $-      [ ( const (CmdTest.notTestProblem-                  "p-0.1" (CLibName LMainLibName))-        , mkTargetComponent "p-0.1" (CLibName LMainLibName) )--      , ( const (CmdTest.notTestProblem-                  "p-0.1" (CExeName "an-exe"))-        , mkTargetComponent "p-0.1" (CExeName "an-exe") )--      , ( const (CmdTest.notTestProblem-                  "p-0.1" (CFLibName "libp"))-        , mkTargetComponent "p-0.1" (CFLibName "libp") )--      , ( const (CmdTest.notTestProblem-                  "p-0.1" (CBenchName "a-benchmark"))-        , mkTargetComponent "p-0.1" (CBenchName "a-benchmark") )-      ] ++-      [ ( const (CmdTest.isSubComponentProblem-                          "p-0.1" cname (ModuleTarget modname))-        , mkTargetModule "p-0.1" cname modname )-      | (cname, modname) <- [ (CTestName  "a-testsuite", "TestModule")-                            , (CBenchName "a-benchmark", "BenchModule")-                            , (CExeName   "an-exe",      "ExeModule")-                            , ((CLibName LMainLibName),                 "P")-                            ]-      ] ++-      [ ( const (CmdTest.isSubComponentProblem-                          "p-0.1" cname (FileTarget fname))-        , mkTargetFile "p-0.1" cname fname)-      | (cname, fname) <- [ (CTestName  "a-testsuite", "Test.hs")-                          , (CBenchName "a-benchmark", "Bench.hs")-                          , (CExeName   "an-exe",      "Main.hs")-                          ]-      ]---testTargetProblemsBench :: ProjectConfig -> (String -> IO ()) -> Assertion-testTargetProblemsBench config reportSubCase = do--    reportSubCase "disabled by config"-    assertProjectTargetProblems-      "targets/benchmarks-disabled"-      config {-        projectConfigLocalPackages = (projectConfigLocalPackages config) {-          packageConfigBenchmarks = toFlag False-        }-      }-      CmdBench.selectPackageTargets-      CmdBench.selectComponentTarget-      [ ( flip TargetProblemNoneEnabled-               [ AvailableTarget "p-0.1" (CBenchName "user-disabled")-                                 TargetDisabledByUser True-               , AvailableTarget "p-0.1" (CBenchName "solver-disabled")-                                 TargetDisabledByUser True-               ]-        , mkTargetPackage "p-0.1" )-      ]--    reportSubCase "disabled by solver & buildable false"-    assertProjectTargetProblems-      "targets/benchmarks-disabled"-      config-      CmdBench.selectPackageTargets-      CmdBench.selectComponentTarget-      [ ( flip TargetProblemNoneEnabled-               [ AvailableTarget "p-0.1" (CBenchName "user-disabled")-                                 TargetDisabledBySolver True-               , AvailableTarget "p-0.1" (CBenchName "solver-disabled")-                                 TargetDisabledBySolver True-               ]-        , mkTargetPackage "p-0.1" )--      , ( flip TargetProblemNoneEnabled-               [ AvailableTarget "q-0.1" (CBenchName "buildable-false")-                                 TargetNotBuildable True-               ]-        , mkTargetPackage "q-0.1" )-      ]--    reportSubCase "empty-pkg"-    assertProjectTargetProblems-      "targets/empty-pkg" config-      CmdBench.selectPackageTargets-      CmdBench.selectComponentTarget-      [ ( TargetProblemNoTargets, mkTargetPackage "p-0.1" )-      ]--    reportSubCase "no benchmarks"-    assertProjectTargetProblems-      "targets/simple"-      config-      CmdBench.selectPackageTargets-      CmdBench.selectComponentTarget-      [ ( CmdBench.noBenchmarksProblem, mkTargetPackage "p-0.1" )-      , ( CmdBench.noBenchmarksProblem, mkTargetPackage "q-0.1" )-      ]--    reportSubCase "not a benchmark"-    assertProjectTargetProblems-      "targets/variety"-      config-      CmdBench.selectPackageTargets-      CmdBench.selectComponentTarget $-      [ ( const (CmdBench.componentNotBenchmarkProblem-                  "p-0.1" (CLibName LMainLibName))-        , mkTargetComponent "p-0.1" (CLibName LMainLibName) )--      , ( const (CmdBench.componentNotBenchmarkProblem-                  "p-0.1" (CExeName "an-exe"))-        , mkTargetComponent "p-0.1" (CExeName "an-exe") )--      , ( const (CmdBench.componentNotBenchmarkProblem-                  "p-0.1" (CFLibName "libp"))-        , mkTargetComponent "p-0.1" (CFLibName "libp") )--      , ( const (CmdBench.componentNotBenchmarkProblem-                  "p-0.1" (CTestName "a-testsuite"))-        , mkTargetComponent "p-0.1" (CTestName "a-testsuite") )-      ] ++-      [ ( const (CmdBench.isSubComponentProblem-                          "p-0.1" cname (ModuleTarget modname))-        , mkTargetModule "p-0.1" cname modname )-      | (cname, modname) <- [ (CTestName  "a-testsuite", "TestModule")-                            , (CBenchName "a-benchmark", "BenchModule")-                            , (CExeName   "an-exe",      "ExeModule")-                            , ((CLibName LMainLibName),                 "P")-                            ]-      ] ++-      [ ( const (CmdBench.isSubComponentProblem-                          "p-0.1" cname (FileTarget fname))-        , mkTargetFile "p-0.1" cname fname)-      | (cname, fname) <- [ (CTestName  "a-testsuite", "Test.hs")-                          , (CBenchName "a-benchmark", "Bench.hs")-                          , (CExeName   "an-exe",      "Main.hs")-                          ]-      ]---testTargetProblemsHaddock :: ProjectConfig -> (String -> IO ()) -> Assertion-testTargetProblemsHaddock config reportSubCase = do--    reportSubCase "all-disabled"-    assertProjectTargetProblems-      "targets/all-disabled"-      config-      (let haddockFlags = mkHaddockFlags False True True False-        in CmdHaddock.selectPackageTargets haddockFlags)-      CmdHaddock.selectComponentTarget-      [ ( flip TargetProblemNoneEnabled-               [ AvailableTarget "p-0.1" (CBenchName "user-disabled")-                                 TargetDisabledByUser True-               , AvailableTarget "p-0.1" (CTestName "solver-disabled")-                                 TargetDisabledBySolver True-               , AvailableTarget "p-0.1" (CExeName "buildable-false")-                                 TargetNotBuildable True-               , AvailableTarget "p-0.1" (CLibName LMainLibName)-                                 TargetNotBuildable True-               ]-        , mkTargetPackage "p-0.1" )-      ]--    reportSubCase "empty-pkg"-    assertProjectTargetProblems-      "targets/empty-pkg" config-      (let haddockFlags = mkHaddockFlags False False False False-        in CmdHaddock.selectPackageTargets haddockFlags)-      CmdHaddock.selectComponentTarget-      [ ( TargetProblemNoTargets, mkTargetPackage "p-0.1" )-      ]--    reportSubCase "enabled component kinds"-    -- When we explicitly enable all the component kinds then selecting the-    -- whole package selects those component kinds too-    (_,elaboratedPlan,_) <- planProject "targets/variety" config-    let haddockFlags = mkHaddockFlags True True True True-     in assertProjectDistinctTargets-          elaboratedPlan-          (CmdHaddock.selectPackageTargets haddockFlags)-          CmdHaddock.selectComponentTarget-          [ mkTargetPackage "p-0.1" ]-          [ ("p-0.1-inplace",             (CLibName LMainLibName))-          , ("p-0.1-inplace-a-benchmark", CBenchName "a-benchmark")-          , ("p-0.1-inplace-a-testsuite", CTestName  "a-testsuite")-          , ("p-0.1-inplace-an-exe",      CExeName   "an-exe")-          , ("p-0.1-inplace-libp",        CFLibName  "libp")-          ]--    reportSubCase "disabled component kinds"-    -- When we explicitly disable all the component kinds then selecting the-    -- whole package only selects the library-    let haddockFlags = mkHaddockFlags False False False False-     in assertProjectDistinctTargets-          elaboratedPlan-          (CmdHaddock.selectPackageTargets haddockFlags)-          CmdHaddock.selectComponentTarget-          [ mkTargetPackage "p-0.1" ]-          [ ("p-0.1-inplace", (CLibName LMainLibName)) ]--    reportSubCase "requested component kinds"-    -- When we selecting the package with an explicit filter then it does not-    -- matter if the config was to disable all the component kinds-    let haddockFlags = mkHaddockFlags False False False False-     in assertProjectDistinctTargets-          elaboratedPlan-          (CmdHaddock.selectPackageTargets haddockFlags)-          CmdHaddock.selectComponentTarget-          [ TargetPackage TargetExplicitNamed ["p-0.1"] (Just FLibKind)-          , TargetPackage TargetExplicitNamed ["p-0.1"] (Just ExeKind)-          , TargetPackage TargetExplicitNamed ["p-0.1"] (Just TestKind)-          , TargetPackage TargetExplicitNamed ["p-0.1"] (Just BenchKind)-          ]-          [ ("p-0.1-inplace-a-benchmark", CBenchName "a-benchmark")-          , ("p-0.1-inplace-a-testsuite", CTestName  "a-testsuite")-          , ("p-0.1-inplace-an-exe",      CExeName   "an-exe")-          , ("p-0.1-inplace-libp",        CFLibName  "libp")-          ]-  where-    mkHaddockFlags flib exe test bench =-      defaultHaddockFlags {-        haddockForeignLibs = toFlag flib,-        haddockExecutables = toFlag exe,-        haddockTestSuites  = toFlag test,-        haddockBenchmarks  = toFlag bench-      }--assertProjectDistinctTargets-  :: forall err. (Eq err, Show err) =>-     ElaboratedInstallPlan-  -> (forall k. TargetSelector -> [AvailableTarget k] -> Either (TargetProblem err) [k])-  -> (forall k. SubComponentTarget ->  AvailableTarget k  -> Either (TargetProblem err)  k )-  -> [TargetSelector]-  -> [(UnitId, ComponentName)]-  -> Assertion-assertProjectDistinctTargets elaboratedPlan-                             selectPackageTargets-                             selectComponentTarget-                             targetSelectors-                             expectedTargets-  | Right targets <- results-  = distinctTargetComponents targets @?= Set.fromList expectedTargets--  | otherwise-  = assertFailure $ "assertProjectDistinctTargets: expected "-                 ++ "(Right targets) but got " ++ show results-  where-    results = resolveTargets-                selectPackageTargets-                selectComponentTarget-                elaboratedPlan-                Nothing-                targetSelectors---assertProjectTargetProblems-  :: forall err. (Eq err, Show err) =>-     FilePath -> ProjectConfig-  -> (forall k. TargetSelector-             -> [AvailableTarget k]-             -> Either (TargetProblem err) [k])-  -> (forall k. SubComponentTarget-             -> AvailableTarget k-             -> Either (TargetProblem err) k )-  -> [(TargetSelector -> TargetProblem err, TargetSelector)]-  -> Assertion-assertProjectTargetProblems testdir config-                            selectPackageTargets-                            selectComponentTarget-                            cases = do-    (_,elaboratedPlan,_) <- planProject testdir config-    assertTargetProblems-      elaboratedPlan-      selectPackageTargets-      selectComponentTarget-      cases---assertTargetProblems-  :: forall err. (Eq err, Show err) =>-     ElaboratedInstallPlan-  -> (forall k. TargetSelector -> [AvailableTarget k] -> Either (TargetProblem err) [k])-  -> (forall k. SubComponentTarget ->  AvailableTarget k  -> Either (TargetProblem err)  k )-  -> [(TargetSelector -> TargetProblem err, TargetSelector)]-  -> Assertion-assertTargetProblems elaboratedPlan selectPackageTargets selectComponentTarget =-    mapM_ (uncurry assertTargetProblem)-  where-    assertTargetProblem expected targetSelector =-      let res = resolveTargets selectPackageTargets selectComponentTarget-                               elaboratedPlan Nothing-                               [targetSelector] in-      case res of-        Left [problem] ->-          problem @?= expected targetSelector--        unexpected ->-          assertFailure $ "expected resolveTargets result: (Left [problem]) "-                       ++ "but got: " ++ show unexpected---testExceptionInFindingPackage :: ProjectConfig -> Assertion-testExceptionInFindingPackage config = do-    BadPackageLocations _ locs <- expectException "BadPackageLocations" $-      void $ planProject testdir config-    case locs of-      [BadLocGlobEmptyMatch "./*.cabal"] -> return ()-      _ -> assertFailure "expected BadLocGlobEmptyMatch"-    cleanProject testdir-  where-    testdir = "exception/no-pkg"---testExceptionInFindingPackage2 :: ProjectConfig -> Assertion-testExceptionInFindingPackage2 config = do-    BadPackageLocations _ locs <- expectException "BadPackageLocations" $-      void $ planProject testdir config-    case locs of-      [BadPackageLocationFile (BadLocDirNoCabalFile ".")] -> return ()-      _ -> assertFailure $ "expected BadLocDirNoCabalFile, got " ++ show locs-    cleanProject testdir-  where-    testdir = "exception/no-pkg2"---testExceptionInProjectConfig :: ProjectConfig -> Assertion-testExceptionInProjectConfig config = do-    BadPerPackageCompilerPaths ps <- expectException "BadPerPackageCompilerPaths" $-      void $ planProject testdir config-    case ps of-      [(pn,"ghc")] | "foo" == pn -> return ()-      _ -> assertFailure $ "expected (PackageName \"foo\",\"ghc\"), got "-                        ++ show ps-    cleanProject testdir-  where-    testdir = "exception/bad-config"---testExceptionInConfigureStep :: ProjectConfig -> Assertion-testExceptionInConfigureStep config = do-    (plan, res) <- executePlan =<< planProject testdir config-    (_pkga1, failure) <- expectPackageFailed plan res pkgidA1-    case buildFailureReason failure of-      ConfigureFailed _ -> return ()-      _ -> assertFailure $ "expected ConfigureFailed, got " ++ show failure-    cleanProject testdir-  where-    testdir = "exception/configure"-    pkgidA1 = PackageIdentifier "a" (mkVersion [1])---testExceptionInBuildStep :: ProjectConfig -> Assertion-testExceptionInBuildStep config = do-    (plan, res) <- executePlan =<< planProject testdir config-    (_pkga1, failure) <- expectPackageFailed plan res pkgidA1-    expectBuildFailed failure-  where-    testdir = "exception/build"-    pkgidA1 = PackageIdentifier "a" (mkVersion [1])--testSetupScriptStyles :: ProjectConfig -> (String -> IO ()) -> Assertion-testSetupScriptStyles config reportSubCase = do--  reportSubCase (show SetupCustomExplicitDeps)--  plan0@(_,_,sharedConfig) <- planProject testdir1 config--  let isOSX (Platform _ OSX) = True-      isOSX _ = False-      compilerVer = compilerVersion (pkgConfigCompiler sharedConfig)-  -- Skip the Custom tests when the shipped Cabal library is buggy-  unless ((isOSX (pkgConfigPlatform sharedConfig) && (compilerVer < mkVersion [7,10]))-       -- 9.10 ships Cabal 3.12.0.0 affected by #9940-       || (mkVersion [9,10] <= compilerVer && compilerVer < mkVersion [9,11])) $ do--    (plan1, res1) <- executePlan plan0-    pkg1          <- expectPackageInstalled plan1 res1 pkgidA-    elabSetupScriptStyle pkg1 @?= SetupCustomExplicitDeps-    hasDefaultSetupDeps pkg1 @?= Just False-    marker1 <- readFile (basedir </> testdir1 </> "marker")-    marker1 @?= "ok"-    removeFile (basedir </> testdir1 </> "marker")--    -- implicit deps implies 'Cabal < 2' which conflicts w/ GHC 8.2 or later-    when (compilerVersion (pkgConfigCompiler sharedConfig) < mkVersion [8,2]) $ do-      reportSubCase (show SetupCustomImplicitDeps)-      (plan2, res2) <- executePlan =<< planProject testdir2 config-      pkg2          <- expectPackageInstalled plan2 res2 pkgidA-      elabSetupScriptStyle pkg2 @?= SetupCustomImplicitDeps-      hasDefaultSetupDeps pkg2 @?= Just True-      marker2 <- readFile (basedir </> testdir2 </> "marker")-      marker2 @?= "ok"-      removeFile (basedir </> testdir2 </> "marker")--    reportSubCase (show SetupNonCustomInternalLib)-    (plan3, res3) <- executePlan =<< planProject testdir3 config-    pkg3          <- expectPackageInstalled plan3 res3 pkgidA-    elabSetupScriptStyle pkg3 @?= SetupNonCustomInternalLib-{--    --TODO: the SetupNonCustomExternalLib case is hard to test since it-    -- requires a version of Cabal that's later than the one we're testing-    -- e.g. needs a .cabal file that specifies cabal-version: >= 2.0-    -- and a corresponding Cabal package that we can use to try and build a-    -- default Setup.hs.-    reportSubCase (show SetupNonCustomExternalLib)-    (plan4, res4) <- executePlan =<< planProject testdir4 config-    pkg4          <- expectPackageInstalled plan4 res4 pkgidA-    pkgSetupScriptStyle pkg4 @?= SetupNonCustomExternalLib--}-  where-    testdir1 = "build/setup-custom1"-    testdir2 = "build/setup-custom2"-    testdir3 = "build/setup-simple"-    pkgidA   = PackageIdentifier "a" (mkVersion [0,1])-    -- The solver fills in default setup deps explicitly, but marks them as such-    hasDefaultSetupDeps = fmap defaultSetupDepends-                        . setupBuildInfo . elabPkgDescription---- | Test the behaviour with and without @--keep-going@----testBuildKeepGoing :: ProjectConfig -> Assertion-testBuildKeepGoing config = do-    -- P is expected to fail, Q does not depend on P but without-    -- parallel build and without keep-going then we don't build Q yet.-    (plan1, res1) <- executePlan =<< planProject testdir (config `mappend` keepGoing False)-    (_, failure1) <- expectPackageFailed plan1 res1 "p-0.1"-    expectBuildFailed failure1-    _ <- expectPackageConfigured plan1 res1 "q-0.1"--    -- With keep-going then we should go on to successfully build Q-    (plan2, res2) <- executePlan-                 =<< planProject testdir (config `mappend` keepGoing True)-    (_, failure2) <- expectPackageFailed plan2 res2 "p-0.1"-    expectBuildFailed failure2-    _ <- expectPackageInstalled plan2 res2 "q-0.1"-    return ()-  where-    testdir = "build/keep-going"-    keepGoing kg =-      mempty {-        projectConfigBuildOnly = mempty {-          projectConfigKeepGoing = toFlag kg-        }-      }---- | Test we can successfully build packages from local tarball files.----testBuildLocalTarball :: ProjectConfig -> Assertion-testBuildLocalTarball config = do-    -- P is a tarball package, Q is a local dir package that depends on it.-    (plan, res) <- executePlan =<< planProject testdir config-    _ <- expectPackageInstalled plan res "p-0.1"-    _ <- expectPackageInstalled plan res "q-0.1"-    return ()-  where-    testdir = "build/local-tarball"---- | See <https://github.com/haskell/cabal/issues/3324>------ This test just doesn't seem to work on Windows,--- due filesystem woes.----testRegressionIssue3324 :: ProjectConfig -> Assertion-testRegressionIssue3324 config = when (buildOS /= Windows) $ do-    -- expected failure first time due to missing dep-    (plan1, res1) <- executePlan =<< planProject testdir config-    (_pkgq, failure) <- expectPackageFailed plan1 res1 "q-0.1"-    expectBuildFailed failure--    -- add the missing dep, now it should work-    let qcabal  = basedir </> testdir </> "q" </> "q.cabal"-    withFileFinallyRestore qcabal $ do-      tryFewTimes $ BS.appendFile qcabal ("  build-depends: p\n")-      (plan2, res2) <- executePlan =<< planProject testdir config-      _ <- expectPackageInstalled plan2 res2 "p-0.1"-      _ <- expectPackageInstalled plan2 res2 "q-0.1"-      return ()-  where-    testdir = "regression/3324"---- | Test global program options are propagated correctly--- from ProjectConfig to ElaboratedInstallPlan-testProgramOptionsAll :: ProjectConfig -> Assertion-testProgramOptionsAll config0 = do-    -- P is a tarball package, Q is a local dir package that depends on it.-    (_, elaboratedPlan, _) <- planProject testdir config-    let packages = filterConfiguredPackages $ InstallPlan.toList elaboratedPlan--    assertEqual "q"-                (Just [ghcFlag])-                (getProgArgs packages "q")-    assertEqual "p"-                (Just [ghcFlag])-                (getProgArgs packages "p")-  where-    testdir = "regression/program-options"-    programArgs = MapMappend (Map.fromList [("ghc", [ghcFlag])])-    ghcFlag = "-fno-full-laziness"--    -- Insert flag into global config-    config = config0 {-      projectConfigAllPackages = (projectConfigAllPackages config0) {-        packageConfigProgramArgs = programArgs-      }-    }---- | Test local program options are propagated correctly--- from ProjectConfig to ElaboratedInstallPlan-testProgramOptionsLocal :: ProjectConfig -> Assertion-testProgramOptionsLocal config0 = do-    (_, elaboratedPlan, _) <- planProject testdir config-    let localPackages = filterConfiguredPackages $ InstallPlan.toList elaboratedPlan--    assertEqual "q"-                (Just [ghcFlag])-                (getProgArgs localPackages "q")-    assertEqual "p"-                Nothing-                (getProgArgs localPackages "p")-  where-    testdir = "regression/program-options"-    programArgs = MapMappend (Map.fromList [("ghc", [ghcFlag])])-    ghcFlag = "-fno-full-laziness"--    -- Insert flag into local config-    config = config0 {-      projectConfigLocalPackages = (projectConfigLocalPackages config0) {-        packageConfigProgramArgs = programArgs-      }-    }---- | Test package specific program options are propagated correctly--- from ProjectConfig to ElaboratedInstallPlan-testProgramOptionsSpecific :: ProjectConfig -> Assertion-testProgramOptionsSpecific config0 = do-    (_, elaboratedPlan, _) <- planProject testdir config-    let packages = filterConfiguredPackages $ InstallPlan.toList elaboratedPlan--    assertEqual "q"-                (Nothing)-                (getProgArgs packages "q")-    assertEqual "p"-                (Just [ghcFlag])-                (getProgArgs packages "p")-  where-    testdir = "regression/program-options"-    programArgs = MapMappend (Map.fromList [("ghc", [ghcFlag])])-    ghcFlag = "-fno-full-laziness"--    -- Insert flag into package "p" config-    config = config0 {-        projectConfigSpecificPackage = MapMappend (Map.fromList [(mkPackageName "p", configArgs)])-    }-    configArgs = mempty {-        packageConfigProgramArgs = programArgs-    }--filterConfiguredPackages :: [ElaboratedPlanPackage] -> [ElaboratedConfiguredPackage]-filterConfiguredPackages [] = []-filterConfiguredPackages (InstallPlan.PreExisting _    : pkgs) = filterConfiguredPackages pkgs-filterConfiguredPackages (InstallPlan.Installed   elab : pkgs) = elab : filterConfiguredPackages pkgs-filterConfiguredPackages (InstallPlan.Configured  elab : pkgs) = elab : filterConfiguredPackages pkgs--getProgArgs :: [ElaboratedConfiguredPackage] -> String -> Maybe [String]-getProgArgs [] _ = Nothing-getProgArgs (elab : pkgs) name-    | pkgName (elabPkgSourceId elab) == mkPackageName name-        = Map.lookup "ghc" (elabProgramArgs elab)-    | otherwise-        = getProgArgs pkgs name-------------------------------------- Test utils to plan and build-----basedir :: FilePath-basedir = "tests" </> "IntegrationTests2"--dirActions :: FilePath -> TS.DirActions IO-dirActions testdir =-    defaultDirActions {-      TS.doesFileExist       = \p ->-        TS.doesFileExist defaultDirActions (virtcwd </> p),--      TS.doesDirectoryExist  = \p ->-        TS.doesDirectoryExist defaultDirActions (virtcwd </> p),--      TS.canonicalizePath    = \p ->-        TS.canonicalizePath defaultDirActions (virtcwd </> p),--      TS.getCurrentDirectory =-        TS.canonicalizePath defaultDirActions virtcwd-    }-  where-    virtcwd = basedir </> testdir--type ProjDetails = (DistDirLayout,-                    CabalDirLayout,-                    ProjectConfig,-                    [PackageSpecifier UnresolvedSourcePackage],-                    BuildTimeSettings)--configureProject :: FilePath -> ProjectConfig -> IO ProjDetails-configureProject testdir cliConfig = do-    cabalDirLayout <- defaultCabalDirLayout--    projectRootDir <- canonicalizePath (basedir </> testdir)-    isexplict <- doesFileExist (projectRootDir </> defaultProjectFile)--    let projectRoot-          | isexplict = ProjectRootExplicit projectRootDir defaultProjectFile-          | otherwise = ProjectRootImplicit projectRootDir-        distDirLayout = defaultDistDirLayout projectRoot Nothing Nothing--    -- Clear state between test runs. The state remains if the previous run-    -- ended in an exception (as we leave the files to help with debugging).-    cleanProject testdir--    httpTransport <- configureTransport verbosity [] Nothing--    (projectConfig, localPackages) <--      rebuildProjectConfig verbosity-                           httpTransport-                           distDirLayout-                           cliConfig--    let buildSettings = resolveBuildTimeSettings-                          verbosity cabalDirLayout-                          projectConfig--    return (distDirLayout,-            cabalDirLayout,-            projectConfig,-            localPackages,-            buildSettings)--type PlanDetails = (ProjDetails,-                    ElaboratedInstallPlan,-                    ElaboratedSharedConfig)--planProject :: FilePath -> ProjectConfig -> IO PlanDetails-planProject testdir cliConfig = do--    projDetails@(-       distDirLayout,-       cabalDirLayout,-       projectConfig,-       localPackages,-       _buildSettings) <- configureProject testdir cliConfig--    (elaboratedPlan, _, elaboratedShared, _, _) <--      rebuildInstallPlan verbosity-                         distDirLayout cabalDirLayout-                         projectConfig-                         localPackages-                         Nothing--    return (projDetails,-            elaboratedPlan,-            elaboratedShared)--executePlan :: PlanDetails -> IO (ElaboratedInstallPlan, BuildOutcomes)-executePlan ((distDirLayout, cabalDirLayout, config, _, buildSettings),-             elaboratedPlan,-             elaboratedShared) = do--    let targets :: Map.Map UnitId [ComponentTarget]-        targets =-          Map.fromList-            [ (unitid, [ComponentTarget cname WholeComponent])-            | ts <- Map.elems (availableTargets elaboratedPlan)-            , AvailableTarget {-                availableTargetStatus = TargetBuildable (unitid, cname) _-              } <- ts-            ]-        elaboratedPlan' = pruneInstallPlanToTargets-                            TargetActionBuild targets-                            elaboratedPlan--    pkgsBuildStatus <--      rebuildTargetsDryRun distDirLayout elaboratedShared-                           elaboratedPlan'--    let elaboratedPlan'' = improveInstallPlanWithUpToDatePackages-                             pkgsBuildStatus elaboratedPlan'--    buildOutcomes <--      rebuildTargets verbosity-                     config-                     distDirLayout-                     (cabalStoreDirLayout cabalDirLayout)-                     elaboratedPlan''-                     elaboratedShared-                     pkgsBuildStatus-                     -- Avoid trying to use act-as-setup mode:-                     buildSettings { buildSettingNumJobs = Serial }--    return (elaboratedPlan'', buildOutcomes)--cleanProject :: FilePath -> IO ()-cleanProject testdir = do-    alreadyExists <- doesDirectoryExist distDir-    when alreadyExists $ removePathForcibly distDir-  where-    projectRoot    = ProjectRootImplicit (basedir </> testdir)-    distDirLayout  = defaultDistDirLayout projectRoot Nothing Nothing-    distDir        = distDirectory distDirLayout---verbosity :: Verbosity-verbosity = minBound --normal --verbose --maxBound --minBound-------------------------------------------------- Tasty integration to adjust the config-----withProjectConfig :: (ProjectConfig -> TestTree) -> TestTree-withProjectConfig testtree =-    askOption $ \ghcPath ->-      testtree (mkProjectConfig ghcPath)--mkProjectConfig :: GhcPath -> ProjectConfig-mkProjectConfig (GhcPath ghcPath) =-    mempty {-      projectConfigShared = mempty {-        projectConfigHcPath = maybeToFlag ghcPath-      },-     projectConfigBuildOnly = mempty {-       projectConfigNumJobs = toFlag (Just 1)-     }-    }-  where-    maybeToFlag = maybe mempty toFlag---data GhcPath = GhcPath (Maybe FilePath)--instance IsOption GhcPath where-  defaultValue = GhcPath Nothing-  optionName   = Tagged "with-ghc"-  optionHelp   = Tagged "The ghc compiler to use"-  parseValue   = Just . GhcPath . Just--projectConfigOptionDescriptions :: [OptionDescription]-projectConfigOptionDescriptions = [Option (Proxy :: Proxy GhcPath)]--------------------------------------------- HUint style utils for this context-----expectException :: Exception e => String -> IO a -> IO e-expectException expected action = do-    res <- try action-    case res of-      Left  e -> return e-      Right _ -> throwIO $ HUnitFailure Nothing $ "expected an exception " ++ expected--expectPackagePreExisting :: ElaboratedInstallPlan -> BuildOutcomes -> PackageId-                         -> IO InstalledPackageInfo-expectPackagePreExisting plan buildOutcomes pkgid = do-    planpkg <- expectPlanPackage plan pkgid-    case (planpkg, InstallPlan.lookupBuildOutcome planpkg buildOutcomes) of-      (InstallPlan.PreExisting pkg, Nothing)-                       -> return pkg-      (_, buildResult) -> unexpectedBuildResult "PreExisting" planpkg buildResult--expectPackageConfigured :: ElaboratedInstallPlan -> BuildOutcomes -> PackageId-                        -> IO ElaboratedConfiguredPackage-expectPackageConfigured plan buildOutcomes pkgid = do-    planpkg <- expectPlanPackage plan pkgid-    case (planpkg, InstallPlan.lookupBuildOutcome planpkg buildOutcomes) of-      (InstallPlan.Configured pkg, Nothing)-                       -> return pkg-      (_, buildResult) -> unexpectedBuildResult "Configured" planpkg buildResult--expectPackageInstalled :: ElaboratedInstallPlan -> BuildOutcomes -> PackageId-                       -> IO ElaboratedConfiguredPackage-expectPackageInstalled plan buildOutcomes pkgid = do-    planpkg <- expectPlanPackage plan pkgid-    case (planpkg, InstallPlan.lookupBuildOutcome planpkg buildOutcomes) of-      (InstallPlan.Configured pkg, Just (Right _result)) -- result isn't used by any test-                       -> return pkg-      -- package can be installed in the global .store!-      -- (when installing from tarball!)-      (InstallPlan.Installed pkg, Nothing)-                       -> return pkg-      (_, buildResult) -> unexpectedBuildResult "Installed" planpkg buildResult--expectPackageFailed :: ElaboratedInstallPlan -> BuildOutcomes -> PackageId-                    -> IO (ElaboratedConfiguredPackage, BuildFailure)-expectPackageFailed plan buildOutcomes pkgid = do-    planpkg <- expectPlanPackage plan pkgid-    case (planpkg, InstallPlan.lookupBuildOutcome planpkg buildOutcomes) of-      (InstallPlan.Configured pkg, Just (Left failure))-                       -> return (pkg, failure)-      (_, buildResult) -> unexpectedBuildResult "Failed" planpkg buildResult--unexpectedBuildResult :: String -> ElaboratedPlanPackage-                      -> Maybe (Either BuildFailure BuildResult) -> IO a-unexpectedBuildResult expected planpkg buildResult =-    throwIO $ HUnitFailure Nothing $-         "expected to find " ++ display (packageId planpkg) ++ " in the "-      ++ expected ++ " state, but it is actually in the " ++ actual ++ " state."-  where-    actual = case (buildResult, planpkg) of-      (Nothing, InstallPlan.PreExisting{})       -> "PreExisting"-      (Nothing, InstallPlan.Configured{})        -> "Configured"-      (Just (Right _), InstallPlan.Configured{}) -> "Installed"-      (Just (Left  _), InstallPlan.Configured{}) -> "Failed"-      (Nothing, InstallPlan.Installed{})         -> "Installed globally"-      _                                          -> "Impossible! " ++ show buildResult ++ show planpkg--expectPlanPackage :: ElaboratedInstallPlan -> PackageId-                  -> IO ElaboratedPlanPackage-expectPlanPackage plan pkgid =-    case [ pkg-         | pkg <- InstallPlan.toList plan-         , packageId pkg == pkgid ] of-      [pkg] -> return pkg-      []    -> throwIO $ HUnitFailure Nothing $-                   "expected to find " ++ display pkgid-                ++ " in the install plan but it's not there"-      _     -> throwIO $ HUnitFailure Nothing $-                   "expected to find only one instance of " ++ display pkgid-                ++ " in the install plan but there's several"--expectBuildFailed :: BuildFailure -> IO ()-expectBuildFailed (BuildFailure _ (BuildFailed _)) = return ()-expectBuildFailed (BuildFailure _ reason) =-    assertFailure $ "expected BuildFailed, got " ++ show reason-------------------------------------------- Other utils------- | Allow altering a file during a test, but then restore it afterwards------ We read into the memory, as filesystems are tricky. (especially Windows)----withFileFinallyRestore :: FilePath -> IO a -> IO a-withFileFinallyRestore file action = do-    originalContents <- BS.readFile file-    action `finally` handle onIOError (tryFewTimes $ BS.writeFile file originalContents)-  where-    onIOError :: IOException -> IO ()-    onIOError e = putStrLn $ "WARNING: Cannot restore " ++ file ++ "; " ++ show e---- Hopefully works around some Windows file-locking things.--- Use with care:------ Try action 4 times, with small sleep in between,--- retrying if it fails for 'IOException' reason.----tryFewTimes :: forall a. IO a -> IO a-tryFewTimes action = go (3 :: Int) where-    go :: Int -> IO a-    go !n | n <= 0    = action-          | otherwise = action `catch` onIOError n--    onIOError :: Int -> IOException -> IO a-    onIOError n e = do-        hPutStrLn stderr $ "Trying " ++ show n ++ " after " ++ show e-        threadDelay 10000-        go (n - 1)--testNixFlags :: Assertion-testNixFlags = do-  let gc = globalCommand []-  -- changing from the v1 to v2 build command does not change whether the "--enable-nix" flag-  -- sets the globalNix param of the GlobalFlags type to True even though the v2 command doesn't use it-  let nixEnabledFlags = getFlags gc . commandParseArgs gc True $ ["--enable-nix", "build"]-  let nixDisabledFlags = getFlags gc . commandParseArgs gc True $ ["--disable-nix", "build"]-  let nixDefaultFlags = getFlags gc . commandParseArgs gc True $ ["build"]-  True @=? isJust nixDefaultFlags-  True @=? isJust nixEnabledFlags-  True @=? isJust nixDisabledFlags-  Just True @=? (fromFlag . globalNix . fromJust $ nixEnabledFlags)-  Just False @=? (fromFlag . globalNix . fromJust $ nixDisabledFlags)-  Nothing @=? (fromFlag . globalNix . fromJust $ nixDefaultFlags)--  -- Config file options-  trueConfig <- loadConfig verbosity (Flag (basedir </> "nix-config/nix-true"))-  falseConfig <- loadConfig verbosity (Flag (basedir </> "nix-config/nix-false"))--  Just True @=? (fromFlag . globalNix . savedGlobalFlags $ trueConfig)-  Just False @=? (fromFlag . globalNix . savedGlobalFlags $ falseConfig)--  where-    fromFlag :: Flag Bool -> Maybe Bool-    fromFlag (Flag x) = Just x-    fromFlag NoFlag = Nothing-    getFlags :: CommandUI GlobalFlags -> CommandParse (GlobalFlags -> GlobalFlags, [String]) -> Maybe GlobalFlags-    getFlags cui (CommandReadyToGo (mkflags, _)) = Just . mkflags . commandDefaultFlags $ cui-    getFlags _ _ = Nothing---- Tests whether config options are commented or not-testConfigOptionComments :: Assertion-testConfigOptionComments = do-  _ <- createDefaultConfigFile verbosity [] (basedir </> "config" </> "default-config")-  defaultConfigFile <- readFile (basedir </> "config" </> "default-config")--  "  url" @=? findLineWith False "url" defaultConfigFile-  "  -- secure" @=? findLineWith True "secure" defaultConfigFile-  "  -- root-keys" @=? findLineWith True "root-keys" defaultConfigFile-  "  -- key-threshold" @=? findLineWith True "key-threshold" defaultConfigFile--  "-- ignore-expiry" @=? findLineWith True "ignore-expiry" defaultConfigFile-  "-- http-transport" @=? findLineWith True "http-transport" defaultConfigFile-  "-- nix" @=? findLineWith True "nix" defaultConfigFile-  "-- store-dir" @=? findLineWith True "store-dir" defaultConfigFile-  "-- active-repositories" @=? findLineWith True "active-repositories" defaultConfigFile-  "-- local-no-index-repo" @=? findLineWith True "local-no-index-repo" defaultConfigFile-  "remote-repo-cache"  @=? findLineWith False "remote-repo-cache" defaultConfigFile-  "-- logs-dir"  @=? findLineWith True "logs-dir" defaultConfigFile-  "-- default-user-config" @=? findLineWith True "default-user-config" defaultConfigFile-  "-- verbose" @=? findLineWith True "verbose" defaultConfigFile-  "-- compiler" @=? findLineWith True "compiler" defaultConfigFile-  "-- cabal-file" @=? findLineWith True "cabal-file" defaultConfigFile-  "-- with-compiler" @=? findLineWith True "with-compiler" defaultConfigFile-  "-- with-hc-pkg" @=? findLineWith True "with-hc-pkg" defaultConfigFile-  "-- program-prefix" @=? findLineWith True "program-prefix" defaultConfigFile-  "-- program-suffix" @=? findLineWith True "program-suffix" defaultConfigFile-  "-- library-vanilla" @=? findLineWith True "library-vanilla" defaultConfigFile-  "-- library-profiling" @=? findLineWith True "library-profiling" defaultConfigFile-  "-- shared" @=? findLineWith True "shared" defaultConfigFile-  "-- static" @=? findLineWith True "static" defaultConfigFile-  "-- executable-dynamic" @=? findLineWith True "executable-dynamic" defaultConfigFile-  "-- executable-static" @=? findLineWith True "executable-static" defaultConfigFile-  "-- profiling" @=? findLineWith True "profiling" defaultConfigFile-  "-- executable-profiling" @=? findLineWith True "executable-profiling" defaultConfigFile-  "-- profiling-detail" @=? findLineWith True "profiling-detail" defaultConfigFile-  "-- library-profiling-detail" @=? findLineWith True "library-profiling-detail" defaultConfigFile-  "-- optimization" @=? findLineWith True "optimization" defaultConfigFile-  "-- debug-info" @=? findLineWith True "debug-info" defaultConfigFile-  "-- build-info" @=? findLineWith True "build-info" defaultConfigFile-  "-- library-for-ghci" @=? findLineWith True "library-for-ghci" defaultConfigFile-  "-- split-sections" @=? findLineWith True "split-sections" defaultConfigFile-  "-- split-objs" @=? findLineWith True "split-objs" defaultConfigFile-  "-- executable-stripping" @=? findLineWith True "executable-stripping" defaultConfigFile-  "-- library-stripping" @=? findLineWith True "library-stripping" defaultConfigFile-  "-- configure-option" @=? findLineWith True "configure-option" defaultConfigFile-  "-- user-install"  @=? findLineWith True "user-install" defaultConfigFile-  "-- package-db"  @=? findLineWith True "package-db" defaultConfigFile-  "-- flags" @=? findLineWith True "flags" defaultConfigFile-  "-- extra-include-dirs" @=? findLineWith True "extra-include-dirs" defaultConfigFile-  "-- deterministic" @=? findLineWith True "deterministic" defaultConfigFile-  "-- cid" @=? findLineWith True "cid" defaultConfigFile-  "-- extra-lib-dirs" @=? findLineWith True "extra-lib-dirs" defaultConfigFile-  "-- extra-lib-dirs-static" @=? findLineWith True "extra-lib-dirs-static" defaultConfigFile-  "-- extra-framework-dirs" @=? findLineWith True "extra-framework-dirs" defaultConfigFile-  "-- extra-prog-path"  @=? findLineWith False "extra-prog-path" defaultConfigFile-  "-- instantiate-with" @=? findLineWith True "instantiate-with" defaultConfigFile-  "-- tests" @=? findLineWith True "tests" defaultConfigFile-  "-- coverage" @=? findLineWith True "coverage" defaultConfigFile-  "-- library-coverage" @=? findLineWith True "library-coverage" defaultConfigFile-  "-- exact-configuration" @=? findLineWith True "exact-configuration" defaultConfigFile-  "-- benchmarks" @=? findLineWith True "benchmarks" defaultConfigFile-  "-- relocatable"  @=? findLineWith True "relocatable" defaultConfigFile-  "-- response-files" @=? findLineWith True "response-files" defaultConfigFile-  "-- allow-depending-on-private-libs" @=? findLineWith True "allow-depending-on-private-libs" defaultConfigFile-  "-- cabal-lib-version" @=? findLineWith True "cabal-lib-version" defaultConfigFile-  "-- append" @=? findLineWith True "append" defaultConfigFile-  "-- backup" @=? findLineWith True "backup" defaultConfigFile-  "-- constraint" @=? findLineWith True "constraint" defaultConfigFile-  "-- preference" @=? findLineWith True "preference" defaultConfigFile-  "-- solver"  @=? findLineWith True "solver" defaultConfigFile-  "-- allow-older"  @=? findLineWith True "allow-older" defaultConfigFile-  "-- allow-newer"  @=? findLineWith True "allow-newer" defaultConfigFile-  "-- write-ghc-environment-files" @=? findLineWith True "write-ghc-environment-files" defaultConfigFile-  "-- documentation"  @=? findLineWith True "documentation" defaultConfigFile-  "-- doc-index-file"  @=? findLineWith True "doc-index-file" defaultConfigFile-  "-- only-download"  @=? findLineWith True "only-download" defaultConfigFile-  "-- target-package-db" @=? findLineWith True "target-package-db" defaultConfigFile-  "-- max-backjumps"  @=? findLineWith True "max-backjumps" defaultConfigFile-  "-- reorder-goals"  @=? findLineWith True "reorder-goals" defaultConfigFile-  "-- count-conflicts"  @=? findLineWith True "count-conflicts" defaultConfigFile-  "-- fine-grained-conflicts"  @=? findLineWith True "fine-grained-conflicts" defaultConfigFile-  "-- minimize-conflict-set"  @=? findLineWith True "minimize-conflict-set" defaultConfigFile-  "-- independent-goals"  @=? findLineWith True "independent-goals" defaultConfigFile-  "-- prefer-oldest"  @=? findLineWith True "prefer-oldest" defaultConfigFile-  "-- shadow-installed-packages"  @=? findLineWith True "shadow-installed-packages" defaultConfigFile-  "-- strong-flags"  @=? findLineWith True "strong-flags" defaultConfigFile-  "-- allow-boot-library-installs"  @=? findLineWith True "allow-boot-library-installs" defaultConfigFile-  "-- reject-unconstrained-dependencies"  @=? findLineWith True "reject-unconstrained-dependencies" defaultConfigFile-  "-- reinstall"  @=? findLineWith True "reinstall" defaultConfigFile-  "-- avoid-reinstalls"  @=? findLineWith True "avoid-reinstalls" defaultConfigFile-  "-- force-reinstalls"  @=? findLineWith True "force-reinstalls" defaultConfigFile-  "-- upgrade-dependencies"  @=? findLineWith True "upgrade-dependencies" defaultConfigFile-  "-- index-state" @=? findLineWith True "index-state" defaultConfigFile-  "-- root-cmd" @=? findLineWith True "root-cmd" defaultConfigFile-  "-- symlink-bindir" @=? findLineWith True "symlink-bindir" defaultConfigFile-  "build-summary"  @=? findLineWith False "build-summary" defaultConfigFile-  "-- build-log" @=? findLineWith True "build-log" defaultConfigFile-  "remote-build-reporting"  @=? findLineWith False "remote-build-reporting" defaultConfigFile-  "-- report-planning-failure"  @=? findLineWith True "report-planning-failure" defaultConfigFile-  "-- per-component"  @=? findLineWith True "per-component" defaultConfigFile-  "-- run-tests" @=? findLineWith True "run-tests" defaultConfigFile-  "jobs"  @=? findLineWith False "jobs" defaultConfigFile-  "-- keep-going"  @=? findLineWith True "keep-going" defaultConfigFile-  "-- offline"  @=? findLineWith True "offline" defaultConfigFile-  "-- lib" @=? findLineWith True "lib" defaultConfigFile-  "-- package-env" @=? findLineWith True "package-env" defaultConfigFile-  "-- overwrite-policy" @=? findLineWith True "overwrite-policy" defaultConfigFile-  "-- install-method" @=? findLineWith True "install-method" defaultConfigFile-  "installdir"  @=? findLineWith False "installdir" defaultConfigFile-  "-- token" @=? findLineWith True "token" defaultConfigFile-  "-- username" @=? findLineWith True "username" defaultConfigFile-  "-- password" @=? findLineWith True "password" defaultConfigFile-  "-- password-command" @=? findLineWith True "password-command" defaultConfigFile-  "-- builddir" @=? findLineWith True "builddir" defaultConfigFile--  "  -- keep-temp-files" @=? findLineWith True "keep-temp-files" defaultConfigFile-  "  -- hoogle" @=? findLineWith True "hoogle" defaultConfigFile-  "  -- html" @=? findLineWith True "html" defaultConfigFile-  "  -- html-location" @=? findLineWith True "html-location" defaultConfigFile-  "  -- executables" @=? findLineWith True "executables" defaultConfigFile-  "  -- foreign-libraries" @=? findLineWith True "foreign-libraries" defaultConfigFile-  "  -- all" @=? findLineWith True "all" defaultConfigFile-  "  -- internal" @=? findLineWith True "internal" defaultConfigFile-  "  -- css" @=? findLineWith True "css" defaultConfigFile-  "  -- hyperlink-source" @=? findLineWith True "hyperlink-source" defaultConfigFile-  "  -- quickjump" @=? findLineWith True "quickjump" defaultConfigFile-  "  -- hscolour-css" @=? findLineWith True "hscolour-css" defaultConfigFile-  "  -- contents-location" @=? findLineWith True "contents-location" defaultConfigFile-  "  -- index-location" @=? findLineWith True "index-location" defaultConfigFile-  "  -- base-url" @=? findLineWith True "base-url" defaultConfigFile-  "  -- resources-dir" @=? findLineWith True "resources-dir" defaultConfigFile-  "  -- output-dir" @=? findLineWith True "output-dir" defaultConfigFile-  "  -- use-unicode" @=? findLineWith True "use-unicode" defaultConfigFile--  "  -- interactive" @=? findLineWith True "interactive" defaultConfigFile-  "  -- quiet" @=? findLineWith True "quiet" defaultConfigFile-  "  -- no-comments" @=? findLineWith True "no-comments" defaultConfigFile-  "  -- minimal" @=? findLineWith True "minimal" defaultConfigFile-  "  -- cabal-version" @=? findLineWith True "cabal-version" defaultConfigFile-  "  -- license" @=? findLineWith True "license" defaultConfigFile-  "  -- extra-doc-file" @=? findLineWith True "extra-doc-file" defaultConfigFile-  "  -- test-dir" @=? findLineWith True "test-dir" defaultConfigFile-  "  -- simple" @=? findLineWith True "simple" defaultConfigFile-  "  -- language" @=? findLineWith True "language" defaultConfigFile-  "  -- application-dir" @=? findLineWith True "application-dir" defaultConfigFile-  "  -- source-dir" @=? findLineWith True "source-dir" defaultConfigFile--  "  -- prefix"  @=? findLineWith True "prefix" defaultConfigFile-  "  -- bindir"@=? findLineWith True "bindir" defaultConfigFile-  "  -- libdir" @=? findLineWith True "libdir" defaultConfigFile-  "  -- libsubdir" @=? findLineWith True "libsubdir" defaultConfigFile-  "  -- dynlibdir" @=? findLineWith True "dynlibdir" defaultConfigFile-  "  -- libexecdir" @=? findLineWith True "libexecdir" defaultConfigFile-  "  -- libexecsubdir" @=? findLineWith True "libexecsubdir" defaultConfigFile-  "  -- datadir" @=? findLineWith True "datadir" defaultConfigFile-  "  -- datasubdir" @=? findLineWith True "datasubdir" defaultConfigFile-  "  -- docdir" @=? findLineWith True "docdir" defaultConfigFile-  "  -- htmldir" @=? findLineWith True "htmldir" defaultConfigFile-  "  -- haddockdir" @=? findLineWith True "haddockdir" defaultConfigFile-  "  -- sysconfdir" @=? findLineWith True "sysconfdir" defaultConfigFile--  "  -- alex-location" @=? findLineWith True "alex-location" defaultConfigFile-  "  -- ar-location" @=? findLineWith True "ar-location" defaultConfigFile-  "  -- c2hs-location" @=? findLineWith True "c2hs-location" defaultConfigFile-  "  -- cpphs-location" @=? findLineWith True "cpphs-location" defaultConfigFile-  "  -- doctest-location" @=? findLineWith True "doctest-location" defaultConfigFile-  "  -- gcc-location" @=? findLineWith True "gcc-location" defaultConfigFile-  "  -- ghc-location" @=? findLineWith True "ghc-location" defaultConfigFile-  "  -- ghc-pkg-location" @=? findLineWith True "ghc-pkg-location" defaultConfigFile-  "  -- ghcjs-location" @=? findLineWith True "ghcjs-location" defaultConfigFile-  "  -- ghcjs-pkg-location" @=? findLineWith True "ghcjs-pkg-location" defaultConfigFile-  "  -- greencard-location" @=? findLineWith True "greencard-location" defaultConfigFile-  "  -- haddock-location" @=? findLineWith True "haddock-location" defaultConfigFile-  "  -- happy-location" @=? findLineWith True "happy-location" defaultConfigFile-  "  -- haskell-suite-location" @=? findLineWith True "haskell-suite-location" defaultConfigFile-  "  -- haskell-suite-pkg-location" @=? findLineWith True "haskell-suite-pkg-location" defaultConfigFile-  "  -- hmake-location" @=? findLineWith True "hmake-location" defaultConfigFile-  "  -- hpc-location" @=? findLineWith True "hpc-location" defaultConfigFile-  "  -- hscolour-location" @=? findLineWith True "hscolour-location" defaultConfigFile-  "  -- jhc-location" @=? findLineWith True "jhc-location" defaultConfigFile-  "  -- ld-location" @=? findLineWith True "ld-location" defaultConfigFile-  "  -- pkg-config-location" @=? findLineWith True "pkg-config-location" defaultConfigFile-  "  -- runghc-location" @=? findLineWith True "runghc-location" defaultConfigFile-  "  -- strip-location" @=? findLineWith True "strip-location" defaultConfigFile-  "  -- tar-location" @=? findLineWith True "tar-location" defaultConfigFile-  "  -- uhc-location" @=? findLineWith True "uhc-location" defaultConfigFile--  "  -- alex-options" @=? findLineWith True "alex-options" defaultConfigFile-  "  -- ar-options" @=? findLineWith True "ar-options" defaultConfigFile-  "  -- c2hs-options" @=? findLineWith True "c2hs-options" defaultConfigFile-  "  -- cpphs-options" @=? findLineWith True "cpphs-options" defaultConfigFile-  "  -- doctest-options" @=? findLineWith True "doctest-options" defaultConfigFile-  "  -- gcc-options" @=? findLineWith True "gcc-options" defaultConfigFile-  "  -- ghc-options" @=? findLineWith True "ghc-options" defaultConfigFile-  "  -- ghc-pkg-options" @=? findLineWith True "ghc-pkg-options" defaultConfigFile-  "  -- ghcjs-options" @=? findLineWith True "ghcjs-options" defaultConfigFile-  "  -- ghcjs-pkg-options" @=? findLineWith True "ghcjs-pkg-options" defaultConfigFile-  "  -- greencard-options" @=? findLineWith True "greencard-options" defaultConfigFile-  "  -- haddock-options" @=? findLineWith True "haddock-options" defaultConfigFile-  "  -- happy-options" @=? findLineWith True "happy-options" defaultConfigFile-  "  -- haskell-suite-options" @=? findLineWith True "haskell-suite-options" defaultConfigFile-  "  -- haskell-suite-pkg-options" @=? findLineWith True "haskell-suite-pkg-options" defaultConfigFile-  "  -- hmake-options" @=? findLineWith True "hmake-options" defaultConfigFile-  "  -- hpc-options" @=? findLineWith True "hpc-options" defaultConfigFile-  "  -- hsc2hs-options" @=? findLineWith True "hsc2hs-options" defaultConfigFile-  "  -- hscolour-options" @=? findLineWith True "hscolour-options" defaultConfigFile-  "  -- jhc-options" @=? findLineWith True "jhc-options" defaultConfigFile-  "  -- ld-options" @=? findLineWith True "ld-options" defaultConfigFile-  "  -- pkg-config-options" @=? findLineWith True "pkg-config-options" defaultConfigFile-  "  -- runghc-options" @=? findLineWith True "runghc-options" defaultConfigFile-  "  -- strip-options" @=? findLineWith True "strip-options" defaultConfigFile-  "  -- tar-options" @=? findLineWith True "tar-options" defaultConfigFile-  "  -- uhc-options" @=? findLineWith True "uhc-options" defaultConfigFile-  where-    -- | Find lines containing a target string.-    findLineWith :: Bool -> String -> String -> String-    findLineWith isComment target text =-      case findLinesWith isComment target text of-        [] -> text-        (l : _) -> removeCommentValue l-    findLinesWith :: Bool -> String -> String -> [String]-    findLinesWith isComment target-      | isComment = filter (isInfixOf (" " ++ target ++ ":")) . lines-      | otherwise = filter (isInfixOf (target ++ ":")) . lines-    removeCommentValue :: String -> String-    removeCommentValue = takeWhile (/= ':')--testIgnoreProjectFlag :: Assertion-testIgnoreProjectFlag = do-  -- Coverage flag should be false globally by default (~/.cabal folder)-  (_, _, prjConfigGlobal, _, _) <- configureProject testdir ignoreSetConfig-  let globalCoverageFlag = packageConfigCoverage . projectConfigLocalPackages $ prjConfigGlobal-  False @=? Flag.fromFlagOrDefault False globalCoverageFlag-  -- It is set to true in the cabal.project file-  (_, _, prjConfigLocal, _, _) <- configureProject testdir emptyConfig-  let localCoverageFlag = packageConfigCoverage . projectConfigLocalPackages $ prjConfigLocal-  True @=? Flag.fromFlagOrDefault False localCoverageFlag-  where-    testdir = "build/ignore-project"-    emptyConfig = mempty-    ignoreSetConfig :: ProjectConfig-    ignoreSetConfig = mempty { projectConfigShared = mempty { projectConfigIgnoreProject = Flag True } }---cleanHaddockProject :: FilePath -> IO ()-cleanHaddockProject testdir = do-    cleanProject testdir-    let haddocksdir = basedir </> testdir </> "haddocks"-    alreadyExists <- doesDirectoryExist haddocksdir-    when alreadyExists $ removePathForcibly haddocksdir-    let storedir = basedir </> testdir </> "store"-    alreadyExists' <- doesDirectoryExist storedir-    when alreadyExists' $ removePathForcibly storedir---testHaddockProjectDependencies :: ProjectConfig -> Assertion-testHaddockProjectDependencies config = do-    (_,_,sharedConfig) <- planProject testdir config-    -- `haddock-project` is only supported by `haddock-2.26.1` and above which is-    -- shipped with `ghc-9.4`-    when (compilerVersion (pkgConfigCompiler sharedConfig) > mkVersion [9,4]) $ do-      let dir = basedir </> testdir-      cleanHaddockProject testdir-      withCurrentDirectory dir $ do-        CmdHaddockProject.haddockProjectAction-          defaultHaddockProjectFlags { haddockProjectVerbosity = Flag verbosity }-          ["all"]-          defaultGlobalFlags { globalStoreDir = Flag "store" }--        let haddock = "haddocks" </> "async" </> "async.haddock"-        hasHaddock <- doesFileExist haddock-        unless hasHaddock $ assertFailure ("File `" ++ haddock ++ "` does not exist.")-      cleanHaddockProject testdir+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+-- For the handy instance IsString PackageIdentifier+{-# OPTIONS_GHC -Wno-orphans #-}++module Main where++import Distribution.Client.Compat.Prelude+import Prelude ()++import Distribution.Client.DistDirLayout+import Distribution.Client.HttpUtils+import qualified Distribution.Client.InstallPlan as InstallPlan+import Distribution.Client.ProjectBuilding+import Distribution.Client.ProjectConfig+import Distribution.Client.ProjectOrchestration+  ( distinctTargetComponents+  , resolveTargetsFromSolver+  )+import Distribution.Client.ProjectPlanning+import Distribution.Client.ProjectPlanning.Types+import Distribution.Client.TargetProblem+  ( TargetProblem (..)+  , TargetProblem'+  )+import Distribution.Client.TargetSelector hiding (DirActions (..))+import qualified Distribution.Client.TargetSelector as TS (DirActions (..))+import Distribution.Client.Targets+  ( UserConstraint (..)+  , UserConstraintScope (UserAnyQualifier)+  )+import Distribution.Client.Types+  ( PackageLocation (..)+  , PackageSpecifier (..)+  , UnresolvedSourcePackage+  )+import Distribution.Solver.Types.ConstraintSource+  ( ConstraintSource (ConstraintSourceUnknown)+  )+import Distribution.Solver.Types.PackageConstraint+  ( PackageProperty (PackagePropertySource)+  )+import Distribution.Solver.Types.SourcePackage as SP++import qualified Distribution.Client.CmdBench as CmdBench+import qualified Distribution.Client.CmdBuild as CmdBuild+import qualified Distribution.Client.CmdHaddock as CmdHaddock+import qualified Distribution.Client.CmdListBin as CmdListBin+import qualified Distribution.Client.CmdRepl as CmdRepl+import qualified Distribution.Client.CmdRun as CmdRun+import qualified Distribution.Client.CmdTest as CmdTest++import qualified Distribution.Client.CmdHaddockProject as CmdHaddockProject+import Distribution.Client.Config (SavedConfig (savedGlobalFlags), createDefaultConfigFile, loadConfig)+import Distribution.Client.GlobalFlags+  ( GlobalFlags+  , defaultGlobalFlags+  , globalNix+  )+import Distribution.Client.Setup (globalCommand, globalStoreDir)+import Distribution.InstalledPackageInfo (InstalledPackageInfo)+import Distribution.ModuleName (ModuleName)+import Distribution.Package+import Distribution.PackageDescription+import Distribution.Simple.Command+import Distribution.Simple.Compiler+import qualified Distribution.Simple.Flag as Flag+import Distribution.Simple.Setup (CommonSetupFlags (..), HaddockFlags (..), HaddockProjectFlags (..), defaultCommonSetupFlags, defaultHaddockFlags, defaultHaddockProjectFlags, toFlag)+import Distribution.System+import Distribution.Text+import Distribution.Utils.Path (unsafeMakeSymbolicPath)+import Distribution.Version+import IntegrationTests2.CPP++import Data.List (isInfixOf)+import qualified Data.Map as Map+import qualified Data.Set as Set++import Control.Concurrent (threadDelay)+import Control.Exception hiding (assert)+import Control.Monad+import System.Directory+import System.Environment (setEnv)+import System.FilePath+import System.IO (hPutStrLn, stderr)+import System.Process (callProcess)++import Data.Tagged (Tagged (..))+import Test.Tasty+import Test.Tasty.ExpectedFailure+import Test.Tasty.HUnit hiding (testCase)+import qualified Test.Tasty.HUnit as T (testCase)+import Test.Tasty.Options+import Test.Tasty.Runners++import System.IO.Silently++import qualified Data.ByteString as BS+import Data.Maybe (fromJust)+import Distribution.Simple.Flag (Flag, pattern Flag, pattern NoFlag)+import Distribution.Types.ParStrat++main :: IO ()+main = do+  -- this is needed to ensure tests aren't affected by the user's cabal config+  cwd <- getCurrentDirectory+  let configDir = cwd </> basedir </> "config" </> "cabal-config"+  setEnv "CABAL_DIR" configDir+  removeDirectoryRecursive configDir <|> return ()+  createDirectoryIfMissing True configDir+  -- sigh+  -- NOTE: This is running the `cabal` from the user environment, which is+  -- generally not the `cabal` being tested!+  callProcess "cabal" ["-v0", "user-config", "init", "-f"]+  callProcess "cabal" ["update"]+  defaultMainWithIngredients+    (defaultIngredients ++ [includingOptions projectConfigOptionDescriptions])+    ( localOption (NumThreads 1) $ withProjectConfig $ \config ->+        sequentialTestGroup+          "Integration tests (internal)"+          AllFinish+          (tests config)+    )++-- Tests are run silently, unless they fail. Firstly because it is annoying to+-- see lots of stderr from your unit tests. Secondly because this output+-- leaks into the result of github actions (#8419)+--+-- Note that this capture is safe to use as the testsuite runs sequentially.+silentTest :: TestTree -> TestTree+silentTest = wrapTest silentHelper+  where+    silentHelper t = do+      (out, res) <- hCapture [stderr] t++      return $+        if not (resultSuccessful res)+          then res{resultDescription = resultDescription res <> "\nCaptured output:\n" <> out}+          else res++testCase :: String -> Assertion -> TestTree+testCase desc action = (T.testCase desc action)++tests :: ProjectConfig -> [TestTree]+tests config =+  -- TODO: tests for:+  -- \* normal success+  -- \* dry-run tests with changes+  [ sequentialTestGroup "Discovery and planning" AllFinish $+      [ testCase "no package" (testExceptionInFindingPackage config)+      , testCase "no package2" (testExceptionInFindingPackage2 config)+      , testCase "proj conf1" (testExceptionInProjectConfig config)+      ]+  , sequentialTestGroup "Target selectors" AllFinish $+      [ testCaseSteps "valid" testTargetSelectors+      , testCase "bad syntax" testTargetSelectorBadSyntax+      , testCaseSteps "ambiguous syntax" testTargetSelectorAmbiguous+      , testCase "no current pkg" testTargetSelectorNoCurrentPackage+      , testCase "no targets" testTargetSelectorNoTargets+      , testCase "project empty" testTargetSelectorProjectEmpty+      , testCase "canonicalized path" testTargetSelectorCanonicalizedPath+      , testCase "problems (common)" (testTargetProblemsCommon config)+      , testCaseSteps "problems (build)" (testTargetProblemsBuild config)+      , testCaseSteps "problems (repl)" (testTargetProblemsRepl config)+      , testCaseSteps "problems (run)" (testTargetProblemsRun config)+      , testCaseSteps "problems (list-bin)" (testTargetProblemsListBin config)+      , testCaseSteps "problems (test)" (testTargetProblemsTest config)+      , testCaseSteps "problems (bench)" (testTargetProblemsBench config)+      , testCaseSteps "problems (haddock)" (testTargetProblemsHaddock config)+      ]+  , sequentialTestGroup "Exceptions during building (local inplace)" AllFinish $+      [ testCase "configure" (testExceptionInConfigureStep config)+      , testCase "build" (testExceptionInBuildStep config)+      --    , testCase "register"   testExceptionInRegisterStep+      ]+  , -- TODO: need to repeat for packages for the store+    -- TODO: need to check we can build sub-libs, foreign libs and exes+    -- components for non-local packages / packages in the store.++    sequentialTestGroup "Successful builds" AllFinish $+      [ testCaseSteps "Setup script styles" (testSetupScriptStyles config)+      , testCase "keep-going" (testBuildKeepGoing config)+      ]+        ++ if isMingw32+          then -- disabled because https://github.com/haskell/cabal/issues/6272+            []+          else+            [ testCase "local tarball" (testBuildLocalTarball config)+            ]+  , sequentialTestGroup "Regression tests" AllFinish $+      [ testCase "issue #3324" (testRegressionIssue3324 config)+      , testCase "program options scope all" (testProgramOptionsAll config)+      , testCase "program options scope local" (testProgramOptionsLocal config)+      , testCase "program options scope specific" (testProgramOptionsSpecific config)+      ]+  , sequentialTestGroup "Flag tests" AllFinish $+      [ testCase "Test Nix Flag" testNixFlags+      , testCase "Test Config options for commented options" testConfigOptionComments+      , testCase "Test Ignore Project Flag" testIgnoreProjectFlag+      ]+  , sequentialTestGroup+      "haddock-project"+      AllFinish+      [ testCase "dependencies" (testHaddockProjectDependencies config)+      ]+  ]++testTargetSelectors :: (String -> IO ()) -> Assertion+testTargetSelectors reportSubCase = do+  (_, _, _, localPackages, _) <- configureProject testdir config+  let readTargetSelectors' =+        readTargetSelectorsWith+          (dirActions testdir)+          localPackages+          Nothing++  reportSubCase "cwd"+  do+    Right ts <- readTargetSelectors' []+    ts @?= [TargetPackage TargetImplicitCwd ["p-0.1"] Nothing]++  reportSubCase "all"+  do+    Right ts <-+      readTargetSelectors'+        ["all", ":all"]+    ts @?= replicate 2 (TargetAllPackages Nothing)++  reportSubCase "filter"+  do+    Right ts <-+      readTargetSelectors'+        [ "libs"+        , ":cwd:libs"+        , "flibs"+        , ":cwd:flibs"+        , "exes"+        , ":cwd:exes"+        , "tests"+        , ":cwd:tests"+        , "benchmarks"+        , ":cwd:benchmarks"+        ]+    zipWithM_+      (@?=)+      ts+      [ TargetPackage TargetImplicitCwd ["p-0.1"] (Just kind)+      | kind <- concatMap (replicate 2) [LibKind ..]+      ]++  reportSubCase "all:filter"+  do+    Right ts <-+      readTargetSelectors'+        [ "all:libs"+        , ":all:libs"+        , "all:flibs"+        , ":all:flibs"+        , "all:exes"+        , ":all:exes"+        , "all:tests"+        , ":all:tests"+        , "all:benchmarks"+        , ":all:benchmarks"+        ]+    zipWithM_+      (@?=)+      ts+      [ TargetAllPackages (Just kind)+      | kind <- concatMap (replicate 2) [LibKind ..]+      ]++  reportSubCase "pkg"+  do+    Right ts <-+      readTargetSelectors'+        [ ":pkg:p"+        , "."+        , "./"+        , "p.cabal"+        , "q"+        , ":pkg:q"+        , "q/"+        , "./q/"+        , "q/q.cabal"+        ]+    ts+      @?= replicate 4 (mkTargetPackage "p-0.1")+        ++ replicate 5 (mkTargetPackage "q-0.1")++  reportSubCase "pkg:filter"+  do+    Right ts <-+      readTargetSelectors'+        [ "p:libs"+        , ".:libs"+        , ":pkg:p:libs"+        , "p:flibs"+        , ".:flibs"+        , ":pkg:p:flibs"+        , "p:exes"+        , ".:exes"+        , ":pkg:p:exes"+        , "p:tests"+        , ".:tests"+        , ":pkg:p:tests"+        , "p:benchmarks"+        , ".:benchmarks"+        , ":pkg:p:benchmarks"+        , "q:libs"+        , "q/:libs"+        , ":pkg:q:libs"+        , "q:flibs"+        , "q/:flibs"+        , ":pkg:q:flibs"+        , "q:exes"+        , "q/:exes"+        , ":pkg:q:exes"+        , "q:tests"+        , "q/:tests"+        , ":pkg:q:tests"+        , "q:benchmarks"+        , "q/:benchmarks"+        , ":pkg:q:benchmarks"+        ]+    zipWithM_ (@?=) ts $+      [ TargetPackage TargetExplicitNamed ["p-0.1"] (Just kind)+      | kind <- concatMap (replicate 3) [LibKind ..]+      ]+        ++ [ TargetPackage TargetExplicitNamed ["q-0.1"] (Just kind)+           | kind <- concatMap (replicate 3) [LibKind ..]+           ]++  reportSubCase "component"+  do+    Right ts <-+      readTargetSelectors'+        [ "p"+        , "lib:p"+        , "p:lib:p"+        , ":pkg:p:lib:p"+        , "lib:q"+        , "q:lib:q"+        , ":pkg:q:lib:q"+        ]+    ts+      @?= replicate 4 (TargetComponent "p-0.1" (CLibName LMainLibName) WholeComponent)+        ++ replicate 3 (TargetComponent "q-0.1" (CLibName LMainLibName) WholeComponent)++  reportSubCase "module"+  do+    Right ts <-+      readTargetSelectors'+        [ "P"+        , "lib:p:P"+        , "p:p:P"+        , ":pkg:p:lib:p:module:P"+        , "QQ"+        , "lib:q:QQ"+        , "q:q:QQ"+        , ":pkg:q:lib:q:module:QQ"+        , "pexe:PMain" -- p:P or q:QQ would be ambiguous here+        , "qexe:QMain" -- package p vs component p+        ]+    ts+      @?= replicate 4 (TargetComponent "p-0.1" (CLibName LMainLibName) (ModuleTarget "P"))+        ++ replicate 4 (TargetComponent "q-0.1" (CLibName LMainLibName) (ModuleTarget "QQ"))+        ++ [ TargetComponent "p-0.1" (CExeName "pexe") (ModuleTarget "PMain")+           , TargetComponent "q-0.1" (CExeName "qexe") (ModuleTarget "QMain")+           ]++  reportSubCase "file"+  do+    Right ts <-+      readTargetSelectors'+        [ "./P.hs"+        , "p:P.lhs"+        , "lib:p:P.hsc"+        , "p:p:P.hsc"+        , ":pkg:p:lib:p:file:P.y"+        , "q/QQ.hs"+        , "q:QQ.lhs"+        , "lib:q:QQ.hsc"+        , "q:q:QQ.hsc"+        , ":pkg:q:lib:q:file:QQ.y"+        , "q/Q.hs"+        , "q:Q.lhs"+        , "lib:q:Q.hsc"+        , "q:q:Q.hsc"+        , ":pkg:q:lib:q:file:Q.y"+        , "app/Main.hs"+        , "p:app/Main.hs"+        , "exe:ppexe:app/Main.hs"+        , "p:ppexe:app/Main.hs"+        , ":pkg:p:exe:ppexe:file:app/Main.hs"+        , "a p p/Main.hs"+        , "p:a p p/Main.hs"+        , "exe:pppexe:a p p/Main.hs"+        , "p:pppexe:a p p/Main.hs"+        , ":pkg:p:exe:pppexe:file:a p p/Main.hs"+        ]+    ts+      @?= replicate 5 (TargetComponent "p-0.1" (CLibName LMainLibName) (FileTarget "P"))+        ++ replicate 5 (TargetComponent "q-0.1" (CLibName LMainLibName) (FileTarget "QQ"))+        ++ replicate 5 (TargetComponent "q-0.1" (CLibName LMainLibName) (FileTarget "Q"))+        ++ replicate 5 (TargetComponent "p-0.1" (CExeName "ppexe") (FileTarget ("app" </> "Main.hs")))+        ++ replicate 5 (TargetComponent "p-0.1" (CExeName "pppexe") (FileTarget ("a p p" </> "Main.hs")))+  -- Note there's a bit of an inconsistency here: for the single-part+  -- syntax the target has to point to a file that exists, whereas for+  -- all the other forms we don't require that.++  cleanProject testdir+  where+    testdir = "targets/simple"+    config = mempty++testTargetSelectorBadSyntax :: Assertion+testTargetSelectorBadSyntax = do+  (_, _, _, localPackages, _) <- configureProject testdir config+  let targets =+        [ "foo:"+        , "foo::bar"+        , " :foo"+        , "foo: :bar"+        , "a:b:c:d:e:f"+        , "a:b:c:d:e:f:g:h"+        ]+  Left errs <- readTargetSelectors localPackages Nothing targets+  zipWithM_ (@?=) errs (map TargetSelectorUnrecognised targets)+  cleanProject testdir+  where+    testdir = "targets/empty"+    config = mempty++testTargetSelectorAmbiguous :: (String -> IO ()) -> Assertion+testTargetSelectorAmbiguous reportSubCase = do+  -- 'all' is ambiguous with packages and cwd components+  reportSubCase "ambiguous: all vs pkg"+  assertAmbiguous+    "all"+    [mkTargetPackage "all", mkTargetAllPackages]+    [mkpkg "all" []]++  reportSubCase "ambiguous: all vs cwd component"+  assertAmbiguous+    "all"+    [mkTargetComponent "other" (CExeName "all"), mkTargetAllPackages]+    [mkpkg "other" [mkexe "all"]]++  -- but 'all' is not ambiguous with non-cwd components, modules or files+  reportSubCase "unambiguous: all vs non-cwd comp, mod, file"+  assertUnambiguous+    "All"+    mkTargetAllPackages+    [ mkpkgAt "foo" [mkexe "All"] "foo"+    , mkpkg+        "bar"+        [ mkexe "bar" `withModules` ["All"]+        , mkexe "baz" `withCFiles` ["All"]+        ]+    ]++  -- filters 'libs', 'exes' etc are ambiguous with packages and+  -- local components+  reportSubCase "ambiguous: cwd-pkg filter vs pkg"+  assertAmbiguous+    "libs"+    [ mkTargetPackage "libs"+    , TargetPackage TargetImplicitCwd ["libs"] (Just LibKind)+    ]+    [mkpkg "libs" []]++  reportSubCase "ambiguous: filter vs cwd component"+  assertAmbiguous+    "exes"+    [ mkTargetComponent "other" (CExeName "exes")+    , TargetPackage TargetImplicitCwd ["other"] (Just ExeKind)+    ]+    [mkpkg "other" [mkexe "exes"]]++  -- but filters are not ambiguous with non-cwd components, modules or files+  reportSubCase "unambiguous: filter vs non-cwd comp, mod, file"+  assertUnambiguous+    "Libs"+    (TargetPackage TargetImplicitCwd ["bar"] (Just LibKind))+    [ mkpkgAt "foo" [mkexe "Libs"] "foo"+    , mkpkg+        "bar"+        [ mkexe "bar" `withModules` ["Libs"]+        , mkexe "baz" `withCFiles` ["Libs"]+        ]+    ]++  -- local components shadow packages and other components+  reportSubCase "unambiguous: cwd comp vs pkg, non-cwd comp"+  assertUnambiguous+    "foo"+    (mkTargetComponent "other" (CExeName "foo"))+    [ mkpkg "other" [mkexe "foo"]+    , mkpkgAt "other2" [mkexe "foo"] "other2" -- shadows non-local foo+    , mkpkg "foo" [] -- shadows package foo+    ]++  -- local components shadow modules and files+  reportSubCase "unambiguous: cwd comp vs module, file"+  assertUnambiguous+    "Foo"+    (mkTargetComponent "bar" (CExeName "Foo"))+    [ mkpkg "bar" [mkexe "Foo"]+    , mkpkg+        "other"+        [ mkexe "other" `withModules` ["Foo"]+        , mkexe "other2" `withCFiles` ["Foo"]+        ]+    ]++  -- packages shadow non-local components+  reportSubCase "unambiguous: pkg vs non-cwd comp"+  assertUnambiguous+    "foo"+    (mkTargetPackage "foo")+    [ mkpkg "foo" []+    , mkpkgAt "other" [mkexe "foo"] "other" -- shadows non-local foo+    ]++  -- packages shadow modules and files+  reportSubCase "unambiguous: pkg vs module, file"+  assertUnambiguous+    "Foo"+    (mkTargetPackage "Foo")+    [ mkpkgAt "Foo" [] "foo"+    , mkpkg+        "other"+        [ mkexe "other" `withModules` ["Foo"]+        , mkexe "other2" `withCFiles` ["Foo"]+        ]+    ]++  -- File target is ambiguous, part of multiple components+  reportSubCase "ambiguous: file in multiple comps"+  assertAmbiguous+    "Bar.hs"+    [ mkTargetFile "foo" (CExeName "bar") "Bar"+    , mkTargetFile "foo" (CExeName "bar2") "Bar"+    ]+    [ mkpkg+        "foo"+        [ mkexe "bar" `withModules` ["Bar"]+        , mkexe "bar2" `withModules` ["Bar"]+        ]+    ]+  reportSubCase "ambiguous: file in multiple comps with path"+  assertAmbiguous+    ("src" </> "Bar.hs")+    [ mkTargetFile "foo" (CExeName "bar") ("src" </> "Bar")+    , mkTargetFile "foo" (CExeName "bar2") ("src" </> "Bar")+    ]+    [ mkpkg+        "foo"+        [ mkexe "bar" `withModules` ["Bar"] `withHsSrcDirs` ["src"]+        , mkexe "bar2" `withModules` ["Bar"] `withHsSrcDirs` ["src"]+        ]+    ]++  -- non-exact case packages and components are ambiguous+  reportSubCase "ambiguous: non-exact-case pkg names"+  assertAmbiguous+    "Foo"+    [mkTargetPackage "foo", mkTargetPackage "FOO"]+    [mkpkg "foo" [], mkpkg "FOO" []]+  reportSubCase "ambiguous: non-exact-case comp names"+  assertAmbiguous+    "Foo"+    [ mkTargetComponent "bar" (CExeName "foo")+    , mkTargetComponent "bar" (CExeName "FOO")+    ]+    [mkpkg "bar" [mkexe "foo", mkexe "FOO"]]++  -- exact-case Module or File over non-exact case package or component+  reportSubCase "unambiguous: module vs non-exact-case pkg, comp"+  assertUnambiguous+    "Baz"+    (mkTargetModule "other" (CExeName "other") "Baz")+    [ mkpkg "baz" [mkexe "BAZ"]+    , mkpkg "other" [mkexe "other" `withModules` ["Baz"]]+    ]+  reportSubCase "unambiguous: file vs non-exact-case pkg, comp"+  assertUnambiguous+    "Baz"+    (mkTargetFile "other" (CExeName "other") "Baz")+    [ mkpkg "baz" [mkexe "BAZ"]+    , mkpkg "other" [mkexe "other" `withCFiles` ["Baz"]]+    ]+  where+    assertAmbiguous+      :: String+      -> [TargetSelector]+      -> [SourcePackage (PackageLocation a)]+      -> Assertion+    assertAmbiguous str tss pkgs = do+      res <-+        readTargetSelectorsWith+          fakeDirActions+          (map SpecificSourcePackage pkgs)+          Nothing+          [str]+      case res of+        Left [TargetSelectorAmbiguous _ tss'] ->+          sort (map snd tss') @?= sort tss+        _ ->+          assertFailure $+            "expected Left [TargetSelectorAmbiguous _ _], "+              ++ "got "+              ++ show res++    assertUnambiguous+      :: String+      -> TargetSelector+      -> [SourcePackage (PackageLocation a)]+      -> Assertion+    assertUnambiguous str ts pkgs = do+      res <-+        readTargetSelectorsWith+          fakeDirActions+          (map SpecificSourcePackage pkgs)+          Nothing+          [str]+      case res of+        Right [ts'] -> ts' @?= ts+        _ ->+          assertFailure $+            "expected Right [Target...], "+              ++ "got "+              ++ show res++    fakeDirActions =+      TS.DirActions+        { TS.doesFileExist = \_p -> return True+        , TS.doesDirectoryExist = \_p -> return True+        , TS.canonicalizePath = \p -> return ("/" </> p) -- FilePath.Unix.</> ?+        , TS.getCurrentDirectory = return "/"+        }++    mkpkg :: String -> [Executable] -> SourcePackage (PackageLocation a)+    mkpkg pkgidstr exes = mkpkgAt pkgidstr exes ""++    mkpkgAt+      :: String+      -> [Executable]+      -> FilePath+      -> SourcePackage (PackageLocation a)+    mkpkgAt pkgidstr exes loc =+      SourcePackage+        { srcpkgPackageId = pkgid+        , srcpkgSource = LocalUnpackedPackage loc+        , srcpkgDescrOverride = Nothing+        , srcpkgDescription =+            GenericPackageDescription+              { packageDescription = emptyPackageDescription{package = pkgid}+              , gpdScannedVersion = Nothing+              , genPackageFlags = []+              , condLibrary = Nothing+              , condSubLibraries = []+              , condForeignLibs = []+              , condExecutables =+                  [ (exeName exe, CondNode exe [] [])+                  | exe <- exes+                  ]+              , condTestSuites = []+              , condBenchmarks = []+              }+        }+      where+        pkgid = fromMaybe (error $ "failed to parse " ++ pkgidstr) $ simpleParse pkgidstr++    mkexe :: String -> Executable+    mkexe name = mempty{exeName = fromString name}++    withModules :: Executable -> [String] -> Executable+    withModules exe mods =+      exe{buildInfo = (buildInfo exe){otherModules = map fromString mods}}++    withCFiles :: Executable -> [FilePath] -> Executable+    withCFiles exe files =+      exe{buildInfo = (buildInfo exe){cSources = map unsafeMakeSymbolicPath files}}++    withHsSrcDirs :: Executable -> [FilePath] -> Executable+    withHsSrcDirs exe srcDirs =+      exe{buildInfo = (buildInfo exe){hsSourceDirs = map unsafeMakeSymbolicPath srcDirs}}++mkTargetPackage :: PackageId -> TargetSelector+mkTargetPackage pkgid =+  TargetPackage TargetExplicitNamed [pkgid] Nothing++mkTargetComponent :: PackageId -> ComponentName -> TargetSelector+mkTargetComponent pkgid cname =+  TargetComponent pkgid cname WholeComponent++mkTargetModule :: PackageId -> ComponentName -> ModuleName -> TargetSelector+mkTargetModule pkgid cname mname =+  TargetComponent pkgid cname (ModuleTarget mname)++mkTargetFile :: PackageId -> ComponentName -> String -> TargetSelector+mkTargetFile pkgid cname fname =+  TargetComponent pkgid cname (FileTarget fname)++mkTargetAllPackages :: TargetSelector+mkTargetAllPackages = TargetAllPackages Nothing++instance IsString PackageIdentifier where+  fromString pkgidstr = pkgid+    where+      pkgid = fromMaybe (error $ "fromString @PackageIdentifier " ++ show pkgidstr) $ simpleParse pkgidstr++testTargetSelectorNoCurrentPackage :: Assertion+testTargetSelectorNoCurrentPackage = do+  (_, _, _, localPackages, _) <- configureProject testdir config+  let readTargetSelectors' =+        readTargetSelectorsWith+          (dirActions testdir)+          localPackages+          Nothing+      targets =+        [ "libs"+        , ":cwd:libs"+        , "flibs"+        , ":cwd:flibs"+        , "exes"+        , ":cwd:exes"+        , "tests"+        , ":cwd:tests"+        , "benchmarks"+        , ":cwd:benchmarks"+        ]+  Left errs <- readTargetSelectors' targets+  zipWithM_+    (@?=)+    errs+    [ TargetSelectorNoCurrentPackage ts+    | target <- targets+    , let ts = fromMaybe (error $ "failed to parse target string " ++ target) $ parseTargetString target+    ]+  cleanProject testdir+  where+    testdir = "targets/complex"+    config = mempty++testTargetSelectorNoTargets :: Assertion+testTargetSelectorNoTargets = do+  (_, _, _, localPackages, _) <- configureProject testdir config+  Left errs <- readTargetSelectors localPackages Nothing []+  errs @?= [TargetSelectorNoTargetsInCwd True]+  cleanProject testdir+  where+    testdir = "targets/complex"+    config = mempty++testTargetSelectorProjectEmpty :: Assertion+testTargetSelectorProjectEmpty = do+  (_, _, _, localPackages, _) <- configureProject testdir config+  Left errs <- readTargetSelectors localPackages Nothing []+  errs @?= [TargetSelectorNoTargetsInProject]+  cleanProject testdir+  where+    testdir = "targets/empty"+    config = mempty++-- | Ensure we don't miss primary package and produce+-- TargetSelectorNoTargetsInCwd error due to symlink or+-- drive capitalisation mismatch when no targets are given+testTargetSelectorCanonicalizedPath :: Assertion+testTargetSelectorCanonicalizedPath = do+  (_, _, _, localPackages, _) <- configureProject testdir config+  cwd <- getCurrentDirectory+  let virtcwd = cwd </> basedir </> symlink+  -- Check that the symlink is there before running test as on Windows+  -- some versions/configurations of git won't pull down/create the symlink+  canRunTest <- doesDirectoryExist virtcwd+  when+    canRunTest+    ( do+        let dirActions' = (dirActions symlink){TS.getCurrentDirectory = return virtcwd}+        Right ts <- readTargetSelectorsWith dirActions' localPackages Nothing []+        ts @?= [TargetPackage TargetImplicitCwd ["p-0.1"] Nothing]+    )+  cleanProject testdir+  where+    testdir = "targets/simple"+    symlink = "targets/symbolic-link-to-simple"+    config = mempty++testTargetProblemsCommon :: ProjectConfig -> Assertion+testTargetProblemsCommon config0 = do+  (_, elaboratedPlan, _) <- planProject testdir config++  let pkgIdMap :: Map.Map PackageName PackageId+      pkgIdMap =+        Map.fromList+          [ (packageName p, packageId p)+          | p <- InstallPlan.toList elaboratedPlan+          ]++      cases+        :: [ ( TargetSelector -> TargetProblem'+             , TargetSelector+             )+           ]+      cases =+        [ -- Cannot resolve packages outside of the project++          ( \_ -> TargetProblemNoSuchPackage "foobar"+          , mkTargetPackage "foobar"+          )+        , -- We cannot currently build components like testsuites or+          -- benchmarks from packages that are not local to the project++          ( \_ ->+              TargetComponentNotProjectLocal+                (pkgIdMap Map.! "filepath")+                (CTestName "filepath-tests")+                WholeComponent+          , mkTargetComponent+              (pkgIdMap Map.! "filepath")+              (CTestName "filepath-tests")+          )+        , -- Components can be explicitly @buildable: False@++          ( \_ -> TargetComponentNotBuildable "q-0.1" (CExeName "buildable-false") WholeComponent+          , mkTargetComponent "q-0.1" (CExeName "buildable-false")+          )+        , -- Testsuites and benchmarks can be disabled by the solver if it+          -- cannot satisfy deps++          ( \_ -> TargetOptionalStanzaDisabledBySolver "q-0.1" (CTestName "solver-disabled") WholeComponent+          , mkTargetComponent "q-0.1" (CTestName "solver-disabled")+          )+        , -- Testsuites and benchmarks can be disabled explicitly by the+          -- user via config++          ( \_ ->+              TargetOptionalStanzaDisabledByUser+                "q-0.1"+                (CBenchName "user-disabled")+                WholeComponent+          , mkTargetComponent "q-0.1" (CBenchName "user-disabled")+          )+        , -- An unknown package. The target selector resolution should only+          -- produce known packages, so this should not happen with the+          -- output from 'readTargetSelectors'.++          ( \_ -> TargetProblemNoSuchPackage "foobar"+          , mkTargetPackage "foobar"+          )+        , -- An unknown component of a known package. The target selector+          -- resolution should only produce known packages, so this should+          -- not happen with the output from 'readTargetSelectors'.++          ( \_ -> TargetProblemNoSuchComponent "q-0.1" (CExeName "no-such")+          , mkTargetComponent "q-0.1" (CExeName "no-such")+          )+        ]+  assertTargetProblems+    elaboratedPlan+    CmdBuild.selectPackageTargets+    CmdBuild.selectComponentTarget+    cases+  where+    testdir = "targets/complex"+    config =+      config0+        { projectConfigLocalPackages =+            (projectConfigLocalPackages config0)+              { packageConfigBenchmarks = toFlag False+              }+        , projectConfigShared =+            (projectConfigShared config0)+              { projectConfigConstraints =+                  [+                    ( UserConstraint (UserAnyQualifier "filepath") PackagePropertySource+                    , ConstraintSourceUnknown+                    )+                  ]+              }+        }++testTargetProblemsBuild :: ProjectConfig -> (String -> IO ()) -> Assertion+testTargetProblemsBuild config reportSubCase = do+  reportSubCase "empty-pkg"+  assertProjectTargetProblems+    "targets/empty-pkg"+    config+    CmdBuild.selectPackageTargets+    CmdBuild.selectComponentTarget+    [ (TargetProblemNoTargets, mkTargetPackage "p-0.1")+    ]++  reportSubCase "all-disabled"+  assertProjectTargetProblems+    "targets/all-disabled"+    config+      { projectConfigLocalPackages =+          (projectConfigLocalPackages config)+            { packageConfigBenchmarks = toFlag False+            }+      }+    CmdBuild.selectPackageTargets+    CmdBuild.selectComponentTarget+    [+      ( flip+          TargetProblemNoneEnabled+          [ AvailableTarget+              "p-0.1"+              (CBenchName "user-disabled")+              TargetDisabledByUser+              True+          , AvailableTarget+              "p-0.1"+              (CTestName "solver-disabled")+              TargetDisabledBySolver+              True+          , AvailableTarget+              "p-0.1"+              (CExeName "buildable-false")+              TargetNotBuildable+              True+          , AvailableTarget+              "p-0.1"+              (CLibName LMainLibName)+              TargetNotBuildable+              True+          ]+      , mkTargetPackage "p-0.1"+      )+    ]++  reportSubCase "enabled component kinds"+  -- When we explicitly enable all the component kinds then selecting the+  -- whole package selects those component kinds too+  do+    (_, elaboratedPlan, _) <-+      planProject+        "targets/variety"+        config+          { projectConfigLocalPackages =+              (projectConfigLocalPackages config)+                { packageConfigTests = toFlag True+                , packageConfigBenchmarks = toFlag True+                }+          }+    assertProjectDistinctTargets+      elaboratedPlan+      CmdBuild.selectPackageTargets+      CmdBuild.selectComponentTarget+      [mkTargetPackage "p-0.1"]+      [ ("p-0.1-inplace", (CLibName LMainLibName))+      , ("p-0.1-inplace-a-benchmark", CBenchName "a-benchmark")+      , ("p-0.1-inplace-a-testsuite", CTestName "a-testsuite")+      , ("p-0.1-inplace-an-exe", CExeName "an-exe")+      , ("p-0.1-inplace-libp", CFLibName "libp")+      ]++  reportSubCase "disabled component kinds"+  -- When we explicitly disable all the component kinds then selecting the+  -- whole package only selects the library, foreign lib and exes+  do+    (_, elaboratedPlan, _) <-+      planProject+        "targets/variety"+        config+          { projectConfigLocalPackages =+              (projectConfigLocalPackages config)+                { packageConfigTests = toFlag False+                , packageConfigBenchmarks = toFlag False+                }+          }+    assertProjectDistinctTargets+      elaboratedPlan+      CmdBuild.selectPackageTargets+      CmdBuild.selectComponentTarget+      [mkTargetPackage "p-0.1"]+      [ ("p-0.1-inplace", (CLibName LMainLibName))+      , ("p-0.1-inplace-an-exe", CExeName "an-exe")+      , ("p-0.1-inplace-libp", CFLibName "libp")+      ]++  reportSubCase "requested component kinds"+  -- When we selecting the package with an explicit filter then we get those+  -- components even though we did not explicitly enable tests/benchmarks+  do+    (_, elaboratedPlan, _) <- planProject "targets/variety" config+    assertProjectDistinctTargets+      elaboratedPlan+      CmdBuild.selectPackageTargets+      CmdBuild.selectComponentTarget+      [ TargetPackage TargetExplicitNamed ["p-0.1"] (Just TestKind)+      , TargetPackage TargetExplicitNamed ["p-0.1"] (Just BenchKind)+      ]+      [ ("p-0.1-inplace-a-benchmark", CBenchName "a-benchmark")+      , ("p-0.1-inplace-a-testsuite", CTestName "a-testsuite")+      ]++testTargetProblemsRepl :: ProjectConfig -> (String -> IO ()) -> Assertion+testTargetProblemsRepl config reportSubCase = do+  reportSubCase "multiple-libs"+  assertProjectTargetProblems+    "targets/multiple-libs"+    config+    (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False))+    CmdRepl.selectComponentTarget+    [+      ( flip+          (CmdRepl.matchesMultipleProblem (CmdRepl.MultiReplDecision Nothing False))+          [ AvailableTarget+              "p-0.1"+              (CLibName LMainLibName)+              (TargetBuildable () TargetRequestedByDefault)+              True+          , AvailableTarget+              "q-0.1"+              (CLibName LMainLibName)+              (TargetBuildable () TargetRequestedByDefault)+              True+          ]+      , mkTargetAllPackages+      )+    ]++  reportSubCase "multiple-exes"+  assertProjectTargetProblems+    "targets/multiple-exes"+    config+    (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False))+    CmdRepl.selectComponentTarget+    [+      ( flip+          (CmdRepl.matchesMultipleProblem (CmdRepl.MultiReplDecision Nothing False))+          [ AvailableTarget+              "p-0.1"+              (CExeName "p2")+              (TargetBuildable () TargetRequestedByDefault)+              True+          , AvailableTarget+              "p-0.1"+              (CExeName "p1")+              (TargetBuildable () TargetRequestedByDefault)+              True+          ]+      , mkTargetPackage "p-0.1"+      )+    ]++  reportSubCase "multiple-tests"+  assertProjectTargetProblems+    "targets/multiple-tests"+    config+    (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False))+    CmdRepl.selectComponentTarget+    [+      ( flip+          (CmdRepl.matchesMultipleProblem (CmdRepl.MultiReplDecision Nothing False))+          [ AvailableTarget+              "p-0.1"+              (CTestName "p2")+              (TargetBuildable () TargetNotRequestedByDefault)+              True+          , AvailableTarget+              "p-0.1"+              (CTestName "p1")+              (TargetBuildable () TargetNotRequestedByDefault)+              True+          ]+      , TargetPackage TargetExplicitNamed ["p-0.1"] (Just TestKind)+      )+    ]++  reportSubCase "multiple targets"+  do+    (_, elaboratedPlan, _) <- planProject "targets/multiple-exes" config+    assertProjectDistinctTargets+      elaboratedPlan+      (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False))+      CmdRepl.selectComponentTarget+      [ mkTargetComponent "p-0.1" (CExeName "p1")+      , mkTargetComponent "p-0.1" (CExeName "p2")+      ]+      [ ("p-0.1-inplace-p1", CExeName "p1")+      , ("p-0.1-inplace-p2", CExeName "p2")+      ]++  reportSubCase "libs-disabled"+  assertProjectTargetProblems+    "targets/libs-disabled"+    config+    (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False))+    CmdRepl.selectComponentTarget+    [+      ( flip+          TargetProblemNoneEnabled+          [AvailableTarget "p-0.1" (CLibName LMainLibName) TargetNotBuildable True]+      , mkTargetPackage "p-0.1"+      )+    ]++  reportSubCase "exes-disabled"+  assertProjectTargetProblems+    "targets/exes-disabled"+    config+    (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False))+    CmdRepl.selectComponentTarget+    [+      ( flip+          TargetProblemNoneEnabled+          [ AvailableTarget "p-0.1" (CExeName "p") TargetNotBuildable True+          ]+      , mkTargetPackage "p-0.1"+      )+    ]++  reportSubCase "test-only"+  assertProjectTargetProblems+    "targets/test-only"+    config+    (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False))+    CmdRepl.selectComponentTarget+    [+      ( flip+          TargetProblemNoneEnabled+          [ AvailableTarget+              "p-0.1"+              (CTestName "pexe")+              (TargetBuildable () TargetNotRequestedByDefault)+              True+          ]+      , mkTargetPackage "p-0.1"+      )+    ]++  reportSubCase "empty-pkg"+  assertProjectTargetProblems+    "targets/empty-pkg"+    config+    (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False))+    CmdRepl.selectComponentTarget+    [ (TargetProblemNoTargets, mkTargetPackage "p-0.1")+    ]++  reportSubCase "requested component kinds"+  do+    (_, elaboratedPlan, _) <- planProject "targets/variety" config+    -- by default we only get the lib+    assertProjectDistinctTargets+      elaboratedPlan+      (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False))+      CmdRepl.selectComponentTarget+      [TargetPackage TargetExplicitNamed ["p-0.1"] Nothing]+      [("p-0.1-inplace", (CLibName LMainLibName))]+    -- When we select the package with an explicit filter then we get those+    -- components even though we did not explicitly enable tests/benchmarks+    assertProjectDistinctTargets+      elaboratedPlan+      (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False))+      CmdRepl.selectComponentTarget+      [TargetPackage TargetExplicitNamed ["p-0.1"] (Just TestKind)]+      [("p-0.1-inplace-a-testsuite", CTestName "a-testsuite")]+    assertProjectDistinctTargets+      elaboratedPlan+      (CmdRepl.selectPackageTargets (CmdRepl.MultiReplDecision Nothing False))+      CmdRepl.selectComponentTarget+      [TargetPackage TargetExplicitNamed ["p-0.1"] (Just BenchKind)]+      [("p-0.1-inplace-a-benchmark", CBenchName "a-benchmark")]++testTargetProblemsListBin :: ProjectConfig -> (String -> IO ()) -> Assertion+testTargetProblemsListBin config reportSubCase = do+  reportSubCase "one-of-each"+  do+    (_, elaboratedPlan, _) <- planProject "targets/one-of-each" config+    assertProjectDistinctTargets+      elaboratedPlan+      CmdListBin.selectPackageTargets+      CmdListBin.selectComponentTarget+      [ TargetPackage TargetExplicitNamed ["p-0.1"] Nothing+      ]+      [ ("p-0.1-inplace-p1", CExeName "p1")+      ]++  reportSubCase "multiple-exes"+  assertProjectTargetProblems+    "targets/multiple-exes"+    config+    CmdListBin.selectPackageTargets+    CmdListBin.selectComponentTarget+    [+      ( flip+          CmdListBin.matchesMultipleProblem+          [ AvailableTarget+              "p-0.1"+              (CExeName "p2")+              (TargetBuildable () TargetRequestedByDefault)+              True+          , AvailableTarget+              "p-0.1"+              (CExeName "p1")+              (TargetBuildable () TargetRequestedByDefault)+              True+          ]+      , mkTargetPackage "p-0.1"+      )+    ]++  reportSubCase "multiple targets"+  do+    (_, elaboratedPlan, _) <- planProject "targets/multiple-exes" config+    assertProjectDistinctTargets+      elaboratedPlan+      CmdListBin.selectPackageTargets+      CmdListBin.selectComponentTarget+      [ mkTargetComponent "p-0.1" (CExeName "p1")+      , mkTargetComponent "p-0.1" (CExeName "p2")+      ]+      [ ("p-0.1-inplace-p1", CExeName "p1")+      , ("p-0.1-inplace-p2", CExeName "p2")+      ]++  reportSubCase "exes-disabled"+  assertProjectTargetProblems+    "targets/exes-disabled"+    config+    CmdListBin.selectPackageTargets+    CmdListBin.selectComponentTarget+    [+      ( flip+          TargetProblemNoneEnabled+          [ AvailableTarget "p-0.1" (CExeName "p") TargetNotBuildable True+          ]+      , mkTargetPackage "p-0.1"+      )+    ]++  reportSubCase "empty-pkg"+  assertProjectTargetProblems+    "targets/empty-pkg"+    config+    CmdListBin.selectPackageTargets+    CmdListBin.selectComponentTarget+    [ (TargetProblemNoTargets, mkTargetPackage "p-0.1")+    ]++  reportSubCase "lib-only"+  assertProjectTargetProblems+    "targets/lib-only"+    config+    CmdListBin.selectPackageTargets+    CmdListBin.selectComponentTarget+    [ (CmdListBin.noComponentsProblem, mkTargetPackage "p-0.1")+    ]++testTargetProblemsRun :: ProjectConfig -> (String -> IO ()) -> Assertion+testTargetProblemsRun config reportSubCase = do+  reportSubCase "one-of-each"+  do+    (_, elaboratedPlan, _) <- planProject "targets/one-of-each" config+    assertProjectDistinctTargets+      elaboratedPlan+      CmdRun.selectPackageTargets+      CmdRun.selectComponentTarget+      [ TargetPackage TargetExplicitNamed ["p-0.1"] Nothing+      ]+      [ ("p-0.1-inplace-p1", CExeName "p1")+      ]++  reportSubCase "multiple-exes"+  assertProjectTargetProblems+    "targets/multiple-exes"+    config+    CmdRun.selectPackageTargets+    CmdRun.selectComponentTarget+    [+      ( flip+          CmdRun.matchesMultipleProblem+          [ AvailableTarget+              "p-0.1"+              (CExeName "p2")+              (TargetBuildable () TargetRequestedByDefault)+              True+          , AvailableTarget+              "p-0.1"+              (CExeName "p1")+              (TargetBuildable () TargetRequestedByDefault)+              True+          ]+      , mkTargetPackage "p-0.1"+      )+    ]++  reportSubCase "multiple targets"+  do+    (_, elaboratedPlan, _) <- planProject "targets/multiple-exes" config+    assertProjectDistinctTargets+      elaboratedPlan+      CmdRun.selectPackageTargets+      CmdRun.selectComponentTarget+      [ mkTargetComponent "p-0.1" (CExeName "p1")+      , mkTargetComponent "p-0.1" (CExeName "p2")+      ]+      [ ("p-0.1-inplace-p1", CExeName "p1")+      , ("p-0.1-inplace-p2", CExeName "p2")+      ]++  reportSubCase "exes-disabled"+  assertProjectTargetProblems+    "targets/exes-disabled"+    config+    CmdRun.selectPackageTargets+    CmdRun.selectComponentTarget+    [+      ( flip+          TargetProblemNoneEnabled+          [ AvailableTarget "p-0.1" (CExeName "p") TargetNotBuildable True+          ]+      , mkTargetPackage "p-0.1"+      )+    ]++  reportSubCase "empty-pkg"+  assertProjectTargetProblems+    "targets/empty-pkg"+    config+    CmdRun.selectPackageTargets+    CmdRun.selectComponentTarget+    [ (TargetProblemNoTargets, mkTargetPackage "p-0.1")+    ]++  reportSubCase "lib-only"+  assertProjectTargetProblems+    "targets/lib-only"+    config+    CmdRun.selectPackageTargets+    CmdRun.selectComponentTarget+    [ (CmdRun.noExesProblem, mkTargetPackage "p-0.1")+    ]++testTargetProblemsTest :: ProjectConfig -> (String -> IO ()) -> Assertion+testTargetProblemsTest config reportSubCase = do+  reportSubCase "disabled by config"+  assertProjectTargetProblems+    "targets/tests-disabled"+    config+      { projectConfigLocalPackages =+          (projectConfigLocalPackages config)+            { packageConfigTests = toFlag False+            }+      }+    CmdTest.selectPackageTargets+    CmdTest.selectComponentTarget+    [+      ( flip+          TargetProblemNoneEnabled+          [ AvailableTarget+              "p-0.1"+              (CTestName "user-disabled")+              TargetDisabledByUser+              True+          , AvailableTarget+              "p-0.1"+              (CTestName "solver-disabled")+              TargetDisabledByUser+              True+          ]+      , mkTargetPackage "p-0.1"+      )+    ]++  reportSubCase "disabled by solver & buildable false"+  assertProjectTargetProblems+    "targets/tests-disabled"+    config+    CmdTest.selectPackageTargets+    CmdTest.selectComponentTarget+    [+      ( flip+          TargetProblemNoneEnabled+          [ AvailableTarget+              "p-0.1"+              (CTestName "user-disabled")+              TargetDisabledBySolver+              True+          , AvailableTarget+              "p-0.1"+              (CTestName "solver-disabled")+              TargetDisabledBySolver+              True+          ]+      , mkTargetPackage "p-0.1"+      )+    ,+      ( flip+          TargetProblemNoneEnabled+          [ AvailableTarget+              "q-0.1"+              (CTestName "buildable-false")+              TargetNotBuildable+              True+          ]+      , mkTargetPackage "q-0.1"+      )+    ]++  reportSubCase "empty-pkg"+  assertProjectTargetProblems+    "targets/empty-pkg"+    config+    CmdTest.selectPackageTargets+    CmdTest.selectComponentTarget+    [ (TargetProblemNoTargets, mkTargetPackage "p-0.1")+    ]++  reportSubCase "no tests"+  assertProjectTargetProblems+    "targets/simple"+    config+    CmdTest.selectPackageTargets+    CmdTest.selectComponentTarget+    [ (CmdTest.noTestsProblem, mkTargetPackage "p-0.1")+    , (CmdTest.noTestsProblem, mkTargetPackage "q-0.1")+    ]++  reportSubCase "not a test"+  assertProjectTargetProblems+    "targets/variety"+    config+    CmdTest.selectPackageTargets+    CmdTest.selectComponentTarget+    $ [+        ( const+            ( CmdTest.notTestProblem+                "p-0.1"+                (CLibName LMainLibName)+            )+        , mkTargetComponent "p-0.1" (CLibName LMainLibName)+        )+      ,+        ( const+            ( CmdTest.notTestProblem+                "p-0.1"+                (CExeName "an-exe")+            )+        , mkTargetComponent "p-0.1" (CExeName "an-exe")+        )+      ,+        ( const+            ( CmdTest.notTestProblem+                "p-0.1"+                (CFLibName "libp")+            )+        , mkTargetComponent "p-0.1" (CFLibName "libp")+        )+      ,+        ( const+            ( CmdTest.notTestProblem+                "p-0.1"+                (CBenchName "a-benchmark")+            )+        , mkTargetComponent "p-0.1" (CBenchName "a-benchmark")+        )+      ]+      ++ [ ( const+              ( CmdTest.isSubComponentProblem+                  "p-0.1"+                  cname+                  (ModuleTarget modname)+              )+           , mkTargetModule "p-0.1" cname modname+           )+         | (cname, modname) <-+            [ (CTestName "a-testsuite", "TestModule")+            , (CBenchName "a-benchmark", "BenchModule")+            , (CExeName "an-exe", "ExeModule")+            , ((CLibName LMainLibName), "P")+            ]+         ]+      ++ [ ( const+              ( CmdTest.isSubComponentProblem+                  "p-0.1"+                  cname+                  (FileTarget fname)+              )+           , mkTargetFile "p-0.1" cname fname+           )+         | (cname, fname) <-+            [ (CTestName "a-testsuite", "Test.hs")+            , (CBenchName "a-benchmark", "Bench.hs")+            , (CExeName "an-exe", "Main.hs")+            ]+         ]++testTargetProblemsBench :: ProjectConfig -> (String -> IO ()) -> Assertion+testTargetProblemsBench config reportSubCase = do+  reportSubCase "disabled by config"+  assertProjectTargetProblems+    "targets/benchmarks-disabled"+    config+      { projectConfigLocalPackages =+          (projectConfigLocalPackages config)+            { packageConfigBenchmarks = toFlag False+            }+      }+    CmdBench.selectPackageTargets+    CmdBench.selectComponentTarget+    [+      ( flip+          TargetProblemNoneEnabled+          [ AvailableTarget+              "p-0.1"+              (CBenchName "user-disabled")+              TargetDisabledByUser+              True+          , AvailableTarget+              "p-0.1"+              (CBenchName "solver-disabled")+              TargetDisabledByUser+              True+          ]+      , mkTargetPackage "p-0.1"+      )+    ]++  reportSubCase "disabled by solver & buildable false"+  assertProjectTargetProblems+    "targets/benchmarks-disabled"+    config+    CmdBench.selectPackageTargets+    CmdBench.selectComponentTarget+    [+      ( flip+          TargetProblemNoneEnabled+          [ AvailableTarget+              "p-0.1"+              (CBenchName "user-disabled")+              TargetDisabledBySolver+              True+          , AvailableTarget+              "p-0.1"+              (CBenchName "solver-disabled")+              TargetDisabledBySolver+              True+          ]+      , mkTargetPackage "p-0.1"+      )+    ,+      ( flip+          TargetProblemNoneEnabled+          [ AvailableTarget+              "q-0.1"+              (CBenchName "buildable-false")+              TargetNotBuildable+              True+          ]+      , mkTargetPackage "q-0.1"+      )+    ]++  reportSubCase "empty-pkg"+  assertProjectTargetProblems+    "targets/empty-pkg"+    config+    CmdBench.selectPackageTargets+    CmdBench.selectComponentTarget+    [ (TargetProblemNoTargets, mkTargetPackage "p-0.1")+    ]++  reportSubCase "no benchmarks"+  assertProjectTargetProblems+    "targets/simple"+    config+    CmdBench.selectPackageTargets+    CmdBench.selectComponentTarget+    [ (CmdBench.noBenchmarksProblem, mkTargetPackage "p-0.1")+    , (CmdBench.noBenchmarksProblem, mkTargetPackage "q-0.1")+    ]++  reportSubCase "not a benchmark"+  assertProjectTargetProblems+    "targets/variety"+    config+    CmdBench.selectPackageTargets+    CmdBench.selectComponentTarget+    $ [+        ( const+            ( CmdBench.componentNotBenchmarkProblem+                "p-0.1"+                (CLibName LMainLibName)+            )+        , mkTargetComponent "p-0.1" (CLibName LMainLibName)+        )+      ,+        ( const+            ( CmdBench.componentNotBenchmarkProblem+                "p-0.1"+                (CExeName "an-exe")+            )+        , mkTargetComponent "p-0.1" (CExeName "an-exe")+        )+      ,+        ( const+            ( CmdBench.componentNotBenchmarkProblem+                "p-0.1"+                (CFLibName "libp")+            )+        , mkTargetComponent "p-0.1" (CFLibName "libp")+        )+      ,+        ( const+            ( CmdBench.componentNotBenchmarkProblem+                "p-0.1"+                (CTestName "a-testsuite")+            )+        , mkTargetComponent "p-0.1" (CTestName "a-testsuite")+        )+      ]+      ++ [ ( const+              ( CmdBench.isSubComponentProblem+                  "p-0.1"+                  cname+                  (ModuleTarget modname)+              )+           , mkTargetModule "p-0.1" cname modname+           )+         | (cname, modname) <-+            [ (CTestName "a-testsuite", "TestModule")+            , (CBenchName "a-benchmark", "BenchModule")+            , (CExeName "an-exe", "ExeModule")+            , ((CLibName LMainLibName), "P")+            ]+         ]+      ++ [ ( const+              ( CmdBench.isSubComponentProblem+                  "p-0.1"+                  cname+                  (FileTarget fname)+              )+           , mkTargetFile "p-0.1" cname fname+           )+         | (cname, fname) <-+            [ (CTestName "a-testsuite", "Test.hs")+            , (CBenchName "a-benchmark", "Bench.hs")+            , (CExeName "an-exe", "Main.hs")+            ]+         ]++testTargetProblemsHaddock :: ProjectConfig -> (String -> IO ()) -> Assertion+testTargetProblemsHaddock config reportSubCase = do+  reportSubCase "all-disabled"+  assertProjectTargetProblems+    "targets/all-disabled"+    config+    ( let haddockFlags = mkHaddockFlags False True True False+       in CmdHaddock.selectPackageTargets haddockFlags+    )+    CmdHaddock.selectComponentTarget+    [+      ( flip+          TargetProblemNoneEnabled+          [ AvailableTarget+              "p-0.1"+              (CBenchName "user-disabled")+              TargetDisabledByUser+              True+          , AvailableTarget+              "p-0.1"+              (CTestName "solver-disabled")+              TargetDisabledBySolver+              True+          , AvailableTarget+              "p-0.1"+              (CExeName "buildable-false")+              TargetNotBuildable+              True+          , AvailableTarget+              "p-0.1"+              (CLibName LMainLibName)+              TargetNotBuildable+              True+          ]+      , mkTargetPackage "p-0.1"+      )+    ]++  reportSubCase "empty-pkg"+  assertProjectTargetProblems+    "targets/empty-pkg"+    config+    ( let haddockFlags = mkHaddockFlags False False False False+       in CmdHaddock.selectPackageTargets haddockFlags+    )+    CmdHaddock.selectComponentTarget+    [ (TargetProblemNoTargets, mkTargetPackage "p-0.1")+    ]++  reportSubCase "enabled component kinds"+  -- When we explicitly enable all the component kinds then selecting the+  -- whole package selects those component kinds too+  (_, elaboratedPlan, _) <- planProject "targets/variety" config+  let haddockFlags = mkHaddockFlags True True True True+   in assertProjectDistinctTargets+        elaboratedPlan+        (CmdHaddock.selectPackageTargets haddockFlags)+        CmdHaddock.selectComponentTarget+        [mkTargetPackage "p-0.1"]+        [ ("p-0.1-inplace", (CLibName LMainLibName))+        , ("p-0.1-inplace-a-benchmark", CBenchName "a-benchmark")+        , ("p-0.1-inplace-a-testsuite", CTestName "a-testsuite")+        , ("p-0.1-inplace-an-exe", CExeName "an-exe")+        , ("p-0.1-inplace-libp", CFLibName "libp")+        ]++  reportSubCase "disabled component kinds"+  -- When we explicitly disable all the component kinds then selecting the+  -- whole package only selects the library+  let haddockFlags = mkHaddockFlags False False False False+   in assertProjectDistinctTargets+        elaboratedPlan+        (CmdHaddock.selectPackageTargets haddockFlags)+        CmdHaddock.selectComponentTarget+        [mkTargetPackage "p-0.1"]+        [("p-0.1-inplace", (CLibName LMainLibName))]++  reportSubCase "requested component kinds"+  -- When we selecting the package with an explicit filter then it does not+  -- matter if the config was to disable all the component kinds+  let haddockFlags = mkHaddockFlags False False False False+   in assertProjectDistinctTargets+        elaboratedPlan+        (CmdHaddock.selectPackageTargets haddockFlags)+        CmdHaddock.selectComponentTarget+        [ TargetPackage TargetExplicitNamed ["p-0.1"] (Just FLibKind)+        , TargetPackage TargetExplicitNamed ["p-0.1"] (Just ExeKind)+        , TargetPackage TargetExplicitNamed ["p-0.1"] (Just TestKind)+        , TargetPackage TargetExplicitNamed ["p-0.1"] (Just BenchKind)+        ]+        [ ("p-0.1-inplace-a-benchmark", CBenchName "a-benchmark")+        , ("p-0.1-inplace-a-testsuite", CTestName "a-testsuite")+        , ("p-0.1-inplace-an-exe", CExeName "an-exe")+        , ("p-0.1-inplace-libp", CFLibName "libp")+        ]+  where+    mkHaddockFlags flib exe test bench =+      defaultHaddockFlags+        { haddockForeignLibs = toFlag flib+        , haddockExecutables = toFlag exe+        , haddockTestSuites = toFlag test+        , haddockBenchmarks = toFlag bench+        }++assertProjectDistinctTargets+  :: forall err+   . (Eq err, Show err)+  => ElaboratedInstallPlan+  -> (forall k. TargetSelector -> [AvailableTarget k] -> Either (TargetProblem err) [k])+  -> (forall k. SubComponentTarget -> AvailableTarget k -> Either (TargetProblem err) k)+  -> [TargetSelector]+  -> [(UnitId, ComponentName)]+  -> Assertion+assertProjectDistinctTargets+  elaboratedPlan+  selectPackageTargets+  selectComponentTarget+  targetSelectors+  expectedTargets+    | Right targets <- results =+        distinctTargetComponents targets @?= Set.fromList expectedTargets+    | otherwise =+        assertFailure $+          "assertProjectDistinctTargets: expected "+            ++ "(Right targets) but got "+            ++ show results+    where+      results =+        resolveTargetsFromSolver+          selectPackageTargets+          selectComponentTarget+          elaboratedPlan+          Nothing+          targetSelectors++assertProjectTargetProblems+  :: forall err+   . (Eq err, Show err)+  => FilePath+  -> ProjectConfig+  -> ( forall k+        . TargetSelector+       -> [AvailableTarget k]+       -> Either (TargetProblem err) [k]+     )+  -> ( forall k+        . SubComponentTarget+       -> AvailableTarget k+       -> Either (TargetProblem err) k+     )+  -> [(TargetSelector -> TargetProblem err, TargetSelector)]+  -> Assertion+assertProjectTargetProblems+  testdir+  config+  selectPackageTargets+  selectComponentTarget+  cases = do+    (_, elaboratedPlan, _) <- planProject testdir config+    assertTargetProblems+      elaboratedPlan+      selectPackageTargets+      selectComponentTarget+      cases++assertTargetProblems+  :: forall err+   . (Eq err, Show err)+  => ElaboratedInstallPlan+  -> (forall k. TargetSelector -> [AvailableTarget k] -> Either (TargetProblem err) [k])+  -> (forall k. SubComponentTarget -> AvailableTarget k -> Either (TargetProblem err) k)+  -> [(TargetSelector -> TargetProblem err, TargetSelector)]+  -> Assertion+assertTargetProblems elaboratedPlan selectPackageTargets selectComponentTarget =+  mapM_ (uncurry assertTargetProblem)+  where+    assertTargetProblem expected targetSelector =+      let res =+            resolveTargetsFromSolver+              selectPackageTargets+              selectComponentTarget+              elaboratedPlan+              Nothing+              [targetSelector]+       in case res of+            Left [problem] ->+              problem @?= expected targetSelector+            unexpected ->+              assertFailure $+                "expected resolveTargetsFromSolver result: (Left [problem]) "+                  ++ "but got: "+                  ++ show unexpected++testExceptionInFindingPackage :: ProjectConfig -> Assertion+testExceptionInFindingPackage config = do+  BadPackageLocations _ locs <-+    expectException "BadPackageLocations" $+      void $+        planProject testdir config+  case locs of+    [BadLocGlobEmptyMatch "./*.cabal"] -> return ()+    _ -> assertFailure "expected BadLocGlobEmptyMatch"+  cleanProject testdir+  where+    testdir = "exception/no-pkg"++testExceptionInFindingPackage2 :: ProjectConfig -> Assertion+testExceptionInFindingPackage2 config = do+  BadPackageLocations _ locs <-+    expectException "BadPackageLocations" $+      void $+        planProject testdir config+  case locs of+    [BadPackageLocationFile (BadLocDirNoCabalFile ".")] -> return ()+    _ -> assertFailure $ "expected BadLocDirNoCabalFile, got " ++ show locs+  cleanProject testdir+  where+    testdir = "exception/no-pkg2"++testExceptionInProjectConfig :: ProjectConfig -> Assertion+testExceptionInProjectConfig config = do+  BadPerPackageCompilerPaths ps <-+    expectException "BadPerPackageCompilerPaths" $+      void $+        planProject testdir config+  case ps of+    [(pn, "ghc")] | "foo" == pn -> return ()+    _ ->+      assertFailure $+        "expected (PackageName \"foo\",\"ghc\"), got "+          ++ show ps+  cleanProject testdir+  where+    testdir = "exception/bad-config"++testExceptionInConfigureStep :: ProjectConfig -> Assertion+testExceptionInConfigureStep config = do+  (plan, res) <- executePlan =<< planProject testdir config+  (_pkga1, failure) <- expectPackageFailed plan res pkgidA1+  case buildFailureReason failure of+    ConfigureFailed _ -> return ()+    _ -> assertFailure $ "expected ConfigureFailed, got " ++ show failure+  cleanProject testdir+  where+    testdir = "exception/configure"+    pkgidA1 = PackageIdentifier "a" (mkVersion [1])++testExceptionInBuildStep :: ProjectConfig -> Assertion+testExceptionInBuildStep config = do+  (plan, res) <- executePlan =<< planProject testdir config+  (_pkga1, failure) <- expectPackageFailed plan res pkgidA1+  expectBuildFailed failure+  where+    testdir = "exception/build"+    pkgidA1 = PackageIdentifier "a" (mkVersion [1])++testSetupScriptStyles :: ProjectConfig -> (String -> IO ()) -> Assertion+testSetupScriptStyles config reportSubCase = do+  reportSubCase (show SetupCustomExplicitDeps)++  plan0@(_, _, sharedConfig) <- planProject testdir1 config++  let isOSX (Platform _ OSX) = True+      isOSX _ = False+      compilerVer = compilerVersion (pkgConfigCompiler sharedConfig)+  -- Skip the Custom tests when the shipped Cabal library is buggy+  unless+    ( (isOSX (pkgConfigPlatform sharedConfig) && (compilerVer < mkVersion [7, 10]))+        -- 9.10 ships Cabal 3.12.0.0 affected by #9940+        || (mkVersion [9, 10] <= compilerVer && compilerVer < mkVersion [9, 11])+    )+    $ do+      (plan1, res1) <- executePlan plan0+      pkg1 <- expectPackageInstalled plan1 res1 pkgidA+      elabSetupScriptStyle pkg1 @?= SetupCustomExplicitDeps+      hasDefaultSetupDeps pkg1 @?= Just False+      marker1 <- readFile (basedir </> testdir1 </> "marker")+      marker1 @?= "ok"+      removeFile (basedir </> testdir1 </> "marker")++      -- implicit deps implies 'Cabal < 2' which conflicts w/ GHC 8.2 or later+      when (compilerVersion (pkgConfigCompiler sharedConfig) < mkVersion [8, 2]) $ do+        reportSubCase (show SetupCustomImplicitDeps)+        (plan2, res2) <- executePlan =<< planProject testdir2 config+        pkg2 <- expectPackageInstalled plan2 res2 pkgidA+        elabSetupScriptStyle pkg2 @?= SetupCustomImplicitDeps+        hasDefaultSetupDeps pkg2 @?= Just True+        marker2 <- readFile (basedir </> testdir2 </> "marker")+        marker2 @?= "ok"+        removeFile (basedir </> testdir2 </> "marker")++      reportSubCase (show SetupNonCustomInternalLib)+      (plan3, res3) <- executePlan =<< planProject testdir3 config+      pkg3 <- expectPackageInstalled plan3 res3 pkgidA+      elabSetupScriptStyle pkg3 @?= SetupNonCustomInternalLib+  where+    {-+        --TODO: the SetupNonCustomExternalLib case is hard to test since it+        -- requires a version of Cabal that's later than the one we're testing+        -- e.g. needs a .cabal file that specifies cabal-version: >= 2.0+        -- and a corresponding Cabal package that we can use to try and build a+        -- default Setup.hs.+        reportSubCase (show SetupNonCustomExternalLib)+        (plan4, res4) <- executePlan =<< planProject testdir4 config+        pkg4          <- expectPackageInstalled plan4 res4 pkgidA+        pkgSetupScriptStyle pkg4 @?= SetupNonCustomExternalLib+    -}++    testdir1 = "build/setup-custom1"+    testdir2 = "build/setup-custom2"+    testdir3 = "build/setup-simple"+    pkgidA = PackageIdentifier "a" (mkVersion [0, 1])+    -- The solver fills in default setup deps explicitly, but marks them as such+    hasDefaultSetupDeps =+      fmap defaultSetupDepends+        . setupBuildInfo+        . elabPkgDescription++-- | Test the behaviour with and without @--keep-going@+testBuildKeepGoing :: ProjectConfig -> Assertion+testBuildKeepGoing config = do+  -- P is expected to fail, Q does not depend on P but without+  -- parallel build and without keep-going then we don't build Q yet.+  (plan1, res1) <- executePlan =<< planProject testdir (config `mappend` keepGoing False)+  (_, failure1) <- expectPackageFailed plan1 res1 "p-0.1"+  expectBuildFailed failure1+  _ <- expectPackageConfigured plan1 res1 "q-0.1"++  -- With keep-going then we should go on to successfully build Q+  (plan2, res2) <-+    executePlan+      =<< planProject testdir (config `mappend` keepGoing True)+  (_, failure2) <- expectPackageFailed plan2 res2 "p-0.1"+  expectBuildFailed failure2+  _ <- expectPackageInstalled plan2 res2 "q-0.1"+  return ()+  where+    testdir = "build/keep-going"+    keepGoing kg =+      mempty+        { projectConfigBuildOnly =+            mempty+              { projectConfigKeepGoing = toFlag kg+              }+        }++-- | Test we can successfully build packages from local tarball files.+testBuildLocalTarball :: ProjectConfig -> Assertion+testBuildLocalTarball config = do+  -- P is a tarball package, Q is a local dir package that depends on it.+  (plan, res) <- executePlan =<< planProject testdir config+  _ <- expectPackageInstalled plan res "p-0.1"+  _ <- expectPackageInstalled plan res "q-0.1"+  return ()+  where+    testdir = "build/local-tarball"++-- | See <https://github.com/haskell/cabal/issues/3324>+--+-- This test just doesn't seem to work on Windows,+-- due filesystem woes.+testRegressionIssue3324 :: ProjectConfig -> Assertion+testRegressionIssue3324 config = when (buildOS /= Windows) $ do+  -- expected failure first time due to missing dep+  (plan1, res1) <- executePlan =<< planProject testdir config+  (_pkgq, failure) <- expectPackageFailed plan1 res1 "q-0.1"+  expectBuildFailed failure++  -- add the missing dep, now it should work+  let qcabal = basedir </> testdir </> "q" </> "q.cabal"+  withFileFinallyRestore qcabal $ do+    tryFewTimes $ BS.appendFile qcabal ("  build-depends: p\n")+    (plan2, res2) <- executePlan =<< planProject testdir config+    _ <- expectPackageInstalled plan2 res2 "p-0.1"+    _ <- expectPackageInstalled plan2 res2 "q-0.1"+    return ()+  where+    testdir = "regression/3324"++-- | Test global program options are propagated correctly+-- from ProjectConfig to ElaboratedInstallPlan+testProgramOptionsAll :: ProjectConfig -> Assertion+testProgramOptionsAll config0 = do+  -- P is a tarball package, Q is a local dir package that depends on it.+  (_, elaboratedPlan, _) <- planProject testdir config+  let packages = filterConfiguredPackages $ InstallPlan.toList elaboratedPlan++  assertEqual+    "q"+    (Just [ghcFlag])+    (getProgArgs packages "q")+  assertEqual+    "p"+    (Just [ghcFlag])+    (getProgArgs packages "p")+  where+    testdir = "regression/program-options"+    programArgs = MapMappend (Map.fromList [("ghc", [ghcFlag])])+    ghcFlag = "-fno-full-laziness"++    -- Insert flag into global config+    config =+      config0+        { projectConfigAllPackages =+            (projectConfigAllPackages config0)+              { packageConfigProgramArgs = programArgs+              }+        }++-- | Test local program options are propagated correctly+-- from ProjectConfig to ElaboratedInstallPlan+testProgramOptionsLocal :: ProjectConfig -> Assertion+testProgramOptionsLocal config0 = do+  (_, elaboratedPlan, _) <- planProject testdir config+  let localPackages = filterConfiguredPackages $ InstallPlan.toList elaboratedPlan++  assertEqual+    "q"+    (Just [ghcFlag])+    (getProgArgs localPackages "q")+  assertEqual+    "p"+    Nothing+    (getProgArgs localPackages "p")+  where+    testdir = "regression/program-options"+    programArgs = MapMappend (Map.fromList [("ghc", [ghcFlag])])+    ghcFlag = "-fno-full-laziness"++    -- Insert flag into local config+    config =+      config0+        { projectConfigLocalPackages =+            (projectConfigLocalPackages config0)+              { packageConfigProgramArgs = programArgs+              }+        }++-- | Test package specific program options are propagated correctly+-- from ProjectConfig to ElaboratedInstallPlan+testProgramOptionsSpecific :: ProjectConfig -> Assertion+testProgramOptionsSpecific config0 = do+  (_, elaboratedPlan, _) <- planProject testdir config+  let packages = filterConfiguredPackages $ InstallPlan.toList elaboratedPlan++  assertEqual+    "q"+    (Nothing)+    (getProgArgs packages "q")+  assertEqual+    "p"+    (Just [ghcFlag])+    (getProgArgs packages "p")+  where+    testdir = "regression/program-options"+    programArgs = MapMappend (Map.fromList [("ghc", [ghcFlag])])+    ghcFlag = "-fno-full-laziness"++    -- Insert flag into package "p" config+    config =+      config0+        { projectConfigSpecificPackage = MapMappend (Map.fromList [(mkPackageName "p", configArgs)])+        }+    configArgs =+      mempty+        { packageConfigProgramArgs = programArgs+        }++filterConfiguredPackages :: [ElaboratedPlanPackage] -> [ElaboratedConfiguredPackage]+filterConfiguredPackages [] = []+filterConfiguredPackages (InstallPlan.PreExisting _ : pkgs) = filterConfiguredPackages pkgs+filterConfiguredPackages (InstallPlan.Installed elab : pkgs) = elab : filterConfiguredPackages pkgs+filterConfiguredPackages (InstallPlan.Configured elab : pkgs) = elab : filterConfiguredPackages pkgs++getProgArgs :: [ElaboratedConfiguredPackage] -> String -> Maybe [String]+getProgArgs [] _ = Nothing+getProgArgs (elab : pkgs) name+  | pkgName (elabPkgSourceId elab) == mkPackageName name =+      Map.lookup "ghc" (elabProgramArgs elab)+  | otherwise =+      getProgArgs pkgs name++---------------------------------+-- Test utils to plan and build+--++basedir :: FilePath+basedir = "tests" </> "IntegrationTests2"++dirActions :: FilePath -> TS.DirActions IO+dirActions testdir =+  defaultDirActions+    { TS.doesFileExist = \p ->+        TS.doesFileExist defaultDirActions (virtcwd </> p)+    , TS.doesDirectoryExist = \p ->+        TS.doesDirectoryExist defaultDirActions (virtcwd </> p)+    , TS.canonicalizePath = \p ->+        TS.canonicalizePath defaultDirActions (virtcwd </> p)+    , TS.getCurrentDirectory =+        TS.canonicalizePath defaultDirActions virtcwd+    }+  where+    virtcwd = basedir </> testdir++type ProjDetails =+  ( DistDirLayout+  , CabalDirLayout+  , ProjectConfig+  , [PackageSpecifier UnresolvedSourcePackage]+  , BuildTimeSettings+  )++configureProject :: FilePath -> ProjectConfig -> IO ProjDetails+configureProject testdir cliConfig = do+  cabalDirLayout <- defaultCabalDirLayout++  projectRootDir <- canonicalizePath (basedir </> testdir)+  isexplict <- doesFileExist (projectRootDir </> defaultProjectFile)++  let projectRoot+        | isexplict = ProjectRootExplicit projectRootDir defaultProjectFile+        | otherwise = ProjectRootImplicit projectRootDir+      distDirLayout = defaultDistDirLayout projectRoot Nothing Nothing++  -- Clear state between test runs. The state remains if the previous run+  -- ended in an exception (as we leave the files to help with debugging).+  cleanProject testdir++  httpTransport <- configureTransport verbosity [] Nothing++  (projectConfig, localPackages) <-+    rebuildProjectConfig+      verbosity+      httpTransport+      distDirLayout+      cliConfig++  let buildSettings =+        resolveBuildTimeSettings+          verbosity+          cabalDirLayout+          projectConfig++  return+    ( distDirLayout+    , cabalDirLayout+    , projectConfig+    , localPackages+    , buildSettings+    )++type PlanDetails =+  ( ProjDetails+  , ElaboratedInstallPlan+  , ElaboratedSharedConfig+  )++planProject :: FilePath -> ProjectConfig -> IO PlanDetails+planProject testdir cliConfig = do+  projDetails@( distDirLayout+                , cabalDirLayout+                , projectConfig+                , localPackages+                , _buildSettings+                ) <-+    configureProject testdir cliConfig++  (elaboratedPlan, _, elaboratedShared, _, _) <-+    rebuildInstallPlan+      verbosity+      distDirLayout+      cabalDirLayout+      projectConfig+      localPackages+      Nothing++  return+    ( projDetails+    , elaboratedPlan+    , elaboratedShared+    )++executePlan :: PlanDetails -> IO (ElaboratedInstallPlan, BuildOutcomes)+executePlan+  ( (distDirLayout, cabalDirLayout, config, _, buildSettings)+    , elaboratedPlan+    , elaboratedShared+    ) = do+    let targets :: Map.Map UnitId [ComponentTarget]+        targets =+          Map.fromList+            [ (unitid, [ComponentTarget cname WholeComponent])+            | ts <- Map.elems (availableTargets elaboratedPlan)+            , AvailableTarget+                { availableTargetStatus = TargetBuildable (unitid, cname) _+                } <-+                ts+            ]+        elaboratedPlan' =+          pruneInstallPlanToTargets+            TargetActionBuild+            targets+            elaboratedPlan++    pkgsBuildStatus <-+      rebuildTargetsDryRun+        distDirLayout+        elaboratedShared+        elaboratedPlan'++    let elaboratedPlan'' =+          improveInstallPlanWithUpToDatePackages+            pkgsBuildStatus+            elaboratedPlan'++    buildOutcomes <-+      rebuildTargets+        verbosity+        config+        distDirLayout+        (cabalStoreDirLayout cabalDirLayout)+        elaboratedPlan''+        elaboratedShared+        pkgsBuildStatus+        -- Avoid trying to use act-as-setup mode:+        buildSettings{buildSettingNumJobs = Serial}++    return (elaboratedPlan'', buildOutcomes)++cleanProject :: FilePath -> IO ()+cleanProject testdir = do+  alreadyExists <- doesDirectoryExist distDir+  when alreadyExists $ removePathForcibly distDir+  where+    projectRoot = ProjectRootImplicit (basedir </> testdir)+    distDirLayout = defaultDistDirLayout projectRoot Nothing Nothing+    distDir = distDirectory distDirLayout++verbosity :: Verbosity+verbosity = minBound -- normal --verbose --maxBound --minBound++-------------------------------------------+-- Tasty integration to adjust the config+--++withProjectConfig :: (ProjectConfig -> TestTree) -> TestTree+withProjectConfig testtree =+  askOption $ \ghcPath ->+    testtree (mkProjectConfig ghcPath)++mkProjectConfig :: GhcPath -> ProjectConfig+mkProjectConfig (GhcPath ghcPath) =+  mempty+    { projectConfigShared =+        mempty+          { projectConfigHcPath = maybeToFlag ghcPath+          }+    , projectConfigBuildOnly =+        mempty+          { projectConfigNumJobs = toFlag (Just 1)+          }+    }+  where+    maybeToFlag = maybe mempty toFlag++data GhcPath = GhcPath (Maybe FilePath)++instance IsOption GhcPath where+  defaultValue = GhcPath Nothing+  optionName = Tagged "with-ghc"+  optionHelp = Tagged "The ghc compiler to use"+  parseValue = Just . GhcPath . Just++projectConfigOptionDescriptions :: [OptionDescription]+projectConfigOptionDescriptions = [Option (Proxy :: Proxy GhcPath)]++---------------------------------------+-- HUint style utils for this context+--++expectException :: Exception e => String -> IO a -> IO e+expectException expected action = do+  res <- try action+  case res of+    Left e -> return e+    Right _ -> throwIO $ HUnitFailure Nothing $ "expected an exception " ++ expected++expectPackagePreExisting+  :: ElaboratedInstallPlan+  -> BuildOutcomes+  -> PackageId+  -> IO InstalledPackageInfo+expectPackagePreExisting plan buildOutcomes pkgid = do+  planpkg <- expectPlanPackage plan pkgid+  case (planpkg, InstallPlan.lookupBuildOutcome planpkg buildOutcomes) of+    (InstallPlan.PreExisting pkg, Nothing) ->+      return pkg+    (_, buildResult) -> unexpectedBuildResult "PreExisting" planpkg buildResult++expectPackageConfigured+  :: ElaboratedInstallPlan+  -> BuildOutcomes+  -> PackageId+  -> IO ElaboratedConfiguredPackage+expectPackageConfigured plan buildOutcomes pkgid = do+  planpkg <- expectPlanPackage plan pkgid+  case (planpkg, InstallPlan.lookupBuildOutcome planpkg buildOutcomes) of+    (InstallPlan.Configured pkg, Nothing) ->+      return pkg+    (_, buildResult) -> unexpectedBuildResult "Configured" planpkg buildResult++expectPackageInstalled+  :: ElaboratedInstallPlan+  -> BuildOutcomes+  -> PackageId+  -> IO ElaboratedConfiguredPackage+expectPackageInstalled plan buildOutcomes pkgid = do+  planpkg <- expectPlanPackage plan pkgid+  case (planpkg, InstallPlan.lookupBuildOutcome planpkg buildOutcomes) of+    (InstallPlan.Configured pkg, Just (Right _result)) ->+      -- result isn't used by any test+      return pkg+    -- package can be installed in the global .store!+    -- (when installing from tarball!)+    (InstallPlan.Installed pkg, Nothing) ->+      return pkg+    (_, buildResult) -> unexpectedBuildResult "Installed" planpkg buildResult++expectPackageFailed+  :: ElaboratedInstallPlan+  -> BuildOutcomes+  -> PackageId+  -> IO (ElaboratedConfiguredPackage, BuildFailure)+expectPackageFailed plan buildOutcomes pkgid = do+  planpkg <- expectPlanPackage plan pkgid+  case (planpkg, InstallPlan.lookupBuildOutcome planpkg buildOutcomes) of+    (InstallPlan.Configured pkg, Just (Left failure)) ->+      return (pkg, failure)+    (_, buildResult) -> unexpectedBuildResult "Failed" planpkg buildResult++unexpectedBuildResult+  :: String+  -> ElaboratedPlanPackage+  -> Maybe (Either BuildFailure BuildResult)+  -> IO a+unexpectedBuildResult expected planpkg buildResult =+  throwIO $+    HUnitFailure Nothing $+      "expected to find "+        ++ display (packageId planpkg)+        ++ " in the "+        ++ expected+        ++ " state, but it is actually in the "+        ++ actual+        ++ " state."+  where+    actual = case (buildResult, planpkg) of+      (Nothing, InstallPlan.PreExisting{}) -> "PreExisting"+      (Nothing, InstallPlan.Configured{}) -> "Configured"+      (Just (Right _), InstallPlan.Configured{}) -> "Installed"+      (Just (Left _), InstallPlan.Configured{}) -> "Failed"+      (Nothing, InstallPlan.Installed{}) -> "Installed globally"+      _ -> "Impossible! " ++ show buildResult ++ show planpkg++expectPlanPackage+  :: ElaboratedInstallPlan+  -> PackageId+  -> IO ElaboratedPlanPackage+expectPlanPackage plan pkgid =+  case [ pkg+       | pkg <- InstallPlan.toList plan+       , packageId pkg == pkgid+       ] of+    [pkg] -> return pkg+    [] ->+      throwIO $+        HUnitFailure Nothing $+          "expected to find "+            ++ display pkgid+            ++ " in the install plan but it's not there"+    _ ->+      throwIO $+        HUnitFailure Nothing $+          "expected to find only one instance of "+            ++ display pkgid+            ++ " in the install plan but there's several"++expectBuildFailed :: BuildFailure -> IO ()+expectBuildFailed (BuildFailure _ (BuildFailed _)) = return ()+expectBuildFailed (BuildFailure _ reason) =+  assertFailure $ "expected BuildFailed, got " ++ show reason++---------------------------------------+-- Other utils+--++-- | Allow altering a file during a test, but then restore it afterwards+--+-- We read into the memory, as filesystems are tricky. (especially Windows)+withFileFinallyRestore :: FilePath -> IO a -> IO a+withFileFinallyRestore file action = do+  originalContents <- BS.readFile file+  action `finally` handle onIOError (tryFewTimes $ BS.writeFile file originalContents)+  where+    onIOError :: IOException -> IO ()+    onIOError e = putStrLn $ "WARNING: Cannot restore " ++ file ++ "; " ++ show e++-- Hopefully works around some Windows file-locking things.+-- Use with care:+--+-- Try action 4 times, with small sleep in between,+-- retrying if it fails for 'IOException' reason.+--+tryFewTimes :: forall a. IO a -> IO a+tryFewTimes action = go (3 :: Int)+  where+    go :: Int -> IO a+    go !n+      | n <= 0 = action+      | otherwise = action `catch` onIOError n++    onIOError :: Int -> IOException -> IO a+    onIOError n e = do+      hPutStrLn stderr $ "Trying " ++ show n ++ " after " ++ show e+      threadDelay 10000+      go (n - 1)++testNixFlags :: Assertion+testNixFlags = do+  let gc = globalCommand []+  -- changing from the v1 to v2 build command does not change whether the "--enable-nix" flag+  -- sets the globalNix param of the GlobalFlags type to True even though the v2 command doesn't use it+  let nixEnabledFlags = getFlags gc . commandParseArgs gc True $ ["--enable-nix", "build"]+  let nixDisabledFlags = getFlags gc . commandParseArgs gc True $ ["--disable-nix", "build"]+  let nixDefaultFlags = getFlags gc . commandParseArgs gc True $ ["build"]+  True @=? isJust nixDefaultFlags+  True @=? isJust nixEnabledFlags+  True @=? isJust nixDisabledFlags+  Just True @=? (fromFlag . globalNix . fromJust $ nixEnabledFlags)+  Just False @=? (fromFlag . globalNix . fromJust $ nixDisabledFlags)+  Nothing @=? (fromFlag . globalNix . fromJust $ nixDefaultFlags)++  -- Config file options+  trueConfig <- loadConfig verbosity (Flag (basedir </> "nix-config/nix-true"))+  falseConfig <- loadConfig verbosity (Flag (basedir </> "nix-config/nix-false"))++  Just True @=? (fromFlag . globalNix . savedGlobalFlags $ trueConfig)+  Just False @=? (fromFlag . globalNix . savedGlobalFlags $ falseConfig)+  where+    fromFlag :: Flag Bool -> Maybe Bool+    fromFlag (Flag x) = Just x+    fromFlag NoFlag = Nothing+    getFlags :: CommandUI GlobalFlags -> CommandParse (GlobalFlags -> GlobalFlags, [String]) -> Maybe GlobalFlags+    getFlags cui (CommandReadyToGo (mkflags, _)) = Just . mkflags . commandDefaultFlags $ cui+    getFlags _ _ = Nothing++-- Tests whether config options are commented or not+testConfigOptionComments :: Assertion+testConfigOptionComments = do+  let+    -- \| Find the first line containing a target setting name.+    --+    -- If `isComment` is set, only comment lines will be found.+    findLineWith :: Bool -> String -> String -> String+    findLineWith isComment target text =+      case findLinesWith isComment target text of+        [] -> text+        (l : _) -> removeColonAndAfter l++    -- \| Find lines containing a target setting name.+    findLinesWith :: Bool -> String -> String -> [String]+    findLinesWith isComment target+      | isComment = filter (isInfixOf ("-- " ++ target ++ ":")) . lines+      | otherwise = filter (isInfixOf (target ++ ":")) . lines++    -- \| Transform @-- puppy: doggy@ into @-- puppy@.+    removeColonAndAfter :: String -> String+    removeColonAndAfter = takeWhile (/= ':')++  cwd <- getCurrentDirectory+  let configFile = cwd </> basedir </> "config" </> "default-config"+  _ <- createDefaultConfigFile verbosity [] configFile+  defaultConfigFile <- readFile configFile++  let+    -- TODO: These assertions are fairly weak. Potential improvements:+    --+    -- - Include the section name in the assertion, so that (e.g.) a+    --   `keep-temp-files` setting in the `haddock` section won't be confused+    --   with a `keep-temp-files` setting in the `init` section.+    --+    -- - Check all matching lines to confirm that settings are not listed+    --   multiple times. For example, `cabal-file` is listed twice right now,+    --   once under the `haddock` settings!+    --+    -- - Consume the file as we go, ensuring that the settings are in a given+    --   order.+    --+    -- - Check the generated config file into Git (replacing e.g. `$HOME` with+    --   a sentinel value) so changes show up in PR diffs.+    assertHasLine' :: Bool -> String -> String -> Assertion+    assertHasLine' isComment expected settingName =+      let actual = findLineWith isComment settingName defaultConfigFile+          messagePrefix =+            "Did not find expected line for setting "+              <> show settingName+              <> " in configuration file "+              <> configFile+       in assertEqual messagePrefix expected actual++    assertHasLine :: String -> String -> Assertion+    assertHasLine = assertHasLine' False++    assertHasCommentLine :: String -> String -> Assertion+    assertHasCommentLine = assertHasLine' True++  "  url" `assertHasLine` "url"+  "  -- secure" `assertHasCommentLine` "secure"+  "  -- root-keys" `assertHasCommentLine` "root-keys"+  "  -- key-threshold" `assertHasCommentLine` "key-threshold"++  "-- ignore-expiry" `assertHasCommentLine` "ignore-expiry"+  "-- http-transport" `assertHasCommentLine` "http-transport"+  "-- nix" `assertHasCommentLine` "nix"+  "-- store-dir" `assertHasCommentLine` "store-dir"+  "-- active-repositories" `assertHasCommentLine` "active-repositories"+  "-- local-no-index-repo" `assertHasCommentLine` "local-no-index-repo"+  "remote-repo-cache" `assertHasLine` "remote-repo-cache"+  "-- logs-dir" `assertHasCommentLine` "logs-dir"+  "-- default-user-config" `assertHasCommentLine` "default-user-config"+  "-- verbose" `assertHasCommentLine` "verbose"+  "-- compiler" `assertHasCommentLine` "compiler"+  "-- cabal-file" `assertHasCommentLine` "cabal-file"+  "-- keep-temp-files" `assertHasCommentLine` "keep-temp-files"+  "-- with-compiler" `assertHasCommentLine` "with-compiler"+  "-- with-hc-pkg" `assertHasCommentLine` "with-hc-pkg"+  "-- program-prefix" `assertHasCommentLine` "program-prefix"+  "-- program-suffix" `assertHasCommentLine` "program-suffix"+  "-- library-vanilla" `assertHasCommentLine` "library-vanilla"+  "-- library-profiling" `assertHasCommentLine` "library-profiling"+  "-- shared" `assertHasCommentLine` "shared"+  "-- static" `assertHasCommentLine` "static"+  "-- executable-dynamic" `assertHasCommentLine` "executable-dynamic"+  "-- executable-static" `assertHasCommentLine` "executable-static"+  "-- profiling" `assertHasCommentLine` "profiling"+  "-- executable-profiling" `assertHasCommentLine` "executable-profiling"+  "-- profiling-detail" `assertHasCommentLine` "profiling-detail"+  "-- library-profiling-detail" `assertHasCommentLine` "library-profiling-detail"+  "-- optimization" `assertHasCommentLine` "optimization"+  "-- debug-info" `assertHasCommentLine` "debug-info"+  "-- build-info" `assertHasCommentLine` "build-info"+  "-- library-for-ghci" `assertHasCommentLine` "library-for-ghci"+  "-- split-sections" `assertHasCommentLine` "split-sections"+  "-- split-objs" `assertHasCommentLine` "split-objs"+  "-- executable-stripping" `assertHasCommentLine` "executable-stripping"+  "-- library-stripping" `assertHasCommentLine` "library-stripping"+  "-- configure-option" `assertHasCommentLine` "configure-option"+  "-- user-install" `assertHasCommentLine` "user-install"+  "-- package-db" `assertHasCommentLine` "package-db"+  "-- flags" `assertHasCommentLine` "flags"+  "-- extra-include-dirs" `assertHasCommentLine` "extra-include-dirs"+  "-- deterministic" `assertHasCommentLine` "deterministic"+  "-- cid" `assertHasCommentLine` "cid"+  "-- extra-lib-dirs" `assertHasCommentLine` "extra-lib-dirs"+  "-- extra-lib-dirs-static" `assertHasCommentLine` "extra-lib-dirs-static"+  "-- extra-framework-dirs" `assertHasCommentLine` "extra-framework-dirs"+  "-- extra-prog-path" `assertHasLine` "extra-prog-path"+  "-- instantiate-with" `assertHasCommentLine` "instantiate-with"+  "-- tests" `assertHasCommentLine` "tests"+  "-- coverage" `assertHasCommentLine` "coverage"+  "-- library-coverage" `assertHasCommentLine` "library-coverage"+  "-- exact-configuration" `assertHasCommentLine` "exact-configuration"+  "-- benchmarks" `assertHasCommentLine` "benchmarks"+  "-- relocatable" `assertHasCommentLine` "relocatable"+  "-- response-files" `assertHasCommentLine` "response-files"+  "-- allow-depending-on-private-libs" `assertHasCommentLine` "allow-depending-on-private-libs"+  "-- cabal-lib-version" `assertHasCommentLine` "cabal-lib-version"+  "-- append" `assertHasCommentLine` "append"+  "-- backup" `assertHasCommentLine` "backup"+  "-- constraint" `assertHasCommentLine` "constraint"+  "-- preference" `assertHasCommentLine` "preference"+  "-- solver" `assertHasCommentLine` "solver"+  "-- allow-older" `assertHasCommentLine` "allow-older"+  "-- allow-newer" `assertHasCommentLine` "allow-newer"+  "-- write-ghc-environment-files" `assertHasCommentLine` "write-ghc-environment-files"+  "-- documentation" `assertHasCommentLine` "documentation"+  "-- doc-index-file" `assertHasCommentLine` "doc-index-file"+  "-- only-download" `assertHasCommentLine` "only-download"+  "-- target-package-db" `assertHasCommentLine` "target-package-db"+  "-- max-backjumps" `assertHasCommentLine` "max-backjumps"+  "-- reorder-goals" `assertHasCommentLine` "reorder-goals"+  "-- count-conflicts" `assertHasCommentLine` "count-conflicts"+  "-- fine-grained-conflicts" `assertHasCommentLine` "fine-grained-conflicts"+  "-- minimize-conflict-set" `assertHasCommentLine` "minimize-conflict-set"+  "-- independent-goals" `assertHasCommentLine` "independent-goals"+  "-- prefer-oldest" `assertHasCommentLine` "prefer-oldest"+  "-- shadow-installed-packages" `assertHasCommentLine` "shadow-installed-packages"+  "-- strong-flags" `assertHasCommentLine` "strong-flags"+  "-- allow-boot-library-installs" `assertHasCommentLine` "allow-boot-library-installs"+  "-- reject-unconstrained-dependencies" `assertHasCommentLine` "reject-unconstrained-dependencies"+  "-- reinstall" `assertHasCommentLine` "reinstall"+  "-- avoid-reinstalls" `assertHasCommentLine` "avoid-reinstalls"+  "-- force-reinstalls" `assertHasCommentLine` "force-reinstalls"+  "-- upgrade-dependencies" `assertHasCommentLine` "upgrade-dependencies"+  "-- index-state" `assertHasCommentLine` "index-state"+  "-- root-cmd" `assertHasCommentLine` "root-cmd"+  "-- symlink-bindir" `assertHasCommentLine` "symlink-bindir"+  "build-summary" `assertHasLine` "build-summary"+  "-- build-log" `assertHasCommentLine` "build-log"+  "remote-build-reporting" `assertHasLine` "remote-build-reporting"+  "-- report-planning-failure" `assertHasCommentLine` "report-planning-failure"+  "-- per-component" `assertHasCommentLine` "per-component"+  "-- run-tests" `assertHasCommentLine` "run-tests"+  "jobs" `assertHasLine` "jobs"+  "-- keep-going" `assertHasCommentLine` "keep-going"+  "-- offline" `assertHasCommentLine` "offline"+  "-- lib" `assertHasCommentLine` "lib"+  "-- package-env" `assertHasCommentLine` "package-env"+  "-- overwrite-policy" `assertHasCommentLine` "overwrite-policy"+  "-- install-method" `assertHasCommentLine` "install-method"+  "installdir" `assertHasLine` "installdir"+  "-- token" `assertHasCommentLine` "token"+  "-- username" `assertHasCommentLine` "username"+  "-- password" `assertHasCommentLine` "password"+  "-- password-command" `assertHasCommentLine` "password-command"+  "-- builddir" `assertHasCommentLine` "builddir"++  "  -- hoogle" `assertHasCommentLine` "hoogle"+  "  -- html" `assertHasCommentLine` "html"+  "  -- html-location" `assertHasCommentLine` "html-location"+  "  -- executables" `assertHasCommentLine` "executables"+  "  -- foreign-libraries" `assertHasCommentLine` "foreign-libraries"+  "  -- all" `assertHasCommentLine` "all"+  "  -- internal" `assertHasCommentLine` "internal"+  "  -- css" `assertHasCommentLine` "css"+  "  -- hyperlink-source" `assertHasCommentLine` "hyperlink-source"+  "  -- quickjump" `assertHasCommentLine` "quickjump"+  "  -- hscolour-css" `assertHasCommentLine` "hscolour-css"+  "  -- contents-location" `assertHasCommentLine` "contents-location"+  "  -- index-location" `assertHasCommentLine` "index-location"+  "  -- base-url" `assertHasCommentLine` "base-url"+  "  -- resources-dir" `assertHasCommentLine` "resources-dir"+  "  -- output-dir" `assertHasCommentLine` "output-dir"+  "  -- use-unicode" `assertHasCommentLine` "use-unicode"++  "  -- interactive" `assertHasCommentLine` "interactive"+  "  -- quiet" `assertHasCommentLine` "quiet"+  "  -- no-comments" `assertHasCommentLine` "no-comments"+  "  -- minimal" `assertHasCommentLine` "minimal"+  "  -- cabal-version" `assertHasCommentLine` "cabal-version"+  "  -- license" `assertHasCommentLine` "license"+  "  -- extra-doc-file" `assertHasCommentLine` "extra-doc-file"+  "  -- test-dir" `assertHasCommentLine` "test-dir"+  "  -- simple" `assertHasCommentLine` "simple"+  "  -- language" `assertHasCommentLine` "language"+  "  -- application-dir" `assertHasCommentLine` "application-dir"+  "  -- source-dir" `assertHasCommentLine` "source-dir"++  "  -- prefix" `assertHasCommentLine` "prefix"+  "  -- bindir" `assertHasCommentLine` "bindir"+  "  -- libdir" `assertHasCommentLine` "libdir"+  "  -- libsubdir" `assertHasCommentLine` "libsubdir"+  "  -- dynlibdir" `assertHasCommentLine` "dynlibdir"+  "  -- libexecdir" `assertHasCommentLine` "libexecdir"+  "  -- libexecsubdir" `assertHasCommentLine` "libexecsubdir"+  "  -- datadir" `assertHasCommentLine` "datadir"+  "  -- datasubdir" `assertHasCommentLine` "datasubdir"+  "  -- docdir" `assertHasCommentLine` "docdir"+  "  -- htmldir" `assertHasCommentLine` "htmldir"+  "  -- haddockdir" `assertHasCommentLine` "haddockdir"+  "  -- sysconfdir" `assertHasCommentLine` "sysconfdir"++  "  -- alex-location" `assertHasCommentLine` "alex-location"+  "  -- ar-location" `assertHasCommentLine` "ar-location"+  "  -- c2hs-location" `assertHasCommentLine` "c2hs-location"+  "  -- cpphs-location" `assertHasCommentLine` "cpphs-location"+  "  -- doctest-location" `assertHasCommentLine` "doctest-location"+  "  -- gcc-location" `assertHasCommentLine` "gcc-location"+  "  -- ghc-location" `assertHasCommentLine` "ghc-location"+  "  -- ghc-pkg-location" `assertHasCommentLine` "ghc-pkg-location"+  "  -- ghcjs-location" `assertHasCommentLine` "ghcjs-location"+  "  -- ghcjs-pkg-location" `assertHasCommentLine` "ghcjs-pkg-location"+  "  -- haddock-location" `assertHasCommentLine` "haddock-location"+  "  -- happy-location" `assertHasCommentLine` "happy-location"+  "  -- hpc-location" `assertHasCommentLine` "hpc-location"+  "  -- hscolour-location" `assertHasCommentLine` "hscolour-location"+  "  -- jhc-location" `assertHasCommentLine` "jhc-location"+  "  -- ld-location" `assertHasCommentLine` "ld-location"+  "  -- pkg-config-location" `assertHasCommentLine` "pkg-config-location"+  "  -- runghc-location" `assertHasCommentLine` "runghc-location"+  "  -- strip-location" `assertHasCommentLine` "strip-location"+  "  -- tar-location" `assertHasCommentLine` "tar-location"+  "  -- uhc-location" `assertHasCommentLine` "uhc-location"++  "  -- alex-options" `assertHasCommentLine` "alex-options"+  "  -- ar-options" `assertHasCommentLine` "ar-options"+  "  -- c2hs-options" `assertHasCommentLine` "c2hs-options"+  "  -- cpphs-options" `assertHasCommentLine` "cpphs-options"+  "  -- doctest-options" `assertHasCommentLine` "doctest-options"+  "  -- gcc-options" `assertHasCommentLine` "gcc-options"+  "  -- ghc-options" `assertHasCommentLine` "ghc-options"+  "  -- ghc-pkg-options" `assertHasCommentLine` "ghc-pkg-options"+  "  -- ghcjs-options" `assertHasCommentLine` "ghcjs-options"+  "  -- ghcjs-pkg-options" `assertHasCommentLine` "ghcjs-pkg-options"+  "  -- haddock-options" `assertHasCommentLine` "haddock-options"+  "  -- happy-options" `assertHasCommentLine` "happy-options"+  "  -- hpc-options" `assertHasCommentLine` "hpc-options"+  "  -- hsc2hs-options" `assertHasCommentLine` "hsc2hs-options"+  "  -- hscolour-options" `assertHasCommentLine` "hscolour-options"+  "  -- jhc-options" `assertHasCommentLine` "jhc-options"+  "  -- ld-options" `assertHasCommentLine` "ld-options"+  "  -- pkg-config-options" `assertHasCommentLine` "pkg-config-options"+  "  -- runghc-options" `assertHasCommentLine` "runghc-options"+  "  -- strip-options" `assertHasCommentLine` "strip-options"+  "  -- tar-options" `assertHasCommentLine` "tar-options"+  "  -- uhc-options" `assertHasCommentLine` "uhc-options"++testIgnoreProjectFlag :: Assertion+testIgnoreProjectFlag = do+  -- Coverage flag should be false globally by default (~/.cabal folder)+  (_, _, prjConfigGlobal, _, _) <- configureProject testdir ignoreSetConfig+  let globalCoverageFlag = packageConfigCoverage . projectConfigLocalPackages $ prjConfigGlobal+  False @=? Flag.fromFlagOrDefault False globalCoverageFlag+  -- It is set to true in the cabal.project file+  (_, _, prjConfigLocal, _, _) <- configureProject testdir emptyConfig+  let localCoverageFlag = packageConfigCoverage . projectConfigLocalPackages $ prjConfigLocal+  True @=? Flag.fromFlagOrDefault False localCoverageFlag+  where+    testdir = "build/ignore-project"+    emptyConfig = mempty+    ignoreSetConfig :: ProjectConfig+    ignoreSetConfig = mempty{projectConfigShared = mempty{projectConfigIgnoreProject = Flag True}}++cleanHaddockProject :: FilePath -> IO ()+cleanHaddockProject testdir = do+  cleanProject testdir+  let haddocksdir = basedir </> testdir </> "haddocks"+  alreadyExists <- doesDirectoryExist haddocksdir+  when alreadyExists $ removePathForcibly haddocksdir+  let storedir = basedir </> testdir </> "store"+  alreadyExists' <- doesDirectoryExist storedir+  when alreadyExists' $ removePathForcibly storedir++testHaddockProjectDependencies :: ProjectConfig -> Assertion+testHaddockProjectDependencies config = do+  (_, _, sharedConfig) <- planProject testdir config+  -- `haddock-project` is only supported by `haddock-2.26.1` and above which is+  -- shipped with `ghc-9.4`+  when (compilerVersion (pkgConfigCompiler sharedConfig) > mkVersion [9, 4]) $ do+    let dir = basedir </> testdir+    cleanHaddockProject testdir+    withCurrentDirectory dir $ do+      CmdHaddockProject.haddockProjectAction+        defaultHaddockProjectFlags+          { haddockProjectCommonFlags =+              defaultCommonSetupFlags+                { setupVerbosity = Flag verbosity+                }+          }+        ["all"]+        defaultGlobalFlags{globalStoreDir = Flag "store"}++      let haddock = "haddocks" </> "async" </> "async.haddock"+      hasHaddock <- doesFileExist haddock+      unless hasHaddock $ assertFailure ("File `" ++ haddock ++ "` does not exist.")+    cleanHaddockProject testdir   where     testdir = "haddock-project/dependencies"
+ tests/IntegrationTests2/CPP.hs view
@@ -0,0 +1,26 @@+{- FOURMOLU_DISABLE -}+{-# LANGUAGE CPP #-}++module IntegrationTests2.CPP+  ( removePathForcibly+  , isMingw32+  ) where++import Distribution.Client.Compat.Prelude+import Prelude ()++#if MIN_VERSION_directory(1,2,7)+import System.Directory (removePathForcibly)+#endif++#if !MIN_VERSION_directory(1,2,7)+removePathForcibly :: FilePath -> IO ()+removePathForcibly = removeDirectoryRecursive+#endif++isMingw32 :: Bool+#ifndef mingw32_HOST_OS+isMingw32 = True+#else+isMingw32 = False+#endif
tests/UnitTests/Distribution/Client/ArbitraryInstances.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-}-{-# LANGUAGE TypeOperators #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-}  module UnitTests.Distribution.Client.ArbitraryInstances   ( adjustSize@@ -26,6 +25,7 @@  import Data.Char (isLetter) import Data.List ((\\))+import Data.Monoid (Last (..))  import Distribution.Simple.Setup import Distribution.Types.Flag (mkFlagAssignment)@@ -200,7 +200,7 @@   arbitrary = arbitraryBoundedEnum  arbitraryFlag :: Gen a -> Gen (Flag a)-arbitraryFlag = liftArbitrary+arbitraryFlag = fmap (fmap Last) liftArbitrary  instance Arbitrary RepoName where   -- TODO: rename refinement?
tests/UnitTests/Distribution/Client/DescribedInstances.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-}  module UnitTests.Distribution.Client.DescribedInstances where
tests/UnitTests/Distribution/Client/Glob.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-}  module UnitTests.Distribution.Client.Glob (tests) where
tests/UnitTests/Distribution/Client/Init/Golden.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE LambdaCase #-}  module UnitTests.Distribution.Client.Init.Golden   ( tests
tests/UnitTests/Distribution/Client/InstallPlan.hs view
@@ -316,9 +316,9 @@ renderDotGraph graph =   unlines (       [header-      ,graphDefaultAtribs-      ,nodeDefaultAtribs-      ,edgeDefaultAtribs]+      ,graphDefaultAttribs+      ,nodeDefaultAttribs+      ,edgeDefaultAttribs]     ++ map renderNode (vertices graph)     ++ map renderEdge (edges graph)     ++ [footer]@@ -328,12 +328,12 @@      renderEdge (n, n') = "\t" ++ show n ++ " -> " ++ show n' ++ "[];" -header, footer, graphDefaultAtribs, nodeDefaultAtribs, edgeDefaultAtribs :: String+header, footer, graphDefaultAttribs, nodeDefaultAttribs, edgeDefaultAttribs :: String  header = "digraph packages {" footer = "}" -graphDefaultAtribs = "\tgraph [fontsize=14, fontcolor=black, color=black];"-nodeDefaultAtribs  = "\tnode [label=\"\\N\", width=\"0.75\", shape=ellipse];"-edgeDefaultAtribs  = "\tedge [fontsize=10];"+graphDefaultAttribs = "\tgraph [fontsize=14, fontcolor=black, color=black];"+nodeDefaultAttribs  = "\tnode [label=\"\\N\", width=\"0.75\", shape=ellipse];"+edgeDefaultAttribs  = "\tedge [fontsize=10];" -}
tests/UnitTests/Distribution/Client/ProjectConfig.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RecordWildCards #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-}  -- simplifier goes nuts otherwise #if __GLASGOW_HASKELL__ < 806
tests/UnitTests/Distribution/Client/TreeDiffInstances.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-}  module UnitTests.Distribution.Client.TreeDiffInstances () where
tests/UnitTests/Distribution/Client/UserConfig.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE PatternSynonyms #-}+ module UnitTests.Distribution.Client.UserConfig   ( tests   ) where@@ -18,7 +20,7 @@ import Distribution.Client.Config import Distribution.Client.Setup (GlobalFlags (..), InstallFlags (..)) import Distribution.Client.Utils (removeExistingFile)-import Distribution.Simple.Setup (ConfigFlags (..), Flag (..), fromFlag)+import Distribution.Simple.Setup (ConfigFlags (..), fromFlag, pattern Flag) import Distribution.Simple.Utils (withTempDirectory) import Distribution.Utils.NubList (fromNubList) import Distribution.Verbosity (silent)
tests/UnitTests/Distribution/Client/VCS.hs view
@@ -56,6 +56,12 @@ tests :: MTimeChange -> [TestTree] tests mtimeChange =   map+    -- Are you tuning performance for these tests? The size of the arbitrary+    -- instances involved is very significant, because each element generated+    -- corresponds to one or more Git subcommands being run.+    --+    -- See [Tuning Arbitrary Instances] below for more information and+    -- parameters.     (localOption $ QuickCheckTests 10)     [ ignoreInWindows "See issue #8048 and #9519" $         testGroup@@ -216,22 +222,27 @@  testSetup   :: VCS Program-  -> ( Verbosity-       -> VCS ConfiguredProgram-       -> FilePath-       -> FilePath-       -> VCSTestDriver-     )+  -> (MkVCSTestDriver -> VCSTestDriver)   -> RepoRecipe submodules   -> (VCSTestDriver -> FilePath -> RepoState -> IO a)   -> IO a testSetup vcs mkVCSTestDriver repoRecipe theTest = do-  -- test setup-  vcs' <- configureVCS verbosity [] vcs   withTestDir verbosity "vcstest" $ \tmpdir -> do+    -- test setup+    vcs' <- configureVCS verbosity [] vcs+     let srcRepoPath = tmpdir </> "src"         submodulesPath = tmpdir </> "submodules"-        vcsDriver = mkVCSTestDriver verbosity vcs' submodulesPath srcRepoPath+        vcsDriver =+          mkVCSTestDriver+            MkVCSTestDriver+              { mkVcsVerbosity = verbosity+              , mkVcsVcs = vcs'+              , mkVcsSubmoduleDir = submodulesPath+              , mkVcsRepoRoot = srcRepoPath+              , mkVcsTmpDir = tmpdir+              }+     repoState <- createRepo vcsDriver repoRecipe      -- actual test@@ -252,12 +263,7 @@ -- the working state is the same as the pure representation. prop_framework   :: VCS Program-  -> ( Verbosity-       -> VCS ConfiguredProgram-       -> FilePath-       -> FilePath-       -> VCSTestDriver-     )+  -> (MkVCSTestDriver -> VCSTestDriver)   -> RepoRecipe submodules   -> IO () prop_framework vcs mkVCSTestDriver repoRecipe =@@ -288,12 +294,7 @@  prop_cloneRepo   :: VCS Program-  -> ( Verbosity-       -> VCS ConfiguredProgram-       -> FilePath-       -> FilePath-       -> VCSTestDriver-     )+  -> (MkVCSTestDriver -> VCSTestDriver)   -> RepoRecipe submodules   -> IO () prop_cloneRepo vcs mkVCSTestDriver repoRecipe =@@ -329,12 +330,7 @@  prop_syncRepos   :: VCS Program-  -> ( Verbosity-       -> VCS ConfiguredProgram-       -> FilePath-       -> FilePath-       -> VCSTestDriver-     )+  -> (MkVCSTestDriver -> VCSTestDriver)   -> RepoDirSet   -> SyncTargetIterations   -> PrngSeed@@ -482,6 +478,7 @@ -- VCS commands to make a repository on-disk.  data SubmodulesSupport = SubmodulesSupported | SubmodulesNotSupported+  deriving (Show, Eq)  class KnownSubmodulesSupport (a :: SubmodulesSupport) where   submoduleSupport :: SubmodulesSupport@@ -494,7 +491,11 @@  data FileUpdate = FileUpdate FilePath String   deriving (Show)-data SubmoduleAdd = SubmoduleAdd FilePath FilePath (Commit 'SubmodulesSupported)+data SubmoduleAdd = SubmoduleAdd+  { submodulePath :: FilePath+  , submoduleSource :: FilePath+  , submoduleCommit :: Commit 'SubmodulesSupported+  }   deriving (Show)  newtype Commit (submodules :: SubmodulesSupport)@@ -535,40 +536,71 @@ genFileName :: Gen FilePath genFileName = (\c -> "file" </> [c]) <$> choose ('A', 'E') +-- [Tuning Arbitrary Instances]+--+-- Arbitrary repo recipes can get quite large due to nesting:+--+-- - `RepoRecipes` contain a number of groups (`TaggedCommits` or `BranchCommits`).+-- - Groups contain a number of `Commit`s.+-- - Commits contain a number of operations (`FileUpdate` or `SubmoduleAdd`).+--+-- There's also another wrinkle in that `SubmoduleAdd`s contain a `Commit`+-- themselves, so square the `operationsPerCommit` number!+--+-- Then, a rough upper bound of the number of `git` calls required for an+-- arbitrary `RepoRecipe` is+-- `groupsPerRecipe * commitsPerGroup * operationsPerCommit^2`.+--+-- The original implementation of these instances, which chose+-- reasonable-sounding size parameters of 5-15, led to a maximum of 1875+-- operations per test case! No wonder they took so long!+--+-- In most cases, we only care about one or many operations, so "two" is a fine+-- stand-in for "many" :)+groupsPerRecipe :: Int+groupsPerRecipe = 3++commitsPerGroup :: Int+commitsPerGroup = 3++operationsPerCommit :: Int+operationsPerCommit = 3+ instance Arbitrary FileUpdate where-  arbitrary = genOnlyFileUpdate+  arbitrary = FileUpdate <$> genFileName <*> genFileContent     where-      genOnlyFileUpdate = FileUpdate <$> genFileName <*> genFileContent       genFileContent = vectorOf 10 (choose ('#', '~'))  instance Arbitrary SubmoduleAdd where-  arbitrary = genOnlySubmoduleAdd+  arbitrary = SubmoduleAdd <$> genFileName <*> genSubmoduleSrc <*> arbitrary     where-      genOnlySubmoduleAdd = SubmoduleAdd <$> genFileName <*> genSubmoduleSrc <*> arbitrary       genSubmoduleSrc = vectorOf 20 (choose ('a', 'z'))  instance forall submodules. KnownSubmodulesSupport submodules => Arbitrary (Commit submodules) where-  arbitrary = Commit <$> shortListOf1 5 fileUpdateOrSubmoduleAdd+  arbitrary = Commit <$> shortListOf1 operationsPerCommit (sized fileUpdateOrSubmoduleAdd)     where-      fileUpdateOrSubmoduleAdd =+      fileUpdateOrSubmoduleAdd 0 = Left <$> arbitrary+      fileUpdateOrSubmoduleAdd size =         case submoduleSupport @submodules of           SubmodulesSupported ->             frequency               [ (10, Left <$> arbitrary)-              , (1, Right <$> arbitrary)+              , -- A `SubmoduleAdd` contains a `Commit`, so we make sure to scale+                -- down the size in the recursive call to avoid unbounded nesting.+                (1, Right <$> resize (size `div` 2) arbitrary)               ]           SubmodulesNotSupported -> Left <$> arbitrary   shrink (Commit writes) = Commit <$> filter (not . null) (shrink writes)  instance KnownSubmodulesSupport submodules => Arbitrary (TaggedCommits submodules) where-  arbitrary = TaggedCommits <$> genTagName <*> shortListOf1 5 arbitrary+  arbitrary = TaggedCommits <$> genTagName <*> shortListOf1 commitsPerGroup arbitrary     where       genTagName = ("tag_" ++) <$> shortListOf1 5 (choose ('A', 'Z'))   shrink (TaggedCommits tag commits) =     TaggedCommits tag <$> filter (not . null) (shrink commits)  instance KnownSubmodulesSupport submodules => Arbitrary (BranchCommits submodules) where-  arbitrary = BranchCommits <$> genBranchName <*> shortListOf1 5 arbitrary+  arbitrary = BranchCommits <$> genBranchName <*> shortListOf1 commitsPerGroup arbitrary     where       genBranchName =         sized $ \n ->@@ -578,12 +610,12 @@     BranchCommits branch <$> filter (not . null) (shrink commits)  instance KnownSubmodulesSupport submodules => Arbitrary (NonBranchingRepoRecipe submodules) where-  arbitrary = NonBranchingRepoRecipe <$> shortListOf1 15 arbitrary+  arbitrary = NonBranchingRepoRecipe <$> shortListOf1 groupsPerRecipe arbitrary   shrink (NonBranchingRepoRecipe xs) =     NonBranchingRepoRecipe <$> filter (not . null) (shrink xs)  instance KnownSubmodulesSupport submodules => Arbitrary (BranchingRepoRecipe submodules) where-  arbitrary = BranchingRepoRecipe <$> shortListOf1 15 taggedOrBranch+  arbitrary = BranchingRepoRecipe <$> shortListOf1 groupsPerRecipe taggedOrBranch     where       taggedOrBranch =         frequency@@ -839,219 +871,282 @@           (TagName -> FilePath -> IO ())   } +data MkVCSTestDriver = MkVCSTestDriver+  { mkVcsVerbosity :: Verbosity+  , mkVcsVcs :: VCS ConfiguredProgram+  , mkVcsSubmoduleDir :: FilePath+  , mkVcsRepoRoot :: FilePath+  , mkVcsTmpDir :: FilePath+  }++vcsTestDriverGit :: MkVCSTestDriver -> VCSTestDriver vcsTestDriverGit-  :: Verbosity-  -> VCS ConfiguredProgram-  -> FilePath-  -> FilePath-  -> VCSTestDriver-vcsTestDriverGit verbosity vcs submoduleDir repoRoot =-  VCSTestDriver-    { vcsVCS = vcs-    , vcsRepoRoot = repoRoot-    , vcsIgnoreFiles = Set.empty-    , vcsInit =-        git $ ["init"] ++ verboseArg-    , vcsAddFile = \_ filename ->-        git ["add", filename]-    , vcsCommitChanges = \_state -> do-        git $-          [ "-c"-          , "user.name=A"-          , "-c"-          , "user.email=a@example.com"-          , "commit"-          , "--all"-          , "--message=a patch"-          , "--author=A <a@example.com>"+  MkVCSTestDriver+    { mkVcsVerbosity = verbosity+    , mkVcsVcs = vcs+    , mkVcsSubmoduleDir = submoduleDir+    , mkVcsRepoRoot = repoRoot+    , mkVcsTmpDir = tmpDir+    } =+    VCSTestDriver+      { vcsVCS = vcs'+      , vcsRepoRoot = repoRoot+      , vcsIgnoreFiles = Set.empty+      , vcsInit = do+          createDirectoryIfMissing True home+          gitconfigExists <- doesFileExist gitconfigPath+          unless gitconfigExists $ do+            writeFile gitconfigPath gitconfig+          gitQuiet ["init"]+      , vcsAddFile = \_ filename ->+          git ["add", filename]+      , vcsCommitChanges = \_state -> do+          gitQuiet+            [ "commit"+            , "--all"+            , "--message=a patch"+            ]+          commit <- git' ["rev-parse", "HEAD"]+          let commit' = takeWhile (not . isSpace) commit+          return (Just commit')+      , vcsTagState = \_ tagname ->+          git ["tag", "--force", "--no-sign", tagname]+      , vcsSubmoduleDriver =+          \newPath ->+            pure $+              vcsTestDriverGit+                MkVCSTestDriver+                  { mkVcsVerbosity = verbosity+                  , mkVcsVcs = vcs'+                  , mkVcsSubmoduleDir = submoduleDir+                  , mkVcsRepoRoot = submoduleDir </> newPath+                  , mkVcsTmpDir = tmpDir+                  }+      , vcsAddSubmodule = \_ source dest -> do+          destExists <- doesPathExist $ repoRoot </> dest+          when destExists $ gitQuiet ["rm", "--force", dest]+          -- If there is an old submodule git dir with the same name, remove it.+          -- It most likely has a different URL and `git submodule add` will fai.+          submoduleGitDirExists <- doesDirectoryExist $ submoduleGitDir dest+          when submoduleGitDirExists $ removeDirectoryRecursive (submoduleGitDir dest)+          gitQuiet ["submodule", "add", source, dest]+          gitQuiet ["submodule", "update", "--init", "--recursive", "--force"]+      , vcsSwitchBranch = \RepoState{allBranches} branchname -> do+          deinitAndRemoveCachedSubmodules+          unless (branchname `Map.member` allBranches) $+            gitQuiet ["branch", branchname]+          gitQuiet ["checkout", branchname]+          updateSubmodulesAndCleanup+      , vcsCheckoutTag = Left $ \tagname -> do+          deinitAndRemoveCachedSubmodules+          gitQuiet ["checkout", "--detach", "--force", tagname]+          updateSubmodulesAndCleanup+      }+    where+      home = tmpDir </> "home"+      gitconfigPath = home </> ".gitconfig"+      -- Git 2.38.1 and newer fails to clone from local paths with `fatal: transport 'file'+      -- not allowed` unless `protocol.file.allow=always` is set.+      --+      -- This is not safe in general, but it's fine in the test suite.+      --+      -- See: https://github.blog/open-source/git/git-security-vulnerabilities-announced/#fn-67904-1+      -- See: https://git-scm.com/docs/git-config#Documentation/git-config.txt-protocolallow+      gitconfig =+        unlines+          [ "[protocol.file]"+          , "  allow = always"+          , "[user]"+          , "  name = Puppy Doggy"+          , "  email = puppy.doggy@example.com"           ]-            ++ verboseArg-        commit <- git' ["log", "--format=%H", "-1"]-        let commit' = takeWhile (not . isSpace) commit-        return (Just commit')-    , vcsTagState = \_ tagname ->-        git ["tag", "--force", "--no-sign", tagname]-    , vcsSubmoduleDriver =-        pure . vcsTestDriverGit verbosity vcs submoduleDir . (submoduleDir </>)-    , vcsAddSubmodule = \_ source dest -> do-        destExists <--          (||)-            <$> doesFileExist (repoRoot </> dest)-            <*> doesDirectoryExist (repoRoot </> dest)-        when destExists $ git ["rm", "-f", dest]-        -- If there is an old submodule git dir with the same name, remove it.-        -- It most likely has a different URL and `git submodule add` will fai.-        submoduleGitDirExists <- doesDirectoryExist $ submoduleGitDir dest-        when submoduleGitDirExists $ removeDirectoryRecursive (submoduleGitDir dest)-        git ["submodule", "add", source, dest]-        git ["submodule", "update", "--init", "--recursive", "--force"]-    , vcsSwitchBranch = \RepoState{allBranches} branchname -> do-        deinitAndRemoveCachedSubmodules-        unless (branchname `Map.member` allBranches) $-          git ["branch", branchname]-        git $ ["checkout", branchname] ++ verboseArg-        updateSubmodulesAndCleanup-    , vcsCheckoutTag = Left $ \tagname -> do-        deinitAndRemoveCachedSubmodules-        git $ ["checkout", "--detach", "--force", tagname] ++ verboseArg-        updateSubmodulesAndCleanup-    }-  where-    gitInvocation args =-      (programInvocation (vcsProgram vcs) args)-        { progInvokeCwd = Just repoRoot-        }-    git = runProgramInvocation verbosity . gitInvocation-    git' = getProgramInvocationOutput verbosity . gitInvocation-    verboseArg = ["--quiet" | verbosity < Verbosity.normal]-    submoduleGitDir path = repoRoot </> ".git" </> "modules" </> path-    deinitAndRemoveCachedSubmodules = do-      git $ ["submodule", "deinit", "--force", "--all"] ++ verboseArg-      let gitModulesDir = repoRoot </> ".git" </> "modules"-      gitModulesExists <- doesDirectoryExist gitModulesDir-      when gitModulesExists $ removeDirectoryRecursive gitModulesDir-    updateSubmodulesAndCleanup = do-      git $ ["submodule", "sync", "--recursive"] ++ verboseArg-      git $ ["submodule", "update", "--init", "--recursive", "--force"] ++ verboseArg-      git $ ["submodule", "foreach", "--recursive"] ++ verboseArg ++ ["git clean -ffxdq"]-      git $ ["clean", "-ffxdq"] ++ verboseArg +      vcs' =+        vcs+          { vcsProgram =+              (vcsProgram vcs)+                { programOverrideEnv =+                    programOverrideEnv (vcsProgram vcs)+                      ++ [ -- > Whether to skip reading settings from the system-wide $(prefix)/etc/gitconfig file.+                           ("GIT_CONFIG_NOSYSTEM", Just "1")+                         , ("GIT_CONFIG_GLOBAL", Just gitconfigPath)+                         , -- Setting the author and committer dates makes commit hashes deterministic between test runs.+                           ("GIT_AUTHOR_DATE", Just "1998-04-30T18:25:03-0400")+                         , ("GIT_COMMITTER_DATE", Just "1998-04-30T18:25:00-0400")+                         , ("HOME", Just home)+                         ]+                }+          }++      gitInvocation args =+        (programInvocation (vcsProgram vcs') args)+          { progInvokeCwd = Just repoRoot+          }++      git = runProgramInvocation verbosity . gitInvocation+      git' = getProgramInvocationOutput verbosity . gitInvocation++      gitQuiet [] = git []+      gitQuiet (cmd : args) = git (cmd : verboseArg ++ args)++      verboseArg = ["--quiet" | verbosity < Verbosity.normal]++      submoduleGitDir path = repoRoot </> ".git" </> "modules" </> path++      dotGitModulesPath = repoRoot </> ".git" </> "modules"+      gitModulesPath = repoRoot </> ".gitmodules"++      deinitAndRemoveCachedSubmodules = do+        dotGitModulesExists <- doesDirectoryExist dotGitModulesPath+        when dotGitModulesExists $ do+          git $ ["submodule", "deinit", "--force", "--all"] ++ verboseArg+          removeDirectoryRecursive dotGitModulesPath++      updateSubmodulesAndCleanup = do+        gitModulesExists <- doesFileExist gitModulesPath+        when gitModulesExists $ do+          gitQuiet ["submodule", "sync", "--recursive"]+          gitQuiet ["submodule", "update", "--init", "--recursive", "--force"]+          -- Note: We need to manually add `verboseArg` here so that the embedded `git clean` command includes it as well.+          gitQuiet $ ["submodule", "foreach", "--recursive", "git clean -ffxdq"] ++ verboseArg+        gitQuiet ["clean", "-ffxdq"]+ type MTimeChange = Int +vcsTestDriverDarcs :: MTimeChange -> MkVCSTestDriver -> VCSTestDriver vcsTestDriverDarcs-  :: MTimeChange-  -> Verbosity-  -> VCS ConfiguredProgram-  -> FilePath-  -> FilePath-  -> VCSTestDriver-vcsTestDriverDarcs mtimeChange verbosity vcs _ repoRoot =-  VCSTestDriver-    { vcsVCS = vcs-    , vcsRepoRoot = repoRoot-    , vcsIgnoreFiles = Set.singleton "_darcs"-    , vcsInit =-        darcs ["initialize"]-    , vcsAddFile = \state filename -> do-        threadDelay mtimeChange-        unless (filename `Map.member` currentWorking state) $-          darcs ["add", filename]-    , -- Darcs's file change tracking relies on mtime changes,-      -- so we have to be careful with doing stuff too quickly:+  mtimeChange+  MkVCSTestDriver+    { mkVcsVerbosity = verbosity+    , mkVcsVcs = vcs+    , mkVcsRepoRoot = repoRoot+    } =+    VCSTestDriver+      { vcsVCS = vcs+      , vcsRepoRoot = repoRoot+      , vcsIgnoreFiles = Set.singleton "_darcs"+      , vcsInit =+          darcs ["initialize"]+      , vcsAddFile = \state filename -> do+          threadDelay mtimeChange+          unless (filename `Map.member` currentWorking state) $+            darcs ["add", filename]+      , -- Darcs's file change tracking relies on mtime changes,+        -- so we have to be careful with doing stuff too quickly: -      vcsSubmoduleDriver = \_ ->-        fail "vcsSubmoduleDriver: darcs does not support submodules"-    , vcsAddSubmodule = \_ _ _ ->-        fail "vcsAddSubmodule: darcs does not support submodules"-    , vcsCommitChanges = \_state -> do-        threadDelay mtimeChange-        darcs ["record", "--all", "--author=author", "--name=a patch"]-        return Nothing-    , vcsTagState = \_ tagname ->-        darcs ["tag", "--author=author", tagname]-    , vcsSwitchBranch = \_ _ ->-        fail "vcsSwitchBranch: darcs does not support branches within a repo"-    , vcsCheckoutTag = Right $ \tagname dest ->-        darcs ["clone", "--lazy", "--tag=^" ++ tagname ++ "$", ".", dest]-    }-  where-    darcsInvocation args =-      (programInvocation (vcsProgram vcs) args)-        { progInvokeCwd = Just repoRoot-        }-    darcs = runProgramInvocation verbosity . darcsInvocation+        vcsSubmoduleDriver = \_ ->+          fail "vcsSubmoduleDriver: darcs does not support submodules"+      , vcsAddSubmodule = \_ _ _ ->+          fail "vcsAddSubmodule: darcs does not support submodules"+      , vcsCommitChanges = \_state -> do+          threadDelay mtimeChange+          darcs ["record", "--all", "--author=author", "--name=a patch"]+          return Nothing+      , vcsTagState = \_ tagname ->+          darcs ["tag", "--author=author", tagname]+      , vcsSwitchBranch = \_ _ ->+          fail "vcsSwitchBranch: darcs does not support branches within a repo"+      , vcsCheckoutTag = Right $ \tagname dest ->+          darcs ["clone", "--lazy", "--tag=^" ++ tagname ++ "$", ".", dest]+      }+    where+      darcsInvocation args =+        (programInvocation (vcsProgram vcs) args)+          { progInvokeCwd = Just repoRoot+          }+      darcs = runProgramInvocation verbosity . darcsInvocation +vcsTestDriverPijul :: MkVCSTestDriver -> VCSTestDriver vcsTestDriverPijul-  :: Verbosity-  -> VCS ConfiguredProgram-  -> FilePath-  -> FilePath-  -> VCSTestDriver-vcsTestDriverPijul verbosity vcs _ repoRoot =-  VCSTestDriver-    { vcsVCS = vcs-    , vcsRepoRoot = repoRoot-    , vcsIgnoreFiles = Set.empty-    , vcsInit =-        pijul $ ["init"]-    , vcsAddFile = \_ filename ->-        pijul ["add", filename]-    , vcsSubmoduleDriver = \_ ->-        fail "vcsSubmoduleDriver: pijul does not support submodules"-    , vcsAddSubmodule = \_ _ _ ->-        fail "vcsAddSubmodule: pijul does not support submodules"-    , vcsCommitChanges = \_state -> do-        pijul $-          [ "record"-          , "-a"-          , "-m 'a patch'"-          , "-A 'A <a@example.com>'"-          ]-        commit <- pijul' ["log"]-        let commit' = takeWhile (not . isSpace) commit-        return (Just commit')-    , -- tags work differently in pijul...-      -- so this is wrong-      vcsTagState = \_ tagname ->-        pijul ["tag", tagname]-    , vcsSwitchBranch = \_ branchname -> do-        --        unless (branchname `Map.member` allBranches) $-        --          pijul ["from-branch", branchname]-        pijul $ ["checkout", branchname]-    , vcsCheckoutTag = Left $ \tagname ->-        pijul $ ["checkout", tagname]-    }-  where-    gitInvocation args =-      (programInvocation (vcsProgram vcs) args)-        { progInvokeCwd = Just repoRoot-        }-    pijul = runProgramInvocation verbosity . gitInvocation-    pijul' = getProgramInvocationOutput verbosity . gitInvocation+  MkVCSTestDriver+    { mkVcsVerbosity = verbosity+    , mkVcsVcs = vcs+    , mkVcsRepoRoot = repoRoot+    } =+    VCSTestDriver+      { vcsVCS = vcs+      , vcsRepoRoot = repoRoot+      , vcsIgnoreFiles = Set.empty+      , vcsInit =+          pijul $ ["init"]+      , vcsAddFile = \_ filename ->+          pijul ["add", filename]+      , vcsSubmoduleDriver = \_ ->+          fail "vcsSubmoduleDriver: pijul does not support submodules"+      , vcsAddSubmodule = \_ _ _ ->+          fail "vcsAddSubmodule: pijul does not support submodules"+      , vcsCommitChanges = \_state -> do+          pijul $+            [ "record"+            , "-a"+            , "-m 'a patch'"+            , "-A 'A <a@example.com>'"+            ]+          commit <- pijul' ["log"]+          let commit' = takeWhile (not . isSpace) commit+          return (Just commit')+      , -- tags work differently in pijul...+        -- so this is wrong+        vcsTagState = \_ tagname ->+          pijul ["tag", tagname]+      , vcsSwitchBranch = \_ branchname -> do+          --        unless (branchname `Map.member` allBranches) $+          --          pijul ["from-branch", branchname]+          pijul $ ["checkout", branchname]+      , vcsCheckoutTag = Left $ \tagname ->+          pijul $ ["checkout", tagname]+      }+    where+      gitInvocation args =+        (programInvocation (vcsProgram vcs) args)+          { progInvokeCwd = Just repoRoot+          }+      pijul = runProgramInvocation verbosity . gitInvocation+      pijul' = getProgramInvocationOutput verbosity . gitInvocation +vcsTestDriverHg :: MkVCSTestDriver -> VCSTestDriver vcsTestDriverHg-  :: Verbosity-  -> VCS ConfiguredProgram-  -> FilePath-  -> FilePath-  -> VCSTestDriver-vcsTestDriverHg verbosity vcs _ repoRoot =-  VCSTestDriver-    { vcsVCS = vcs-    , vcsRepoRoot = repoRoot-    , vcsIgnoreFiles = Set.empty-    , vcsInit =-        hg $ ["init"] ++ verboseArg-    , vcsAddFile = \_ filename ->-        hg ["add", filename]-    , vcsSubmoduleDriver = \_ ->-        fail "vcsSubmoduleDriver: hg submodules not supported"-    , vcsAddSubmodule = \_ _ _ ->-        fail "vcsAddSubmodule: hg submodules not supported"-    , vcsCommitChanges = \_state -> do-        hg $-          [ "--user='A <a@example.com>'"-          , "commit"-          , "--message=a patch"-          ]-            ++ verboseArg-        commit <- hg' ["log", "--template='{node}\\n' -l1"]-        let commit' = takeWhile (not . isSpace) commit-        return (Just commit')-    , vcsTagState = \_ tagname ->-        hg ["tag", "--force", tagname]-    , vcsSwitchBranch = \RepoState{allBranches} branchname -> do-        unless (branchname `Map.member` allBranches) $-          hg ["branch", branchname]-        hg $ ["checkout", branchname] ++ verboseArg-    , vcsCheckoutTag = Left $ \tagname ->-        hg $ ["checkout", "--rev", tagname] ++ verboseArg-    }-  where-    hgInvocation args =-      (programInvocation (vcsProgram vcs) args)-        { progInvokeCwd = Just repoRoot-        }-    hg = runProgramInvocation verbosity . hgInvocation-    hg' = getProgramInvocationOutput verbosity . hgInvocation-    verboseArg = ["--quiet" | verbosity < Verbosity.normal]+  MkVCSTestDriver+    { mkVcsVerbosity = verbosity+    , mkVcsVcs = vcs+    , mkVcsRepoRoot = repoRoot+    } =+    VCSTestDriver+      { vcsVCS = vcs+      , vcsRepoRoot = repoRoot+      , vcsIgnoreFiles = Set.empty+      , vcsInit =+          hg $ ["init"] ++ verboseArg+      , vcsAddFile = \_ filename ->+          hg ["add", filename]+      , vcsSubmoduleDriver = \_ ->+          fail "vcsSubmoduleDriver: hg submodules not supported"+      , vcsAddSubmodule = \_ _ _ ->+          fail "vcsAddSubmodule: hg submodules not supported"+      , vcsCommitChanges = \_state -> do+          hg $+            [ "--user='A <a@example.com>'"+            , "commit"+            , "--message=a patch"+            ]+              ++ verboseArg+          commit <- hg' ["log", "--template='{node}\\n' -l1"]+          let commit' = takeWhile (not . isSpace) commit+          return (Just commit')+      , vcsTagState = \_ tagname ->+          hg ["tag", "--force", tagname]+      , vcsSwitchBranch = \RepoState{allBranches} branchname -> do+          unless (branchname `Map.member` allBranches) $+            hg ["branch", branchname]+          hg $ ["checkout", branchname] ++ verboseArg+      , vcsCheckoutTag = Left $ \tagname ->+          hg $ ["checkout", "--rev", tagname] ++ verboseArg+      }+    where+      hgInvocation args =+        (programInvocation (vcsProgram vcs) args)+          { progInvokeCwd = Just repoRoot+          }+      hg = runProgramInvocation verbosity . hgInvocation+      hg' = getProgramInvocationOutput verbosity . hgInvocation+      verboseArg = ["--quiet" | verbosity < Verbosity.normal]
tests/UnitTests/Distribution/Solver/Modular/DSL.hs view
@@ -1,6 +1,6 @@+{-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}  -- | DSL for testing the modular solver
tests/UnitTests/Distribution/Solver/Modular/QuickCheck.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE StandaloneDeriving #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-}  module UnitTests.Distribution.Solver.Modular.QuickCheck (tests) where
tests/UnitTests/Distribution/Solver/Modular/RetryLog.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE StandaloneDeriving #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-}  module UnitTests.Distribution.Solver.Modular.RetryLog   ( tests