Commit 56cd88d9 authored by Merijn Verstraaten's avatar Merijn Verstraaten
Browse files

Propagate REPL options to Setup.

parent 4d49ae81
......@@ -61,6 +61,7 @@ module Distribution.Simple.Setup (
programDbOptions, programDbPaths',
programConfigurationOptions, programConfigurationPaths',
programFlagsDescription,
replOptions,
splitArgs,
defaultDistPref, optionDistPref,
......@@ -1708,7 +1709,8 @@ data ReplFlags = ReplFlags {
replProgramArgs :: [(String, [String])],
replDistPref :: Flag FilePath,
replVerbosity :: Flag Verbosity,
replReload :: Flag Bool
replReload :: Flag Bool,
replReplOptions :: [String]
}
deriving (Show, Generic)
......@@ -1718,7 +1720,8 @@ defaultReplFlags = ReplFlags {
replProgramArgs = [],
replDistPref = NoFlag,
replVerbosity = Flag normal,
replReload = Flag False
replReload = Flag False,
replReplOptions = []
}
instance Monoid ReplFlags where
......@@ -1794,7 +1797,14 @@ replCommand progDb = CommandUI
trueArg
]
_ -> []
++ map liftReplOption (replOptions showOrParseArgs)
}
where
liftReplOption = liftOption replReplOptions (\v flags -> flags { replReplOptions = v })
replOptions :: ShowOrParseArgs -> [OptionField [String]]
replOptions _ = [ option [] ["repl-options"] "use this option for the repl" id
const (reqArg "FLAG" (succeedReadE (:[])) id) ]
-- ------------------------------------------------------------
-- * Test flags
......
......@@ -13,6 +13,7 @@ module Distribution.Client.CmdRepl (
selectComponentTarget
) where
import Distribution.Client.ProjectPlanning (ElaboratedSharedConfig(..))
import Distribution.Client.ProjectOrchestration
import Distribution.Client.CmdErrorMessages
......@@ -20,9 +21,9 @@ import Distribution.Client.Setup
( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags )
import qualified Distribution.Client.Setup as Client
import Distribution.Simple.Setup
( HaddockFlags, fromFlagOrDefault )
( HaddockFlags, fromFlagOrDefault, replOptions )
import Distribution.Simple.Command
( CommandUI(..), usageAlternatives )
( CommandUI(..), liftOption, usageAlternatives )
import Distribution.Package
( packageName )
import Distribution.Types.ComponentName
......@@ -39,7 +40,7 @@ import qualified Data.Set as Set
import Control.Monad (when)
replCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
replCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, [String])
replCommand = Client.installCommand {
commandName = "new-repl",
commandSynopsis = "Open an interactive session for the given component.",
......@@ -70,9 +71,23 @@ replCommand = Client.installCommand {
++ " " ++ pname ++ " new-repl pkgname:cname\n"
++ " for the component 'cname' in the package 'pkgname'\n\n"
++ cmdCommonHelpTextNewBuildBeta
++ cmdCommonHelpTextNewBuildBeta,
commandDefaultFlags = (configFlags,configExFlags,installFlags,haddockFlags,[]),
commandOptions = \showOrParseArgs ->
map liftOriginal (commandOptions Client.installCommand showOrParseArgs)
++ map liftReplOpts (replOptions showOrParseArgs)
}
where
(configFlags,configExFlags,installFlags,haddockFlags) = commandDefaultFlags Client.installCommand
liftOriginal = liftOption projectOriginal updateOriginal
liftReplOpts = liftOption projectReplOpts updateReplOpts
projectOriginal (a,b,c,d,_) = (a,b,c,d)
updateOriginal (a,b,c,d) (_,_,_,_,x) = (a,b,c,d,x)
projectReplOpts (_,_,_,_,x) = x
updateReplOpts v (a,b,c,d,_) = (a,b,c,d,v)
-- | 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
......@@ -85,9 +100,9 @@ replCommand = Client.installCommand {
-- For more details on how this works, see the module
-- "Distribution.Client.ProjectOrchestration"
--
replAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
replAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags, [String])
-> [String] -> GlobalFlags -> IO ()
replAction (configFlags, configExFlags, installFlags, haddockFlags)
replAction (configFlags, configExFlags, installFlags, haddockFlags, replArgs)
targetStrings globalFlags = do
baseCtx <- establishProjectBaseContext verbosity cliConfig
......@@ -95,7 +110,7 @@ replAction (configFlags, configExFlags, installFlags, haddockFlags)
targetSelectors <- either (reportTargetSelectorProblems verbosity) return
=<< readTargetSelectors (localPackages baseCtx) targetStrings
buildCtx <-
buildCtx' <-
runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do
when (buildSettingOnlyDeps (buildSettings baseCtx)) $
......@@ -126,6 +141,10 @@ replAction (configFlags, configExFlags, installFlags, haddockFlags)
elaboratedPlan
return (elaboratedPlan', targets)
let buildCtx = buildCtx'
{ elaboratedShared = (elaboratedShared buildCtx')
{ pkgConfigReplOptions = replArgs }
}
printPlan verbosity baseCtx buildCtx
buildOutcomes <- runProjectBuildPhase verbosity baseCtx buildCtx
......
......@@ -1237,7 +1237,8 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB
ElaboratedSharedConfig {
pkgConfigPlatform = platform,
pkgConfigCompiler = compiler,
pkgConfigCompilerProgs = compilerprogdb
pkgConfigCompilerProgs = compilerprogdb,
pkgConfigReplOptions = []
}
preexistingInstantiatedPkgs =
......@@ -3369,13 +3370,14 @@ setupHsReplFlags :: ElaboratedConfiguredPackage
-> Verbosity
-> FilePath
-> Cabal.ReplFlags
setupHsReplFlags _ _ verbosity builddir =
setupHsReplFlags _ sharedConfig verbosity builddir =
Cabal.ReplFlags {
replProgramPaths = mempty, --unused, set at configure time
replProgramArgs = mempty, --unused, set at configure time
replVerbosity = toFlag verbosity,
replDistPref = toFlag builddir,
replReload = mempty --only used as callback from repl
replReload = mempty, --only used as callback from repl
replReplOptions = pkgConfigReplOptions sharedConfig --runtime override for repl flags
}
......
......@@ -148,7 +148,8 @@ data ElaboratedSharedConfig
-- | The programs that the compiler configured (e.g. for GHC, the progs
-- ghc & ghc-pkg). Once constructed, only the 'configuredPrograms' are
-- used.
pkgConfigCompilerProgs :: ProgramDb
pkgConfigCompilerProgs :: ProgramDb,
pkgConfigReplOptions :: [String]
}
deriving (Show, Generic, Typeable)
--TODO: [code cleanup] no Eq instance
......
Supports Markdown
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