No longer use build options with ghci #2199

ChangeLog.md

@@ -64,7 +64,7 @@ Other enhancements:
   on discussion in [#2647](https://github.com/commercialhaskell/stack/issues/2647).
 * The `--main-is` flag for GHCI now implies the TARGET, fixing
   [#1845](https://github.com/commercialhaskell/stack/issues/1845).
-* `stack ghci` will now use CLI `--ghc-options`.
+* `stack ghci` no longer takes all build options, as many weren't useful
   [#2199](https://github.com/commercialhaskell/stack/issues/2199)
 
 Bug fixes:

src/Stack/Ghci.hs

@@ -89,7 +89,7 @@ data GhciOpts = GhciOpts
     , ghciLoadLocalDeps      :: !Bool
     , ghciSkipIntermediate   :: !Bool
     , ghciHidePackages       :: !Bool
-    , ghciBuildOptsCLI       :: !BuildOptsCLI
+    , ghciTargets            :: ![Text]
     , ghciNoBuild            :: !Bool
     } deriving Show
 
@@ -136,12 +136,12 @@ instance Show GhciException where
 ghci :: M r m => GhciOpts -> m ()
 ghci opts@GhciOpts{..} = do
     -- Load source map, without explicit targets, to collect all info.
-    (_, _, locals, _, sourceMap) <- loadSourceMap AllowNoTargets ghciBuildOptsCLI
+    (_, _, locals, _, sourceMap) <- loadSourceMap AllowNoTargets defaultBuildOptsCLI
         { boptsCLITargets = [] }
     -- Parse --main-is argument.
-    mainIsTargets <- parseMainIsTargets ghciBuildOptsCLI ghciMainIs
+    mainIsTargets <- parseMainIsTargets ghciMainIs
     -- Parse to either file targets or build targets
-    etargets <- preprocessTargets ghciBuildOptsCLI
+    etargets <- preprocessTargets ghciTargets
     (inputTargets, mfileTargets) <- case etargets of
         Left rawFileTargets -> do
             case mainIsTargets of
@@ -151,7 +151,7 @@ ghci opts@GhciOpts{..} = do
             (targetMap, fileInfo, extraFiles) <- findFileTargets locals rawFileTargets
             return (targetMap, Just (fileInfo, extraFiles))
         Right rawTargets -> do
-            (_,_,normalTargets) <- parseTargetsFromBuildOpts AllowNoTargets ghciBuildOptsCLI
+            (_,_,normalTargets) <- parseTargetsFromBuildOpts AllowNoTargets defaultBuildOptsCLI
                 { boptsCLITargets = rawTargets }
             return (normalTargets, Nothing)
     -- Make sure the targets are known.
@@ -163,16 +163,16 @@ ghci opts@GhciOpts{..} = do
     -- Build required dependencies and setup local packages.
     buildDepsAndInitialSteps opts (map (packageNameText . fst) localTargets)
     -- Load the list of modules _after_ building, to catch changes in unlisted dependencies (#1180)
-    pkgs <- getGhciPkgInfos ghciBuildOptsCLI sourceMap addPkgs (fmap fst mfileTargets) localTargets
+    pkgs <- getGhciPkgInfos sourceMap addPkgs (fmap fst mfileTargets) localTargets
     checkForIssues pkgs
     -- Finally, do the invocation of ghci
     runGhci opts localTargets mainIsTargets pkgs
 
-preprocessTargets :: M r m => BuildOptsCLI -> m (Either [Path Abs File] [Text])
-preprocessTargets boptsCLI = do
+preprocessTargets :: M r m => [Text] -> m (Either [Path Abs File] [Text])
+preprocessTargets rawTargets = do
     let (fileTargetsRaw, normalTargets) =
             partition (\t -> ".hs" `T.isSuffixOf` t || ".lhs" `T.isSuffixOf` t)
-                      (boptsCLITargets boptsCLI)
+                      rawTargets
     fileTargets <- forM fileTargetsRaw $ \fp0 -> do
         let fp = T.unpack fp0
         mpath <- forgivingAbsence (resolveFile' fp)
@@ -184,9 +184,9 @@ preprocessTargets boptsCLI = do
         (False, _) -> return (Left fileTargets)
         _ -> return (Right normalTargets)
 
-parseMainIsTargets :: M env m => BuildOptsCLI -> Maybe Text -> m (Maybe (Map PackageName SimpleTarget))
-parseMainIsTargets boptsCli mtarget = forM mtarget $ \target -> do
-     (_,_,targets) <- parseTargetsFromBuildOpts AllowNoTargets boptsCli
+parseMainIsTargets :: M env m => Maybe Text -> m (Maybe (Map PackageName SimpleTarget))
+parseMainIsTargets mtarget = forM mtarget $ \target -> do
+     (_,_,targets) <- parseTargetsFromBuildOpts AllowNoTargets defaultBuildOptsCLI
          { boptsCLITargets = [target] }
      return targets
 
@@ -306,7 +306,7 @@ buildDepsAndInitialSteps GhciOpts{..} targets0 = do
     -- If necessary, do the build, for local packagee targets, only do
     -- 'initialBuildSteps'.
     when (not ghciNoBuild && not (null targets)) $ do
-        eres <- tryAny $ build (const (return ())) Nothing ghciBuildOptsCLI
+        eres <- tryAny $ build (const (return ())) Nothing defaultBuildOptsCLI
             { boptsCLITargets = targets
             , boptsCLIInitialBuildSteps = True
             }
@@ -341,7 +341,6 @@ runGhci GhciOpts{..} targets mainIsTargets pkgs = do
         genOpts = nubOrd (concatMap (concatMap (oneWordOpts . snd) . ghciPkgOpts) pkgs)
         (omittedOpts, ghcOpts) = partition badForGhci $
             concatMap (concatMap (bioOpts . snd) . ghciPkgOpts) pkgs ++
-            map T.unpack (boptsCLIGhcOptions ghciBuildOptsCLI) ++
             getUserOptions Nothing ++
             concatMap (getUserOptions . Just . ghciPkgName) pkgs
         getUserOptions mpkg =
@@ -530,13 +529,12 @@ figureOutMainFile bopts mainIsTargets targets0 packages = do
 
 getGhciPkgInfos
     :: M env m
-    => BuildOptsCLI
-    -> SourceMap
+    => SourceMap
     -> [PackageName]
     -> Maybe (Map PackageName (Set (Path Abs File)))
     -> [(PackageName, (Path Abs File, SimpleTarget))]
     -> m [GhciPkgInfo]
-getGhciPkgInfos boptsCli sourceMap addPkgs mfileTargets localTargets = do
+getGhciPkgInfos sourceMap addPkgs mfileTargets localTargets = do
     menv <- getMinimalEnvOverride
     (installedMap, _, _, _) <- getInstalled
         menv
@@ -547,13 +545,12 @@ getGhciPkgInfos boptsCli sourceMap addPkgs mfileTargets localTargets = do
         sourceMap
     let localLibs = [name | (name, (_, target)) <- localTargets, hasLocalComp isCLib target]
     forM localTargets $ \(name, (cabalfp, target)) ->
-        makeGhciPkgInfo boptsCli sourceMap installedMap localLibs addPkgs mfileTargets name cabalfp target
+        makeGhciPkgInfo sourceMap installedMap localLibs addPkgs mfileTargets name cabalfp target
 
 -- | Make information necessary to load the given package in GHCi.
 makeGhciPkgInfo
     :: (MonadReader r m, HasEnvConfig r, HasTerminal r, MonadLogger m, MonadIO m, MonadCatch m, MonadBaseControl IO m)
-    => BuildOptsCLI
-    -> SourceMap
+    => SourceMap
     -> InstalledMap
     -> [PackageName]
     -> [PackageName]
@@ -562,16 +559,16 @@ makeGhciPkgInfo
     -> Path Abs File
     -> SimpleTarget
     -> m GhciPkgInfo
-makeGhciPkgInfo boptsCli sourceMap installedMap locals addPkgs mfileTargets name cabalfp target = do
+makeGhciPkgInfo sourceMap installedMap locals addPkgs mfileTargets name cabalfp target = do
     bopts <- asks (configBuild . getConfig)
     econfig <- asks getEnvConfig
     bconfig <- asks getBuildConfig
     let config =
             PackageConfig
             { packageConfigEnableTests = True
             , packageConfigEnableBenchmarks = True
-            , packageConfigFlags = getLocalFlags bconfig boptsCli name
-            , packageConfigGhcOptions = getGhcOptions bconfig boptsCli name True True
+            , packageConfigFlags = getLocalFlags bconfig defaultBuildOptsCLI name
+            , packageConfigGhcOptions = getGhcOptions bconfig defaultBuildOptsCLI name True True
             , packageConfigCompilerVersion = envConfigCompilerVersion econfig
             , packageConfigPlatform = configPlatform (getConfig bconfig)
             }

src/Stack/Options/BuildMonoidParser.hs

@@ -11,12 +11,15 @@ import           Stack.Options.HaddockParser
 import           Stack.Options.Utils
 import           Stack.Types.Config.Build
 
-buildOptsMonoidParser :: Bool -> Parser BuildOptsMonoid
+buildOptsMonoidParser :: GlobalOptsContext -> Parser BuildOptsMonoid
 buildOptsMonoidParser hide0 =
     transform <$> trace <*> profile <*> options
   where
+    hideBool = hide0 /= BuildCmdGlobalOpts
     hide =
-        hideMods hide0
+        hideMods hideBool
+    hideExceptGhci =
+        hideMods (hide0 `notElem` [BuildCmdGlobalOpts, GhciCmdGlobalOpts])
     transform tracing profiling =
         enable
       where
@@ -60,7 +63,7 @@ buildOptsMonoidParser hide0 =
                  "Enable profiling in libraries, executables, etc. \
                     \for all expressions and generate a profiling report\
                     \ in tests or benchmarks" <>
-            hide)
+            hideExceptGhci)
 
     trace =
         flag
@@ -71,13 +74,13 @@ buildOptsMonoidParser hide0 =
                  "Enable profiling in libraries, executables, etc. \
                     \for all expressions and generate a backtrace on \
                     \exception" <>
-            hide)
+            hideExceptGhci)
     options =
         BuildOptsMonoid <$> libProfiling <*> exeProfiling <*> haddock <*>
-        haddockOptsParser hide0 <*> openHaddocks <*> haddockDeps <*>
+        haddockOptsParser hideBool <*> openHaddocks <*> haddockDeps <*>
         haddockInternal <*> copyBins <*> preFetch <*> keepGoing <*>
-        forceDirty <*> tests <*> testOptsParser hide0 <*> benches <*>
-        benchOptsParser hide0 <*> reconfigure <*>
+        forceDirty <*> tests <*> testOptsParser hideBool <*> benches <*>
+        benchOptsParser hideBool <*> reconfigure <*>
         cabalVerbose <*> splitObjs
     libProfiling =
         firstBoolFlags
@@ -130,12 +133,12 @@ buildOptsMonoidParser hide0 =
         firstBoolFlags
             "test"
             "testing the package(s) in this directory/configuration"
-            hide
+            hideExceptGhci
     benches =
         firstBoolFlags
             "bench"
             "benchmarking the package(s) in this directory/configuration"
-            hide
+            hideExceptGhci
     reconfigure =
         firstBoolFlags
              "reconfigure"

src/Stack/Options/BuildParser.hs

@@ -15,15 +15,12 @@ import           Stack.Types.Config
 import           Stack.Types.FlagName
 import           Stack.Types.PackageName
 
-data BuildOptsVariant = NormalBuildOpts | GhciBuildOpts
-
 -- | Parser for CLI-only build arguments
-buildOptsParser :: BuildOptsVariant
-                -> BuildCommand
+buildOptsParser :: BuildCommand
                 -> Parser BuildOptsCLI
-buildOptsParser variant cmd =
+buildOptsParser cmd =
     BuildOptsCLI <$>
-    targetsParser variant <*>
+    targetsParser <*>
     switch
         (long "dry-run" <>
          help "Don't build anything, just prepare to") <*>
@@ -85,24 +82,15 @@ buildOptsParser variant cmd =
          help "For target packages, only run initial build steps needed for GHCi" <>
          internal)
 
-targetsParser :: BuildOptsVariant -> Parser [Text]
-targetsParser NormalBuildOpts =
+targetsParser :: Parser [Text]
+targetsParser =
     many
         (textArgument
              (metavar "TARGET" <>
               help ("If none specified, use all local packages. " <>
                     "See https://docs.haskellstack.org/en/v" <>
                     showVersion Meta.version <>
                     "/build_command/#target-syntax for details.")))
-targetsParser GhciBuildOpts =
-    many
-        (textArgument
-             (metavar "TARGET/FILE" <>
-              help ("If none specified, use all local packages. " <>
-                    "See https://docs.haskellstack.org/en/v" <>
-                    showVersion Meta.version <>
-                    "/build_command/#target-syntax for details. " <>
-                    "If a path to a .hs or .lhs file is specified, it will be loaded.")))
 
 flagsParser :: Parser (Map.Map (Maybe PackageName) (Map.Map FlagName Bool))
 flagsParser =

src/Stack/Options/ConfigParser.hs

@@ -52,7 +52,7 @@ configOptsParser hide0 =
             <> help "Override work directory (default: .stack-work)"
             <> hide
             ))
-    <*> buildOptsMonoidParser (hide0 /= BuildCmdGlobalOpts)
+    <*> buildOptsMonoidParser hide0
     <*> dockerOptsParser True
     <*> nixOptsParser True
     <*> firstBoolFlags

src/Stack/Options/DotParser.hs

@@ -19,7 +19,7 @@ dotOptsParser externalDefault =
           <*> includeBase
           <*> depthLimit
           <*> fmap (maybe Set.empty Set.fromList . fmap splitNames) prunedPkgs
-          <*> targetsParser NormalBuildOpts
+          <*> targetsParser
           <*> flagsParser
           <*> testTargets
           <*> benchTargets

src/Stack/Options/GhciParser.hs

@@ -1,13 +1,13 @@
 module Stack.Options.GhciParser where
 
-import           Data.Monoid.Extra
-import           Options.Applicative
-import           Options.Applicative.Args
-import           Options.Applicative.Builder.Extra
-import           Stack.Config                      (packagesParser)
-import           Stack.Ghci                        (GhciOpts (..))
-import           Stack.Options.BuildParser
-import           Stack.Types.Config
+import Data.Monoid.Extra
+import Data.Version (showVersion)
+import Options.Applicative
+import Options.Applicative.Args
+import Options.Applicative.Builder.Extra
+import Paths_stack as Meta
+import Stack.Config (packagesParser)
+import Stack.Ghci (GhciOpts (..))
 
 -- | Parser for GHCI options
 ghciOptsParser :: Parser GhciOpts
@@ -31,5 +31,12 @@ ghciOptsParser = GhciOpts
              <*> switch (long "load-local-deps" <> help "Load all local dependencies of your targets")
              <*> switch (long "skip-intermediate-deps" <> help "Skip loading intermediate target dependencies")
              <*> boolFlags True "package-hiding" "package hiding" idm
-             <*> buildOptsParser GhciBuildOpts Build
+             <*> many
+                   (textArgument
+                        (metavar "TARGET/FILE" <>
+                         help ("If none specified, use all local packages. " <>
+                               "See https://docs.haskellstack.org/en/v" <>
+                               showVersion Meta.version <>
+                               "/build_command/#target-syntax for details. " <>
+                               "If a path to a .hs or .lhs file is specified, it will be loaded.")))
              <*> switch (long "no-build" <> help "Don't build before launching GHCi (deprecated, should be unneeded)")

src/Stack/Options/Utils.hs

@@ -16,4 +16,5 @@ data GlobalOptsContext
     = OuterGlobalOpts -- ^ Global options before subcommand name
     | OtherCmdGlobalOpts -- ^ Global options following any other subcommand
     | BuildCmdGlobalOpts
+    | GhciCmdGlobalOpts
     deriving (Show, Eq)

src/main/Main.hs

@@ -229,27 +229,27 @@ commandLineHandler progName isInterpreter = complicatedOptions
         addBuildCommand' "build"
                          "Build the package(s) in this directory/configuration"
                          buildCmd
-                         (buildOptsParser NormalBuildOpts Build)
+                         (buildOptsParser Build)
         addBuildCommand' "install"
                          "Shortcut for 'build --copy-bins'"
                          buildCmd
-                         (buildOptsParser NormalBuildOpts Install)
+                         (buildOptsParser Install)
         addCommand' "uninstall"
                     "DEPRECATED: This command performs no actions, and is present for documentation only"
                     uninstallCmd
                     (many $ strArgument $ metavar "IGNORED")
         addBuildCommand' "test"
                          "Shortcut for 'build --test'"
                          buildCmd
-                         (buildOptsParser NormalBuildOpts Test)
+                         (buildOptsParser Test)
         addBuildCommand' "bench"
                          "Shortcut for 'build --bench'"
                          buildCmd
-                         (buildOptsParser NormalBuildOpts Bench)
+                         (buildOptsParser Bench)
         addBuildCommand' "haddock"
                          "Shortcut for 'build --haddock'"
                          buildCmd
-                         (buildOptsParser NormalBuildOpts Haddock)
+                         (buildOptsParser Haddock)
         addCommand' "new"
                     "Create a new project from a template. Run `stack templates' to see available templates."
                     newCmd
@@ -344,14 +344,14 @@ commandLineHandler progName isInterpreter = complicatedOptions
                   "Execute a command"
                   execCmd
                   (execOptsParser Nothing)
-      addCommand' "ghci"
-                  "Run ghci in the context of package(s) (experimental)"
-                  ghciCmd
-                  ghciOptsParser
-      addCommand' "repl"
-                  "Run ghci in the context of package(s) (experimental) (alias for 'ghci')"
-                  ghciCmd
-                  ghciOptsParser
+      addGhciCommand' "ghci"
+                      "Run ghci in the context of package(s) (experimental)"
+                      ghciCmd
+                      ghciOptsParser
+      addGhciCommand' "repl"
+                      "Run ghci in the context of package(s) (experimental) (alias for 'ghci')"
+                      ghciCmd
+                      ghciOptsParser
       addCommand' "runghc"
                   "Run runghc"
                   execCmd
@@ -461,6 +461,12 @@ commandLineHandler progName isInterpreter = complicatedOptions
         addBuildCommand' cmd title constr =
             addCommand cmd title globalFooter constr (globalOpts BuildCmdGlobalOpts)
 
+        -- Additional helper that hides global options and shows some ghci options
+        addGhciCommand' :: String -> String -> (a -> GlobalOpts -> IO ()) -> Parser a
+                         -> AddCommand
+        addGhciCommand' cmd title constr =
+            addCommand cmd title globalFooter constr (globalOpts GhciCmdGlobalOpts)
+
     globalOpts :: GlobalOptsContext -> Parser GlobalOptsMonoid
     globalOpts kind =
         extraHelpOption hide progName (Docker.dockerCmdName ++ "*") Docker.dockerHelpOptName <*>