Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
10
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Open sidebar
Glasgow Haskell Compiler
Packages
Cabal
Commits
5a31fda3
Commit
5a31fda3
authored
Nov 05, 2017
by
Herbert Valerio Riedel
🕺
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Revert "Introduce applyFlagsDefault and use ViewPatterns"
See #4737 This reverts commit
71131cf4
.
parent
45b7334c
Changes
9
Hide whitespace changes
Inline
Side-by-side
Showing
9 changed files
with
25 additions
and
45 deletions
+25
-45
cabal-install/Distribution/Client/CmdBench.hs
cabal-install/Distribution/Client/CmdBench.hs
+2
-4
cabal-install/Distribution/Client/CmdBuild.hs
cabal-install/Distribution/Client/CmdBuild.hs
+2
-5
cabal-install/Distribution/Client/CmdConfigure.hs
cabal-install/Distribution/Client/CmdConfigure.hs
+2
-4
cabal-install/Distribution/Client/CmdFreeze.hs
cabal-install/Distribution/Client/CmdFreeze.hs
+3
-4
cabal-install/Distribution/Client/CmdHaddock.hs
cabal-install/Distribution/Client/CmdHaddock.hs
+2
-4
cabal-install/Distribution/Client/CmdRepl.hs
cabal-install/Distribution/Client/CmdRepl.hs
+2
-4
cabal-install/Distribution/Client/CmdRun.hs
cabal-install/Distribution/Client/CmdRun.hs
+2
-4
cabal-install/Distribution/Client/CmdTest.hs
cabal-install/Distribution/Client/CmdTest.hs
+2
-4
cabal-install/Distribution/Client/Setup.hs
cabal-install/Distribution/Client/Setup.hs
+8
-12
No files found.
cabal-install/Distribution/Client/CmdBench.hs
View file @
5a31fda3
{-# 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
...
...
cabal-install/Distribution/Client/CmdBuild.hs
View file @
5a31fda3
{-# 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
...
...
cabal-install/Distribution/Client/CmdConfigure.hs
View file @
5a31fda3
{-# 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
...
...
cabal-install/Distribution/Client/CmdFreeze.hs
View file @
5a31fda3
{-# 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
)
$
...
...
cabal-install/Distribution/Client/CmdHaddock.hs
View file @
5a31fda3
{-# 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
...
...
cabal-install/Distribution/Client/CmdRepl.hs
View file @
5a31fda3
{-# 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
...
...
cabal-install/Distribution/Client/CmdRun.hs
View file @
5a31fda3
{-# 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
...
...
cabal-install/Distribution/Client/CmdTest.hs
View file @
5a31fda3
{-# 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
...
...
cabal-install/Distribution/Client/Setup.hs
View file @
5a31fda3
...
...
@@ -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]
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment