Revert "Introduce applyFlagsDefault and use ViewPatterns"

See haskell#4737 This reverts commit 71131cf.
hvr · Feb 8, 2018 · 5a31fda · 5a31fda
1 parent 45b7334
commit 5a31fda
Show file tree

Hide file tree

Showing 9 changed files with 25 additions and 45 deletions.
diff --git a/cabal-install/Distribution/Client/CmdBench.hs b/cabal-install/Distribution/Client/CmdBench.hs
@@ -1,5 +1,4 @@
 {-# 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

diff --git a/cabal-install/Distribution/Client/CmdBuild.hs b/cabal-install/Distribution/Client/CmdBuild.hs
@@ -1,5 +1,3 @@
-{-# 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

diff --git a/cabal-install/Distribution/Client/CmdConfigure.hs b/cabal-install/Distribution/Client/CmdConfigure.hs
@@ -1,4 +1,3 @@
-{-# 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
 

diff --git a/cabal-install/Distribution/Client/CmdFreeze.hs b/cabal-install/Distribution/Client/CmdFreeze.hs
@@ -1,4 +1,4 @@
-{-# 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) $

diff --git a/cabal-install/Distribution/Client/CmdHaddock.hs b/cabal-install/Distribution/Client/CmdHaddock.hs
@@ -1,5 +1,4 @@
 {-# 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

diff --git a/cabal-install/Distribution/Client/CmdRepl.hs b/cabal-install/Distribution/Client/CmdRepl.hs
@@ -1,5 +1,4 @@
 {-# 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

diff --git a/cabal-install/Distribution/Client/CmdRun.hs b/cabal-install/Distribution/Client/CmdRun.hs
@@ -1,5 +1,4 @@
 {-# 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

diff --git a/cabal-install/Distribution/Client/CmdTest.hs b/cabal-install/Distribution/Client/CmdTest.hs
@@ -1,5 +1,4 @@
 {-# 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

diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs
@@ -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]