Commit 5a31fda3 authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel 🕺

Revert "Introduce applyFlagsDefault and use ViewPatterns"

See #4737

This reverts commit 71131cf4.
parent 45b7334c
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ViewPatterns #-}
-- | cabal-install CLI command: bench
--
......@@ -18,8 +17,7 @@ import Distribution.Client.ProjectOrchestration
import Distribution.Client.CmdErrorMessages
import Distribution.Client.Setup
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags
, applyFlagDefaults )
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags )
import qualified Distribution.Client.Setup as Client
import Distribution.Simple.Setup
( HaddockFlags, fromFlagOrDefault )
......@@ -77,7 +75,7 @@ benchCommand = Client.installCommand {
--
benchAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
-> [String] -> GlobalFlags -> IO ()
benchAction (applyFlagDefaults -> (configFlags, configExFlags, installFlags, haddockFlags))
benchAction (configFlags, configExFlags, installFlags, haddockFlags)
targetStrings globalFlags = do
baseCtx <- establishProjectBaseContext verbosity cliConfig
......
{-# LANGUAGE ViewPatterns #-}
-- | cabal-install CLI command: build
--
module Distribution.Client.CmdBuild (
......@@ -17,8 +15,7 @@ import Distribution.Client.ProjectOrchestration
import Distribution.Client.CmdErrorMessages
import Distribution.Client.Setup
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags
, applyFlagDefaults )
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags )
import qualified Distribution.Client.Setup as Client
import Distribution.Simple.Setup
( HaddockFlags, fromFlagOrDefault )
......@@ -75,7 +72,7 @@ buildCommand = Client.installCommand {
--
buildAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
-> [String] -> GlobalFlags -> IO ()
buildAction (applyFlagDefaults -> (configFlags, configExFlags, installFlags, haddockFlags))
buildAction (configFlags, configExFlags, installFlags, haddockFlags)
targetStrings globalFlags = do
baseCtx <- establishProjectBaseContext verbosity cliConfig
......
{-# LANGUAGE ViewPatterns #-}
-- | cabal-install CLI command: configure
--
module Distribution.Client.CmdConfigure (
......@@ -15,8 +14,7 @@ import Distribution.Client.ProjectConfig
( writeProjectLocalExtraConfig )
import Distribution.Client.Setup
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags
, applyFlagDefaults )
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags )
import Distribution.Simple.Setup
( HaddockFlags, fromFlagOrDefault )
import Distribution.Verbosity
......@@ -82,7 +80,7 @@ configureCommand = Client.installCommand {
--
configureAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
-> [String] -> GlobalFlags -> IO ()
configureAction (applyFlagDefaults -> (configFlags, configExFlags, installFlags, haddockFlags))
configureAction (configFlags, configExFlags, installFlags, haddockFlags)
_extraArgs globalFlags = do
--TODO: deal with _extraArgs, since flags with wrong syntax end up there
......
{-# LANGUAGE CPP, NamedFieldPuns, RecordWildCards, ViewPatterns #-}
{-# LANGUAGE CPP, NamedFieldPuns, RecordWildCards #-}
-- | cabal-install CLI command: freeze
--
......@@ -31,8 +31,7 @@ import Distribution.Version
import Distribution.PackageDescription
( FlagAssignment, nullFlagAssignment )
import Distribution.Client.Setup
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags
, applyFlagDefaults )
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags )
import Distribution.Simple.Setup
( HaddockFlags, fromFlagOrDefault )
import Distribution.Simple.Utils
......@@ -102,7 +101,7 @@ freezeCommand = Client.installCommand {
--
freezeAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
-> [String] -> GlobalFlags -> IO ()
freezeAction (applyFlagDefaults -> (configFlags, configExFlags, installFlags, haddockFlags))
freezeAction (configFlags, configExFlags, installFlags, haddockFlags)
extraArgs globalFlags = do
unless (null extraArgs) $
......
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ViewPatterns #-}
-- | cabal-install CLI command: haddock
--
......@@ -18,8 +17,7 @@ import Distribution.Client.ProjectOrchestration
import Distribution.Client.CmdErrorMessages
import Distribution.Client.Setup
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags
, applyFlagDefaults )
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags )
import qualified Distribution.Client.Setup as Client
import Distribution.Simple.Setup
( HaddockFlags(..), fromFlagOrDefault, fromFlag )
......@@ -73,7 +71,7 @@ haddockCommand = Client.installCommand {
--
haddockAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
-> [String] -> GlobalFlags -> IO ()
haddockAction (applyFlagDefaults -> (configFlags, configExFlags, installFlags, haddockFlags))
haddockAction (configFlags, configExFlags, installFlags, haddockFlags)
targetStrings globalFlags = do
baseCtx <- establishProjectBaseContext verbosity cliConfig
......
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ViewPatterns #-}
-- | cabal-install CLI command: repl
--
......@@ -18,8 +17,7 @@ import Distribution.Client.ProjectOrchestration
import Distribution.Client.CmdErrorMessages
import Distribution.Client.Setup
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags
, applyFlagDefaults )
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags )
import qualified Distribution.Client.Setup as Client
import Distribution.Simple.Setup
( HaddockFlags, fromFlagOrDefault )
......@@ -89,7 +87,7 @@ replCommand = Client.installCommand {
--
replAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
-> [String] -> GlobalFlags -> IO ()
replAction (applyFlagDefaults -> (configFlags, configExFlags, installFlags, haddockFlags))
replAction (configFlags, configExFlags, installFlags, haddockFlags)
targetStrings globalFlags = do
baseCtx <- establishProjectBaseContext verbosity cliConfig
......
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ViewPatterns #-}
-- | cabal-install CLI command: run
--
......@@ -21,8 +20,7 @@ import Distribution.Client.ProjectOrchestration
import Distribution.Client.CmdErrorMessages
import Distribution.Client.Setup
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags
, applyFlagDefaults )
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags )
import qualified Distribution.Client.Setup as Client
import Distribution.Simple.Setup
( HaddockFlags, fromFlagOrDefault )
......@@ -110,7 +108,7 @@ runCommand = Client.installCommand {
--
runAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
-> [String] -> GlobalFlags -> IO ()
runAction (applyFlagDefaults -> (configFlags, configExFlags, installFlags, haddockFlags))
runAction (configFlags, configExFlags, installFlags, haddockFlags)
targetStrings globalFlags = do
baseCtx <- establishProjectBaseContext verbosity cliConfig
......
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ViewPatterns #-}
-- | cabal-install CLI command: test
--
......@@ -18,8 +17,7 @@ import Distribution.Client.ProjectOrchestration
import Distribution.Client.CmdErrorMessages
import Distribution.Client.Setup
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags
, applyFlagDefaults )
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags )
import qualified Distribution.Client.Setup as Client
import Distribution.Simple.Setup
( HaddockFlags, fromFlagOrDefault )
......@@ -80,7 +78,7 @@ testCommand = Client.installCommand {
--
testAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
-> [String] -> GlobalFlags -> IO ()
testAction (applyFlagDefaults -> (configFlags, configExFlags, installFlags, haddockFlags))
testAction (configFlags, configExFlags, installFlags, haddockFlags)
targetStrings globalFlags = do
baseCtx <- establishProjectBaseContext verbosity cliConfig
......
......@@ -49,7 +49,6 @@ module Distribution.Client.Setup
, userConfigCommand, UserConfigFlags(..)
, manpageCommand
, applyFlagDefaults
, parsePackageArgs
--TODO: stop exporting these:
, showRepo
......@@ -131,15 +130,6 @@ 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 = "",
......@@ -1118,7 +1108,10 @@ upgradeCommand = configureCommand {
commandSynopsis = "(command disabled, use install instead)",
commandDescription = Nothing,
commandUsage = usageFlagsOrPackages "upgrade",
commandDefaultFlags = (mempty, mempty, mempty, mempty),
commandDefaultFlags = (commandDefaultFlags configureCommand,
defaultConfigExFlags,
defaultInstallFlags,
Cabal.defaultHaddockFlags),
commandOptions = commandOptions installCommand
}
......@@ -1627,7 +1620,10 @@ installCommand = CommandUI {
++ " " ++ (map (const ' ') pname)
++ " "
++ " Change installation destination\n",
commandDefaultFlags = (mempty, mempty, mempty, mempty),
commandDefaultFlags = (commandDefaultFlags configureCommand,
defaultConfigExFlags,
defaultInstallFlags,
Cabal.defaultHaddockFlags),
commandOptions = \showOrParseArgs ->
liftOptions get1 set1
-- Note: [Hidden Flags]
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment