diff --git a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs index 3bdf0465244..610e8a07207 100644 --- a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs +++ b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs @@ -34,4 +34,4 @@ md5CheckGenericPackageDescription proxy = md5Check proxy md5CheckLocalBuildInfo :: Proxy LocalBuildInfo -> Assertion md5CheckLocalBuildInfo proxy = md5Check proxy - 0x94827844fdb1afedee525061749fb16f + 0xff829d7b383bcccb8192c5a61176c2e0 diff --git a/Cabal/src/Distribution/Simple/Haddock.hs b/Cabal/src/Distribution/Simple/Haddock.hs index ba025a85549..3b69f6e0630 100644 --- a/Cabal/src/Distribution/Simple/Haddock.hs +++ b/Cabal/src/Distribution/Simple/Haddock.hs @@ -67,12 +67,9 @@ import Distribution.Simple.Program.GHC import qualified Distribution.Simple.Program.HcPkg as HcPkg import Distribution.Simple.Program.ResponseFile import Distribution.Simple.Register -import Distribution.Simple.Setup.Common -import Distribution.Simple.Setup.Haddock -import Distribution.Simple.Setup.Hscolour +import Distribution.Simple.Setup import Distribution.Simple.SetupHooks.Internal ( BuildHooks (..) - , BuildingWhat (..) , noBuildHooks ) import qualified Distribution.Simple.SetupHooks.Internal as SetupHooks @@ -265,6 +262,7 @@ haddock_setupHooks mbWorkDir = flagToMaybe $ haddockWorkingDir flags comp = compiler lbi platform = hostPlatform lbi + config = configFlags lbi quickJmpFlag = haddockQuickJump flags' flags = case haddockTarget of @@ -282,9 +280,7 @@ haddock_setupHooks flag f = fromFlag $ f flags tmpFileOpts = - defaultTempFileOptions - { optKeepTempFiles = flag haddockKeepTempFiles - } + commonSetupTempFileOptions $ configCommonFlags config htmlTemplate = fmap toPathTemplate . flagToMaybe . haddockHtmlLocation $ flags diff --git a/Cabal/src/Distribution/Simple/Setup.hs b/Cabal/src/Distribution/Simple/Setup.hs index dfde4466b30..691a0ba5901 100644 --- a/Cabal/src/Distribution/Simple/Setup.hs +++ b/Cabal/src/Distribution/Simple/Setup.hs @@ -41,6 +41,7 @@ module Distribution.Simple.Setup , globalCommand , CommonSetupFlags (..) , defaultCommonSetupFlags + , commonSetupTempFileOptions , ConfigFlags (..) , emptyConfigFlags , defaultConfigFlags diff --git a/Cabal/src/Distribution/Simple/Setup/Common.hs b/Cabal/src/Distribution/Simple/Setup/Common.hs index 0a1422b327f..92e3b59c933 100644 --- a/Cabal/src/Distribution/Simple/Setup/Common.hs +++ b/Cabal/src/Distribution/Simple/Setup/Common.hs @@ -23,6 +23,7 @@ module Distribution.Simple.Setup.Common ( CommonSetupFlags (..) , defaultCommonSetupFlags , withCommonSetupOptions + , commonSetupTempFileOptions , CopyDest (..) , configureCCompiler , configureLinker @@ -85,6 +86,13 @@ data CommonSetupFlags = CommonSetupFlags -- -- TODO: this one should not be here, it's just that the silly -- UserHooks stop us from passing extra info in other ways + , setupKeepTempFiles :: Flag Bool + -- ^ When this flag is set, temporary files will be kept after building. + -- + -- Note: Keeping temporary files is important functionality for HLS, which + -- runs @cabal repl@ with a fake GHC to get CLI arguments. It will need the + -- temporary files (including multi unit repl response files) to stay, even + -- after the @cabal repl@ command exits. } deriving (Eq, Show, Read, Generic) @@ -106,6 +114,15 @@ defaultCommonSetupFlags = , setupDistPref = NoFlag , setupCabalFilePath = NoFlag , setupTargets = [] + , setupKeepTempFiles = NoFlag + } + +-- | Get `TempFileOptions` that respect the `setupKeepTempFiles` flag. +commonSetupTempFileOptions :: CommonSetupFlags -> TempFileOptions +commonSetupTempFileOptions options = + TempFileOptions + { optKeepTempFiles = + fromFlagOrDefault False (setupKeepTempFiles options) } commonSetupOptions :: ShowOrParseArgs -> [OptionField CommonSetupFlags] @@ -124,8 +141,17 @@ commonSetupOptions showOrParseArgs = setupCabalFilePath (\v flags -> flags{setupCabalFilePath = v}) (reqSymbolicPathArgFlag "PATH") - -- NB: no --working-dir flag, as that value is populated using the - -- global flag (see Distribution.Simple.Setup.Global.globalCommand). + , option + "" + ["keep-temp-files"] + ( "Keep temporary files." + ) + setupKeepTempFiles + (\keepTempFiles flags -> flags{setupKeepTempFiles = keepTempFiles}) + trueArg + + -- NB: no --working-dir flag, as that value is populated using the + -- global flag (see Distribution.Simple.Setup.Global.globalCommand). ] withCommonSetupOptions diff --git a/Cabal/src/Distribution/Simple/Setup/Haddock.hs b/Cabal/src/Distribution/Simple/Setup/Haddock.hs index aee2210d907..6f0459b7311 100644 --- a/Cabal/src/Distribution/Simple/Setup/Haddock.hs +++ b/Cabal/src/Distribution/Simple/Setup/Haddock.hs @@ -111,7 +111,6 @@ data HaddockFlags = HaddockFlags , haddockHscolourCss :: Flag FilePath , haddockContents :: Flag PathTemplate , haddockIndex :: Flag PathTemplate - , haddockKeepTempFiles :: Flag Bool , haddockBaseUrl :: Flag String , haddockResourcesDir :: Flag String , haddockOutputDir :: Flag FilePath @@ -166,7 +165,6 @@ defaultHaddockFlags = , haddockQuickJump = Flag False , haddockHscolourCss = NoFlag , haddockContents = NoFlag - , haddockKeepTempFiles = Flag False , haddockIndex = NoFlag , haddockBaseUrl = NoFlag , haddockResourcesDir = NoFlag @@ -219,13 +217,6 @@ haddockOptions showOrParseArgs = (\c f -> f{haddockCommonFlags = c}) showOrParseArgs [ option - "" - ["keep-temp-files"] - "Keep temporary files" - haddockKeepTempFiles - (\b flags -> flags{haddockKeepTempFiles = b}) - trueArg - , option "" ["hoogle"] "Generate a hoogle database" @@ -413,7 +404,8 @@ data Visibility = Visible | Hidden deriving (Eq, Show) data HaddockProjectFlags = HaddockProjectFlags - { haddockProjectHackage :: Flag Bool + { haddockProjectCommonFlags :: !CommonSetupFlags + , haddockProjectHackage :: Flag Bool -- ^ a shortcut option which builds documentation linked to hackage. It implies: -- * `--html-location='https://hackage.haskell.org/package/$prg-$version/docs' -- * `--quickjump` @@ -446,9 +438,7 @@ data HaddockProjectFlags = HaddockProjectFlags , -- haddockContent is not supported, a fixed value is provided -- haddockIndex is not supported, a fixed value is provided -- haddockDistPerf is not supported, note: it changes location of the haddocks - haddockProjectKeepTempFiles :: Flag Bool - , haddockProjectVerbosity :: Flag Verbosity - , -- haddockBaseUrl is not supported, a fixed value is provided + -- haddockBaseUrl is not supported, a fixed value is provided haddockProjectResourcesDir :: Flag String , haddockProjectUseUnicode :: Flag Bool } @@ -457,7 +447,8 @@ data HaddockProjectFlags = HaddockProjectFlags defaultHaddockProjectFlags :: HaddockProjectFlags defaultHaddockProjectFlags = HaddockProjectFlags - { haddockProjectHackage = Flag False + { haddockProjectCommonFlags = defaultCommonSetupFlags + , haddockProjectHackage = Flag False , haddockProjectDir = Flag "./haddocks" , haddockProjectPrologue = NoFlag , haddockProjectTestSuites = Flag False @@ -471,8 +462,6 @@ defaultHaddockProjectFlags = , haddockProjectInternal = Flag False , haddockProjectCss = NoFlag , haddockProjectHscolourCss = NoFlag - , haddockProjectKeepTempFiles = Flag False - , haddockProjectVerbosity = Flag normal , haddockProjectResourcesDir = NoFlag , haddockProjectInterfaces = NoFlag , haddockProjectUseUnicode = NoFlag @@ -517,140 +506,134 @@ haddockProjectCommand = emptyProgramDb haddockProjectOptions :: ShowOrParseArgs -> [OptionField HaddockProjectFlags] -haddockProjectOptions _showOrParseArgs = - [ option - "" - ["hackage"] - ( concat - [ "A short-cut option to build documentation linked to hackage." - ] - ) - haddockProjectHackage - (\v flags -> flags{haddockProjectHackage = v}) - trueArg - , option - "" - ["output"] - "Output directory" - haddockProjectDir - (\v flags -> flags{haddockProjectDir = v}) - (optArg' "DIRECTORY" maybeToFlag (fmap Just . flagToList)) - , option - "" - ["prologue"] - "File path to a prologue file in haddock format" - haddockProjectPrologue - (\v flags -> flags{haddockProjectPrologue = v}) - (optArg' "PATH" maybeToFlag (fmap Just . flagToList)) - , option - "" - ["hoogle"] - "Generate a hoogle database" - haddockProjectHoogle - (\v flags -> flags{haddockProjectHoogle = v}) - trueArg - , option - "" - ["html-location"] - "Location of HTML documentation for pre-requisite packages" - haddockProjectHtmlLocation - (\v flags -> flags{haddockProjectHtmlLocation = v}) - (reqArgFlag "URL") - , option - "" - ["executables"] - "Run haddock for Executables targets" - haddockProjectExecutables - (\v flags -> flags{haddockProjectExecutables = v}) - trueArg - , option - "" - ["tests"] - "Run haddock for Test Suite targets" - haddockProjectTestSuites - (\v flags -> flags{haddockProjectTestSuites = v}) - trueArg - , option - "" - ["benchmarks"] - "Run haddock for Benchmark targets" - haddockProjectBenchmarks - (\v flags -> flags{haddockProjectBenchmarks = v}) - trueArg - , option - "" - ["foreign-libraries"] - "Run haddock for Foreign Library targets" - haddockProjectForeignLibs - (\v flags -> flags{haddockProjectForeignLibs = v}) - trueArg - , option - "" - ["all", "haddock-all"] - "Run haddock for all targets" - ( \f -> - allFlags - [ haddockProjectExecutables f - , haddockProjectTestSuites f - , haddockProjectBenchmarks f - , haddockProjectForeignLibs f +haddockProjectOptions showOrParseArgs = + withCommonSetupOptions + haddockProjectCommonFlags + (\c f -> f{haddockProjectCommonFlags = c}) + showOrParseArgs + [ option + "" + ["hackage"] + ( concat + [ "A short-cut option to build documentation linked to hackage." ] - ) - ( \v flags -> - flags - { haddockProjectExecutables = v - , haddockProjectTestSuites = v - , haddockProjectBenchmarks = v - , haddockProjectForeignLibs = v - } - ) - trueArg - , option - "" - ["internal"] - "Run haddock for internal modules and include all symbols" - haddockProjectInternal - (\v flags -> flags{haddockProjectInternal = v}) - trueArg - , option - "" - ["css"] - "Use PATH as the haddock stylesheet" - haddockProjectCss - (\v flags -> flags{haddockProjectCss = v}) - (reqArgFlag "PATH") - , option - "" - ["hscolour-css"] - "Use PATH as the HsColour stylesheet" - haddockProjectHscolourCss - (\v flags -> flags{haddockProjectHscolourCss = v}) - (reqArgFlag "PATH") - , option - "" - ["keep-temp-files"] - "Keep temporary files" - haddockProjectKeepTempFiles - (\b flags -> flags{haddockProjectKeepTempFiles = b}) - trueArg - , optionVerbosity - haddockProjectVerbosity - (\v flags -> flags{haddockProjectVerbosity = v}) - , option - "" - ["resources-dir"] - "location of Haddocks static / auxiliary files" - haddockProjectResourcesDir - (\v flags -> flags{haddockProjectResourcesDir = v}) - (reqArgFlag "DIR") - , option - "" - ["use-unicode"] - "Pass --use-unicode option to haddock" - haddockProjectUseUnicode - (\v flags -> flags{haddockProjectUseUnicode = v}) - trueArg - ] + ) + haddockProjectHackage + (\v flags -> flags{haddockProjectHackage = v}) + trueArg + , option + "" + ["output"] + "Output directory" + haddockProjectDir + (\v flags -> flags{haddockProjectDir = v}) + (optArg' "DIRECTORY" maybeToFlag (fmap Just . flagToList)) + , option + "" + ["prologue"] + "File path to a prologue file in haddock format" + haddockProjectPrologue + (\v flags -> flags{haddockProjectPrologue = v}) + (optArg' "PATH" maybeToFlag (fmap Just . flagToList)) + , option + "" + ["hoogle"] + "Generate a hoogle database" + haddockProjectHoogle + (\v flags -> flags{haddockProjectHoogle = v}) + trueArg + , option + "" + ["html-location"] + "Location of HTML documentation for pre-requisite packages" + haddockProjectHtmlLocation + (\v flags -> flags{haddockProjectHtmlLocation = v}) + (reqArgFlag "URL") + , option + "" + ["executables"] + "Run haddock for Executables targets" + haddockProjectExecutables + (\v flags -> flags{haddockProjectExecutables = v}) + trueArg + , option + "" + ["tests"] + "Run haddock for Test Suite targets" + haddockProjectTestSuites + (\v flags -> flags{haddockProjectTestSuites = v}) + trueArg + , option + "" + ["benchmarks"] + "Run haddock for Benchmark targets" + haddockProjectBenchmarks + (\v flags -> flags{haddockProjectBenchmarks = v}) + trueArg + , option + "" + ["foreign-libraries"] + "Run haddock for Foreign Library targets" + haddockProjectForeignLibs + (\v flags -> flags{haddockProjectForeignLibs = v}) + trueArg + , option + "" + ["all", "haddock-all"] + "Run haddock for all targets" + ( \f -> + allFlags + [ haddockProjectExecutables f + , haddockProjectTestSuites f + , haddockProjectBenchmarks f + , haddockProjectForeignLibs f + ] + ) + ( \v flags -> + flags + { haddockProjectExecutables = v + , haddockProjectTestSuites = v + , haddockProjectBenchmarks = v + , haddockProjectForeignLibs = v + } + ) + trueArg + , option + "" + ["internal"] + "Run haddock for internal modules and include all symbols" + haddockProjectInternal + (\v flags -> flags{haddockProjectInternal = v}) + trueArg + , option + "" + ["css"] + "Use PATH as the haddock stylesheet" + haddockProjectCss + (\v flags -> flags{haddockProjectCss = v}) + (reqArgFlag "PATH") + , option + "" + ["hscolour-css"] + "Use PATH as the HsColour stylesheet" + haddockProjectHscolourCss + (\v flags -> flags{haddockProjectHscolourCss = v}) + (reqArgFlag "PATH") + , option + "" + ["resources-dir"] + "location of Haddocks static / auxiliary files" + haddockProjectResourcesDir + (\v flags -> flags{haddockProjectResourcesDir = v}) + (reqArgFlag "DIR") + , option + "" + ["use-unicode"] + "Pass --use-unicode option to haddock" + haddockProjectUseUnicode + (\v flags -> flags{haddockProjectUseUnicode = v}) + trueArg + ] emptyHaddockProjectFlags :: HaddockProjectFlags emptyHaddockProjectFlags = mempty diff --git a/cabal-install/src/Distribution/Client/CmdHaddockProject.hs b/cabal-install/src/Distribution/Client/CmdHaddockProject.hs index f632e8b7caa..0635a77d68e 100644 --- a/cabal-install/src/Distribution/Client/CmdHaddockProject.hs +++ b/cabal-install/src/Distribution/Client/CmdHaddockProject.hs @@ -85,7 +85,6 @@ import Distribution.Simple.Setup , HaddockProjectFlags (..) , HaddockTarget (..) , Visibility (..) - , defaultCommonSetupFlags , defaultHaddockFlags , haddockProjectCommand ) @@ -119,62 +118,6 @@ haddockProjectAction flags _extraArgs globalFlags = do 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. @@ -409,7 +352,61 @@ haddockProjectAction flags _extraArgs globalFlags = do 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 diff --git a/cabal-install/src/Distribution/Client/CmdRepl.hs b/cabal-install/src/Distribution/Client/CmdRepl.hs index e381b291d7d..f762c3d72bf 100644 --- a/cabal-install/src/Distribution/Client/CmdRepl.hs +++ b/cabal-install/src/Distribution/Client/CmdRepl.hs @@ -103,11 +103,11 @@ import Distribution.Simple.Compiler ) import Distribution.Simple.Setup ( ReplOptions (..) + , commonSetupTempFileOptions , setupVerbosity ) import Distribution.Simple.Utils - ( TempFileOptions (..) - , debugNoWrap + ( debugNoWrap , dieWithException , withTempDirectoryEx , wrapText @@ -411,7 +411,7 @@ replAction flags@NixStyleFlags{extraFlags = r@ReplFlags{..}, ..} targetStrings g -- Multi Repl implemention 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 @@ -507,7 +507,7 @@ replAction flags@NixStyleFlags{extraFlags = r@ReplFlags{..}, ..} targetStrings g go m _ = m verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags configFlags) - keepTempFiles = fromFlagOrDefault False replKeepTempFiles + tempFileOptions = commonSetupTempFileOptions $ configCommonFlags configFlags validatedTargets ctx compiler elaboratedPlan targetSelectors = do let multi_repl_enabled = multiReplDecision ctx compiler r diff --git a/cabal-install/src/Distribution/Client/Config.hs b/cabal-install/src/Distribution/Client/Config.hs index 2faf9e1756d..f9889ca85cf 100644 --- a/cabal-install/src/Distribution/Client/Config.hs +++ b/cabal-install/src/Distribution/Client/Config.hs @@ -161,6 +161,7 @@ import Distribution.Parsec (ParsecParser, parsecFilePath, parsecOptCommaList, pa import Distribution.Simple.Command ( CommandUI (commandOptions) , ShowOrParseArgs (..) + , OptionField , commandDefaultFlags ) import Distribution.Simple.Compiler @@ -469,6 +470,7 @@ instance Semigroup SavedConfig where , setupCabalFilePath = combine setupCabalFilePath , setupVerbosity = combine setupVerbosity , setupTargets = lastNonEmpty setupTargets + , setupKeepTempFiles = combine setupKeepTempFiles } where lastNonEmpty = lastNonEmpty' which @@ -629,7 +631,6 @@ instance Semigroup SavedConfig where , haddockQuickJump = combine haddockQuickJump , haddockHscolourCss = combine haddockHscolourCss , haddockContents = combine haddockContents - , haddockKeepTempFiles = combine haddockKeepTempFiles , haddockIndex = combine haddockIndex , haddockBaseUrl = combine haddockBaseUrl , haddockResourcesDir = combine haddockResourcesDir @@ -1314,6 +1315,19 @@ configFieldDescriptions src = 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 @@ -1830,7 +1844,7 @@ haddockFlagsFields = , name `notElem` exclusions ] where - exclusions = ["verbose", "builddir", "for-hackage"] + exclusions = ["verbose", "builddir", "cabal-file", "keep-temp-files", "for-hackage"] -- | Fields for the 'init' section. initFlagsFields :: [FieldDescr IT.InitFlags] diff --git a/cabal-install/src/Distribution/Client/ParseUtils.hs b/cabal-install/src/Distribution/Client/ParseUtils.hs index 44cdc4ccc22..18062b7428f 100644 --- a/cabal-install/src/Distribution/Client/ParseUtils.hs +++ b/cabal-install/src/Distribution/Client/ParseUtils.hs @@ -17,6 +17,8 @@ module Distribution.Client.ParseUtils FieldDescr (..) , liftField , liftFields + , addFields + , aliasField , filterFields , mapFieldNames , commandOptionToField @@ -103,9 +105,15 @@ liftFields get set = map (liftField get set) -- | 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 +128,30 @@ commandOptionToField = viewAsFieldDescr 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 -- diff --git a/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs b/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs index f1486388b8c..f38b84ad752 100644 --- a/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs +++ b/cabal-install/src/Distribution/Client/ProjectBuilding/UnpackedPackage.hs @@ -169,7 +169,7 @@ buildAndRegisterUnpackedPackage verbosity distDirLayout@DistDirLayout{distTempDirectory} maybe_semaphore - buildTimeSettings@BuildTimeSettings{buildSettingNumJobs} + buildTimeSettings@BuildTimeSettings{buildSettingNumJobs, buildSettingKeepTempFiles} registerLock cacheLock pkgshared@ElaboratedSharedConfig @@ -274,7 +274,7 @@ buildAndRegisterUnpackedPackage mbWorkDir = useWorkingDir scriptOptions commonFlags v = flip filterCommonFlags v $ - setupHsCommonFlags verbosity mbWorkDir builddir + setupHsCommonFlags verbosity mbWorkDir builddir buildSettingKeepTempFiles configureCommand = Cabal.configureCommand defaultProgramDb configureFlags v = diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs index a4191325f8b..7354e5e9cb3 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs @@ -861,9 +861,9 @@ convertLegacyBuildOnlyFlags configFlags installFlags clientInstallFlags - haddockFlags - _ - _ = + _haddockFlags + _testFlags + _benchmarkFlags = ProjectConfigBuildOnly{..} where projectConfigClientInstallFlags = clientInstallFlags @@ -880,6 +880,7 @@ convertLegacyBuildOnlyFlags CommonSetupFlags { setupVerbosity = projectConfigVerbosity + , setupKeepTempFiles = projectConfigKeepTempFiles } = commonFlags InstallFlags @@ -899,10 +900,6 @@ convertLegacyBuildOnlyFlags , installOfflineMode = projectConfigOfflineMode } = installFlags - HaddockFlags - { haddockKeepTempFiles = projectConfigKeepTempFiles -- TODO: this ought to live elsewhere - } = haddockFlags - convertToLegacyProjectConfig :: ProjectConfig -> LegacyProjectConfig convertToLegacyProjectConfig projectConfig@ProjectConfig @@ -975,6 +972,7 @@ convertToLegacySharedConfig mempty { setupVerbosity = projectConfigVerbosity , setupDistPref = fmap makeSymbolicPath $ projectConfigDistDir + , setupKeepTempFiles = projectConfigKeepTempFiles } configFlags = @@ -1047,8 +1045,7 @@ convertToLegacySharedConfig convertToLegacyAllPackageConfig :: ProjectConfig -> LegacyPackageConfig convertToLegacyAllPackageConfig ProjectConfig - { projectConfigBuildOnly = ProjectConfigBuildOnly{..} - , projectConfigShared = ProjectConfigShared{..} + { projectConfigShared = ProjectConfigShared{..} } = LegacyPackageConfig { legacyConfigureFlags = configFlags @@ -1124,8 +1121,6 @@ convertToLegacyAllPackageConfig haddockFlags = mempty - { haddockKeepTempFiles = projectConfigKeepTempFiles - } convertToLegacyPerPackageConfig :: PackageConfig -> LegacyPackageConfig convertToLegacyPerPackageConfig PackageConfig{..} = @@ -1225,7 +1220,6 @@ convertToLegacyPerPackageConfig PackageConfig{..} = , haddockQuickJump = packageConfigHaddockQuickJump , haddockHscolourCss = packageConfigHaddockHscolourCss , haddockContents = packageConfigHaddockContents - , haddockKeepTempFiles = mempty , haddockIndex = packageConfigHaddockIndex , haddockBaseUrl = packageConfigHaddockBaseUrl , haddockResourcesDir = packageConfigHaddockResourcesDir @@ -1408,7 +1402,8 @@ legacySharedConfigFieldDescrs constraintSrc = 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 @@ -1630,7 +1625,6 @@ legacyPackageConfigFieldDescrs = , "hscolour-css" , "contents-location" , "index-location" - , "keep-temp-files" , "base-url" , "resources-dir" , "output-dir" @@ -2073,9 +2067,3 @@ showTokenQ "" = Disp.empty 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 = (++) diff --git a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs index 77573944a19..fef9f6efde4 100644 --- a/cabal-install/src/Distribution/Client/ProjectOrchestration.hs +++ b/cabal-install/src/Distribution/Client/ProjectOrchestration.hs @@ -946,7 +946,7 @@ printPlan printPlan verbosity ProjectBaseContext - { buildSettings = BuildTimeSettings{buildSettingDryRun} + { buildSettings = BuildTimeSettings{buildSettingDryRun, buildSettingKeepTempFiles} , projectConfig = ProjectConfig { projectConfigAllPackages = @@ -1048,6 +1048,7 @@ printPlan verbosity Nothing -- omit working directory (makeSymbolicPath "$builddir") + buildSettingKeepTempFiles fullConfigureFlags = runIdentity $ ( setupHsConfigureFlags diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index 50423b2d1df..9cfde415502 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -4090,14 +4090,16 @@ setupHsCommonFlags :: 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 @@ -4226,7 +4228,7 @@ setupHsHaddockFlags setupHsHaddockFlags (ElaboratedConfiguredPackage{..}) (ElaboratedSharedConfig{..}) - (BuildTimeSettings{buildSettingKeepTempFiles = keepTmpFiles}) + _buildTimeSettings common = Cabal.HaddockFlags { haddockCommonFlags = common @@ -4254,7 +4256,6 @@ setupHsHaddockFlags , 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 diff --git a/cabal-install/src/Distribution/Client/ReplFlags.hs b/cabal-install/src/Distribution/Client/ReplFlags.hs index a7136aa572d..0d587b1d501 100644 --- a/cabal-install/src/Distribution/Client/ReplFlags.hs +++ b/cabal-install/src/Distribution/Client/ReplFlags.hs @@ -27,7 +27,6 @@ import Distribution.Simple.Setup , falseArg , replOptions , toFlag - , trueArg ) import Distribution.Types.Dependency ( Dependency (..) @@ -55,11 +54,10 @@ data ReplFlags = ReplFlags { 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 +68,6 @@ defaultReplFlags = { configureReplOptions = mempty , replEnvFlags = defaultEnvFlags , replUseMulti = NoFlag - , replKeepTempFiles = NoFlag } topReplOptions :: ShowOrParseArgs -> [OptionField ReplFlags] @@ -78,18 +75,6 @@ topReplOptions showOrParseArgs = 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} diff --git a/cabal-install/src/Distribution/Client/Setup.hs b/cabal-install/src/Distribution/Client/Setup.hs index 78e864d1a65..5c3b65d586e 100644 --- a/cabal-install/src/Distribution/Client/Setup.hs +++ b/cabal-install/src/Distribution/Client/Setup.hs @@ -647,9 +647,11 @@ filterCommonFlags flags cabalLibVersion 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 diff --git a/cabal-install/tests/IntegrationTests2.hs b/cabal-install/tests/IntegrationTests2.hs index e6373cd18b8..5c2892d3771 100644 --- a/cabal-install/tests/IntegrationTests2.hs +++ b/cabal-install/tests/IntegrationTests2.hs @@ -49,7 +49,7 @@ import qualified Distribution.Client.CmdListBin as CmdListBin import Distribution.Package import Distribution.PackageDescription import Distribution.InstalledPackageInfo (InstalledPackageInfo) -import Distribution.Simple.Setup (toFlag, HaddockFlags(..), defaultHaddockFlags) +import Distribution.Simple.Setup (toFlag, HaddockFlags(..), CommonSetupFlags(..), defaultHaddockFlags, defaultCommonSetupFlags) import Distribution.Client.Setup (globalCommand) import Distribution.Client.Config (loadConfig, SavedConfig(savedGlobalFlags), createDefaultConfigFile) import Distribution.Simple.Compiler @@ -2002,6 +2002,7 @@ testConfigOptionComments = do "-- verbose" @=? findLineWith True "verbose" defaultConfigFile "-- compiler" @=? findLineWith True "compiler" defaultConfigFile "-- cabal-file" @=? findLineWith True "cabal-file" defaultConfigFile + "-- keep-temp-files" @=? findLineWith True "keep-temp-files" defaultConfigFile "-- with-compiler" @=? findLineWith True "with-compiler" defaultConfigFile "-- with-hc-pkg" @=? findLineWith True "with-hc-pkg" defaultConfigFile "-- program-prefix" @=? findLineWith True "program-prefix" defaultConfigFile @@ -2095,7 +2096,6 @@ testConfigOptionComments = do "-- 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 @@ -2245,7 +2245,12 @@ testHaddockProjectDependencies config = do cleanHaddockProject testdir withCurrentDirectory dir $ do CmdHaddockProject.haddockProjectAction - defaultHaddockProjectFlags { haddockProjectVerbosity = Flag verbosity } + defaultHaddockProjectFlags + { haddockProjectCommonFlags = + defaultCommonSetupFlags + { setupVerbosity = Flag verbosity + } + } ["all"] defaultGlobalFlags { globalStoreDir = Flag "store" }