Commit 5f6d2745 authored by Oleg Grenrus's avatar Oleg Grenrus

Make NixStyleOptions

parent f7d1b4e4
......@@ -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
......@@ -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" ],
......@@ -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.
......@@ -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
......
......@@ -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(..) )
......@@ -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(..)
......@@ -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
......@@ -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."
......@@ -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:
......
......@@ -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
......@@ -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) )
......@@ -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.",
......@@ -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
......@@ -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)
......
......@@ -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
......@@ -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."
......@@ -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,
......
-- | 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 )
......@@ -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
......
......@@ -159,6 +159,7 @@ Version: 3.3.0.0
Distribution.Client.Manpage
Distribution.Client.ManpageFlags
Distribution.Client.Nix
Distribution.Client.NixStyleOptions
Distribution.Client.Outdated
Distribution.Client.PackageHash
Distribution.Client.PackageUtils
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment