Skip to content
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.

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

Make NixStyleOptions #6745

Merged
merged 1 commit into from
May 4, 2020
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
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
17 changes: 9 additions & 8 deletions cabal-install/Distribution/Client/CmdHaddock.hs
Original file line number Diff line number Diff line change
Expand Up @@ -16,9 +16,10 @@ module Distribution.Client.CmdHaddock (
import Distribution.Client.ProjectOrchestration
import Distribution.Client.CmdErrorMessages

import Distribution.Client.NixStyleOptions
( NixStyleFlags, nixStyleOptions, defaultNixStyleFlags )
import Distribution.Client.Setup
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags )
import qualified Distribution.Client.Setup as Client
import Distribution.Simple.Setup
( HaddockFlags(..), TestFlags, BenchmarkFlags(..), fromFlagOrDefault )
import Distribution.Simple.Command
Expand All @@ -31,10 +32,8 @@ import Distribution.Simple.Utils
import Control.Monad (when)


haddockCommand :: CommandUI ( ConfigFlags, ConfigExFlags, InstallFlags
, HaddockFlags, TestFlags, BenchmarkFlags
)
haddockCommand = Client.installCommand {
haddockCommand :: CommandUI (NixStyleFlags ())
haddockCommand = CommandUI {
commandName = "v2-haddock",
commandSynopsis = "Build Haddock documentation",
commandUsage = usageAlternatives "v2-haddock" [ "[FLAGS] TARGET" ],
Expand All @@ -61,7 +60,9 @@ haddockCommand = Client.installCommand {
++ " Build documentation for the package named pkgname\n\n"

++ cmdCommonHelpTextNewBuildBeta
}
, commandOptions = nixStyleOptions (const [])
, commandDefaultFlags = defaultNixStyleFlags ()
}
--TODO: [nice to have] support haddock on specific components, not just
-- whole packages and the silly --executables etc modifiers.

Expand All @@ -71,10 +72,10 @@ haddockCommand = Client.installCommand {
-- "Distribution.Client.ProjectOrchestration"
--
haddockAction :: ( ConfigFlags, ConfigExFlags, InstallFlags
, HaddockFlags, TestFlags, BenchmarkFlags )
, HaddockFlags, TestFlags, BenchmarkFlags, () )
-> [String] -> GlobalFlags -> IO ()
haddockAction ( configFlags, configExFlags, installFlags
, haddockFlags, testFlags, benchmarkFlags )
, haddockFlags, testFlags, benchmarkFlags, () )
targetStrings globalFlags = do

baseCtx <- establishProjectBaseContext verbosity cliConfig HaddockCommand
Expand Down
54 changes: 7 additions & 47 deletions cabal-install/Distribution/Client/CmdInstall.hs
Original file line number Diff line number Diff line change
Expand Up @@ -33,11 +33,7 @@ import Distribution.Client.CmdInstall.ClientInstallFlags
import Distribution.Client.CmdInstall.ClientInstallTargetSelector

