diff --git a/cabal-install/Distribution/Client/CmdBench.hs b/cabal-install/Distribution/Client/CmdBench.hs index 83d7db3124fb384564fe932c496df9906f312741..d99e91a7574e7e9580149bbd76a9a5c292ed31c1 100644 --- a/cabal-install/Distribution/Client/CmdBench.hs +++ b/cabal-install/Distribution/Client/CmdBench.hs @@ -1,4 +1,5 @@ {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE ViewPatterns #-} -- | cabal-install CLI command: bench -- @@ -17,7 +18,8 @@ import Distribution.Client.ProjectOrchestration import Distribution.Client.CmdErrorMessages import Distribution.Client.Setup - ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags ) + ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags + , applyFlagDefaults ) import qualified Distribution.Client.Setup as Client import Distribution.Simple.Setup ( HaddockFlags, fromFlagOrDefault ) @@ -75,7 +77,7 @@ benchCommand = Client.installCommand { -- benchAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) -> [String] -> GlobalFlags -> IO () -benchAction (configFlags, configExFlags, installFlags, haddockFlags) +benchAction (applyFlagDefaults -> (configFlags, configExFlags, installFlags, haddockFlags)) targetStrings globalFlags = do baseCtx <- establishProjectBaseContext verbosity cliConfig diff --git a/cabal-install/Distribution/Client/CmdBuild.hs b/cabal-install/Distribution/Client/CmdBuild.hs index dcc5c41da7be7bc99cc8a0b1d1b639aafc8caace..484f1d73caeb25fbe1086d2f77694d6d5741dfc1 100644 --- a/cabal-install/Distribution/Client/CmdBuild.hs +++ b/cabal-install/Distribution/Client/CmdBuild.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE ViewPatterns #-} + -- | cabal-install CLI command: build -- module Distribution.Client.CmdBuild ( @@ -15,7 +17,8 @@ import Distribution.Client.ProjectOrchestration import Distribution.Client.CmdErrorMessages import Distribution.Client.Setup - ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags ) + ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags + , applyFlagDefaults ) import qualified Distribution.Client.Setup as Client import Distribution.Simple.Setup ( HaddockFlags, fromFlagOrDefault ) @@ -72,7 +75,7 @@ buildCommand = Client.installCommand { -- buildAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) -> [String] -> GlobalFlags -> IO () -buildAction (configFlags, configExFlags, installFlags, haddockFlags) +buildAction (applyFlagDefaults -> (configFlags, configExFlags, installFlags, haddockFlags)) targetStrings globalFlags = do baseCtx <- establishProjectBaseContext verbosity cliConfig diff --git a/cabal-install/Distribution/Client/CmdConfigure.hs b/cabal-install/Distribution/Client/CmdConfigure.hs index 726390b50f92efefbb31ada4da30c8d4d7b823d3..a1895e583c7585eefc75f48d6e46b9a8841f3270 100644 --- a/cabal-install/Distribution/Client/CmdConfigure.hs +++ b/cabal-install/Distribution/Client/CmdConfigure.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ViewPatterns #-} -- | cabal-install CLI command: configure -- module Distribution.Client.CmdConfigure ( @@ -10,7 +11,8 @@ import Distribution.Client.ProjectConfig ( writeProjectLocalExtraConfig ) import Distribution.Client.Setup - ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags ) + ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags + , applyFlagDefaults ) import Distribution.Simple.Setup ( HaddockFlags, fromFlagOrDefault ) import Distribution.Verbosity @@ -76,7 +78,7 @@ configureCommand = Client.installCommand { -- configureAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) -> [String] -> GlobalFlags -> IO () -configureAction (configFlags, configExFlags, installFlags, haddockFlags) +configureAction (applyFlagDefaults -> (configFlags, configExFlags, installFlags, haddockFlags)) _extraArgs globalFlags = do --TODO: deal with _extraArgs, since flags with wrong syntax end up there diff --git a/cabal-install/Distribution/Client/CmdFreeze.hs b/cabal-install/Distribution/Client/CmdFreeze.hs index 429f8e75875ff96ee73a72ca43eab7e12cad97f3..29c1f7800876b7e74dc1307ee243fe354ed72201 100644 --- a/cabal-install/Distribution/Client/CmdFreeze.hs +++ b/cabal-install/Distribution/Client/CmdFreeze.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, NamedFieldPuns, RecordWildCards #-} +{-# LANGUAGE CPP, NamedFieldPuns, RecordWildCards, ViewPatterns #-} -- | cabal-install CLI command: freeze -- @@ -31,7 +31,8 @@ import Distribution.Version import Distribution.PackageDescription ( FlagAssignment ) import Distribution.Client.Setup - ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags ) + ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags + , applyFlagDefaults ) import Distribution.Simple.Setup ( HaddockFlags, fromFlagOrDefault ) import Distribution.Simple.Utils @@ -103,7 +104,7 @@ freezeCommand = Client.installCommand { -- freezeAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) -> [String] -> GlobalFlags -> IO () -freezeAction (configFlags, configExFlags, installFlags, haddockFlags) +freezeAction (applyFlagDefaults -> (configFlags, configExFlags, installFlags, haddockFlags)) extraArgs globalFlags = do unless (null extraArgs) $ diff --git a/cabal-install/Distribution/Client/CmdHaddock.hs b/cabal-install/Distribution/Client/CmdHaddock.hs index 0ea3c53549fb1b8377dcced3ed148e69fba1147d..dad01e887485db38139326768fedf78e5343af9c 100644 --- a/cabal-install/Distribution/Client/CmdHaddock.hs +++ b/cabal-install/Distribution/Client/CmdHaddock.hs @@ -1,4 +1,5 @@ {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE ViewPatterns #-} -- | cabal-install CLI command: haddock -- @@ -17,7 +18,8 @@ import Distribution.Client.ProjectOrchestration import Distribution.Client.CmdErrorMessages import Distribution.Client.Setup - ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags ) + ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags + , applyFlagDefaults ) import qualified Distribution.Client.Setup as Client import Distribution.Simple.Setup ( HaddockFlags(..), fromFlagOrDefault, fromFlag ) @@ -71,7 +73,7 @@ haddockCommand = Client.installCommand { -- haddockAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) -> [String] -> GlobalFlags -> IO () -haddockAction (configFlags, configExFlags, installFlags, haddockFlags) +haddockAction (applyFlagDefaults -> (configFlags, configExFlags, installFlags, haddockFlags)) targetStrings globalFlags = do baseCtx <- establishProjectBaseContext verbosity cliConfig diff --git a/cabal-install/Distribution/Client/CmdRepl.hs b/cabal-install/Distribution/Client/CmdRepl.hs index 5f4f104ebb24a7ca2343a80e9367b0b7cb1e8378..f1c70478125f9639e67410400d1e78a6f5fbf8c7 100644 --- a/cabal-install/Distribution/Client/CmdRepl.hs +++ b/cabal-install/Distribution/Client/CmdRepl.hs @@ -1,4 +1,5 @@ {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE ViewPatterns #-} -- | cabal-install CLI command: repl -- @@ -17,7 +18,8 @@ import Distribution.Client.ProjectOrchestration import Distribution.Client.CmdErrorMessages import Distribution.Client.Setup - ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags ) + ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags + , applyFlagDefaults ) import qualified Distribution.Client.Setup as Client import Distribution.Simple.Setup ( HaddockFlags, fromFlagOrDefault ) @@ -87,7 +89,7 @@ replCommand = Client.installCommand { -- replAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) -> [String] -> GlobalFlags -> IO () -replAction (configFlags, configExFlags, installFlags, haddockFlags) +replAction (applyFlagDefaults -> (configFlags, configExFlags, installFlags, haddockFlags)) targetStrings globalFlags = do baseCtx <- establishProjectBaseContext verbosity cliConfig diff --git a/cabal-install/Distribution/Client/CmdRun.hs b/cabal-install/Distribution/Client/CmdRun.hs index 15ace6411bc1336b272123d9021be933af0598b0..d34c909ff5e4293a9709c0335c7e72083f09b2d8 100644 --- a/cabal-install/Distribution/Client/CmdRun.hs +++ b/cabal-install/Distribution/Client/CmdRun.hs @@ -1,4 +1,5 @@ {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE ViewPatterns #-} -- | cabal-install CLI command: run -- @@ -17,7 +18,8 @@ import Distribution.Client.ProjectOrchestration import Distribution.Client.CmdErrorMessages import Distribution.Client.Setup - ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags ) + ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags + , applyFlagDefaults ) import qualified Distribution.Client.Setup as Client import Distribution.Simple.Setup ( HaddockFlags, fromFlagOrDefault ) @@ -84,7 +86,7 @@ runCommand = Client.installCommand { -- runAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) -> [String] -> GlobalFlags -> IO () -runAction (configFlags, configExFlags, installFlags, haddockFlags) +runAction (applyFlagDefaults -> (configFlags, configExFlags, installFlags, haddockFlags)) targetStrings globalFlags = do baseCtx <- establishProjectBaseContext verbosity cliConfig diff --git a/cabal-install/Distribution/Client/CmdTest.hs b/cabal-install/Distribution/Client/CmdTest.hs index 5f6f489199d2ee65cff38d550cb9ff28ed2ac2cf..c4e51ff7ef489c12935fa0a9600e71cd27065f2d 100644 --- a/cabal-install/Distribution/Client/CmdTest.hs +++ b/cabal-install/Distribution/Client/CmdTest.hs @@ -1,4 +1,5 @@ {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE ViewPatterns #-} -- | cabal-install CLI command: test -- @@ -17,7 +18,8 @@ import Distribution.Client.ProjectOrchestration import Distribution.Client.CmdErrorMessages import Distribution.Client.Setup - ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags ) + ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags + , applyFlagDefaults ) import qualified Distribution.Client.Setup as Client import Distribution.Simple.Setup ( HaddockFlags, fromFlagOrDefault ) @@ -78,7 +80,7 @@ testCommand = Client.installCommand { -- testAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) -> [String] -> GlobalFlags -> IO () -testAction (configFlags, configExFlags, installFlags, haddockFlags) +testAction (applyFlagDefaults -> (configFlags, configExFlags, installFlags, haddockFlags)) targetStrings globalFlags = do baseCtx <- establishProjectBaseContext verbosity cliConfig diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs index f2d1e0312104e08adb99b53e22f58a1899c032da..202c99094b01031d0a2483ac34b4955f2618ffe0 100644 --- a/cabal-install/Distribution/Client/Setup.hs +++ b/cabal-install/Distribution/Client/Setup.hs @@ -49,6 +49,7 @@ module Distribution.Client.Setup , userConfigCommand, UserConfigFlags(..) , manpageCommand + , applyFlagDefaults , parsePackageArgs --TODO: stop exporting these: , showRepo @@ -128,6 +129,15 @@ import System.FilePath import Network.URI ( parseAbsoluteURI, uriToString ) +applyFlagDefaults :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) + -> (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) +applyFlagDefaults (configFlags, configExFlags, installFlags, haddockFlags) = + ( commandDefaultFlags configureCommand <> configFlags + , defaultConfigExFlags <> configExFlags + , defaultInstallFlags <> installFlags + , Cabal.defaultHaddockFlags <> haddockFlags + ) + globalCommand :: [Command action] -> CommandUI GlobalFlags globalCommand commands = CommandUI { commandName = "", @@ -1023,10 +1033,7 @@ upgradeCommand = configureCommand { commandSynopsis = "(command disabled, use install instead)", commandDescription = Nothing, commandUsage = usageFlagsOrPackages "upgrade", - commandDefaultFlags = (commandDefaultFlags configureCommand, - defaultConfigExFlags, - defaultInstallFlags, - Cabal.defaultHaddockFlags), + commandDefaultFlags = (mempty, mempty, mempty, mempty), commandOptions = commandOptions installCommand } @@ -1533,10 +1540,7 @@ installCommand = CommandUI { ++ " " ++ (map (const ' ') pname) ++ " " ++ " Change installation destination\n", - commandDefaultFlags = (commandDefaultFlags configureCommand, - defaultConfigExFlags, - defaultInstallFlags, - Cabal.defaultHaddockFlags), + commandDefaultFlags = (mempty, mempty, mempty, mempty), commandOptions = \showOrParseArgs -> liftOptions get1 set1 (filter ((`notElem` ["constraint", "dependency"