Skip to content

Replace flag-defaulting hack by proper solution #4886

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 5 commits into from
Feb 12, 2018
Merged

Replace flag-defaulting hack by proper solution #4886

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
45b7334
Revert applyDefaults introduced via new-install & new-update
hvr Nov 12, 2017
5a31fda
Revert "Introduce applyFlagsDefault and use ViewPatterns"
hvr Nov 4, 2017
f72eb1d
Revert "Use default flags rather than mempty."
hvr Nov 4, 2017
f36a01d
CmdHaddock: use fromFlagOrDefault
Feb 12, 2018
28b0b9e
CmdHaddock: Suggested comment
Feb 12, 2018
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 2 additions & 4 deletions cabal-install/Distribution/Client/CmdBench.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,4 @@
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ViewPatterns #-}

-- | cabal-install CLI command: bench
--
Expand All @@ -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 )
Expand Down Expand Up @@ -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
Expand Down
7 changes: 2 additions & 5 deletions cabal-install/Distribution/Client/CmdBuild.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,3 @@
{-# LANGUAGE ViewPatterns #-}

-- | cabal-install CLI command: build
--
module Distribution.Client.CmdBuild (
Expand All @@ -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 )
Expand Down Expand Up @@ -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
Expand Down
6 changes: 2 additions & 4 deletions cabal-install/Distribution/Client/CmdConfigure.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,3 @@
{-# LANGUAGE ViewPatterns #-}
-- | cabal-install CLI command: configure
--
module Distribution.Client.CmdConfigure (
Expand All @@ -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
Expand Down Expand Up @@ -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

Expand Down
7 changes: 3 additions & 4 deletions cabal-install/Distribution/Client/CmdFreeze.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
{-# LANGUAGE CPP, NamedFieldPuns, RecordWildCards, ViewPatterns #-}
{-# LANGUAGE CPP, NamedFieldPuns, RecordWildCards #-}

-- | cabal-install CLI command: freeze
--
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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) $
Expand Down
23 changes: 14 additions & 9 deletions cabal-install/Distribution/Client/CmdHaddock.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,4 @@
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ViewPatterns #-}

-- | cabal-install CLI command: haddock
--
Expand All @@ -18,11 +17,10 @@ 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 )
( HaddockFlags(..), fromFlagOrDefault )
import Distribution.Simple.Command
( CommandUI(..), usageAlternatives )
import Distribution.Verbosity
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -153,10 +151,17 @@ selectPackageTargets haddockFlags targetSelector targets
isRequested (TargetAllPackages (Just _)) _ = True
isRequested _ LibKind = True
-- isRequested _ SubLibKind = True --TODO: what about sublibs?
isRequested _ FLibKind = fromFlag (haddockForeignLibs haddockFlags)
isRequested _ ExeKind = fromFlag (haddockExecutables haddockFlags)
isRequested _ TestKind = fromFlag (haddockTestSuites haddockFlags)
isRequested _ BenchKind = fromFlag (haddockBenchmarks haddockFlags)

-- TODO/HACK, we encode some defaults here as new-haddock's logic;
-- make sure this matches the defaults applied in
-- "Distribution.Client.ProjectPlanning"; this may need more work
-- to be done properly
--
-- See also https://github.com/haskell/cabal/pull/4886
isRequested _ FLibKind = fromFlagOrDefault False (haddockForeignLibs haddockFlags)
isRequested _ ExeKind = fromFlagOrDefault False (haddockExecutables haddockFlags)
isRequested _ TestKind = fromFlagOrDefault False (haddockTestSuites haddockFlags)
isRequested _ BenchKind = fromFlagOrDefault False (haddockBenchmarks haddockFlags)


-- | For a 'TargetComponent' 'TargetSelector', check if the component can be
Expand Down
6 changes: 2 additions & 4 deletions cabal-install/Distribution/Client/CmdInstall.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -21,8 +21,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.Client.Types
( PackageSpecifier(NamedPackage), UnresolvedSourcePackage )
Expand Down Expand Up @@ -119,8 +118,7 @@ installCommand = CommandUI
--
installAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
-> [String] -> GlobalFlags -> IO ()
installAction (applyFlagDefaults ->
(configFlags, configExFlags, installFlags, haddockFlags))
installAction (configFlags, configExFlags, installFlags, haddockFlags)
targetStrings globalFlags = do
-- We never try to build tests/benchmarks for remote packages.
-- So we set them as disabled by default and error if they are explicitly
Expand Down
6 changes: 2 additions & 4 deletions cabal-install/Distribution/Client/CmdRepl.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,4 @@
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ViewPatterns #-}

-- | cabal-install CLI command: repl
--
Expand All @@ -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 )
Expand Down Expand Up @@ -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
Expand Down
6 changes: 2 additions & 4 deletions cabal-install/Distribution/Client/CmdRun.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,4 @@
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ViewPatterns #-}

-- | cabal-install CLI command: run
--
Expand All @@ -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 )
Expand Down Expand Up @@ -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
Expand Down
6 changes: 2 additions & 4 deletions cabal-install/Distribution/Client/CmdTest.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,5 +1,4 @@
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ViewPatterns #-}

-- | cabal-install CLI command: test
--
Expand All @@ -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 )
Expand Down Expand Up @@ -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
Expand Down
5 changes: 2 additions & 3 deletions cabal-install/Distribution/Client/CmdUpdate.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,7 @@ import Distribution.Client.JobControl
( newParallelJobControl, spawnJob, collectJob )
import Distribution.Client.Setup
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags
, UpdateFlags, applyFlagDefaults, defaultUpdateFlags
, UpdateFlags, defaultUpdateFlags
, RepoContext(..) )
import Distribution.Simple.Setup
( HaddockFlags, fromFlagOrDefault )
Expand Down Expand Up @@ -107,8 +107,7 @@ instance Text UpdateRequest where

updateAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
-> [String] -> GlobalFlags -> IO ()
updateAction (applyFlagDefaults -> ( configFlags, configExFlags
, installFlags, haddockFlags ))
updateAction (configFlags, configExFlags, installFlags, haddockFlags)
extraArgs globalFlags = do

ProjectBaseContext {
Expand Down
10 changes: 0 additions & 10 deletions cabal-install/Distribution/Client/Setup.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -49,7 +49,6 @@ module Distribution.Client.Setup
, userConfigCommand, UserConfigFlags(..)
, manpageCommand

, applyFlagDefaults
, parsePackageArgs
--TODO: stop exporting these:
, showRepo
Expand Down Expand Up @@ -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 = "",
Expand Down