Skip to content

Commit 41a4ef1

Browse files
Alexander Biehl23Skidoo
Alexander Biehl
authored and
23Skidoo
committed
Introduce applyFlagsDefault and use ViewPatterns
(cherry picked from commit 71131cf)
1 parent 387d443 commit 41a4ef1

File tree

9 files changed

+45
-25
lines changed

9 files changed

+45
-25
lines changed

‎cabal-install/Distribution/Client/CmdBench.hs

+4-2
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# LANGUAGE NamedFieldPuns #-}
2+
{-# LANGUAGE ViewPatterns #-}
23

34
-- | cabal-install CLI command: bench
45
--
@@ -17,7 +18,8 @@ import Distribution.Client.ProjectOrchestration
1718
import Distribution.Client.CmdErrorMessages
1819

1920
import Distribution.Client.Setup
20-
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags )
21+
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags
22+
, applyFlagDefaults )
2123
import qualified Distribution.Client.Setup as Client
2224
import Distribution.Simple.Setup
2325
( HaddockFlags, fromFlagOrDefault )
@@ -75,7 +77,7 @@ benchCommand = Client.installCommand {
7577
--
7678
benchAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
7779
-> [String] -> GlobalFlags -> IO ()
78-
benchAction (configFlags, configExFlags, installFlags, haddockFlags)
80+
benchAction (applyFlagDefaults -> (configFlags, configExFlags, installFlags, haddockFlags))
7981
targetStrings globalFlags = do
8082

8183
baseCtx <- establishProjectBaseContext verbosity cliConfig

‎cabal-install/Distribution/Client/CmdBuild.hs

+5-2
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,5 @@
1+
{-# LANGUAGE ViewPatterns #-}
2+
13
-- | cabal-install CLI command: build
24
--
35
module Distribution.Client.CmdBuild (
@@ -15,7 +17,8 @@ import Distribution.Client.ProjectOrchestration
1517
import Distribution.Client.CmdErrorMessages
1618

1719
import Distribution.Client.Setup
18-
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags )
20+
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags
21+
, applyFlagDefaults )
1922
import qualified Distribution.Client.Setup as Client
2023
import Distribution.Simple.Setup
2124
( HaddockFlags, fromFlagOrDefault )
@@ -72,7 +75,7 @@ buildCommand = Client.installCommand {
7275
--
7376
buildAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
7477
-> [String] -> GlobalFlags -> IO ()
75-
buildAction (configFlags, configExFlags, installFlags, haddockFlags)
78+
buildAction (applyFlagDefaults -> (configFlags, configExFlags, installFlags, haddockFlags))
7679
targetStrings globalFlags = do
7780

7881
baseCtx <- establishProjectBaseContext verbosity cliConfig

‎cabal-install/Distribution/Client/CmdConfigure.hs

+4-2
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE ViewPatterns #-}
12
-- | cabal-install CLI command: configure
23
--
34
module Distribution.Client.CmdConfigure (
@@ -10,7 +11,8 @@ import Distribution.Client.ProjectConfig
1011
( writeProjectLocalExtraConfig )
1112

1213
import Distribution.Client.Setup
13-
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags )
14+
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags
15+
, applyFlagDefaults )
1416
import Distribution.Simple.Setup
1517
( HaddockFlags, fromFlagOrDefault )
1618
import Distribution.Verbosity
@@ -76,7 +78,7 @@ configureCommand = Client.installCommand {
7678
--
7779
configureAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
7880
-> [String] -> GlobalFlags -> IO ()
79-
configureAction (configFlags, configExFlags, installFlags, haddockFlags)
81+
configureAction (applyFlagDefaults -> (configFlags, configExFlags, installFlags, haddockFlags))
8082
_extraArgs globalFlags = do
8183
--TODO: deal with _extraArgs, since flags with wrong syntax end up there
8284

‎cabal-install/Distribution/Client/CmdFreeze.hs

+4-3
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
{-# LANGUAGE CPP, NamedFieldPuns, RecordWildCards #-}
1+
{-# LANGUAGE CPP, NamedFieldPuns, RecordWildCards, ViewPatterns #-}
22

33
-- | cabal-install CLI command: freeze
44
--
@@ -31,7 +31,8 @@ import Distribution.Version
3131
import Distribution.PackageDescription
3232
( FlagAssignment )
3333
import Distribution.Client.Setup
34-
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags )
34+
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags
35+
, applyFlagDefaults )
3536
import Distribution.Simple.Setup
3637
( HaddockFlags, fromFlagOrDefault )
3738
import Distribution.Simple.Utils
@@ -103,7 +104,7 @@ freezeCommand = Client.installCommand {
103104
--
104105
freezeAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
105106
-> [String] -> GlobalFlags -> IO ()
106-
freezeAction (configFlags, configExFlags, installFlags, haddockFlags)
107+
freezeAction (applyFlagDefaults -> (configFlags, configExFlags, installFlags, haddockFlags))
107108
extraArgs globalFlags = do
108109

109110
unless (null extraArgs) $

‎cabal-install/Distribution/Client/CmdHaddock.hs

+4-2
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# LANGUAGE NamedFieldPuns #-}
2+
{-# LANGUAGE ViewPatterns #-}
23

34
-- | cabal-install CLI command: haddock
45
--
@@ -17,7 +18,8 @@ import Distribution.Client.ProjectOrchestration
1718
import Distribution.Client.CmdErrorMessages
1819

1920
import Distribution.Client.Setup
20-
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags )
21+
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags
22+
, applyFlagDefaults )
2123
import qualified Distribution.Client.Setup as Client
2224
import Distribution.Simple.Setup
2325
( HaddockFlags(..), fromFlagOrDefault, fromFlag )
@@ -71,7 +73,7 @@ haddockCommand = Client.installCommand {
7173
--
7274
haddockAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
7375
-> [String] -> GlobalFlags -> IO ()
74-
haddockAction (configFlags, configExFlags, installFlags, haddockFlags)
76+
haddockAction (applyFlagDefaults -> (configFlags, configExFlags, installFlags, haddockFlags))
7577
targetStrings globalFlags = do
7678

7779
baseCtx <- establishProjectBaseContext verbosity cliConfig

‎cabal-install/Distribution/Client/CmdRepl.hs

+4-2
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# LANGUAGE NamedFieldPuns #-}
2+
{-# LANGUAGE ViewPatterns #-}
23

34
-- | cabal-install CLI command: repl
45
--
@@ -17,7 +18,8 @@ import Distribution.Client.ProjectOrchestration
1718
import Distribution.Client.CmdErrorMessages
1819

1920
import Distribution.Client.Setup
20-
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags )
21+
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags
22+
, applyFlagDefaults )
2123
import qualified Distribution.Client.Setup as Client
2224
import Distribution.Simple.Setup
2325
( HaddockFlags, fromFlagOrDefault )
@@ -87,7 +89,7 @@ replCommand = Client.installCommand {
8789
--
8890
replAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
8991
-> [String] -> GlobalFlags -> IO ()
90-
replAction (configFlags, configExFlags, installFlags, haddockFlags)
92+
replAction (applyFlagDefaults -> (configFlags, configExFlags, installFlags, haddockFlags))
9193
targetStrings globalFlags = do
9294

9395
baseCtx <- establishProjectBaseContext verbosity cliConfig

‎cabal-install/Distribution/Client/CmdRun.hs

+4-2
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# LANGUAGE NamedFieldPuns #-}
2+
{-# LANGUAGE ViewPatterns #-}
23

34
-- | cabal-install CLI command: run
45
--
@@ -17,7 +18,8 @@ import Distribution.Client.ProjectOrchestration
1718
import Distribution.Client.CmdErrorMessages
1819

1920
import Distribution.Client.Setup
20-
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags )
21+
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags
22+
, applyFlagDefaults )
2123
import qualified Distribution.Client.Setup as Client
2224
import Distribution.Simple.Setup
2325
( HaddockFlags, fromFlagOrDefault )
@@ -84,7 +86,7 @@ runCommand = Client.installCommand {
8486
--
8587
runAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
8688
-> [String] -> GlobalFlags -> IO ()
87-
runAction (configFlags, configExFlags, installFlags, haddockFlags)
89+
runAction (applyFlagDefaults -> (configFlags, configExFlags, installFlags, haddockFlags))
8890
targetStrings globalFlags = do
8991

9092
baseCtx <- establishProjectBaseContext verbosity cliConfig

‎cabal-install/Distribution/Client/CmdTest.hs

+4-2
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# LANGUAGE NamedFieldPuns #-}
2+
{-# LANGUAGE ViewPatterns #-}
23

34
-- | cabal-install CLI command: test
45
--
@@ -17,7 +18,8 @@ import Distribution.Client.ProjectOrchestration
1718
import Distribution.Client.CmdErrorMessages
1819

1920
import Distribution.Client.Setup
20-
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags )
21+
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags
22+
, applyFlagDefaults )
2123
import qualified Distribution.Client.Setup as Client
2224
import Distribution.Simple.Setup
2325
( HaddockFlags, fromFlagOrDefault )
@@ -78,7 +80,7 @@ testCommand = Client.installCommand {
7880
--
7981
testAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
8082
-> [String] -> GlobalFlags -> IO ()
81-
testAction (configFlags, configExFlags, installFlags, haddockFlags)
83+
testAction (applyFlagDefaults -> (configFlags, configExFlags, installFlags, haddockFlags))
8284
targetStrings globalFlags = do
8385

8486
baseCtx <- establishProjectBaseContext verbosity cliConfig

‎cabal-install/Distribution/Client/Setup.hs

+12-8
Original file line numberDiff line numberDiff line change
@@ -49,6 +49,7 @@ module Distribution.Client.Setup
4949
, userConfigCommand, UserConfigFlags(..)
5050
, manpageCommand
5151

52+
, applyFlagDefaults
5253
, parsePackageArgs
5354
--TODO: stop exporting these:
5455
, showRepo
@@ -128,6 +129,15 @@ import System.FilePath
128129
import Network.URI
129130
( parseAbsoluteURI, uriToString )
130131

132+
applyFlagDefaults :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
133+
-> (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
134+
applyFlagDefaults (configFlags, configExFlags, installFlags, haddockFlags) =
135+
( commandDefaultFlags configureCommand <> configFlags
136+
, defaultConfigExFlags <> configExFlags
137+
, defaultInstallFlags <> installFlags
138+
, Cabal.defaultHaddockFlags <> haddockFlags
139+
)
140+
131141
globalCommand :: [Command action] -> CommandUI GlobalFlags
132142
globalCommand commands = CommandUI {
133143
commandName = "",
@@ -1023,10 +1033,7 @@ upgradeCommand = configureCommand {
10231033
commandSynopsis = "(command disabled, use install instead)",
10241034
commandDescription = Nothing,
10251035
commandUsage = usageFlagsOrPackages "upgrade",
1026-
commandDefaultFlags = (commandDefaultFlags configureCommand,
1027-
defaultConfigExFlags,
1028-
defaultInstallFlags,
1029-
Cabal.defaultHaddockFlags),
1036+
commandDefaultFlags = (mempty, mempty, mempty, mempty),
10301037
commandOptions = commandOptions installCommand
10311038
}
10321039

@@ -1533,10 +1540,7 @@ installCommand = CommandUI {
15331540
++ " " ++ (map (const ' ') pname)
15341541
++ " "
15351542
++ " Change installation destination\n",
1536-
commandDefaultFlags = (commandDefaultFlags configureCommand,
1537-
defaultConfigExFlags,
1538-
defaultInstallFlags,
1539-
Cabal.defaultHaddockFlags),
1543+
commandDefaultFlags = (mempty, mempty, mempty, mempty),
15401544
commandOptions = \showOrParseArgs ->
15411545
liftOptions get1 set1
15421546
(filter ((`notElem` ["constraint", "dependency"

0 commit comments

Comments
 (0)