From 5f6d27454b106202211d4cbc40a2762e82341e46 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Thu, 30 Apr 2020 23:10:56 +0300 Subject: [PATCH] Make NixStyleOptions --- .../Distribution/Client/CmdHaddock.hs | 17 ++--- .../Distribution/Client/CmdInstall.hs | 54 +++------------- cabal-install/Distribution/Client/CmdRepl.hs | 43 ++++--------- cabal-install/Distribution/Client/CmdRun.hs | 47 +++----------- .../Distribution/Client/NixStyleOptions.hs | 63 +++++++++++++++++++ cabal-install/cabal-install.cabal | 1 + cabal-install/cabal-install.cabal.pp | 1 + 7 files changed, 99 insertions(+), 127 deletions(-) create mode 100644 cabal-install/Distribution/Client/NixStyleOptions.hs diff --git a/cabal-install/Distribution/Client/CmdHaddock.hs b/cabal-install/Distribution/Client/CmdHaddock.hs index d82d70c48e0..6d06c679b9f 100644 --- a/cabal-install/Distribution/Client/CmdHaddock.hs +++ b/cabal-install/Distribution/Client/CmdHaddock.hs @@ -16,9 +16,10 @@ module Distribution.Client.CmdHaddock ( import Distribution.Client.ProjectOrchestration import Distribution.Client.CmdErrorMessages +import Distribution.Client.NixStyleOptions + ( NixStyleFlags, nixStyleOptions, defaultNixStyleFlags ) import Distribution.Client.Setup ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags ) -import qualified Distribution.Client.Setup as Client import Distribution.Simple.Setup ( HaddockFlags(..), TestFlags, BenchmarkFlags(..), fromFlagOrDefault ) import Distribution.Simple.Command @@ -31,10 +32,8 @@ import Distribution.Simple.Utils import Control.Monad (when) -haddockCommand :: CommandUI ( ConfigFlags, ConfigExFlags, InstallFlags - , HaddockFlags, TestFlags, BenchmarkFlags - ) -haddockCommand = Client.installCommand { +haddockCommand :: CommandUI (NixStyleFlags ()) +haddockCommand = CommandUI { commandName = "v2-haddock", commandSynopsis = "Build Haddock documentation", commandUsage = usageAlternatives "v2-haddock" [ "[FLAGS] TARGET" ], @@ -61,7 +60,9 @@ haddockCommand = Client.installCommand { ++ " Build documentation for the package named pkgname\n\n" ++ cmdCommonHelpTextNewBuildBeta - } + , commandOptions = nixStyleOptions (const []) + , commandDefaultFlags = defaultNixStyleFlags () + } --TODO: [nice to have] support haddock on specific components, not just -- whole packages and the silly --executables etc modifiers. @@ -71,10 +72,10 @@ haddockCommand = Client.installCommand { -- "Distribution.Client.ProjectOrchestration" -- haddockAction :: ( ConfigFlags, ConfigExFlags, InstallFlags - , HaddockFlags, TestFlags, BenchmarkFlags ) + , HaddockFlags, TestFlags, BenchmarkFlags, () ) -> [String] -> GlobalFlags -> IO () haddockAction ( configFlags, configExFlags, installFlags - , haddockFlags, testFlags, benchmarkFlags ) + , haddockFlags, testFlags, benchmarkFlags, () ) targetStrings globalFlags = do baseCtx <- establishProjectBaseContext verbosity cliConfig HaddockCommand diff --git a/cabal-install/Distribution/Client/CmdInstall.hs b/cabal-install/Distribution/Client/CmdInstall.hs index 4157cf7eee6..95fd172b66c 100644 --- a/cabal-install/Distribution/Client/CmdInstall.hs +++ b/cabal-install/Distribution/Client/CmdInstall.hs @@ -33,11 +33,7 @@ import Distribution.Client.CmdInstall.ClientInstallFlags import Distribution.Client.CmdInstall.ClientInstallTargetSelector import Distribution.Client.Setup - ( GlobalFlags(..), ConfigFlags(..), ConfigExFlags, InstallFlags(..) - , configureExOptions, haddockOptions, installOptions, testOptions - , benchmarkOptions, configureOptions, liftOptions ) -import Distribution.Solver.Types.ConstraintSource - ( ConstraintSource(..) ) + ( GlobalFlags(..), ConfigFlags(..), ConfigExFlags, InstallFlags(..) ) import Distribution.Client.Types ( PackageSpecifier(..), PackageLocation(..), UnresolvedSourcePackage , SourcePackageDb(..) ) @@ -50,6 +46,8 @@ import Distribution.Client.ProjectConfig ( ProjectPackageLocation(..) , fetchAndReadSourcePackages ) +import Distribution.Client.NixStyleOptions + ( NixStyleFlags, nixStyleOptions, defaultNixStyleFlags ) import Distribution.Client.ProjectConfig.Types ( ProjectConfig(..), ProjectConfigShared(..) , ProjectConfigBuildOnly(..), PackageConfig(..) @@ -99,7 +97,7 @@ import Distribution.Simple.Setup import Distribution.Solver.Types.SourcePackage ( SourcePackage(..) ) import Distribution.Simple.Command - ( CommandUI(..), OptionField(..), usageAlternatives ) + ( CommandUI(..), usageAlternatives ) import Distribution.Simple.Configure ( configCompilerEx ) import Distribution.Simple.Compiler @@ -149,10 +147,7 @@ import System.Directory import System.FilePath ( (), (<.>), takeDirectory, takeBaseName ) -installCommand :: CommandUI ( ConfigFlags, ConfigExFlags, InstallFlags - , HaddockFlags, TestFlags, BenchmarkFlags - , ClientInstallFlags - ) +installCommand :: CommandUI (NixStyleFlags ClientInstallFlags) installCommand = CommandUI { commandName = "v2-install" , commandSynopsis = "Install packages." @@ -179,44 +174,9 @@ installCommand = CommandUI ++ " Install the package in the ./pkgfoo directory\n" ++ cmdCommonHelpTextNewBuildBeta - , commandOptions = \showOrParseArgs -> - liftOptions get1 set1 - -- Note: [Hidden Flags] - -- hide "constraint", "dependency", and - -- "exact-configuration" from the configure options. - (filter ((`notElem` ["constraint", "dependency" - , "exact-configuration"]) - . optionName) $ configureOptions showOrParseArgs) - ++ liftOptions get2 set2 (configureExOptions showOrParseArgs - ConstraintSourceCommandlineFlag) - ++ liftOptions get3 set3 - -- hide "target-package-db" and "symlink-bindir" flags from the - -- install options. - -- "symlink-bindir" is obsoleted by "installdir" in ClientInstallFlags - (filter ((`notElem` ["target-package-db", "symlink-bindir"]) - . optionName) $ - installOptions showOrParseArgs) - ++ liftOptions get4 set4 - -- hide "verbose" and "builddir" flags from the - -- haddock options. - (filter ((`notElem` ["v", "verbose", "builddir"]) - . optionName) $ - haddockOptions showOrParseArgs) - ++ liftOptions get5 set5 (testOptions showOrParseArgs) - ++ liftOptions get6 set6 (benchmarkOptions showOrParseArgs) - ++ liftOptions get7 set7 (clientInstallOptions showOrParseArgs) - , commandDefaultFlags = ( mempty, mempty, mempty, mempty, mempty, mempty - , defaultClientInstallFlags ) + , commandOptions = nixStyleOptions clientInstallOptions + , commandDefaultFlags = defaultNixStyleFlags defaultClientInstallFlags } - where - get1 (a,_,_,_,_,_,_) = a; set1 a (_,b,c,d,e,f,g) = (a,b,c,d,e,f,g) - get2 (_,b,_,_,_,_,_) = b; set2 b (a,_,c,d,e,f,g) = (a,b,c,d,e,f,g) - get3 (_,_,c,_,_,_,_) = c; set3 c (a,b,_,d,e,f,g) = (a,b,c,d,e,f,g) - get4 (_,_,_,d,_,_,_) = d; set4 d (a,b,c,_,e,f,g) = (a,b,c,d,e,f,g) - get5 (_,_,_,_,e,_,_) = e; set5 e (a,b,c,d,_,f,g) = (a,b,c,d,e,f,g) - get6 (_,_,_,_,_,f,_) = f; set6 f (a,b,c,d,e,_,g) = (a,b,c,d,e,f,g) - get7 (_,_,_,_,_,_,g) = g; set7 g (a,b,c,d,e,f,_) = (a,b,c,d,e,f,g) - -- | The @install@ command actually serves four different needs. It installs: -- * exes: diff --git a/cabal-install/Distribution/Client/CmdRepl.hs b/cabal-install/Distribution/Client/CmdRepl.hs index 381b55379f8..711c2e40c93 100644 --- a/cabal-install/Distribution/Client/CmdRepl.hs +++ b/cabal-install/Distribution/Client/CmdRepl.hs @@ -23,6 +23,8 @@ import Distribution.Client.Compat.Prelude import Distribution.Compat.Lens import qualified Distribution.Types.Lens as L +import Distribution.Client.NixStyleOptions + ( NixStyleFlags, nixStyleOptions, defaultNixStyleFlags ) import Distribution.Client.CmdErrorMessages import qualified Distribution.Client.InstallPlan as InstallPlan import Distribution.Client.ProjectBuilding @@ -45,7 +47,7 @@ import Distribution.Simple.Setup , fromFlagOrDefault, replOptions , Flag(..), toFlag, trueArg, falseArg ) import Distribution.Simple.Command - ( CommandUI(..), liftOption, usageAlternatives, option + ( CommandUI(..), liftOptionL, usageAlternatives, option , ShowOrParseArgs, OptionField, reqArg ) import Distribution.Compiler ( CompilerFlavor(GHC) ) @@ -144,10 +146,7 @@ envOptions _ = ("couldn't parse dependencies: " ++) (parsecCommaList parsec) -replCommand :: CommandUI ( ConfigFlags, ConfigExFlags, InstallFlags - , HaddockFlags, TestFlags, BenchmarkFlags - , ReplFlags, EnvFlags - ) +replCommand :: CommandUI (NixStyleFlags (ReplFlags, EnvFlags)) replCommand = Client.installCommand { commandName = "v2-repl", commandSynopsis = "Open an interactive session for the given component.", @@ -185,31 +184,11 @@ replCommand = Client.installCommand { ++ "to the default component (or no component if there is no project present)\n" ++ cmdCommonHelpTextNewBuildBeta, - commandDefaultFlags = ( configFlags, configExFlags, installFlags - , haddockFlags, testFlags, benchmarkFlags - , [], defaultEnvFlags - ), - commandOptions = \showOrParseArgs -> - map liftOriginal (commandOptions Client.installCommand showOrParseArgs) - ++ map liftReplOpts (replOptions showOrParseArgs) - ++ map liftEnvOpts (envOptions showOrParseArgs) - } - where - (configFlags,configExFlags,installFlags,haddockFlags,testFlags,benchmarkFlags) - = commandDefaultFlags Client.installCommand - - liftOriginal = liftOption projectOriginal updateOriginal - liftReplOpts = liftOption projectReplOpts updateReplOpts - liftEnvOpts = liftOption projectEnvOpts updateEnvOpts - - projectOriginal (a,b,c,d,e,f,_,_) = (a,b,c,d,e,f) - updateOriginal (a,b,c,d,e,f) (_,_,_,_,_,_,g,h) = (a,b,c,d,e,f,g,h) - - projectReplOpts (_,_,_,_,_,_,g,_) = g - updateReplOpts g (a,b,c,d,e,f,_,h) = (a,b,c,d,e,f,g,h) - - projectEnvOpts (_,_,_,_,_,_,_,h) = h - updateEnvOpts h (a,b,c,d,e,f,g,_) = (a,b,c,d,e,f,g,h) + commandDefaultFlags = defaultNixStyleFlags ([], defaultEnvFlags), + commandOptions = nixStyleOptions $ \showOrParseArgs -> + map (liftOptionL _1) (replOptions showOrParseArgs) ++ + map (liftOptionL _2) (envOptions showOrParseArgs) + } -- | The @repl@ command is very much like @build@. It brings the install plan -- up to date, selects that part of the plan needed by the given or implicit @@ -224,11 +203,11 @@ replCommand = Client.installCommand { -- replAction :: ( ConfigFlags, ConfigExFlags, InstallFlags , HaddockFlags, TestFlags, BenchmarkFlags - , ReplFlags, EnvFlags ) + , (ReplFlags, EnvFlags) ) -> [String] -> GlobalFlags -> IO () replAction ( configFlags, configExFlags, installFlags , haddockFlags, testFlags, benchmarkFlags - , replFlags, envFlags ) + , (replFlags, envFlags) ) targetStrings globalFlags = do let ignoreProject = fromFlagOrDefault False (envIgnoreProject envFlags) diff --git a/cabal-install/Distribution/Client/CmdRun.hs b/cabal-install/Distribution/Client/CmdRun.hs index 09ece44ae4c..904fadf51d4 100644 --- a/cabal-install/Distribution/Client/CmdRun.hs +++ b/cabal-install/Distribution/Client/CmdRun.hs @@ -25,18 +25,16 @@ import Distribution.Client.CmdErrorMessages import Distribution.Client.CmdRun.ClientRunFlags +import Distribution.Client.NixStyleOptions + ( NixStyleFlags, nixStyleOptions, defaultNixStyleFlags ) import Distribution.Client.Setup - ( GlobalFlags(..), ConfigFlags(..), ConfigExFlags, InstallFlags(..) - , configureExOptions, haddockOptions, installOptions, testOptions - , benchmarkOptions, configureOptions, liftOptions ) -import Distribution.Solver.Types.ConstraintSource - ( ConstraintSource(..) ) + ( GlobalFlags(..), ConfigFlags(..), ConfigExFlags, InstallFlags(..) ) import Distribution.Client.GlobalFlags ( defaultGlobalFlags ) import Distribution.Simple.Setup ( HaddockFlags, TestFlags, BenchmarkFlags, fromFlagOrDefault ) import Distribution.Simple.Command - ( CommandUI(..), OptionField (..), usageAlternatives ) + ( CommandUI(..), usageAlternatives ) import Distribution.Types.ComponentName ( showComponentName ) import Distribution.Deprecated.Text @@ -109,10 +107,7 @@ import System.FilePath ( (), isValid, isPathSeparator, takeExtension ) -runCommand :: CommandUI ( ConfigFlags, ConfigExFlags, InstallFlags - , HaddockFlags, TestFlags, BenchmarkFlags - , ClientRunFlags - ) +runCommand :: CommandUI (NixStyleFlags ClientRunFlags) runCommand = CommandUI { commandName = "v2-run" , commandSynopsis = "Run an executable." @@ -148,37 +143,9 @@ runCommand = CommandUI ++ " Build with '-O2' and run the program, passing it extra arguments.\n\n" ++ cmdCommonHelpTextNewBuildBeta - , commandDefaultFlags = (mempty, mempty, mempty, mempty, mempty, mempty, mempty) - , commandOptions = \showOrParseArgs -> - liftOptions get1 set1 - -- Note: [Hidden Flags] - -- hide "constraint", "dependency", and - -- "exact-configuration" from the configure options. - (filter ((`notElem` ["constraint", "dependency" - , "exact-configuration"]) - . optionName) $ - configureOptions showOrParseArgs) - ++ liftOptions get2 set2 (configureExOptions showOrParseArgs ConstraintSourceCommandlineFlag) - ++ liftOptions get3 set3 - -- hide "target-package-db" flag from the - -- install options. - (filter ((`notElem` ["target-package-db"]) - . optionName) $ - installOptions showOrParseArgs) - ++ liftOptions get4 set4 (haddockOptions showOrParseArgs) - ++ liftOptions get5 set5 (testOptions showOrParseArgs) - ++ liftOptions get6 set6 (benchmarkOptions showOrParseArgs) - ++ liftOptions get7 set7 (clientRunOptions showOrParseArgs) + , commandDefaultFlags = defaultNixStyleFlags mempty + , commandOptions = nixStyleOptions clientRunOptions } - where - get1 (a,_,_,_,_,_,_) = a; set1 a (_,b,c,d,e,f,g) = (a,b,c,d,e,f,g) - get2 (_,b,_,_,_,_,_) = b; set2 b (a,_,c,d,e,f,g) = (a,b,c,d,e,f,g) - get3 (_,_,c,_,_,_,_) = c; set3 c (a,b,_,d,e,f,g) = (a,b,c,d,e,f,g) - get4 (_,_,_,d,_,_,_) = d; set4 d (a,b,c,_,e,f,g) = (a,b,c,d,e,f,g) - get5 (_,_,_,_,e,_,_) = e; set5 e (a,b,c,d,_,f,g) = (a,b,c,d,e,f,g) - get6 (_,_,_,_,_,f,_) = f; set6 f (a,b,c,d,e,_,g) = (a,b,c,d,e,f,g) - get7 (_,_,_,_,_,_,g) = g; set7 g (a,b,c,d,e,f,_) = (a,b,c,d,e,f,g) - -- | The @run@ command runs a specified executable-like component, building it -- first if necessary. The component can be either an executable, a test, diff --git a/cabal-install/Distribution/Client/NixStyleOptions.hs b/cabal-install/Distribution/Client/NixStyleOptions.hs new file mode 100644 index 00000000000..8fb43d84e87 --- /dev/null +++ b/cabal-install/Distribution/Client/NixStyleOptions.hs @@ -0,0 +1,63 @@ +-- | Command line options for nix-style / v2 commands. +-- +-- The commands take a lot of the same options, which affect how install plan +-- is constructed. +module Distribution.Client.NixStyleOptions ( + NixStyleFlags, nixStyleOptions, defaultNixStyleFlags, +) where + +import Distribution.Client.Compat.Prelude +import Prelude () + +import Distribution.Simple.Command (OptionField (..), ShowOrParseArgs) +import Distribution.Simple.Setup (BenchmarkFlags, HaddockFlags, TestFlags) +import Distribution.Solver.Types.ConstraintSource (ConstraintSource (..)) + +import Distribution.Client.Setup + (ConfigExFlags, ConfigFlags (..), InstallFlags (..), benchmarkOptions, configureExOptions, + configureOptions, haddockOptions, installOptions, liftOptions, testOptions) + +-- TODO: turn into data record +-- Then we could use RecordWildCards in command implementation. +type NixStyleFlags a = (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags, BenchmarkFlags, a) + +nixStyleOptions + :: (ShowOrParseArgs -> [OptionField a]) + -> ShowOrParseArgs -> [OptionField (NixStyleFlags a)] +nixStyleOptions commandOptions showOrParseArgs = + liftOptions get1 set1 + -- Note: [Hidden Flags] + -- hide "constraint", "dependency", and + -- "exact-configuration" from the configure options. + (filter ((`notElem` ["constraint", "dependency" + , "exact-configuration"]) + . optionName) $ configureOptions showOrParseArgs) + ++ liftOptions get2 set2 (configureExOptions showOrParseArgs + ConstraintSourceCommandlineFlag) + ++ liftOptions get3 set3 + -- hide "target-package-db" and "symlink-bindir" flags from the + -- install options. + -- "symlink-bindir" is obsoleted by "installdir" in ClientInstallFlags + (filter ((`notElem` ["target-package-db", "symlink-bindir"]) + . optionName) $ + installOptions showOrParseArgs) + ++ liftOptions get4 set4 + -- hide "verbose" and "builddir" flags from the + -- haddock options. + (filter ((`notElem` ["v", "verbose", "builddir"]) + . optionName) $ + haddockOptions showOrParseArgs) + ++ liftOptions get5 set5 (testOptions showOrParseArgs) + ++ liftOptions get6 set6 (benchmarkOptions showOrParseArgs) + ++ liftOptions get7 set7 (commandOptions showOrParseArgs) + where + get1 (a,_,_,_,_,_,_) = a; set1 a (_,b,c,d,e,f,g) = (a,b,c,d,e,f,g) + get2 (_,b,_,_,_,_,_) = b; set2 b (a,_,c,d,e,f,g) = (a,b,c,d,e,f,g) + get3 (_,_,c,_,_,_,_) = c; set3 c (a,b,_,d,e,f,g) = (a,b,c,d,e,f,g) + get4 (_,_,_,d,_,_,_) = d; set4 d (a,b,c,_,e,f,g) = (a,b,c,d,e,f,g) + get5 (_,_,_,_,e,_,_) = e; set5 e (a,b,c,d,_,f,g) = (a,b,c,d,e,f,g) + get6 (_,_,_,_,_,f,_) = f; set6 f (a,b,c,d,e,_,g) = (a,b,c,d,e,f,g) + get7 (_,_,_,_,_,_,g) = g; set7 g (a,b,c,d,e,f,_) = (a,b,c,d,e,f,g) + +defaultNixStyleFlags :: a -> NixStyleFlags a +defaultNixStyleFlags x = ( mempty, mempty, mempty, mempty, mempty, mempty, x ) diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index 27241f5d6d6..ccf415a81a2 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -220,6 +220,7 @@ executable cabal Distribution.Client.Manpage Distribution.Client.ManpageFlags Distribution.Client.Nix + Distribution.Client.NixStyleOptions Distribution.Client.Outdated Distribution.Client.PackageHash Distribution.Client.PackageUtils diff --git a/cabal-install/cabal-install.cabal.pp b/cabal-install/cabal-install.cabal.pp index 9ee0e34ec0f..8996c5c3f5a 100644 --- a/cabal-install/cabal-install.cabal.pp +++ b/cabal-install/cabal-install.cabal.pp @@ -159,6 +159,7 @@ Distribution.Client.Manpage Distribution.Client.ManpageFlags Distribution.Client.Nix + Distribution.Client.NixStyleOptions Distribution.Client.Outdated Distribution.Client.PackageHash Distribution.Client.PackageUtils