import Distribution.Client.Setup
( GlobalFlags(..), ConfigFlags(..), ConfigExFlags, InstallFlags(..)
, configureExOptions, haddockOptions, installOptions, testOptions
, benchmarkOptions, configureOptions, liftOptions )
import Distribution.Solver.Types.ConstraintSource
( ConstraintSource(..) )
( GlobalFlags(..), ConfigFlags(..), ConfigExFlags, InstallFlags(..) )
import Distribution.Client.Types
( PackageSpecifier(..), PackageLocation(..), UnresolvedSourcePackage
, SourcePackageDb(..) )
Expand All @@ -50,6 +46,8 @@ import Distribution.Client.ProjectConfig
( ProjectPackageLocation(..)
, fetchAndReadSourcePackages
)
import Distribution.Client.NixStyleOptions
( NixStyleFlags, nixStyleOptions, defaultNixStyleFlags )
import Distribution.Client.ProjectConfig.Types
( ProjectConfig(..), ProjectConfigShared(..)
, ProjectConfigBuildOnly(..), PackageConfig(..)
Expand Down Expand Up @@ -99,7 +97,7 @@ import Distribution.Simple.Setup
import Distribution.Solver.Types.SourcePackage
( SourcePackage(..) )
import Distribution.Simple.Command
( CommandUI(..), OptionField(..), usageAlternatives )
( CommandUI(..), usageAlternatives )
import Distribution.Simple.Configure
( configCompilerEx )
import Distribution.Simple.Compiler
Expand Down Expand Up @@ -149,10 +147,7 @@ import System.Directory
import System.FilePath
( (</>), (<.>), takeDirectory, takeBaseName )

installCommand :: CommandUI ( ConfigFlags, ConfigExFlags, InstallFlags
, HaddockFlags, TestFlags, BenchmarkFlags
, ClientInstallFlags
)
installCommand :: CommandUI (NixStyleFlags ClientInstallFlags)
installCommand = CommandUI
{ commandName = "v2-install"
, commandSynopsis = "Install packages."
Expand All @@ -179,44 +174,9 @@ installCommand = CommandUI
++ " Install the package in the ./pkgfoo directory\n"

++ cmdCommonHelpTextNewBuildBeta
, commandOptions = \showOrParseArgs ->
liftOptions get1 set1
-- Note: [Hidden Flags]
-- hide "constraint", "dependency", and
-- "exact-configuration" from the configure options.
(filter ((`notElem` ["constraint", "dependency"
, "exact-configuration"])
. optionName) $ configureOptions showOrParseArgs)
++ liftOptions get2 set2 (configureExOptions showOrParseArgs
ConstraintSourceCommandlineFlag)
++ liftOptions get3 set3
-- hide "target-package-db" and "symlink-bindir" flags from the
-- install options.
-- "symlink-bindir" is obsoleted by "installdir" in ClientInstallFlags
(filter ((`notElem` ["target-package-db", "symlink-bindir"])
. optionName) $
installOptions showOrParseArgs)
++ liftOptions get4 set4
-- hide "verbose" and "builddir" flags from the
-- haddock options.
(filter ((`notElem` ["v", "verbose", "builddir"])
. optionName) $
haddockOptions showOrParseArgs)
++ liftOptions get5 set5 (testOptions showOrParseArgs)
++ liftOptions get6 set6 (benchmarkOptions showOrParseArgs)
++ liftOptions get7 set7 (clientInstallOptions showOrParseArgs)
, commandDefaultFlags = ( mempty, mempty, mempty, mempty, mempty, mempty
, defaultClientInstallFlags )
, commandOptions = nixStyleOptions clientInstallOptions
, commandDefaultFlags = defaultNixStyleFlags defaultClientInstallFlags
}
where
get1 (a,_,_,_,_,_,_) = a; set1 a (_,b,c,d,e,f,g) = (a,b,c,d,e,f,g)
get2 (_,b,_,_,_,_,_) = b; set2 b (a,_,c,d,e,f,g) = (a,b,c,d,e,f,g)
get3 (_,_,c,_,_,_,_) = c; set3 c (a,b,_,d,e,f,g) = (a,b,c,d,e,f,g)
get4 (_,_,_,d,_,_,_) = d; set4 d (a,b,c,_,e,f,g) = (a,b,c,d,e,f,g)
get5 (_,_,_,_,e,_,_) = e; set5 e (a,b,c,d,_,f,g) = (a,b,c,d,e,f,g)
get6 (_,_,_,_,_,f,_) = f; set6 f (a,b,c,d,e,_,g) = (a,b,c,d,e,f,g)
get7 (_,_,_,_,_,_,g) = g; set7 g (a,b,c,d,e,f,_) = (a,b,c,d,e,f,g)


-- | The @install@ command actually serves four different needs. It installs:
-- * exes:
Expand Down
43 changes: 11 additions & 32 deletions cabal-install/Distribution/Client/CmdRepl.hs
Original file line number Diff line number Diff line change
Expand Up @@ -23,6 +23,8 @@ import Distribution.Client.Compat.Prelude
import Distribution.Compat.Lens
import qualified Distribution.Types.Lens as L

import Distribution.Client.NixStyleOptions
( NixStyleFlags, nixStyleOptions, defaultNixStyleFlags )
import Distribution.Client.CmdErrorMessages
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.ProjectBuilding
Expand All @@ -45,7 +47,7 @@ import Distribution.Simple.Setup
, fromFlagOrDefault, replOptions
, Flag(..), toFlag, trueArg, falseArg )
import Distribution.Simple.Command
( CommandUI(..), liftOption, usageAlternatives, option
( CommandUI(..), liftOptionL, usageAlternatives, option
, ShowOrParseArgs, OptionField, reqArg )
import Distribution.Compiler
( CompilerFlavor(GHC) )
Expand Down Expand Up @@ -144,10 +146,7 @@ envOptions _ =
("couldn't parse dependencies: " ++)
(parsecCommaList parsec)

replCommand :: CommandUI ( ConfigFlags, ConfigExFlags, InstallFlags
, HaddockFlags, TestFlags, BenchmarkFlags
, ReplFlags, EnvFlags
)
replCommand :: CommandUI (NixStyleFlags (ReplFlags, EnvFlags))
replCommand = Client.installCommand {
commandName = "v2-repl",
commandSynopsis = "Open an interactive session for the given component.",
Expand Down Expand Up @@ -185,31 +184,11 @@ replCommand = Client.installCommand {
++ "to the default component (or no component if there is no project present)\n"

++ cmdCommonHelpTextNewBuildBeta,
commandDefaultFlags = ( configFlags, configExFlags, installFlags
, haddockFlags, testFlags, benchmarkFlags
, [], defaultEnvFlags
),
commandOptions = \showOrParseArgs ->
map liftOriginal (commandOptions Client.installCommand showOrParseArgs)
++ map liftReplOpts (replOptions showOrParseArgs)
++ map liftEnvOpts (envOptions showOrParseArgs)
}
where
(configFlags,configExFlags,installFlags,haddockFlags,testFlags,benchmarkFlags)
= commandDefaultFlags Client.installCommand

liftOriginal = liftOption projectOriginal updateOriginal
liftReplOpts = liftOption projectReplOpts updateReplOpts
liftEnvOpts = liftOption projectEnvOpts updateEnvOpts

projectOriginal (a,b,c,d,e,f,_,_) = (a,b,c,d,e,f)
updateOriginal (a,b,c,d,e,f) (_,_,_,_,_,_,g,h) = (a,b,c,d,e,f,g,h)

projectReplOpts (_,_,_,_,_,_,g,_) = g
updateReplOpts g (a,b,c,d,e,f,_,h) = (a,b,c,d,e,f,g,h)

projectEnvOpts (_,_,_,_,_,_,_,h) = h
updateEnvOpts h (a,b,c,d,e,f,g,_) = (a,b,c,d,e,f,g,h)
commandDefaultFlags = defaultNixStyleFlags ([], defaultEnvFlags),
commandOptions = nixStyleOptions $ \showOrParseArgs ->
map (liftOptionL _1) (replOptions showOrParseArgs) ++
map (liftOptionL _2) (envOptions showOrParseArgs)
}

-- | The @repl@ command is very much like @build@. It brings the install plan
-- up to date, selects that part of the plan needed by the given or implicit
Expand All @@ -224,11 +203,11 @@ replCommand = Client.installCommand {
--
replAction :: ( ConfigFlags, ConfigExFlags, InstallFlags
, HaddockFlags, TestFlags, BenchmarkFlags
, ReplFlags, EnvFlags )
, (ReplFlags, EnvFlags) )
-> [String] -> GlobalFlags -> IO ()
replAction ( configFlags, configExFlags, installFlags
, haddockFlags, testFlags, benchmarkFlags
, replFlags, envFlags )
, (replFlags, envFlags) )
targetStrings globalFlags = do
let
ignoreProject = fromFlagOrDefault False (envIgnoreProject envFlags)
Expand Down
47 changes: 7 additions & 40 deletions cabal-install/Distribution/Client/CmdRun.hs
Original file line number Diff line number Diff line change
Expand Up @@ -25,18 +25,16 @@ import Distribution.Client.CmdErrorMessages

import Distribution.Client.CmdRun.ClientRunFlags

import Distribution.Client.NixStyleOptions
( NixStyleFlags, nixStyleOptions, defaultNixStyleFlags )
import Distribution.Client.Setup
( GlobalFlags(..), ConfigFlags(..), ConfigExFlags, InstallFlags(..)
, configureExOptions, haddockOptions, installOptions, testOptions
, benchmarkOptions, configureOptions, liftOptions )
import Distribution.Solver.Types.ConstraintSource
( ConstraintSource(..) )
( GlobalFlags(..), ConfigFlags(..), ConfigExFlags, InstallFlags(..) )
import Distribution.Client.GlobalFlags
( defaultGlobalFlags )
import Distribution.Simple.Setup
( HaddockFlags, TestFlags, BenchmarkFlags, fromFlagOrDefault )
import Distribution.Simple.Command
( CommandUI(..), OptionField (..), usageAlternatives )
( CommandUI(..), usageAlternatives )
import Distribution.Types.ComponentName
( showComponentName )
import Distribution.Deprecated.Text
Expand Down Expand Up @@ -109,10 +107,7 @@ import System.FilePath
( (</>), isValid, isPathSeparator, takeExtension )


runCommand :: CommandUI ( ConfigFlags, ConfigExFlags, InstallFlags
, HaddockFlags, TestFlags, BenchmarkFlags
, ClientRunFlags
)
runCommand :: CommandUI (NixStyleFlags ClientRunFlags)
runCommand = CommandUI
{ commandName = "v2-run"
, commandSynopsis = "Run an executable."
Expand Down Expand Up @@ -148,37 +143,9 @@ runCommand = CommandUI
++ " Build with '-O2' and run the program, passing it extra arguments.\n\n"

++ cmdCommonHelpTextNewBuildBeta
, commandDefaultFlags = (mempty, mempty, mempty, mempty, mempty, mempty, mempty)
, commandOptions = \showOrParseArgs ->
liftOptions get1 set1
-- Note: [Hidden Flags]
-- hide "constraint", "dependency", and
-- "exact-configuration" from the configure options.
(filter ((`notElem` ["constraint", "dependency"
, "exact-configuration"])
. optionName) $
configureOptions showOrParseArgs)
++ liftOptions get2 set2 (configureExOptions showOrParseArgs ConstraintSourceCommandlineFlag)
++ liftOptions get3 set3
-- hide "target-package-db" flag from the
-- install options.
(filter ((`notElem` ["target-package-db"])
. optionName) $
installOptions showOrParseArgs)
++ liftOptions get4 set4 (haddockOptions showOrParseArgs)
++ liftOptions get5 set5 (testOptions showOrParseArgs)
++ liftOptions get6 set6 (benchmarkOptions showOrParseArgs)
++ liftOptions get7 set7 (clientRunOptions showOrParseArgs)
, commandDefaultFlags = defaultNixStyleFlags mempty
, commandOptions = nixStyleOptions clientRunOptions
}
where
get1 (a,_,_,_,_,_,_) = a; set1 a (_,b,c,d,e,f,g) = (a,b,c,d,e,f,g)
get2 (_,b,_,_,_,_,_) = b; set2 b (a,_,c,d,e,f,g) = (a,b,c,d,e,f,g)
get3 (_,_,c,_,_,_,_) = c; set3 c (a,b,_,d,e,f,g) = (a,b,c,d,e,f,g)
get4 (_,_,_,d,_,_,_) = d; set4 d (a,b,c,_,e,f,g) = (a,b,c,d,e,f,g)
get5 (_,_,_,_,e,_,_) = e; set5 e (a,b,c,d,_,f,g) = (a,b,c,d,e,f,g)
get6 (_,_,_,_,_,f,_) = f; set6 f (a,b,c,d,e,_,g) = (a,b,c,d,e,f,g)
get7 (_,_,_,_,_,_,g) = g; set7 g (a,b,c,d,e,f,_) = (a,b,c,d,e,f,g)


-- | The @run@ command runs a specified executable-like component, building it
-- first if necessary. The component can be either an executable, a test,
Expand Down
63 changes: 63 additions & 0 deletions cabal-install/Distribution/Client/NixStyleOptions.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,63 @@
-- | Command line options for nix-style / v2 commands.
--
-- The commands take a lot of the same options, which affect how install plan
-- is constructed.
module Distribution.Client.NixStyleOptions (
NixStyleFlags, nixStyleOptions, defaultNixStyleFlags,
) where

import Distribution.Client.Compat.Prelude
import Prelude ()

import Distribution.Simple.Command (OptionField (..), ShowOrParseArgs)
import Distribution.Simple.Setup (BenchmarkFlags, HaddockFlags, TestFlags)
import Distribution.Solver.Types.ConstraintSource (ConstraintSource (..))

import Distribution.Client.Setup
(ConfigExFlags, ConfigFlags (..), InstallFlags (..), benchmarkOptions, configureExOptions,
configureOptions, haddockOptions, installOptions, liftOptions, testOptions)

-- TODO: turn into data record
-- Then we could use RecordWildCards in command implementation.
type NixStyleFlags a = (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, TestFlags, BenchmarkFlags, a)

nixStyleOptions
:: (ShowOrParseArgs -> [OptionField a])
-> ShowOrParseArgs -> [OptionField (NixStyleFlags a)]
nixStyleOptions commandOptions showOrParseArgs =
liftOptions get1 set1
-- Note: [Hidden Flags]
-- hide "constraint", "dependency", and
-- "exact-configuration" from the configure options.
(filter ((`notElem` ["constraint", "dependency"
, "exact-configuration"])
. optionName) $ configureOptions showOrParseArgs)
++ liftOptions get2 set2 (configureExOptions showOrParseArgs
ConstraintSourceCommandlineFlag)
++ liftOptions get3 set3
-- hide "target-package-db" and "symlink-bindir" flags from the
-- install options.
-- "symlink-bindir" is obsoleted by "installdir" in ClientInstallFlags
(filter ((`notElem` ["target-package-db", "symlink-bindir"])
. optionName) $
installOptions showOrParseArgs)
++ liftOptions get4 set4
-- hide "verbose" and "builddir" flags from the
-- haddock options.
(filter ((`notElem` ["v", "verbose", "builddir"])
. optionName) $
haddockOptions showOrParseArgs)
++ liftOptions get5 set5 (testOptions showOrParseArgs)
++ liftOptions get6 set6 (benchmarkOptions showOrParseArgs)
++ liftOptions get7 set7 (commandOptions showOrParseArgs)
where
get1 (a,_,_,_,_,_,_) = a; set1 a (_,b,c,d,e,f,g) = (a,b,c,d,e,f,g)
get2 (_,b,_,_,_,_,_) = b; set2 b (a,_,c,d,e,f,g) = (a,b,c,d,e,f,g)
get3 (_,_,c,_,_,_,_) = c; set3 c (a,b,_,d,e,f,g) = (a,b,c,d,e,f,g)
get4 (_,_,_,d,_,_,_) = d; set4 d (a,b,c,_,e,f,g) = (a,b,c,d,e,f,g)
get5 (_,_,_,_,e,_,_) = e; set5 e (a,b,c,d,_,f,g) = (a,b,c,d,e,f,g)
get6 (_,_,_,_,_,f,_) = f; set6 f (a,b,c,d,e,_,g) = (a,b,c,d,e,f,g)
get7 (_,_,_,_,_,_,g) = g; set7 g (a,b,c,d,e,f,_) = (a,b,c,d,e,f,g)

defaultNixStyleFlags :: a -> NixStyleFlags a
defaultNixStyleFlags x = ( mempty, mempty, mempty, mempty, mempty, mempty, x )
1 change: 1 addition & 0 deletions cabal-install/cabal-install.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -220,6 +220,7 @@ executable cabal
Distribution.Client.Manpage
Distribution.Client.ManpageFlags
Distribution.Client.Nix
Distribution.Client.NixStyleOptions
Distribution.Client.Outdated
Distribution.Client.PackageHash
Distribution.Client.PackageUtils
Expand Down
1 change: 1 addition & 0 deletions cabal-install/cabal-install.cabal.pp
Original file line number Diff line number Diff line change
Expand Up @@ -159,6 +159,7 @@
Distribution.Client.Manpage
Distribution.Client.ManpageFlags
Distribution.Client.Nix
Distribution.Client.NixStyleOptions
Distribution.Client.Outdated
Distribution.Client.PackageHash
Distribution.Client.PackageUtils
Expand Down