From e29406c25271e8f80befb08532700f58177d4ec9 Mon Sep 17 00:00:00 2001 From: Matt Renaud Date: Thu, 3 Jan 2019 18:04:47 -0800 Subject: [PATCH] Add global configuration option for non-interactive cabal init. --- cabal-install/Distribution/Client/Config.hs | 54 +++ cabal-install/Distribution/Client/Setup.hs | 351 ++++++++++---------- cabal-install/main/Main.hs | 3 +- 3 files changed, 233 insertions(+), 175 deletions(-) diff --git a/cabal-install/Distribution/Client/Config.hs b/cabal-install/Distribution/Client/Config.hs index 8c85cc6fa4d..b059be14cb3 100644 --- a/cabal-install/Distribution/Client/Config.hs +++ b/cabal-install/Distribution/Client/Config.hs @@ -53,9 +53,12 @@ import Distribution.Client.Types ) import Distribution.Client.BuildReports.Types ( ReportLevel(..) ) +import qualified Distribution.Client.Init.Types as IT + ( InitFlags(..) ) import Distribution.Client.Setup ( GlobalFlags(..), globalCommand, defaultGlobalFlags , ConfigExFlags(..), configureExOptions, defaultConfigExFlags + , initOptions , InstallFlags(..), installOptions, defaultInstallFlags , UploadFlags(..), uploadCommand , ReportFlags(..), reportCommand @@ -147,6 +150,7 @@ import GHC.Generics ( Generic ) data SavedConfig = SavedConfig { savedGlobalFlags :: GlobalFlags, + savedInitFlags :: IT.InitFlags, savedInstallFlags :: InstallFlags, savedConfigureFlags :: ConfigFlags, savedConfigureExFlags :: ConfigExFlags, @@ -165,6 +169,7 @@ instance Monoid SavedConfig where instance Semigroup SavedConfig where a <> b = SavedConfig { savedGlobalFlags = combinedSavedGlobalFlags, + savedInitFlags = combinedSavedInitFlags, savedInstallFlags = combinedSavedInstallFlags, savedConfigureFlags = combinedSavedConfigureFlags, savedConfigureExFlags = combinedSavedConfigureExFlags, @@ -246,6 +251,39 @@ instance Semigroup SavedConfig where combine = combine' savedGlobalFlags lastNonEmptyNL = lastNonEmptyNL' savedGlobalFlags + combinedSavedInitFlags = IT.InitFlags { + IT.nonInteractive = combine IT.nonInteractive, + IT.quiet = combine IT.quiet, + IT.packageDir = combine IT.packageDir, + IT.noComments = combine IT.noComments, + IT.minimal = combine IT.minimal, + IT.simpleProject = combine IT.simpleProject, + IT.packageName = combine IT.packageName, + IT.version = combine IT.version, + IT.cabalVersion = combine IT.cabalVersion, + IT.license = combine IT.license, + IT.author = combine IT.author, + IT.email = combine IT.email, + IT.homepage = combine IT.homepage, + IT.synopsis = combine IT.synopsis, + IT.category = combine IT.category, + IT.extraSrc = combineMonoid savedInitFlags IT.extraSrc, + IT.packageType = combine IT.packageType, + IT.mainIs = combine IT.mainIs, + IT.language = combine IT.language, + IT.exposedModules = combineMonoid savedInitFlags IT.exposedModules, + IT.otherModules = combineMonoid savedInitFlags IT.otherModules, + IT.otherExts = combineMonoid savedInitFlags IT.otherExts, + IT.dependencies = combineMonoid savedInitFlags IT.dependencies, + IT.sourceDirs = combineMonoid savedInitFlags IT.sourceDirs, + IT.buildTools = combineMonoid savedInitFlags IT.buildTools, + IT.initHcPath = combine IT.initHcPath, + IT.initVerbosity = combine IT.initVerbosity, + IT.overwrite = combine IT.overwrite + } + where + combine = combine' savedInitFlags + combinedSavedInstallFlags = InstallFlags { installDocumentation = combine installDocumentation, installHaddockIndex = combine installHaddockIndex, @@ -754,6 +792,9 @@ commentSavedConfig = do savedGlobalFlags = defaultGlobalFlags { globalRemoteRepos = toNubList [defaultRemoteRepo] }, + savedInitFlags = mempty { + IT.nonInteractive = toFlag False + }, savedInstallFlags = defaultInstallFlags, savedConfigureExFlags = defaultConfigExFlags { configAllowNewer = Just (AllowNewer mempty), @@ -873,6 +914,15 @@ configFieldDescriptions src = configAllowNewer (\v flags -> flags { configAllowNewer = v }) ] + ++ toSavedConfig liftInitFlag + (initOptions ParseArgs) + ["quiet", "no-comments", "minimal", "overwrite", "package-dir", + "packagedir", "package-name", "version", "cabal-version", "license", + "author", "email", "homepage", "synopsis", "category", + "extra-source-file", "lib", "exe", "libandexe", "simple", + "main-is", "language", "exposed-module", "extension", "dependency", + "source-dir", "build-tool", "with-compiler"] [] + ++ toSavedConfig liftInstallFlag (installOptions ParseArgs) ["dry-run", "only", "only-dependencies", "dependencies-only"] [] @@ -980,6 +1030,10 @@ liftConfigExFlag :: FieldDescr ConfigExFlags -> FieldDescr SavedConfig liftConfigExFlag = liftField savedConfigureExFlags (\flags conf -> conf { savedConfigureExFlags = flags }) +liftInitFlag :: FieldDescr IT.InitFlags -> FieldDescr SavedConfig +liftInitFlag = liftField + savedInitFlags (\flags conf -> conf { savedInitFlags = flags }) + liftInstallFlag :: FieldDescr InstallFlags -> FieldDescr SavedConfig liftInstallFlag = liftField savedInstallFlags (\flags conf -> conf { savedInstallFlags = flags }) diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs index 9c8416f237f..915a2f37345 100644 --- a/cabal-install/Distribution/Client/Setup.hs +++ b/cabal-install/Distribution/Client/Setup.hs @@ -42,7 +42,7 @@ module Distribution.Client.Setup , uploadCommand, UploadFlags(..), IsCandidate(..) , reportCommand, ReportFlags(..) , runCommand - , initCommand, IT.InitFlags(..) + , initCommand, initOptions, IT.InitFlags(..) , sdistCommand, SDistFlags(..) , win32SelfUpgradeCommand, Win32SelfUpgradeFlags(..) , actAsSetupCommand, ActAsSetupFlags(..) @@ -2201,181 +2201,184 @@ initCommand = CommandUI { commandUsage = \pname -> "Usage: " ++ pname ++ " init [FLAGS]\n", commandDefaultFlags = defaultInitFlags, - commandOptions = \_ -> - [ option ['n'] ["non-interactive"] - "Non-interactive mode." - IT.nonInteractive (\v flags -> flags { IT.nonInteractive = v }) - trueArg - - , option ['q'] ["quiet"] - "Do not generate log messages to stdout." - IT.quiet (\v flags -> flags { IT.quiet = v }) - trueArg - - , option [] ["no-comments"] - "Do not generate explanatory comments in the .cabal file." - IT.noComments (\v flags -> flags { IT.noComments = v }) - trueArg - - , option ['m'] ["minimal"] - "Generate a minimal .cabal file, that is, do not include extra empty fields. Also implies --no-comments." - IT.minimal (\v flags -> flags { IT.minimal = v }) - trueArg - - , option [] ["overwrite"] - "Overwrite any existing .cabal, LICENSE, or Setup.hs files without warning." - IT.overwrite (\v flags -> flags { IT.overwrite = v }) - trueArg - - , option [] ["package-dir", "packagedir"] - "Root directory of the package (default = current directory)." - IT.packageDir (\v flags -> flags { IT.packageDir = v }) - (reqArgFlag "DIRECTORY") - - , option ['p'] ["package-name"] - "Name of the Cabal package to create." - IT.packageName (\v flags -> flags { IT.packageName = v }) - (reqArg "PACKAGE" (readP_to_E ("Cannot parse package name: "++) - (toFlag `fmap` parse)) - (flagToList . fmap display)) - - , option [] ["version"] - "Initial version of the package." - IT.version (\v flags -> flags { IT.version = v }) - (reqArg "VERSION" (readP_to_E ("Cannot parse package version: "++) - (toFlag `fmap` parse)) - (flagToList . fmap display)) - - , option [] ["cabal-version"] - "Version of the Cabal specification." - IT.cabalVersion (\v flags -> flags { IT.cabalVersion = v }) - (reqArg "VERSION_RANGE" (readP_to_E ("Cannot parse Cabal specification version: "++) - (toFlag `fmap` parse)) - (flagToList . fmap display)) - - , option ['l'] ["license"] - "Project license." - IT.license (\v flags -> flags { IT.license = v }) - (reqArg "LICENSE" (readP_to_E ("Cannot parse license: "++) - (toFlag `fmap` parse)) - (flagToList . fmap display)) - - , option ['a'] ["author"] - "Name of the project's author." - IT.author (\v flags -> flags { IT.author = v }) - (reqArgFlag "NAME") - - , option ['e'] ["email"] - "Email address of the maintainer." - IT.email (\v flags -> flags { IT.email = v }) - (reqArgFlag "EMAIL") - - , option ['u'] ["homepage"] - "Project homepage and/or repository." - IT.homepage (\v flags -> flags { IT.homepage = v }) - (reqArgFlag "URL") - - , option ['s'] ["synopsis"] - "Short project synopsis." - IT.synopsis (\v flags -> flags { IT.synopsis = v }) - (reqArgFlag "TEXT") - - , option ['c'] ["category"] - "Project category." - IT.category (\v flags -> flags { IT.category = v }) - (reqArg' "CATEGORY" (\s -> toFlag $ maybe (Left s) Right (readMaybe s)) - (flagToList . fmap (either id show))) - - , option ['x'] ["extra-source-file"] - "Extra source file to be distributed with tarball." - IT.extraSrc (\v flags -> flags { IT.extraSrc = v }) - (reqArg' "FILE" (Just . (:[])) - (fromMaybe [])) - - , option [] ["lib", "is-library"] - "Build a library." - IT.packageType (\v flags -> flags { IT.packageType = v }) - (noArg (Flag IT.Library)) - - , option [] ["exe", "is-executable"] - "Build an executable." - IT.packageType - (\v flags -> flags { IT.packageType = v }) - (noArg (Flag IT.Executable)) - - , option [] ["libandexe", "is-libandexe"] - "Build a library and an executable." - IT.packageType - (\v flags -> flags { IT.packageType = v }) - (noArg (Flag IT.LibraryAndExecutable)) - - , option [] ["simple"] - "Create a simple project with sensible defaults." - IT.simpleProject - (\v flags -> flags { IT.simpleProject = v }) - trueArg - - , option [] ["main-is"] - "Specify the main module." - IT.mainIs - (\v flags -> flags { IT.mainIs = v }) - (reqArgFlag "FILE") - - , option [] ["language"] - "Specify the default language." - IT.language - (\v flags -> flags { IT.language = v }) - (reqArg "LANGUAGE" (readP_to_E ("Cannot parse language: "++) - (toFlag `fmap` parse)) - (flagToList . fmap display)) - - , option ['o'] ["expose-module"] - "Export a module from the package." - IT.exposedModules - (\v flags -> flags { IT.exposedModules = v }) - (reqArg "MODULE" (readP_to_E ("Cannot parse module name: "++) - ((Just . (:[])) `fmap` parse)) - (maybe [] (fmap display))) - - , option [] ["extension"] - "Use a LANGUAGE extension (in the other-extensions field)." - IT.otherExts - (\v flags -> flags { IT.otherExts = v }) - (reqArg "EXTENSION" (readP_to_E ("Cannot parse extension: "++) - ((Just . (:[])) `fmap` parse)) - (maybe [] (fmap display))) - - , option ['d'] ["dependency"] - "Package dependency." - IT.dependencies (\v flags -> flags { IT.dependencies = v }) - (reqArg "PACKAGE" (readP_to_E ("Cannot parse dependency: "++) - ((Just . (:[])) `fmap` parse)) - (maybe [] (fmap display))) - - , option [] ["source-dir", "sourcedir"] - "Directory containing package source." - IT.sourceDirs (\v flags -> flags { IT.sourceDirs = v }) - (reqArg' "DIR" (Just . (:[])) - (fromMaybe [])) - - , option [] ["build-tool"] - "Required external build tool." - 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 }) - ] + commandOptions = initOptions } +initOptions :: ShowOrParseArgs -> [OptionField IT.InitFlags] +initOptions _ = + [ option ['n'] ["non-interactive"] + "Non-interactive mode." + IT.nonInteractive (\v flags -> flags { IT.nonInteractive = v }) + trueArg + + , option ['q'] ["quiet"] + "Do not generate log messages to stdout." + IT.quiet (\v flags -> flags { IT.quiet = v }) + trueArg + + , option [] ["no-comments"] + "Do not generate explanatory comments in the .cabal file." + IT.noComments (\v flags -> flags { IT.noComments = v }) + trueArg + + , option ['m'] ["minimal"] + "Generate a minimal .cabal file, that is, do not include extra empty fields. Also implies --no-comments." + IT.minimal (\v flags -> flags { IT.minimal = v }) + trueArg + + , option [] ["overwrite"] + "Overwrite any existing .cabal, LICENSE, or Setup.hs files without warning." + IT.overwrite (\v flags -> flags { IT.overwrite = v }) + trueArg + + , option [] ["package-dir", "packagedir"] + "Root directory of the package (default = current directory)." + IT.packageDir (\v flags -> flags { IT.packageDir = v }) + (reqArgFlag "DIRECTORY") + + , option ['p'] ["package-name"] + "Name of the Cabal package to create." + IT.packageName (\v flags -> flags { IT.packageName = v }) + (reqArg "PACKAGE" (readP_to_E ("Cannot parse package name: "++) + (toFlag `fmap` parse)) + (flagToList . fmap display)) + + , option [] ["version"] + "Initial version of the package." + IT.version (\v flags -> flags { IT.version = v }) + (reqArg "VERSION" (readP_to_E ("Cannot parse package version: "++) + (toFlag `fmap` parse)) + (flagToList . fmap display)) + + , option [] ["cabal-version"] + "Version of the Cabal specification." + IT.cabalVersion (\v flags -> flags { IT.cabalVersion = v }) + (reqArg "VERSION_RANGE" (readP_to_E ("Cannot parse Cabal specification version: "++) + (toFlag `fmap` parse)) + (flagToList . fmap display)) + + , option ['l'] ["license"] + "Project license." + IT.license (\v flags -> flags { IT.license = v }) + (reqArg "LICENSE" (readP_to_E ("Cannot parse license: "++) + (toFlag `fmap` parse)) + (flagToList . fmap display)) + + , option ['a'] ["author"] + "Name of the project's author." + IT.author (\v flags -> flags { IT.author = v }) + (reqArgFlag "NAME") + + , option ['e'] ["email"] + "Email address of the maintainer." + IT.email (\v flags -> flags { IT.email = v }) + (reqArgFlag "EMAIL") + + , option ['u'] ["homepage"] + "Project homepage and/or repository." + IT.homepage (\v flags -> flags { IT.homepage = v }) + (reqArgFlag "URL") + + , option ['s'] ["synopsis"] + "Short project synopsis." + IT.synopsis (\v flags -> flags { IT.synopsis = v }) + (reqArgFlag "TEXT") + + , option ['c'] ["category"] + "Project category." + IT.category (\v flags -> flags { IT.category = v }) + (reqArg' "CATEGORY" (\s -> toFlag $ maybe (Left s) Right (readMaybe s)) + (flagToList . fmap (either id show))) + + , option ['x'] ["extra-source-file"] + "Extra source file to be distributed with tarball." + IT.extraSrc (\v flags -> flags { IT.extraSrc = v }) + (reqArg' "FILE" (Just . (:[])) + (fromMaybe [])) + + , option [] ["lib", "is-library"] + "Build a library." + IT.packageType (\v flags -> flags { IT.packageType = v }) + (noArg (Flag IT.Library)) + + , option [] ["exe", "is-executable"] + "Build an executable." + IT.packageType + (\v flags -> flags { IT.packageType = v }) + (noArg (Flag IT.Executable)) + + , option [] ["libandexe", "is-libandexe"] + "Build a library and an executable." + IT.packageType + (\v flags -> flags { IT.packageType = v }) + (noArg (Flag IT.LibraryAndExecutable)) + + , option [] ["simple"] + "Create a simple project with sensible defaults." + IT.simpleProject + (\v flags -> flags { IT.simpleProject = v }) + trueArg + + , option [] ["main-is"] + "Specify the main module." + IT.mainIs + (\v flags -> flags { IT.mainIs = v }) + (reqArgFlag "FILE") + + , option [] ["language"] + "Specify the default language." + IT.language + (\v flags -> flags { IT.language = v }) + (reqArg "LANGUAGE" (readP_to_E ("Cannot parse language: "++) + (toFlag `fmap` parse)) + (flagToList . fmap display)) + + , option ['o'] ["expose-module"] + "Export a module from the package." + IT.exposedModules + (\v flags -> flags { IT.exposedModules = v }) + (reqArg "MODULE" (readP_to_E ("Cannot parse module name: "++) + ((Just . (:[])) `fmap` parse)) + (maybe [] (fmap display))) + + , option [] ["extension"] + "Use a LANGUAGE extension (in the other-extensions field)." + IT.otherExts + (\v flags -> flags { IT.otherExts = v }) + (reqArg "EXTENSION" (readP_to_E ("Cannot parse extension: "++) + ((Just . (:[])) `fmap` parse)) + (maybe [] (fmap display))) + + , option ['d'] ["dependency"] + "Package dependency." + IT.dependencies (\v flags -> flags { IT.dependencies = v }) + (reqArg "PACKAGE" (readP_to_E ("Cannot parse dependency: "++) + ((Just . (:[])) `fmap` parse)) + (maybe [] (fmap display))) + + , option [] ["source-dir", "sourcedir"] + "Directory containing package source." + IT.sourceDirs (\v flags -> flags { IT.sourceDirs = v }) + (reqArg' "DIR" (Just . (:[])) + (fromMaybe [])) + + , option [] ["build-tool"] + "Required external build tool." + 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 }) + ] + -- ------------------------------------------------------------ -- * SDist flags -- ------------------------------------------------------------ diff --git a/cabal-install/main/Main.hs b/cabal-install/main/Main.hs index 244a3cfc11c..b3b1d53ecb2 100644 --- a/cabal-install/main/Main.hs +++ b/cabal-install/main/Main.hs @@ -1141,6 +1141,7 @@ initAction initFlags extraArgs globalFlags = do let configFlags = savedConfigureFlags config `mappend` -- override with `--with-compiler` from CLI if available mempty { configHcPath = initHcPath initFlags } + let initFlags' = savedInitFlags config `mappend` initFlags let globalFlags' = savedGlobalFlags config `mappend` globalFlags (comp, _, progdb) <- configCompilerAux' configFlags withRepoContext verbosity globalFlags' $ \repoContext -> @@ -1149,7 +1150,7 @@ initAction initFlags extraArgs globalFlags = do repoContext comp progdb - initFlags + initFlags' sandboxAction :: SandboxFlags -> [String] -> Action sandboxAction sandboxFlags extraArgs globalFlags = do