cabal-install 2.4.0.0 → 2.4.1.0
raw patch · 26 files changed
+730/−283 lines, 26 filesdep ~Cabaldep ~hashabledep ~network
Dependency ranges changed: Cabal, hashable, network, zip-archive
Files
- Distribution/Client/CmdBuild.hs +42/−11
- Distribution/Client/CmdClean.hs +31/−23
- Distribution/Client/CmdExec.hs +3/−4
- Distribution/Client/CmdInstall.hs +145/−28
- Distribution/Client/CmdRepl.hs +10/−2
- Distribution/Client/CmdRun.hs +3/−1
- Distribution/Client/CmdSdist.hs +90/−63
- Distribution/Client/Config.hs +3/−1
- Distribution/Client/DistDirLayout.hs +1/−1
- Distribution/Client/Init.hs +85/−26
- Distribution/Client/Init/Types.hs +3/−1
- Distribution/Client/Install.hs +2/−1
- Distribution/Client/InstallSymlink.hs +27/−9
- Distribution/Client/ProjectBuilding.hs +12/−8
- Distribution/Client/ProjectConfig/Legacy.hs +7/−4
- Distribution/Client/ProjectConfig/Types.hs +4/−1
- Distribution/Client/ProjectOrchestration.hs +34/−9
- Distribution/Client/ProjectPlanOutput.hs +5/−2
- Distribution/Client/ProjectPlanning.hs +52/−37
- Distribution/Client/ProjectPlanning/Types.hs +50/−17
- Distribution/Client/Setup.hs +49/−11
- Distribution/Client/Types.hs +16/−0
- bootstrap.sh +2/−2
- cabal-install.cabal +16/−16
- changelog +34/−3
- main/Main.hs +4/−2
Distribution/Client/CmdBuild.hs view
@@ -14,13 +14,15 @@ import Distribution.Client.ProjectOrchestration import Distribution.Client.CmdErrorMessages +import Distribution.Compat.Semigroup ((<>)) import Distribution.Client.Setup- ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags )+ ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags+ , liftOptions, yesNoOpt ) import qualified Distribution.Client.Setup as Client import Distribution.Simple.Setup- ( HaddockFlags, fromFlagOrDefault )+ ( HaddockFlags, Flag(..), toFlag, fromFlag, fromFlagOrDefault ) import Distribution.Simple.Command- ( CommandUI(..), usageAlternatives )+ ( CommandUI(..), usageAlternatives, option ) import Distribution.Verbosity ( Verbosity, normal ) import Distribution.Simple.Utils@@ -29,8 +31,8 @@ import qualified Data.Map as Map -buildCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)-buildCommand = Client.installCommand {+buildCommand :: CommandUI (BuildFlags, (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags))+buildCommand = CommandUI { commandName = "new-build", commandSynopsis = "Compile targets within the project.", commandUsage = usageAlternatives "new-build" [ "[TARGETS] [FLAGS]" ],@@ -59,10 +61,33 @@ ++ " " ++ pname ++ " new-build cname --enable-profiling\n" ++ " Build the component in profiling mode (including dependencies as needed)\n\n" - ++ cmdCommonHelpTextNewBuildBeta- }+ ++ cmdCommonHelpTextNewBuildBeta,+ commandDefaultFlags =+ (defaultBuildFlags, commandDefaultFlags Client.installCommand),+ commandOptions = \ showOrParseArgs ->+ liftOptions snd setSnd+ (commandOptions Client.installCommand showOrParseArgs) +++ liftOptions fst setFst+ [ option [] ["only-configure"]+ "Instead of performing a full build just run the configure step"+ buildOnlyConfigure (\v flags -> flags { buildOnlyConfigure = v })+ (yesNoOpt showOrParseArgs)+ ]+ } + where+ setFst a (_,b) = (a,b)+ setSnd b (a,_) = (a,b) +data BuildFlags = BuildFlags+ { buildOnlyConfigure :: Flag Bool+ }++defaultBuildFlags :: BuildFlags+defaultBuildFlags = BuildFlags+ { buildOnlyConfigure = toFlag False+ }+ -- | The @build@ command does a lot. It brings the install plan up to date, -- selects that part of the plan needed by the given or implicit targets and -- then executes the plan.@@ -70,10 +95,17 @@ -- For more details on how this works, see the module -- "Distribution.Client.ProjectOrchestration" ---buildAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)+buildAction :: (BuildFlags, (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)) -> [String] -> GlobalFlags -> IO ()-buildAction (configFlags, configExFlags, installFlags, haddockFlags)+buildAction (buildFlags,+ (configFlags, configExFlags, installFlags, haddockFlags)) targetStrings globalFlags = do+ -- TODO: This flags defaults business is ugly+ let onlyConfigure = fromFlag (buildOnlyConfigure defaultBuildFlags+ <> buildOnlyConfigure buildFlags)+ targetAction+ | onlyConfigure = TargetActionConfigure+ | otherwise = TargetActionBuild baseCtx <- establishProjectBaseContext verbosity cliConfig @@ -95,7 +127,7 @@ targetSelectors let elaboratedPlan' = pruneInstallPlanToTargets- TargetActionBuild+ targetAction targets elaboratedPlan elaboratedPlan'' <-@@ -192,4 +224,3 @@ reportCannotPruneDependencies :: Verbosity -> CannotPruneDependencies -> IO a reportCannotPruneDependencies verbosity = die' verbosity . renderCannotPruneDependencies-
Distribution/Client/CmdClean.hs view
@@ -22,46 +22,52 @@ import Distribution.Verbosity ( Verbosity, normal ) +import Control.Monad+ ( mapM_ ) import Control.Exception ( throwIO ) import System.Directory- ( removeDirectoryRecursive, doesDirectoryExist )+ ( removeDirectoryRecursive, removeFile+ , doesDirectoryExist, getDirectoryContents )+import System.FilePath+ ( (</>) ) data CleanFlags = CleanFlags- { cleanSaveConfig :: Flag Bool- , cleanVerbosity :: Flag Verbosity- , cleanDistDir :: Flag FilePath+ { cleanSaveConfig :: Flag Bool+ , cleanVerbosity :: Flag Verbosity+ , cleanDistDir :: Flag FilePath , cleanProjectFile :: Flag FilePath } deriving (Eq) defaultCleanFlags :: CleanFlags defaultCleanFlags = CleanFlags- { cleanSaveConfig = toFlag False- , cleanVerbosity = toFlag normal- , cleanDistDir = NoFlag+ { cleanSaveConfig = toFlag False+ , cleanVerbosity = toFlag normal+ , cleanDistDir = NoFlag , cleanProjectFile = mempty } cleanCommand :: CommandUI CleanFlags cleanCommand = CommandUI- { commandName = "new-clean"- , commandSynopsis = "Clean the package store and remove temporary files."- , commandUsage = \pname ->+ { commandName = "new-clean"+ , commandSynopsis = "Clean the package store and remove temporary files."+ , commandUsage = \pname -> "Usage: " ++ pname ++ " new-clean [FLAGS]\n" , commandDescription = Just $ \_ -> wrapText $ "Removes all temporary files created during the building process " ++ "(.hi, .o, preprocessed sources, etc.) and also empties out the " ++ "local caches (by default).\n\n"- , commandNotes = Nothing+ , commandNotes = Nothing , commandDefaultFlags = defaultCleanFlags- , commandOptions = \showOrParseArgs ->+ , commandOptions = \showOrParseArgs -> [ optionVerbosity cleanVerbosity (\v flags -> flags { cleanVerbosity = v }) , optionDistPref cleanDistDir (\dd flags -> flags { cleanDistDir = dd }) showOrParseArgs , option [] ["project-file"]- "Set the name of the cabal.project file to search for in parent directories"+ ("Set the name of the cabal.project file"+ ++ " to search for in parent directories") cleanProjectFile (\pf flags -> flags {cleanProjectFile = pf}) (reqArg "FILE" (succeedReadE Flag) flagToList) , option ['s'] ["save-config"]@@ -73,13 +79,14 @@ cleanAction :: CleanFlags -> [String] -> GlobalFlags -> IO () cleanAction CleanFlags{..} extraArgs _ = do- let verbosity = fromFlagOrDefault normal cleanVerbosity- saveConfig = fromFlagOrDefault False cleanSaveConfig+ let verbosity = fromFlagOrDefault normal cleanVerbosity+ saveConfig = fromFlagOrDefault False cleanSaveConfig mdistDirectory = flagToMaybe cleanDistDir- mprojectFile = flagToMaybe cleanProjectFile+ mprojectFile = flagToMaybe cleanProjectFile unless (null extraArgs) $- die' verbosity $ "'clean' doesn't take any extra arguments: " ++ unwords extraArgs+ die' verbosity $ "'clean' doesn't take any extra arguments: "+ ++ unwords extraArgs projectRoot <- either throwIO return =<< findProjectRoot Nothing mprojectFile @@ -88,20 +95,21 @@ if saveConfig then do let buildRoot = distBuildRootDirectory distLayout- unpackedSrcRoot = distUnpackedSrcRootDirectory distLayout buildRootExists <- doesDirectoryExist buildRoot- unpackedSrcRootExists <- doesDirectoryExist unpackedSrcRoot when buildRootExists $ do info verbosity ("Deleting build root (" ++ buildRoot ++ ")") handleDoesNotExist () $ removeDirectoryRecursive buildRoot-- when unpackedSrcRootExists $ do- info verbosity ("Deleting unpacked source root (" ++ unpackedSrcRoot ++ ")")- handleDoesNotExist () $ removeDirectoryRecursive unpackedSrcRoot else do let distRoot = distDirectory distLayout info verbosity ("Deleting dist-newstyle (" ++ distRoot ++ ")") handleDoesNotExist () $ removeDirectoryRecursive distRoot++ removeEnvFiles (distProjectRootDirectory distLayout)++removeEnvFiles :: FilePath -> IO ()+removeEnvFiles dir =+ (mapM_ (removeFile . (dir </>)) . filter ((".ghc.environment" ==) . take 16))+ =<< getDirectoryContents dir
Distribution/Client/CmdExec.hs view
@@ -27,6 +27,7 @@ , GlobalFlags , InstallFlags )+import qualified Distribution.Client.Setup as Client import Distribution.Client.ProjectOrchestration ( ProjectBuildContext(..) , runProjectPreBuildPhase@@ -86,8 +87,6 @@ , normal ) -import qualified Distribution.Client.CmdBuild as CmdBuild- import Prelude () import Distribution.Client.Compat.Prelude @@ -116,8 +115,8 @@ ++ " to choose an appropriate version of ghc and to include any" ++ " ghc-specific flags requested." , commandNotes = Nothing- , commandOptions = commandOptions CmdBuild.buildCommand- , commandDefaultFlags = commandDefaultFlags CmdBuild.buildCommand+ , commandOptions = commandOptions Client.installCommand+ , commandDefaultFlags = commandDefaultFlags Client.installCommand } execAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
Distribution/Client/CmdInstall.hs view
@@ -26,15 +26,16 @@ import Distribution.Client.CmdSdist import Distribution.Client.Setup- ( GlobalFlags(..), ConfigFlags(..), ConfigExFlags, InstallFlags+ ( GlobalFlags(..), ConfigFlags(..), ConfigExFlags, InstallFlags(..) , configureExOptions, installOptions, liftOptions ) import Distribution.Solver.Types.ConstraintSource ( ConstraintSource(..) ) import Distribution.Client.Types- ( PackageSpecifier(..), PackageLocation(..), UnresolvedSourcePackage )+ ( PackageSpecifier(..), PackageLocation(..), UnresolvedSourcePackage+ , SourcePackageDb(..) ) import qualified Distribution.Client.InstallPlan as InstallPlan import Distribution.Package- ( Package(..), PackageName, mkPackageName )+ ( Package(..), PackageName, mkPackageName, unPackageName ) import Distribution.Types.PackageId ( PackageIdentifier(..) ) import Distribution.Client.ProjectConfig.Types@@ -50,8 +51,9 @@ ( ProgramSearchPathEntry(..) ) import Distribution.Client.Config ( getCabalDir )-import Distribution.Simple.PackageIndex- ( InstalledPackageIndex, lookupPackageName, lookupUnitId )+import qualified Distribution.Simple.PackageIndex as PI+import Distribution.Solver.Types.PackageIndex+ ( lookupPackageName, searchByName ) import Distribution.Types.InstalledPackageInfo ( InstalledPackageInfo(..) ) import Distribution.Types.Version@@ -73,14 +75,14 @@ import Distribution.Client.RebuildMonad ( runRebuild ) import Distribution.Client.InstallSymlink- ( symlinkBinary )+ ( OverwritePolicy(..), symlinkBinary ) import Distribution.Simple.Setup- ( Flag(Flag), HaddockFlags, fromFlagOrDefault, flagToMaybe, toFlag+ ( Flag(..), HaddockFlags, fromFlagOrDefault, flagToMaybe, toFlag , trueArg, configureOptions, haddockOptions, flagToList ) import Distribution.Solver.Types.SourcePackage ( SourcePackage(..) ) import Distribution.ReadE- ( succeedReadE )+ ( ReadE(..), succeedReadE ) import Distribution.Simple.Command ( CommandUI(..), ShowOrParseArgs(..), OptionField(..) , option, usageAlternatives, reqArg )@@ -107,6 +109,8 @@ ( writeFileAtomic ) import Distribution.Text ( simpleParse )+import Distribution.Pretty+ ( prettyShow ) import Control.Exception ( catch )@@ -114,7 +118,7 @@ ( mapM, mapM_ ) import qualified Data.ByteString.Lazy.Char8 as BS import Data.Either- ( partitionEithers )+ ( partitionEithers, isLeft ) import Data.Ord ( comparing, Down(..) ) import qualified Data.Map as Map@@ -129,12 +133,14 @@ data NewInstallFlags = NewInstallFlags { ninstInstallLibs :: Flag Bool , ninstEnvironmentPath :: Flag FilePath+ , ninstOverwritePolicy :: Flag OverwritePolicy } defaultNewInstallFlags :: NewInstallFlags defaultNewInstallFlags = NewInstallFlags { ninstInstallLibs = toFlag False , ninstEnvironmentPath = mempty+ , ninstOverwritePolicy = toFlag NeverOverwrite } newInstallOptions :: ShowOrParseArgs -> [OptionField NewInstallFlags]@@ -147,7 +153,22 @@ "Set the environment file that may be modified." ninstEnvironmentPath (\pf flags -> flags { ninstEnvironmentPath = pf }) (reqArg "ENV" (succeedReadE Flag) flagToList)+ , option [] ["overwrite-policy"]+ "How to handle already existing symlinks."+ ninstOverwritePolicy (\v flags -> flags { ninstOverwritePolicy = v })+ $ reqArg+ "always|never"+ readOverwritePolicyFlag+ showOverwritePolicyFlag ]+ where+ readOverwritePolicyFlag = ReadE $ \case+ "always" -> Right $ Flag AlwaysOverwrite+ "never" -> Right $ Flag NeverOverwrite+ policy -> Left $ "'" <> policy <> "' isn't a valid overwrite policy"+ showOverwritePolicyFlag (Flag AlwaysOverwrite) = ["always"]+ showOverwritePolicyFlag (Flag NeverOverwrite) = ["never"]+ showOverwritePolicyFlag NoFlag = [] installCommand :: CommandUI ( ConfigFlags, ConfigExFlags, InstallFlags , HaddockFlags, NewInstallFlags@@ -194,9 +215,9 @@ . optionName) $ installOptions showOrParseArgs) ++ liftOptions get4 set4- -- hide "target-package-db" flag from the- -- install options.- (filter ((`notElem` ["v", "verbose"])+ -- hide "verbose" and "builddir" flags from the+ -- haddock options.+ (filter ((`notElem` ["v", "verbose", "builddir"]) . optionName) $ haddockOptions showOrParseArgs) ++ liftOptions get5 set5 (newInstallOptions showOrParseArgs)@@ -289,6 +310,18 @@ TargetProblemCommon (TargetAvailableInIndex name) -> Right name err -> Left err + -- report incorrect case for known package.+ for_ errs' $ \case+ TargetProblemCommon (TargetNotInProject hn) ->+ case searchByName (packageIndex pkgDb) (unPackageName hn) of+ [] -> return ()+ xs -> die' verbosity . concat $+ [ "Unknown package \"", unPackageName hn, "\". "+ , "Did you mean any of the following?\n"+ , unlines (("- " ++) . unPackageName . fst <$> xs)+ ]+ _ -> return ()+ when (not . null $ errs') $ reportTargetProblems verbosity errs' let@@ -356,6 +389,42 @@ | Just (pkg :: PackageId) <- simpleParse pkgName = return pkg | otherwise = die' verbosity ("Invalid package ID: " ++ pkgName) packageIds <- mapM parsePkg targetStrings+ + cabalDir <- getCabalDir+ let + projectConfig = globalConfig <> cliConfig++ ProjectConfigBuildOnly {+ projectConfigLogsDir+ } = projectConfigBuildOnly projectConfig++ ProjectConfigShared {+ projectConfigStoreDir+ } = projectConfigShared projectConfig++ mlogsDir = flagToMaybe projectConfigLogsDir+ mstoreDir = flagToMaybe projectConfigStoreDir+ cabalDirLayout = mkCabalDirLayout cabalDir mstoreDir mlogsDir++ buildSettings = resolveBuildTimeSettings+ verbosity cabalDirLayout+ projectConfig++ SourcePackageDb { packageIndex } <- projectConfigWithBuilderRepoContext+ verbosity buildSettings + (getSourcePackages verbosity)++ for_ targetStrings $ \case+ name+ | null (lookupPackageName packageIndex (mkPackageName name))+ , xs@(_:_) <- searchByName packageIndex name ->+ die' verbosity . concat $+ [ "Unknown package \"", name, "\". "+ , "Did you mean any of the following?\n"+ , unlines (("- " ++) . unPackageName . fst <$> xs)+ ]+ _ -> return ()+ let packageSpecifiers = flip fmap packageIds $ \case PackageIdentifier{..}@@ -363,7 +432,7 @@ | otherwise -> NamedPackage pkgName [PackagePropertyVersion (thisVersion pkgVersion)] packageTargets = flip TargetPackageNamed Nothing . pkgName <$> packageIds- return (packageSpecifiers, packageTargets, globalConfig <> cliConfig)+ return (packageSpecifiers, packageTargets, projectConfig) (specs, selectors, config) <- withProjectOrGlobalConfig verbosity globalConfigFlag withProject withoutProject@@ -437,9 +506,9 @@ " is unparsable. Libraries cannot be installed.") >> return [] else return [] - cabalDir <- getCabalDir+ cabalDir <- getCabalDir+ mstoreDir <- sequenceA $ makeAbsolute <$> flagToMaybe (globalStoreDir globalFlags) let- mstoreDir = flagToMaybe (globalStoreDir globalFlags) mlogsDir = flagToMaybe (globalLogsDir globalFlags) cabalLayout = mkCabalDirLayout cabalDir mstoreDir mlogsDir packageDbs = storePackageDBStack (cabalStoreDirLayout cabalLayout) compilerId@@ -492,15 +561,21 @@ printPlan verbosity baseCtx buildCtx buildOutcomes <- runProjectBuildPhase verbosity baseCtx buildCtx+ -- Temporary fix for #5641+ when (any isLeft buildOutcomes) $+ warn verbosity $ "Some package(s) failed to build. "+ <> "Try rerunning with -j1 if you can't see the error."+ runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes let+ dryRun = buildSettingDryRun $ buildSettings baseCtx mkPkgBinDir = (</> "bin") . storePackageDirectory (cabalStoreDirLayout $ cabalDirLayout baseCtx) compilerId installLibs = fromFlagOrDefault False (ninstInstallLibs newInstallFlags) - when (not installLibs) $ do+ when (not installLibs && not dryRun) $ do -- If there are exes, symlink them let symlinkBindirUnknown = "symlink-bindir is not defined. Set it in your cabal config file "@@ -511,11 +586,15 @@ $ projectConfigBuildOnly $ projectConfig $ baseCtx createDirectoryIfMissingVerbose verbosity False symlinkBindir- traverse_ (symlinkBuiltPackage verbosity mkPkgBinDir symlinkBindir)- $ Map.toList $ targetsMap buildCtx- runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes+ warnIfNoExes verbosity buildCtx+ let+ doSymlink = symlinkBuiltPackage+ verbosity+ overwritePolicy+ mkPkgBinDir symlinkBindir+ in traverse_ doSymlink $ Map.toList $ targetsMap buildCtx - when installLibs $+ when (installLibs && not dryRun) $ if supportsPkgEnvFiles then do -- Why do we get it again? If we updated a globalPackage then we need@@ -523,7 +602,7 @@ installedIndex' <- getInstalledPackages verbosity compiler packageDbs progDb' let getLatest = fmap (head . snd) . take 1 . sortBy (comparing (Down . fst))- . lookupPackageName installedIndex'+ . PI.lookupPackageName installedIndex' globalLatest = concat (getLatest <$> globalPackages) baseEntries =@@ -548,7 +627,26 @@ globalFlags configFlags' configExFlags installFlags haddockFlags globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig)+ overwritePolicy = fromFlagOrDefault NeverOverwrite+ $ ninstOverwritePolicy newInstallFlags +warnIfNoExes :: Verbosity -> ProjectBuildContext -> IO ()+warnIfNoExes verbosity buildCtx =+ when noExes $+ warn verbosity $ "You asked to install executables, "+ <> "but there are no executables in "+ <> plural (listPlural selectors) "target" "targets" <> ": "+ <> intercalate ", " (showTargetSelector <$> selectors) <> ". "+ <> "Perhaps you want to use --lib "+ <> "to install libraries instead."+ where+ targets = concat $ Map.elems $ targetsMap buildCtx+ components = fst <$> targets+ selectors = concatMap snd targets+ noExes = null $ catMaybes $ exeMaybe <$> components+ exeMaybe (ComponentTarget (CExeName exe) _) = Just exe+ exeMaybe _ = Nothing+ globalPackages :: [PackageName] globalPackages = mkPackageName <$> [ "ghc", "hoopl", "bytestring", "unix", "base", "time", "hpc", "filepath"@@ -558,12 +656,12 @@ , "bin-package-db" ] -environmentFileToSpecifiers :: InstalledPackageIndex -> [GhcEnvironmentFileEntry]+environmentFileToSpecifiers :: PI.InstalledPackageIndex -> [GhcEnvironmentFileEntry] -> ([PackageSpecifier a], [GhcEnvironmentFileEntry]) environmentFileToSpecifiers ipi = foldMap $ \case (GhcEnvFilePackageId unitId) | Just InstalledPackageInfo{ sourcePackageId = PackageIdentifier{..}, installedUnitId }- <- lookupUnitId ipi unitId+ <- PI.lookupUnitId ipi unitId , let pkgSpec = NamedPackage pkgName [PackagePropertyVersion (thisVersion pkgVersion)] -> if pkgName `elem` globalPackages then ([pkgSpec], [])@@ -579,24 +677,43 @@ -- | Symlink every exe from a package from the store to a given location symlinkBuiltPackage :: Verbosity+ -> OverwritePolicy -- ^ Whether to overwrite existing files -> (UnitId -> FilePath) -- ^ A function to get an UnitId's -- store directory -> FilePath -- ^ Where to put the symlink -> ( UnitId , [(ComponentTarget, [TargetSelector])] ) -> IO ()-symlinkBuiltPackage verbosity mkSourceBinDir destDir (pkg, components) =- traverse_ (symlinkBuiltExe verbosity (mkSourceBinDir pkg) destDir) exes+symlinkBuiltPackage verbosity overwritePolicy+ mkSourceBinDir destDir+ (pkg, components) =+ traverse_ symlinkAndWarn exes where exes = catMaybes $ (exeMaybe . fst) <$> components exeMaybe (ComponentTarget (CExeName exe) _) = Just exe exeMaybe _ = Nothing+ symlinkAndWarn exe = do+ success <- symlinkBuiltExe+ verbosity overwritePolicy+ (mkSourceBinDir pkg) destDir exe+ let errorMessage = case overwritePolicy of+ NeverOverwrite ->+ "Path '" <> (destDir </> prettyShow exe) <> "' already exists. "+ <> "Use --overwrite-policy=always to overwrite."+ -- This shouldn't even be possible, but we keep it in case+ -- symlinking logic changes+ AlwaysOverwrite -> "Symlinking '" <> prettyShow exe <> "' failed."+ unless success $ die' verbosity errorMessage -- | Symlink a specific exe.-symlinkBuiltExe :: Verbosity -> FilePath -> FilePath -> UnqualComponentName -> IO Bool-symlinkBuiltExe verbosity sourceDir destDir exe = do- notice verbosity $ "Symlinking " ++ unUnqualComponentName exe+symlinkBuiltExe :: Verbosity -> OverwritePolicy+ -> FilePath -> FilePath+ -> UnqualComponentName+ -> IO Bool+symlinkBuiltExe verbosity overwritePolicy sourceDir destDir exe = do+ notice verbosity $ "Symlinking '" <> prettyShow exe <> "'" symlinkBinary+ overwritePolicy destDir sourceDir exe
Distribution/Client/CmdRepl.hs view
@@ -35,6 +35,8 @@ import Distribution.Client.ProjectOrchestration import Distribution.Client.ProjectPlanning ( ElaboratedSharedConfig(..), ElaboratedInstallPlan )+import Distribution.Client.ProjectPlanning.Types+ ( elabOrderExeDependencies ) import Distribution.Client.RebuildMonad ( runRebuild ) import Distribution.Client.Setup@@ -407,14 +409,20 @@ generateReplFlags :: Bool -> ElaboratedInstallPlan -> OriginalComponentInfo -> ReplFlags generateReplFlags includeTransitive elaboratedPlan OriginalComponentInfo{..} = flags where+ exeDeps :: [UnitId]+ exeDeps = + foldMap + (InstallPlan.foldPlanPackage (const []) elabOrderExeDependencies)+ (InstallPlan.dependencyClosure elaboratedPlan [ociUnitId])+ deps, deps', trans, trans' :: [UnitId] flags :: ReplFlags deps = installedUnitId <$> InstallPlan.directDeps elaboratedPlan ociUnitId deps' = deps \\ ociOriginalDeps trans = installedUnitId <$> InstallPlan.dependencyClosure elaboratedPlan deps' trans' = trans \\ ociOriginalDeps- flags = ("-package-id " ++) . prettyShow <$> - if includeTransitive then trans' else deps'+ flags = fmap (("-package-id " ++) . prettyShow) . (\\ exeDeps)+ $ if includeTransitive then trans' else deps' -- | This defines what a 'TargetSelector' means for the @repl@ command. -- It selects the 'AvailableTarget's that the 'TargetSelector' refers to,
Distribution/Client/CmdRun.hs view
@@ -286,7 +286,9 @@ emptyProgramInvocation { progInvokePath = exePath, progInvokeArgs = args,- progInvokeEnv = dataDirsEnvironmentForPlan elaboratedPlan+ progInvokeEnv = dataDirsEnvironmentForPlan+ (distDirLayout baseCtx)+ elaboratedPlan } handleDoesNotExist () (removeDirectoryRecursive tempDir)
Distribution/Client/CmdSdist.hs view
@@ -29,6 +29,9 @@ import Distribution.Client.ProjectConfig ( findProjectRoot, readProjectConfig ) +import Distribution.Compat.Semigroup+ ((<>))+ import Distribution.Package ( Package(packageId) ) import Distribution.PackageDescription.Configuration@@ -217,78 +220,102 @@ packageToSdist :: Verbosity -> FilePath -> OutputFormat -> FilePath -> UnresolvedSourcePackage -> IO () packageToSdist verbosity projectRootDir format outputFile pkg = do- dir <- case packageSource pkg of- LocalUnpackedPackage path -> return path- _ -> die' verbosity "The impossible happened: a local package isn't local"- oldPwd <- getCurrentDirectory- setCurrentDirectory dir-- let norm flag = fmap ((flag, ) . normalise)- (norm NoExec -> nonexec, norm Exec -> exec) <- - listPackageSources verbosity (flattenPackageDescription $ packageDescription pkg) knownSuffixHandlers+ let death = die' verbosity ("The impossible happened: a local package isn't local" <> (show pkg))+ dir0 <- case packageSource pkg of+ LocalUnpackedPackage path -> pure (Right path)+ RemoteSourceRepoPackage _ (Just path) -> pure (Right path)+ RemoteSourceRepoPackage {} -> death+ LocalTarballPackage tgz -> pure (Left tgz)+ RemoteTarballPackage _ (Just tgz) -> pure (Left tgz)+ RemoteTarballPackage {} -> death+ RepoTarballPackage {} -> death let write = if outputFile == "-" then putStr . withOutputMarker verbosity . BSL.unpack else BSL.writeFile outputFile- files = nub . sortOn snd $ nonexec ++ exec - case format of- SourceList nulSep -> do- let prefix = makeRelative projectRootDir dir- write (BSL.pack . (++ [nulSep]) . intercalate [nulSep] . fmap ((prefix </>) . snd) $ files)+ case dir0 of+ Left tgz -> do+ case format of+ Archive TargzFormat -> do+ write =<< BSL.readFile tgz when (outputFile /= "-") $- notice verbosity $ "Wrote source list to " ++ outputFile ++ "\n"- Archive TargzFormat -> do- let entriesM :: StateT (Set.Set FilePath) (WriterT [Tar.Entry] IO) ()- entriesM = do- let prefix = prettyShow (packageId pkg)- modify (Set.insert prefix)- case Tar.toTarPath True prefix of- Left err -> liftIO $ die' verbosity ("Error packing sdist: " ++ err)- Right path -> tell [Tar.directoryEntry path]+ notice verbosity $ "Wrote tarball sdist to " ++ outputFile ++ "\n"+ _ -> die' verbosity ("cannot convert tarball package to " ++ show format) - forM_ files $ \(perm, file) -> do- let fileDir = takeDirectory (prefix </> file)- perm' = case perm of- Exec -> Tar.executableFilePermissions- NoExec -> Tar.ordinaryFilePermissions- needsEntry <- gets (Set.notMember fileDir)+ Right dir -> do+ oldPwd <- getCurrentDirectory+ setCurrentDirectory dir - when needsEntry $ do- modify (Set.insert fileDir)- case Tar.toTarPath True fileDir of- Left err -> liftIO $ die' verbosity ("Error packing sdist: " ++ err)- Right path -> tell [Tar.directoryEntry path]- - contents <- liftIO . fmap BSL.fromStrict . BS.readFile $ file- case Tar.toTarPath False (prefix </> file) of+ let norm flag = fmap ((flag, ) . normalise)+ (norm NoExec -> nonexec, norm Exec -> exec) <-+ listPackageSources verbosity (flattenPackageDescription $ packageDescription pkg) knownSuffixHandlers++ let files = nub . sortOn snd $ nonexec ++ exec++ case format of+ SourceList nulSep -> do+ let prefix = makeRelative projectRootDir dir+ write (BSL.pack . (++ [nulSep]) . intercalate [nulSep] . fmap ((prefix </>) . snd) $ files)+ when (outputFile /= "-") $+ notice verbosity $ "Wrote source list to " ++ outputFile ++ "\n"+ Archive TargzFormat -> do+ let entriesM :: StateT (Set.Set FilePath) (WriterT [Tar.Entry] IO) ()+ entriesM = do+ let prefix = prettyShow (packageId pkg)+ modify (Set.insert prefix)+ case Tar.toTarPath True prefix of Left err -> liftIO $ die' verbosity ("Error packing sdist: " ++ err)- Right path -> tell [(Tar.fileEntry path contents) { Tar.entryPermissions = perm' }]- - entries <- execWriterT (evalStateT entriesM mempty)- let -- Pretend our GZip file is made on Unix.- normalize bs = BSL.concat [first, "\x03", rest']- where- (first, rest) = BSL.splitAt 9 bs- rest' = BSL.tail rest- write . normalize . GZip.compress . Tar.write $ entries- when (outputFile /= "-") $- notice verbosity $ "Wrote tarball sdist to " ++ outputFile ++ "\n"- Archive ZipFormat -> do- let prefix = prettyShow (packageId pkg)- entries <- forM files $ \(perm, file) -> do- let perm' = case perm of- -- -rwxr-xr-x- Exec -> 0o010755 `shiftL` 16- -- -rw-r--r--- NoExec -> 0o010644 `shiftL` 16- contents <- BSL.readFile file- return $ (Zip.toEntry (prefix </> file) 0 contents) { Zip.eExternalFileAttributes = perm' }- let archive = foldr Zip.addEntryToArchive Zip.emptyArchive entries- write (Zip.fromArchive archive)- when (outputFile /= "-") $- notice verbosity $ "Wrote zip sdist to " ++ outputFile ++ "\n"- setCurrentDirectory oldPwd+ Right path -> tell [Tar.directoryEntry path]++ forM_ files $ \(perm, file) -> do+ let fileDir = takeDirectory (prefix </> file)+ perm' = case perm of+ Exec -> Tar.executableFilePermissions+ NoExec -> Tar.ordinaryFilePermissions+ needsEntry <- gets (Set.notMember fileDir)++ when needsEntry $ do+ modify (Set.insert fileDir)+ case Tar.toTarPath True fileDir of+ Left err -> liftIO $ die' verbosity ("Error packing sdist: " ++ err)+ Right path -> tell [Tar.directoryEntry path]++ contents <- liftIO . fmap BSL.fromStrict . BS.readFile $ file+ case Tar.toTarPath False (prefix </> file) of+ Left err -> liftIO $ die' verbosity ("Error packing sdist: " ++ err)+ Right path -> tell [(Tar.fileEntry path contents) { Tar.entryPermissions = perm' }]++ entries <- execWriterT (evalStateT entriesM mempty)+ let -- Pretend our GZip file is made on Unix.+ normalize bs = BSL.concat [first, "\x03", rest']+ where+ (first, rest) = BSL.splitAt 9 bs+ rest' = BSL.tail rest+ -- The Unix epoch, which is the default value, is+ -- unsuitable because it causes unpacking problems on+ -- Windows; we need a post-1980 date. One gigasecond+ -- after the epoch is during 2001-09-09, so that does+ -- nicely. See #5596.+ setModTime entry = entry { Tar.entryTime = 1000000000 }+ write . normalize . GZip.compress . Tar.write $ fmap setModTime entries+ when (outputFile /= "-") $+ notice verbosity $ "Wrote tarball sdist to " ++ outputFile ++ "\n"+ Archive ZipFormat -> do+ let prefix = prettyShow (packageId pkg)+ entries <- forM files $ \(perm, file) -> do+ let perm' = case perm of+ -- -rwxr-xr-x+ Exec -> 0o010755 `shiftL` 16+ -- -rw-r--r--+ NoExec -> 0o010644 `shiftL` 16+ contents <- BSL.readFile file+ return $ (Zip.toEntry (prefix </> file) 0 contents) { Zip.eExternalFileAttributes = perm' }+ let archive = foldr Zip.addEntryToArchive Zip.emptyArchive entries+ write (Zip.fromArchive archive)+ when (outputFile /= "-") $+ notice verbosity $ "Wrote zip sdist to " ++ outputFile ++ "\n"+ setCurrentDirectory oldPwd --
Distribution/Client/Config.hs view
@@ -359,7 +359,9 @@ configPreferences = lastNonEmpty configPreferences, configSolver = combine configSolver, configAllowNewer = combineMonoid savedConfigureExFlags configAllowNewer,- configAllowOlder = combineMonoid savedConfigureExFlags configAllowOlder+ configAllowOlder = combineMonoid savedConfigureExFlags configAllowOlder,+ configWriteGhcEnvironmentFilesPolicy+ = combine configWriteGhcEnvironmentFilesPolicy } where combine = combine' savedConfigureExFlags
Distribution/Client/DistDirLayout.hs view
@@ -273,7 +273,7 @@ mkCabalDirLayout cabalDir Nothing Nothing mkCabalDirLayout :: FilePath -- ^ Cabal directory- -> Maybe FilePath -- ^ Store directory+ -> Maybe FilePath -- ^ Store directory. Must be absolute -> Maybe FilePath -- ^ Log directory -> CabalDirLayout mkCabalDirLayout cabalDir mstoreDir mlogDir =
Distribution/Client/Init.hs view
@@ -17,7 +17,6 @@ -- * Commands initCabal- , pvpize , incVersion ) where@@ -48,7 +47,7 @@ import Text.PrettyPrint hiding (mode, cat) import Distribution.Version- ( Version, mkVersion, alterVersion+ ( Version, mkVersion, alterVersion, versionNumbers, majorBoundVersion , orLaterVersion, earlierVersion, intersectVersionRanges, VersionRange ) import Distribution.Verbosity ( Verbosity )@@ -70,7 +69,8 @@ scanForModules, neededBuildPrograms ) import Distribution.License- ( License(..), knownLicenses )+ ( License(..), knownLicenses, licenseToSPDX )+import qualified Distribution.SPDX as SPDX import Distribution.ReadE ( runReadE, readP_to_E )@@ -88,6 +88,10 @@ ( InstalledPackageIndex, moduleNameIndex ) import Distribution.Text ( display, Text(..) )+import Distribution.Pretty+ ( prettyShow )+import Distribution.Parsec.Class+ ( eitherParsec ) import Distribution.Solver.Types.PackageIndex ( elemByPackageName )@@ -134,7 +138,8 @@ -- user. extendFlags :: InstalledPackageIndex -> SourcePackageDb -> InitFlags -> IO InitFlags extendFlags pkgIx sourcePkgDb =- getPackageName sourcePkgDb+ getCabalVersion+ >=> getPackageName sourcePkgDb >=> getVersion >=> getLicense >=> getAuthorInfo@@ -162,6 +167,30 @@ maybeToFlag :: Maybe a -> Flag a maybeToFlag = maybe NoFlag Flag +defaultCabalVersion :: Version+defaultCabalVersion = mkVersion [1,10]++displayCabalVersion :: Version -> String+displayCabalVersion v = case versionNumbers v of+ [1,10] -> "1.10 (legacy)"+ [2,0] -> "2.0 (+ support for Backpack, internal sub-libs, '^>=' operator)"+ [2,2] -> "2.2 (+ support for 'common', 'elif', redundant commas, SPDX)"+ [2,4] -> "2.4 (+ support for '**' globbing)"+ _ -> display v++-- | Ask which version of the cabal spec to use.+getCabalVersion :: InitFlags -> IO InitFlags+getCabalVersion flags = do+ cabVer <- return (flagToMaybe $ cabalVersion flags)+ ?>> maybePrompt flags (either (const defaultCabalVersion) id `fmap`+ promptList "Please choose version of the Cabal specification to use"+ [mkVersion [1,10], mkVersion [2,0], mkVersion [2,2], mkVersion [2,4]]+ (Just defaultCabalVersion) displayCabalVersion False)+ ?>> return (Just defaultCabalVersion)++ return $ flags { cabalVersion = maybeToFlag cabVer }++ -- | Get the package name: use the package directory (supplied, or the current -- directory by default) as a guess. It looks at the SourcePackageDb to avoid -- using an existing package name.@@ -209,16 +238,26 @@ lic <- return (flagToMaybe $ license flags) ?>> fmap (fmap (either UnknownLicense id)) (maybePrompt flags- (promptList "Please choose a license" listedLicenses (Just BSD3) display True))+ (promptList "Please choose a license" listedLicenses+ (Just BSD3) displayLicense True)) - if isLicenseInvalid lic- then putStrLn promptInvalidOtherLicenseMsg >> getLicense flags- else return $ flags { license = maybeToFlag lic }+ case checkLicenseInvalid lic of+ Just msg -> putStrLn msg >> getLicense flags+ Nothing -> return $ flags { license = maybeToFlag lic } where- isLicenseInvalid (Just (UnknownLicense t)) = any (not . isAlphaNum) t- isLicenseInvalid _ = False+ displayLicense l | needSpdx = prettyShow (licenseToSPDX l)+ | otherwise = display l + checkLicenseInvalid (Just (UnknownLicense t))+ | needSpdx = case eitherParsec t :: Either String SPDX.License of+ Right _ -> Nothing+ Left _ -> Just "\nThe license must be a valid SPDX expression."+ | otherwise = if any (not . isAlphaNum) t+ then Just promptInvalidOtherLicenseMsg+ else Nothing+ checkLicenseInvalid _ = Nothing+ promptInvalidOtherLicenseMsg = "\nThe license must be alphanumeric. " ++ "If your license name has many words, " ++ "the convention is to use camel case (e.g. PublicDomain). " ++@@ -228,6 +267,8 @@ knownLicenses \\ [GPL Nothing, LGPL Nothing, AGPL Nothing , Apache Nothing, OtherLicense] + needSpdx = maybe False (>= mkVersion [2,2]) $ flagToMaybe (cabalVersion flags)+ -- | The author's name and email. Prompt, or try to guess from an existing -- darcs repo. getAuthorInfo :: InitFlags -> IO InitFlags@@ -480,24 +521,31 @@ where pkgGroups = groupBy ((==) `on` P.pkgName) (map P.packageId ps) + desugar = maybe True (< mkVersion [2]) $ flagToMaybe (cabalVersion flags)+ -- Given a list of available versions of the same package, pick a dependency. toDep :: [P.PackageIdentifier] -> IO P.Dependency -- If only one version, easy. We change e.g. 0.4.2 into 0.4.*- toDep [pid] = return $ P.Dependency (P.pkgName pid) (pvpize . P.pkgVersion $ pid)+ toDep [pid] = return $ P.Dependency (P.pkgName pid) (pvpize desugar . P.pkgVersion $ pid) -- Otherwise, choose the latest version and issue a warning. toDep pids = do message flags ("\nWarning: multiple versions of " ++ display (P.pkgName . head $ pids) ++ " provide " ++ display m ++ ", choosing the latest.") return $ P.Dependency (P.pkgName . head $ pids)- (pvpize . maximum . map P.pkgVersion $ pids)+ (pvpize desugar . maximum . map P.pkgVersion $ pids) -- | Given a version, return an API-compatible (according to PVP) version range. ----- Example: @0.4.1@ produces the version range @>= 0.4 && < 0.5@ (which is the+-- If the boolean argument denotes whether to use a desugared+-- representation (if 'True') or the new-style @^>=@-form (if+-- 'False').+--+-- Example: @pvpize True (mkVersion [0,4,1])@ produces the version range @>= 0.4 && < 0.5@ (which is the -- same as @0.4.*@).-pvpize :: Version -> VersionRange-pvpize v = orLaterVersion v'+pvpize :: Bool -> Version -> VersionRange+pvpize False v = majorBoundVersion v+pvpize True v = orLaterVersion v' `intersectVersionRanges` earlierVersion (incVersion 1 v') where v' = alterVersion (take 2) v@@ -804,9 +852,16 @@ generateCabalFile fileName c = trimTrailingWS $ (++ "\n") . renderStyle style { lineLength = 79, ribbonsPerLine = 1.1 } $+ -- Starting with 2.2 the `cabal-version` field needs to be the first line of the PD+ (if specVer < mkVersion [1,12]+ then field "cabal-version" (Flag $ orLaterVersion specVer) -- legacy+ else field "cabal-version" (Flag $ specVer))+ Nothing -- NB: the first line must be the 'cabal-version' declaration+ False+ $$ (if minimal c /= Flag True- then showComment (Just $ "Initial " ++ fileName ++ " generated by cabal "- ++ "init. For further documentation, see "+ then showComment (Just $ "Initial package description '" ++ fileName ++ "' generated "+ ++ "by 'cabal init'. For further documentation, see " ++ "http://haskell.org/cabal/users-guide/") $$ text "" else empty)@@ -816,7 +871,7 @@ True , field "version" (version c)- (Just $ "The package version. See the Haskell package versioning policy (PVP) for standards guiding when and how versions should be incremented.\nhttps://wiki.haskell.org/Package_versioning_policy\n"+ (Just $ "The package version. See the Haskell package versioning policy (PVP) for standards guiding when and how versions should be incremented.\nhttps://pvp.haskell.org\n" ++ "PVP summary: +-+------- breaking API changes\n" ++ " | | +----- non-breaking API additions\n" ++ " | | | +--- code changes with no API change")@@ -836,9 +891,9 @@ , fieldS "bug-reports" NoFlag (Just "A URL where users can report bugs.")- False+ True - , field "license" (license c)+ , fieldS "license" licenseStr (Just "The license under which the package is released.") True @@ -866,18 +921,14 @@ Nothing True - , fieldS "build-type" (Flag "Simple")+ , fieldS "build-type" (if specVer >= mkVersion [2,2] then NoFlag else Flag "Simple") Nothing- True+ False , fieldS "extra-source-files" (listFieldS (extraSrc c)) (Just "Extra files to be distributed with the package, such as examples or a README.") True - , field "cabal-version" (Flag $ orLaterVersion (mkVersion [1,10]))- (Just "Constraint on the version of Cabal needed to build this package.")- False- , case packageType c of Flag Executable -> executableStanza Flag Library -> libraryStanza@@ -885,6 +936,14 @@ _ -> empty ] where+ specVer = fromMaybe defaultCabalVersion $ flagToMaybe (cabalVersion c)++ licenseStr | specVer < mkVersion [2,2] = prettyShow `fmap` license c+ | otherwise = go `fmap` license c+ where+ go (UnknownLicense s) = s+ go l = prettyShow (licenseToSPDX l)+ generateBuildInfo :: BuildType -> InitFlags -> Doc generateBuildInfo buildType c' = vcat [ fieldS "other-modules" (listField (otherModules c'))
Distribution/Client/Init/Types.hs view
@@ -47,7 +47,7 @@ , packageName :: Flag P.PackageName , version :: Flag Version- , cabalVersion :: Flag VersionRange+ , cabalVersion :: Flag Version , license :: Flag License , author :: Flag String , email :: Flag String@@ -68,6 +68,8 @@ , dependencies :: Maybe [P.Dependency] , sourceDirs :: Maybe [String] , buildTools :: Maybe [String]++ , initHcPath :: Flag FilePath , initVerbosity :: Flag Verbosity , overwrite :: Flag Bool
Distribution/Client/Install.hs view
@@ -96,7 +96,7 @@ import qualified Distribution.Client.BuildReports.Storage as BuildReports ( storeAnonymous, storeLocal, fromInstallPlan, fromPlanningFailure ) import qualified Distribution.Client.InstallSymlink as InstallSymlink- ( symlinkBinaries )+ ( OverwritePolicy(..), symlinkBinaries ) import qualified Distribution.Client.Win32SelfUpgrade as Win32SelfUpgrade import qualified Distribution.Client.World as World import qualified Distribution.InstalledPackageInfo as Installed@@ -962,6 +962,7 @@ symlinkBinaries verbosity platform comp configFlags installFlags plan buildOutcomes = do failed <- InstallSymlink.symlinkBinaries platform comp+ InstallSymlink.NeverOverwrite configFlags installFlags plan buildOutcomes case failed of
Distribution/Client/InstallSymlink.hs view
@@ -12,6 +12,7 @@ -- Managing installing binaries with symlinks. ----------------------------------------------------------------------------- module Distribution.Client.InstallSymlink (+ OverwritePolicy(..), symlinkBinaries, symlinkBinary, ) where@@ -27,16 +28,22 @@ import Distribution.Simple.Compiler import Distribution.System +data OverwritePolicy = NeverOverwrite | AlwaysOverwrite+ deriving (Show, Eq)+ symlinkBinaries :: Platform -> Compiler+ -> OverwritePolicy -> ConfigFlags -> InstallFlags -> InstallPlan -> BuildOutcomes -> IO [(PackageIdentifier, UnqualComponentName, FilePath)]-symlinkBinaries _ _ _ _ _ _ = return []+symlinkBinaries _ _ _ _ _ _ _ = return [] -symlinkBinary :: FilePath -> FilePath -> UnqualComponentName -> String -> IO Bool-symlinkBinary _ _ _ _ = fail "Symlinking feature not available on Windows"+symlinkBinary :: OverwritePolicy+ -> FilePath -> FilePath -> UnqualComponentName -> String+ -> IO Bool+symlinkBinary _ _ _ _ _ = fail "Symlinking feature not available on Windows" #else @@ -87,6 +94,9 @@ import Data.Maybe ( catMaybes ) +data OverwritePolicy = NeverOverwrite | AlwaysOverwrite+ deriving (Show, Eq)+ -- | We would like by default to install binaries into some location that is on -- the user's PATH. For per-user installations on Unix systems that basically -- means the @~/bin/@ directory. On the majority of platforms the @~/bin/@@@ -108,12 +118,15 @@ -- with symlinks so is not available to Windows users. -- symlinkBinaries :: Platform -> Compiler+ -> OverwritePolicy -> ConfigFlags -> InstallFlags -> InstallPlan -> BuildOutcomes -> IO [(PackageIdentifier, UnqualComponentName, FilePath)]-symlinkBinaries platform comp configFlags installFlags plan buildOutcomes =+symlinkBinaries platform comp overwritePolicy+ configFlags installFlags+ plan buildOutcomes = case flagToMaybe (installSymlinkBinDir installFlags) of Nothing -> return [] Just symlinkBinDir@@ -125,6 +138,7 @@ fmap catMaybes $ sequence [ do privateBinDir <- pkgBinDir pkg ipid ok <- symlinkBinary+ overwritePolicy publicBinDir privateBinDir publicExeName privateExeName if ok@@ -187,7 +201,8 @@ (CompilerId compilerFlavor _) = compilerInfoId cinfo symlinkBinary ::- FilePath -- ^ The canonical path of the public bin dir eg+ OverwritePolicy -- ^ Whether to force overwrite an existing file+ -> FilePath -- ^ The canonical path of the public bin dir eg -- @/home/user/bin@ -> FilePath -- ^ The canonical path of the private bin dir eg -- @/home/user/.cabal/bin@@@ -199,13 +214,16 @@ -- there was another file there already that we did -- not own. Other errors like permission errors just -- propagate as exceptions.-symlinkBinary publicBindir privateBindir publicName privateName = do+symlinkBinary overwritePolicy publicBindir privateBindir publicName privateName = do ok <- targetOkToOverwrite (publicBindir </> publicName') (privateBindir </> privateName) case ok of- NotOurFile -> return False- NotExists -> mkLink >> return True- OkToOverwrite -> rmLink >> mkLink >> return True+ NotExists -> mkLink >> return True+ OkToOverwrite -> rmLink >> mkLink >> return True+ NotOurFile ->+ case overwritePolicy of+ NeverOverwrite -> return False+ AlwaysOverwrite -> rmLink >> mkLink >> return True where publicName' = display publicName relativeBindir = makeRelative publicBindir privateBindir
Distribution/Client/ProjectBuilding.hs view
@@ -910,7 +910,7 @@ -> FilePath -> FilePath -> IO BuildResult buildAndInstallUnpackedPackage verbosity- DistDirLayout{distTempDirectory}+ distDirLayout@DistDirLayout{distTempDirectory} storeDirLayout@StoreDirLayout { storePackageDBStack }@@ -963,12 +963,13 @@ annotateFailure mlogFile InstallFailed $ do let copyPkgFiles tmpDir = do- setup Cabal.copyCommand (copyFlags tmpDir)+ let tmpDirNormalised = normalise tmpDir+ setup Cabal.copyCommand (copyFlags tmpDirNormalised) -- Note that the copy command has put the files into -- @$tmpDir/$prefix@ so we need to return this dir so -- the store knows which dir will be the final store entry.- let prefix = dropDrive (InstallDirs.prefix (elabInstallDirs pkg))- entryDir = tmpDir </> prefix+ let prefix = normalise $ dropDrive (InstallDirs.prefix (elabInstallDirs pkg))+ entryDir = tmpDirNormalised </> prefix LBS.writeFile (entryDir </> "cabal-hash.txt") (renderPackageHashInputs (packageHashInputs pkgshared pkg))@@ -977,7 +978,9 @@ -- While this breaks the prefix-relocatable property of the lirbaries -- it is necessary on macOS to stay under the load command limit of the -- macOS mach-o linker. See also @PackageHash.hashedInstalledPackageIdVeryShort@.- otherFiles <- filter (not . isPrefixOf entryDir) <$> listFilesRecursive tmpDir+ -- We also normalise paths to ensure that there are no different representations+ -- for the same path. Like / and \\ on windows under msys.+ otherFiles <- filter (not . isPrefixOf entryDir) <$> listFilesRecursive tmpDirNormalised -- here's where we could keep track of the installed files ourselves -- if we wanted to by making a manifest of the files in the tmp dir return (entryDir, otherFiles)@@ -1086,7 +1089,8 @@ copyFlags destdir _ = setupHsCopyFlags pkg pkgshared verbosity builddir destdir - scriptOptions = setupHsScriptOptions rpkg plan pkgshared srcdir builddir+ scriptOptions = setupHsScriptOptions rpkg plan pkgshared+ distDirLayout srcdir builddir isParallelBuild cacheLock setup :: CommandUI flags -> (Version -> flags) -> IO ()@@ -1099,7 +1103,7 @@ verbosity scriptOptions { useLoggingHandle = mLogFileHandle- , useExtraEnvOverrides = dataDirsEnvironmentForPlan plan }+ , useExtraEnvOverrides = dataDirsEnvironmentForPlan distDirLayout plan } (Just (elabPkgDescription pkg)) cmd flags args @@ -1359,7 +1363,7 @@ setupHsHaddockArgs pkg scriptOptions = setupHsScriptOptions rpkg plan pkgshared- srcdir builddir+ distDirLayout srcdir builddir isParallelBuild cacheLock setupInteractive :: CommandUI flags
Distribution/Client/ProjectConfig/Legacy.hs view
@@ -325,7 +325,9 @@ configPreferences = projectConfigPreferences, configSolver = projectConfigSolver, configAllowOlder = projectConfigAllowOlder,- configAllowNewer = projectConfigAllowNewer+ configAllowNewer = projectConfigAllowNewer,+ configWriteGhcEnvironmentFilesPolicy+ = projectConfigWriteGhcEnvironmentFilesPolicy } = configExFlags InstallFlags {@@ -536,8 +538,9 @@ configPreferences = projectConfigPreferences, configSolver = projectConfigSolver, configAllowOlder = projectConfigAllowOlder,- configAllowNewer = projectConfigAllowNewer-+ configAllowNewer = projectConfigAllowNewer,+ configWriteGhcEnvironmentFilesPolicy+ = projectConfigWriteGhcEnvironmentFilesPolicy } installFlags = InstallFlags {@@ -893,7 +896,7 @@ (\v conf -> conf { configAllowNewer = fmap AllowNewer v }) ] . filterFields- [ "cabal-lib-version", "solver"+ [ "cabal-lib-version", "solver", "write-ghc-environment-files" -- not "constraint" or "preference", we use our own plural ones above ] . commandOptionsToFields
Distribution/Client/ProjectConfig/Types.hs view
@@ -21,7 +21,8 @@ ) where import Distribution.Client.Types- ( RemoteRepo, AllowNewer(..), AllowOlder(..) )+ ( RemoteRepo, AllowNewer(..), AllowOlder(..)+ , WriteGhcEnvironmentFilesPolicy ) import Distribution.Client.Dependency.Types ( PreSolver ) import Distribution.Client.Targets@@ -186,6 +187,8 @@ projectConfigSolver :: Flag PreSolver, projectConfigAllowOlder :: Maybe AllowOlder, projectConfigAllowNewer :: Maybe AllowNewer,+ projectConfigWriteGhcEnvironmentFilesPolicy+ :: Flag WriteGhcEnvironmentFilesPolicy, projectConfigMaxBackjumps :: Flag Int, projectConfigReorderGoals :: Flag ReorderGoals, projectConfigCountConflicts :: Flag CountConflicts,
Distribution/Client/ProjectOrchestration.hs view
@@ -98,6 +98,8 @@ import Prelude () import Distribution.Client.Compat.Prelude+import Distribution.Compat.Directory+ ( makeAbsolute ) import Distribution.Client.ProjectConfig import Distribution.Client.ProjectPlanning@@ -111,7 +113,8 @@ import Distribution.Client.Types ( GenericReadyPackage(..), UnresolvedSourcePackage , PackageSpecifier(..)- , SourcePackageDb(..) )+ , SourcePackageDb(..)+ , WriteGhcEnvironmentFilesPolicy(..) ) import Distribution.Solver.Types.PackageIndex ( lookupPackageName ) import qualified Distribution.Client.InstallPlan as InstallPlan@@ -122,6 +125,8 @@ import Distribution.Client.DistDirLayout import Distribution.Client.Config (getCabalDir) import Distribution.Client.Setup hiding (packageName)+import Distribution.Compiler+ ( CompilerFlavor(GHC) ) import Distribution.Types.ComponentName ( componentNameString ) import Distribution.Types.UnqualComponentName@@ -136,6 +141,8 @@ , diffFlagAssignment ) import Distribution.Simple.LocalBuildInfo ( ComponentName(..), pkgComponents )+import Distribution.Simple.Flag+ ( fromFlagOrDefault ) import qualified Distribution.Simple.Setup as Setup import Distribution.Simple.Command (commandShowOptions) import Distribution.Simple.Configure (computeEffectiveProfiling)@@ -143,9 +150,11 @@ import Distribution.Simple.Utils ( die', warn, notice, noticeNoWrap, debugNoWrap ) import Distribution.Verbosity+import Distribution.Version+ ( mkVersion ) import Distribution.Text import Distribution.Simple.Compiler- ( showCompilerId+ ( compilerCompatVersion, showCompilerId , OptimisationLevel(..)) import qualified Data.Monoid as Mon@@ -196,8 +205,8 @@ } = projectConfigShared projectConfig mlogsDir = Setup.flagToMaybe projectConfigLogsDir- mstoreDir = Setup.flagToMaybe projectConfigStoreDir- cabalDirLayout = mkCabalDirLayout cabalDir mstoreDir mlogsDir+ mstoreDir <- sequenceA $ makeAbsolute <$> Setup.flagToMaybe projectConfigStoreDir+ let cabalDirLayout = mkCabalDirLayout cabalDir mstoreDir mlogsDir buildSettings = resolveBuildTimeSettings verbosity cabalDirLayout@@ -388,11 +397,27 @@ pkgsBuildStatus buildOutcomes - void $ writePlanGhcEnvironment (distProjectRootDirectory- distDirLayout)- elaboratedPlanOriginal- elaboratedShared- postBuildStatus+ -- Write the .ghc.environment file (if allowed by the env file write policy).+ let writeGhcEnvFilesPolicy =+ projectConfigWriteGhcEnvironmentFilesPolicy . projectConfigShared+ $ projectConfig++ shouldWriteGhcEnvironment =+ case fromFlagOrDefault WriteGhcEnvironmentFilesOnlyForGhc844AndNewer+ writeGhcEnvFilesPolicy+ of+ AlwaysWriteGhcEnvironmentFiles -> True+ NeverWriteGhcEnvironmentFiles -> False+ WriteGhcEnvironmentFilesOnlyForGhc844AndNewer ->+ let compiler = pkgConfigCompiler elaboratedShared+ ghcCompatVersion = compilerCompatVersion GHC compiler+ in maybe False (>= mkVersion [8,4,4]) ghcCompatVersion++ when shouldWriteGhcEnvironment $+ void $ writePlanGhcEnvironment (distProjectRootDirectory distDirLayout)+ elaboratedPlanOriginal+ elaboratedShared+ postBuildStatus -- Finally if there were any build failures then report them and throw -- an exception to terminate the program
Distribution/Client/ProjectPlanOutput.hs view
@@ -19,7 +19,7 @@ import Distribution.Client.ProjectBuilding.Types import Distribution.Client.DistDirLayout import Distribution.Client.Types (Repo(..), RemoteRepo(..), PackageLocation(..), confInstId)-import Distribution.Client.PackageHash (showHashValue)+import Distribution.Client.PackageHash (showHashValue, hashValue) import qualified Distribution.Client.InstallPlan as InstallPlan import qualified Distribution.Client.Utils.Json as J@@ -141,6 +141,8 @@ , "style" J..= J.String (style2str (elabLocalToProject elab) (elabBuildStyle elab)) , "pkg-src" J..= packageLocationToJ (elabPkgSourceLocation elab) ] +++ [ "pkg-cabal-sha256" J..= J.String (showHashValue hash)+ | Just hash <- [ fmap hashValue (elabPkgDescriptionOverride elab) ] ] ++ [ "pkg-src-sha256" J..= J.String (showHashValue hash) | Just hash <- [elabPkgSourceHash elab] ] ++ (case elabBuildStyle elab of@@ -155,7 +157,8 @@ let components = J.object $ [ comp2str c J..= (J.object $ [ "depends" J..= map (jdisplay . confInstId) ldeps- , "exe-depends" J..= map (jdisplay . confInstId) edeps ] +++ , "exe-depends" J..= map (jdisplay . confInstId) edeps+ ] ++ bin_file c) | (c,(ldeps,edeps)) <- ComponentDeps.toList $
Distribution/Client/ProjectPlanning.hs view
@@ -1429,7 +1429,8 @@ compExeDependencyPaths = [ (annotatedIdToConfiguredId aid', path) | aid' <- cc_exe_deps cc0- , Just path <- [Map.lookup (ann_id aid') exe_map1]]+ , Just paths <- [Map.lookup (ann_id aid') exe_map1]+ , path <- paths ] elab_comp = ElaboratedComponent {..} -- 3. Construct a preliminary ElaboratedConfiguredPackage,@@ -1514,10 +1515,10 @@ external_exe_dep_sids ++ external_lib_dep_sids external_exe_map = Map.fromList $- [ (getComponentId pkg, path)+ [ (getComponentId pkg, paths) | pkg <- external_exe_dep_pkgs- , Just path <- [planPackageExePath pkg] ]- exe_map1 = Map.union external_exe_map exe_map+ , let paths = planPackageExePaths pkg ]+ exe_map1 = Map.union external_exe_map $ fmap (\x -> [x]) exe_map external_lib_cc_map = Map.fromListWith Map.union $ map mkCCMapping external_lib_dep_pkgs@@ -1577,24 +1578,35 @@ -> SolverId -> [ElaboratedPlanPackage] elaborateLibSolverId mapDep = filter (matchPlanPkg (== CLibName)) . mapDep - -- | Given an 'ElaboratedPlanPackage', return the path to where the- -- executable that this package represents would be installed.- planPackageExePath :: ElaboratedPlanPackage -> Maybe FilePath- planPackageExePath =+ -- | Given an 'ElaboratedPlanPackage', return the paths to where the+ -- executables that this package represents would be installed.+ -- The only case where multiple paths can be returned is the inplace+ -- monolithic package one, since there can be multiple exes and each one+ -- has its own directory.+ planPackageExePaths :: ElaboratedPlanPackage -> [FilePath]+ planPackageExePaths = -- Pre-existing executables are assumed to be in PATH -- already. In fact, this should be impossible.- InstallPlan.foldPlanPackage (const Nothing) $ \elab -> Just $- binDirectoryFor- distDirLayout- elaboratedSharedConfig- elab $- case elabPkgOrComp elab of- ElabPackage _ -> ""- ElabComponent comp ->- case fmap Cabal.componentNameString- (compComponentName comp) of- Just (Just n) -> display n- _ -> ""+ InstallPlan.foldPlanPackage (const []) $ \elab ->+ let+ executables :: [FilePath]+ executables =+ case elabPkgOrComp elab of+ -- Monolithic mode: all exes of the package+ ElabPackage _ -> unUnqualComponentName . PD.exeName+ <$> PD.executables (elabPkgDescription elab)+ -- Per-component mode: just the selected exe+ ElabComponent comp ->+ case fmap Cabal.componentNameString+ (compComponentName comp) of+ Just (Just n) -> [display n]+ _ -> [""]+ in+ binDirectoryFor+ distDirLayout+ elaboratedSharedConfig+ elab+ <$> executables elaborateSolverToPackage :: SolverPackage UnresolvedPkgLoc -> ComponentsGraph@@ -1763,6 +1775,7 @@ -- but this function doesn't know what is installed (since -- we haven't improved the plan yet), so we do it in another pass. -- Check the comments of those functions for more details.+ elabConfigureTargets = [] elabBuildTargets = [] elabTestTargets = [] elabBenchTargets = []@@ -1921,10 +1934,10 @@ where shouldBeLocal :: PackageSpecifier (SourcePackage (PackageLocation loc)) -> Maybe PackageId shouldBeLocal NamedPackage{} = Nothing- shouldBeLocal (SpecificSourcePackage pkg) + shouldBeLocal (SpecificSourcePackage pkg) | LocalTarballPackage _ <- packageSource pkg = Nothing | otherwise = Just (packageId pkg)- -- TODO: Is it only LocalTarballPackages we can know about without + -- TODO: Is it only LocalTarballPackages we can know about without -- them being "local" in the sense meant here? -- -- Also, review use of SourcePackage's loc vs ProjectPackageLocation@@ -2403,7 +2416,7 @@ componentAvailableTargetStatus :: Component -> AvailableTargetStatus (UnitId, ComponentName) componentAvailableTargetStatus component =- case componentOptionalStanza (componentName component) of+ case componentOptionalStanza $ CD.componentNameToComponent cname of -- it is not an optional stanza, so a library, exe or foreign lib Nothing | not buildable -> TargetNotBuildable@@ -2505,7 +2518,8 @@ -- | How 'pruneInstallPlanToTargets' should interpret the per-package -- 'ComponentTarget's: as build, repl or haddock targets. ---data TargetAction = TargetActionBuild+data TargetAction = TargetActionConfigure+ | TargetActionBuild | TargetActionRepl | TargetActionTest | TargetActionBench@@ -2578,6 +2592,7 @@ case (Map.lookup (installedUnitId elab) perPkgTargetsMap, targetAction) of (Nothing, _) -> elab+ (Just tgts, TargetActionConfigure) -> elab { elabConfigureTargets = tgts } (Just tgts, TargetActionBuild) -> elab { elabBuildTargets = tgts } (Just tgts, TargetActionTest) -> elab { elabTestTargets = tgts } (Just tgts, TargetActionBench) -> elab { elabBenchTargets = tgts }@@ -2622,11 +2637,13 @@ $ addOptionalStanzas elab find_root (InstallPlan.Configured (PrunedPackage elab _)) =- if not (null (elabBuildTargets elab)- && null (elabTestTargets elab)- && null (elabBenchTargets elab)- && isNothing (elabReplTarget elab)- && null (elabHaddockTargets elab))+ if not $ and [ null (elabConfigureTargets elab)+ , null (elabBuildTargets elab)+ , null (elabTestTargets elab)+ , null (elabBenchTargets elab)+ , isNothing (elabReplTarget elab)+ , null (elabHaddockTargets elab)+ ] then Just (installedUnitId elab) else Nothing find_root _ = Nothing@@ -2719,7 +2736,9 @@ ++ elabBenchTargets pkg ++ maybeToList (elabReplTarget pkg) ++ elabHaddockTargets pkg- , stanza <- maybeToList (componentOptionalStanza cname)+ , stanza <- maybeToList $+ componentOptionalStanza $+ CD.componentNameToComponent cname ] availablePkgs =@@ -2849,11 +2868,6 @@ mapConfiguredPackage _ (InstallPlan.PreExisting pkg) = InstallPlan.PreExisting pkg -componentOptionalStanza :: Cabal.ComponentName -> Maybe OptionalStanza-componentOptionalStanza (Cabal.CTestName _) = Just TestStanzas-componentOptionalStanza (Cabal.CBenchName _) = Just BenchStanzas-componentOptionalStanza _ = Nothing- ------------------------------------ -- Support for --only-dependencies --@@ -3102,6 +3116,7 @@ setupHsScriptOptions :: ElaboratedReadyPackage -> ElaboratedInstallPlan -> ElaboratedSharedConfig+ -> DistDirLayout -> FilePath -> FilePath -> Bool@@ -3110,7 +3125,7 @@ -- TODO: Fix this so custom is a separate component. Custom can ALWAYS -- be a separate component!!! setupHsScriptOptions (ReadyPackage elab@ElaboratedConfiguredPackage{..})- plan ElaboratedSharedConfig{..} srcdir builddir+ plan ElaboratedSharedConfig{..} distdir srcdir builddir isParallelBuild cacheLock = SetupScriptOptions { useCabalVersion = thisVersion elabSetupScriptCliVersion,@@ -3129,7 +3144,7 @@ useLoggingHandle = Nothing, -- this gets set later useWorkingDir = Just srcdir, useExtraPathEnv = elabExeDependencyPaths elab,- useExtraEnvOverrides = dataDirsEnvironmentForPlan plan,+ useExtraEnvOverrides = dataDirsEnvironmentForPlan distdir plan, useWin32CleanHack = False, --TODO: [required eventually] forceExternalSetupMethod = isParallelBuild, setupCacheLock = Just cacheLock,
Distribution/Client/ProjectPlanning/Types.hs view
@@ -54,6 +54,8 @@ isTestComponentTarget, isBenchComponentTarget, + componentOptionalStanza,+ -- * Setup script SetupScriptStyle(..), ) where@@ -298,6 +300,7 @@ elabSetupScriptCliVersion :: Version, -- Build time related:+ elabConfigureTargets :: [ComponentTarget], elabBuildTargets :: [ComponentTarget], elabTestTargets :: [ComponentTarget], elabBenchTargets :: [ComponentTarget],@@ -355,7 +358,24 @@ -- register in all cases, but some Custom Setups will fall -- over if you try to do that, ESPECIALLY if there actually is -- a library but they hadn't built it.- build_target || any (depends_on_lib pkg) (elabBuildTargets elab)+ --+ -- However, as the case of `cpphs-1.20.8` has shown in+ -- #5379, in cases when a monolithic package gets+ -- installed due to its executable components+ -- (i.e. exe:cpphs) into the store we *have* to register+ -- if there's a buildable public library (i.e. lib:cpphs)+ -- that was built and installed into the same store folder+ -- as otherwise this will cause build failures once a+ -- target actually depends on lib:cpphs.+ build_target || (elabBuildStyle elab == BuildAndInstall &&+ Cabal.hasPublicLib (elabPkgDescription elab))+ -- the next sub-condition below is currently redundant+ -- (see discussion in #5604 for more details), but it's+ -- being kept intentionally here as a safeguard because if+ -- internal libraries ever start working with+ -- non-per-component builds this condition won't be+ -- redundant anymore.+ || any (depends_on_lib pkg) (elabBuildTargets elab) where depends_on_lib pkg (ComponentTarget cn _) = not (null (CD.select (== CD.componentNameToComponent cn)@@ -378,12 +398,13 @@ -- | Construct the environment needed for the data files to work. -- This consists of a separate @*_datadir@ variable for each -- inplace package in the plan.-dataDirsEnvironmentForPlan :: ElaboratedInstallPlan+dataDirsEnvironmentForPlan :: DistDirLayout+ -> ElaboratedInstallPlan -> [(String, Maybe FilePath)]-dataDirsEnvironmentForPlan = catMaybes+dataDirsEnvironmentForPlan distDirLayout = catMaybes . fmap (InstallPlan.foldPlanPackage (const Nothing)- dataDirEnvVarForPackage)+ (dataDirEnvVarForPackage distDirLayout)) . InstallPlan.toList -- | Construct an environment variable that points@@ -393,19 +414,27 @@ -- for inplace packages. -- * 'Nothing' for packages installed in the store (the path was -- already included in the package at install/build time).--- * The other cases are not handled yet. See below.-dataDirEnvVarForPackage :: ElaboratedConfiguredPackage+dataDirEnvVarForPackage :: DistDirLayout+ -> ElaboratedConfiguredPackage -> Maybe (String, Maybe FilePath)-dataDirEnvVarForPackage pkg =- case (elabBuildStyle pkg, elabPkgSourceLocation pkg)- of (BuildAndInstall, _) -> Nothing- (BuildInplaceOnly, LocalUnpackedPackage path) -> Just- (pkgPathEnvVar (elabPkgDescription pkg) "datadir",- Just $ path </> dataDir (elabPkgDescription pkg))- -- TODO: handle the other cases for PackageLocation.- -- We will only need this when we add support for- -- remote/local tarballs.- (BuildInplaceOnly, _) -> Nothing+dataDirEnvVarForPackage distDirLayout pkg =+ case elabBuildStyle pkg+ of BuildAndInstall -> Nothing+ BuildInplaceOnly -> Just+ ( pkgPathEnvVar (elabPkgDescription pkg) "datadir"+ , Just $ srcPath (elabPkgSourceLocation pkg)+ </> dataDir (elabPkgDescription pkg))+ where+ srcPath (LocalUnpackedPackage path) = path+ srcPath (LocalTarballPackage _path) = unpackedPath+ srcPath (RemoteTarballPackage _uri _localTar) = unpackedPath+ srcPath (RepoTarballPackage _repo _packageId _localTar) = unpackedPath+ srcPath (RemoteSourceRepoPackage _sourceRepo (Just localCheckout)) = localCheckout+ -- TODO: see https://github.com/haskell/cabal/wiki/Potential-Refactors#unresolvedpkgloc+ srcPath (RemoteSourceRepoPackage _sourceRepo Nothing) = error+ "calling dataDirEnvVarForPackage on a not-downloaded repo is an error"+ unpackedPath =+ distUnpackedSrcDirectory distDirLayout $ elabPkgSourceId pkg instance Package ElaboratedConfiguredPackage where packageId = elabPkgSourceId@@ -753,6 +782,11 @@ isSubLibComponentTarget (ComponentTarget (CSubLibName _) _) = True isSubLibComponentTarget _ = False +componentOptionalStanza :: CD.Component -> Maybe OptionalStanza+componentOptionalStanza (CD.ComponentTest _) = Just TestStanzas+componentOptionalStanza (CD.ComponentBench _) = Just BenchStanzas+componentOptionalStanza _ = Nothing+ --------------------------- -- Setup.hs script policy --@@ -781,4 +815,3 @@ deriving (Eq, Show, Generic, Typeable) instance Binary SetupScriptStyle-
Distribution/Client/Setup.hs view
@@ -1,7 +1,8 @@ {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- | -- Module : Distribution.Client.Setup@@ -57,6 +58,7 @@ , parsePackageArgs , liftOptions+ , yesNoOpt --TODO: stop exporting these: , showRepo , parseRepo@@ -69,6 +71,7 @@ import Distribution.Client.Types ( Username(..), Password(..), RemoteRepo(..) , AllowNewer(..), AllowOlder(..), RelaxDeps(..)+ , WriteGhcEnvironmentFilesPolicy(..) ) import Distribution.Client.BuildReports.Types ( ReportLevel(..) )@@ -610,12 +613,14 @@ -- | cabal configure takes some extra flags beyond runghc Setup configure -- data ConfigExFlags = ConfigExFlags {- configCabalVersion :: Flag Version,- configExConstraints:: [(UserConstraint, ConstraintSource)],- configPreferences :: [Dependency],- configSolver :: Flag PreSolver,- configAllowNewer :: Maybe AllowNewer,- configAllowOlder :: Maybe AllowOlder+ configCabalVersion :: Flag Version,+ configExConstraints :: [(UserConstraint, ConstraintSource)],+ configPreferences :: [Dependency],+ configSolver :: Flag PreSolver,+ configAllowNewer :: Maybe AllowNewer,+ configAllowOlder :: Maybe AllowOlder,+ configWriteGhcEnvironmentFilesPolicy+ :: Flag WriteGhcEnvironmentFilesPolicy } deriving (Eq, Generic) @@ -680,9 +685,34 @@ (readP_to_E ("Cannot parse the list of packages: " ++) relaxDepsParser) (Just RelaxDepsAll) relaxDepsPrinter) + , option [] ["write-ghc-environment-files"]+ ("Whether to create a .ghc.environment file after a successful build"+ ++ " (v2-build only)")+ configWriteGhcEnvironmentFilesPolicy+ (\v flags -> flags { configWriteGhcEnvironmentFilesPolicy = v})+ (reqArg "always|never|ghc8.4.4+"+ writeGhcEnvironmentFilesPolicyParser+ writeGhcEnvironmentFilesPolicyPrinter) ] +writeGhcEnvironmentFilesPolicyParser :: ReadE (Flag WriteGhcEnvironmentFilesPolicy)+writeGhcEnvironmentFilesPolicyParser = ReadE $ \case+ "always" -> Right $ Flag AlwaysWriteGhcEnvironmentFiles+ "never" -> Right $ Flag NeverWriteGhcEnvironmentFiles+ "ghc8.4.4+" -> Right $ Flag WriteGhcEnvironmentFilesOnlyForGhc844AndNewer+ policy -> Left $ "Cannot parse the GHC environment file write policy '"+ <> policy <> "'"++writeGhcEnvironmentFilesPolicyPrinter+ :: Flag WriteGhcEnvironmentFilesPolicy -> [String]+writeGhcEnvironmentFilesPolicyPrinter = \case+ (Flag AlwaysWriteGhcEnvironmentFiles) -> ["always"]+ (Flag NeverWriteGhcEnvironmentFiles) -> ["never"]+ (Flag WriteGhcEnvironmentFilesOnlyForGhc844AndNewer) -> ["ghc8.4.4+"]+ NoFlag -> []++ relaxDepsParser :: Parse.ReadP r (Maybe RelaxDeps) relaxDepsParser = (Just . RelaxDepsSome) `fmap` Parse.sepBy1 parse (Parse.char ',')@@ -2172,9 +2202,9 @@ (flagToList . fmap display)) , option [] ["cabal-version"]- "Required version of the Cabal library."+ "Version of the Cabal specification." IT.cabalVersion (\v flags -> flags { IT.cabalVersion = v })- (reqArg "VERSION_RANGE" (readP_to_E ("Cannot parse Cabal version range: "++)+ (reqArg "VERSION_RANGE" (readP_to_E ("Cannot parse Cabal specification version: "++) (toFlag `fmap` parse)) (flagToList . fmap display)) @@ -2282,6 +2312,14 @@ IT.buildTools (\v flags -> flags { IT.buildTools = v }) (reqArg' "TOOL" (Just . (:[])) (fromMaybe []))++ -- NB: this is a bit of a transitional hack and will likely be+ -- removed again if `cabal init` is migrated to the v2-* command+ -- framework+ , option "w" ["with-compiler"]+ "give the path to a particular compiler"+ IT.initHcPath (\v flags -> flags { IT.initHcPath = v })+ (reqArgFlag "PATH") , optionVerbosity IT.initVerbosity (\v flags -> flags { IT.initVerbosity = v }) ]
Distribution/Client/Types.hs view
@@ -589,3 +589,19 @@ instance Monoid AllowOlder where mempty = AllowOlder mempty mappend = (<>)++-- ------------------------------------------------------------+-- * --write-ghc-environment-file+-- ------------------------------------------------------------++-- | Whether 'v2-build' should write a .ghc.environment file after+-- success. Possible values: 'always', 'never', 'ghc8.4.4+' (the+-- default; GHC 8.4.4 is the earliest version that supports+-- '-package-env -').+data WriteGhcEnvironmentFilesPolicy+ = AlwaysWriteGhcEnvironmentFiles+ | NeverWriteGhcEnvironmentFiles+ | WriteGhcEnvironmentFilesOnlyForGhc844AndNewer+ deriving (Eq, Enum, Bounded, Generic, Show)++instance Binary WriteGhcEnvironmentFilesPolicy
bootstrap.sh view
@@ -221,8 +221,8 @@ # >= 2.6.0.2 && < 2.7 NETWORK_VER="2.7.0.0"; NETWORK_VER_REGEXP="2\.[0-7]\." # >= 2.0 && < 2.7-CABAL_VER="2.4.0.1"; CABAL_VER_REGEXP="2\.4\.[0-9]"- # >= 2.4 && < 2.5+CABAL_VER="2.4.1.0"; CABAL_VER_REGEXP="2\.4\.[1-9]"+ # >= 2.4.1.0 && < 2.5 TRANS_VER="0.5.5.0"; TRANS_VER_REGEXP="0\.[45]\." # >= 0.2.* && < 0.6 MTL_VER="2.2.2"; MTL_VER_REGEXP="[2]\."
cabal-install.cabal view
@@ -4,7 +4,7 @@ -- To update this file, edit 'cabal-install.cabal.pp' and run -- 'make cabal-install-prod' in the project's root folder. Name: cabal-install-Version: 2.4.0.0+Version: 2.4.1.0 Synopsis: The command-line interface for Cabal and Hackage. Description: The \'cabal\' command-line program simplifies the process of managing@@ -297,31 +297,31 @@ Paths_cabal_install build-depends:- async >= 2.0 && < 3,+ async >= 2.0 && < 2.3, array >= 0.4 && < 0.6,- base >= 4.6 && < 5,+ base >= 4.8 && < 4.13, base16-bytestring >= 0.1.1 && < 0.2,- binary >= 0.7 && < 0.9,- bytestring >= 0.10.2 && < 1,- Cabal == 2.4.*,- containers >= 0.5 && < 0.7,+ binary >= 0.7.3 && < 0.9,+ bytestring >= 0.10.6.0 && < 0.11,+ Cabal >= 2.4.1.0 && < 2.5,+ containers >= 0.5.6.2 && < 0.7, cryptohash-sha256 >= 0.11 && < 0.12,- deepseq >= 1.3 && < 1.5,+ deepseq >= 1.4.1.1 && < 1.5, directory >= 1.2.2.0 && < 1.4, echo >= 0.1.3 && < 0.2, edit-distance >= 0.2.2 && < 0.3,- filepath >= 1.3 && < 1.5,- hashable >= 1.0 && < 2,+ filepath >= 1.4.0.0 && < 1.5,+ hashable >= 1.0 && < 1.3, HTTP >= 4000.1.5 && < 4000.4,- mtl >= 2.0 && < 3,+ mtl >= 2.0 && < 2.3, network-uri >= 2.6.0.2 && < 2.7,- network >= 2.6 && < 2.8,+ network >= 2.6 && < 2.9, pretty >= 1.1 && < 1.2,- process >= 1.1.0.2 && < 1.7,+ process >= 1.2.3.0 && < 1.7, random >= 1 && < 1.2,- stm >= 2.0 && < 3,+ stm >= 2.0 && < 2.6, tar >= 0.5.0.3 && < 0.6,- time >= 1.4 && < 1.10,+ time >= 1.5.0.1 && < 1.10, zlib >= 0.5.3 && < 0.7, hackage-security >= 0.5.2.2 && < 0.6, text >= 1.2.3 && < 1.3,@@ -337,7 +337,7 @@ if os(windows) build-depends: Win32 >= 2 && < 3 else- build-depends: unix >= 2.5 && < 2.9+ build-depends: unix >= 2.5 && < 2.8 if flag(debug-expensive-assertions) cpp-options: -DDEBUG_EXPENSIVE_ASSERTIONS
changelog view
@@ -1,7 +1,35 @@ -*-change-log-*- +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'"+ * 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).@@ -50,6 +78,9 @@ * Default changelog generated by 'cabal init' is now named 'CHANGELOG.md' (#5441). * Align output of 'new-build' command phases (#4040).+ * Add suport 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@@ -117,8 +148,8 @@ * 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).+ * `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).
main/Main.hs view
@@ -38,7 +38,7 @@ , UploadFlags(..), uploadCommand , ReportFlags(..), reportCommand , runCommand- , InitFlags(initVerbosity), initCommand+ , InitFlags(initVerbosity, initHcPath), initCommand , SDistFlags(..), SDistExFlags(..), sdistCommand , Win32SelfUpgradeFlags(..), win32SelfUpgradeCommand , ActAsSetupFlags(..), actAsSetupCommand@@ -1143,7 +1143,9 @@ die' verbosity $ "'init' doesn't take any extra arguments: " ++ unwords extraArgs (_useSandbox, config) <- loadConfigOrSandboxConfig verbosity (globalFlags { globalRequireSandbox = Flag False })- let configFlags = savedConfigureFlags config+ let configFlags = savedConfigureFlags config `mappend`+ -- override with `--with-compiler` from CLI if available+ mempty { configHcPath = initHcPath initFlags } let globalFlags' = savedGlobalFlags config `mappend` globalFlags (comp, _, progdb) <- configCompilerAux' configFlags withRepoContext verbosity globalFlags' $ \repoContext ->