ghc: allow --show-options and --interactive together

Summary:
Previously 'ghc --show-options' showed all options that GHC can possibly
accept. With this patch, it'll only show the options that have effect in
non-interactive modes.
This change also adds support for using 'ghc --interactive --show-options'
which previously was disallowed. This command will show all options that have
effect in the interactive mode.
The CmdLineParser is updated to know about the GHC modes, and then each flag
is annotated with which mode it has effect.
This fixes #9259.

Test Plan:
Try out --show-options with --interactive on the command line. With and without
--interactive should give different results.
Run the test suite, mode001 has been updated to verify this new flag
combination.

Reviewers: austin, jstolarek

Reviewed By: austin, jstolarek

Subscribers: jstolarek, thomie, carter, simonmar

Differential Revision: https://phabricator.haskell.org/D337

GHC Trac Issues: #9259

2 files changed, 64 insertions, 50 deletions

diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index 503811731d..a1f0dba2f4 100644
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -2025,11 +2025,13 @@ showDynFlags show_all dflags = do
      text "warning settings:" $$
          nest 2 (vcat (map (setting wopt) DynFlags.fWarningFlags))
   where
-        setting test (str, f, _)
+        setting test flag
           | quiet     = empty
-          | is_on     = fstr str
-          | otherwise = fnostr str
-          where is_on = test f dflags
+          | is_on     = fstr name
+          | otherwise = fnostr name
+          where name = flagSpecName flag
+                f = flagSpecFlag flag
+                is_on = test f dflags
                 quiet = not show_all && test f default_dflags == is_on
 
         default_dflags = defaultDynFlags (settings dflags)
@@ -2037,7 +2039,7 @@ showDynFlags show_all dflags = do
         fstr   str = text "-f"    <> text str
         fnostr str = text "-fno-" <> text str
 
-        (ghciFlags,others)  = partition (\(_, f, _) -> f `elem` flgs)
+        (ghciFlags,others)  = partition (\f -> flagSpecFlag f `elem` flgs)
                                         DynFlags.fFlags
         flgs = [ Opt_PrintExplicitForalls
                , Opt_PrintExplicitKinds
@@ -2387,11 +2389,13 @@ showLanguages' show_all dflags =
           nest 2 (vcat (map (setting xopt) DynFlags.xFlags))
      ]
   where
-   setting test (str, f, _)
+   setting test flag
           | quiet     = empty
-          | is_on     = text "-X" <> text str
-          | otherwise = text "-XNo" <> text str
-          where is_on = test f dflags
+          | is_on     = text "-X" <> text name
+          | otherwise = text "-XNo" <> text name
+          where name = flagSpecName flag
+                f = flagSpecFlag flag
+                is_on = test f dflags
                 quiet = not show_all && test f default_dflags == is_on
 
    default_dflags =
diff --git a/ghc/Main.hs b/ghc/Main.hs
index 4fd7803f7b..d70691431e 100644
--- a/ghc/Main.hs
+++ b/ghc/Main.hs
@@ -107,10 +107,10 @@ main = do
     case mode of
         Left preStartupMode ->
             do case preStartupMode of
-                   ShowSupportedExtensions -> showSupportedExtensions
-                   ShowVersion             -> showVersion
-                   ShowNumVersion          -> putStrLn cProjectVersion
-                   ShowOptions             -> showOptions
+                   ShowSupportedExtensions   -> showSupportedExtensions
+                   ShowVersion               -> showVersion
+                   ShowNumVersion            -> putStrLn cProjectVersion
+                   ShowOptions isInteractive -> showOptions isInteractive
         Right postStartupMode ->
             -- start our GHC session
             GHC.runGhc mbMinusB $ do
@@ -378,16 +378,16 @@ type Mode = Either PreStartupMode PostStartupMode
 type PostStartupMode = Either PreLoadMode PostLoadMode
 
 data PreStartupMode
-  = ShowVersion             -- ghc -V/--version
-  | ShowNumVersion          -- ghc --numeric-version
-  | ShowSupportedExtensions -- ghc --supported-extensions
-  | ShowOptions             -- ghc --show-options
+  = ShowVersion                          -- ghc -V/--version
+  | ShowNumVersion                       -- ghc --numeric-version
+  | ShowSupportedExtensions              -- ghc --supported-extensions
+  | ShowOptions Bool {- isInteractive -} -- ghc --show-options
 
 showVersionMode, showNumVersionMode, showSupportedExtensionsMode, showOptionsMode :: Mode
 showVersionMode             = mkPreStartupMode ShowVersion
 showNumVersionMode          = mkPreStartupMode ShowNumVersion
 showSupportedExtensionsMode = mkPreStartupMode ShowSupportedExtensions
-showOptionsMode             = mkPreStartupMode ShowOptions
+showOptionsMode             = mkPreStartupMode (ShowOptions False)
 
 mkPreStartupMode :: PreStartupMode -> Mode
 mkPreStartupMode = Left
@@ -528,18 +528,18 @@ type ModeM = CmdLineP (Maybe (Mode, String), [String], [Located String])
 mode_flags :: [Flag ModeM]
 mode_flags =
   [  ------- help / version ----------------------------------------------
-    Flag "?"                     (PassFlag (setMode showGhcUsageMode))
-  , Flag "-help"                 (PassFlag (setMode showGhcUsageMode))
-  , Flag "V"                     (PassFlag (setMode showVersionMode))
-  , Flag "-version"              (PassFlag (setMode showVersionMode))
-  , Flag "-numeric-version"      (PassFlag (setMode showNumVersionMode))
-  , Flag "-info"                 (PassFlag (setMode showInfoMode))
-  , Flag "-show-options"         (PassFlag (setMode showOptionsMode))
-  , Flag "-supported-languages"  (PassFlag (setMode showSupportedExtensionsMode))
-  , Flag "-supported-extensions" (PassFlag (setMode showSupportedExtensionsMode))
-  , Flag "-show-packages"        (PassFlag (setMode showPackagesMode))
+    defFlag "?"                     (PassFlag (setMode showGhcUsageMode))
+  , defFlag "-help"                 (PassFlag (setMode showGhcUsageMode))
+  , defFlag "V"                     (PassFlag (setMode showVersionMode))
+  , defFlag "-version"              (PassFlag (setMode showVersionMode))
+  , defFlag "-numeric-version"      (PassFlag (setMode showNumVersionMode))
+  , defFlag "-info"                 (PassFlag (setMode showInfoMode))
+  , defFlag "-show-options"         (PassFlag (setMode showOptionsMode))
+  , defFlag "-supported-languages"  (PassFlag (setMode showSupportedExtensionsMode))
+  , defFlag "-supported-extensions" (PassFlag (setMode showSupportedExtensionsMode))
+  , defFlag "-show-packages"        (PassFlag (setMode showPackagesMode))
   ] ++
-  [ Flag k'                      (PassFlag (setMode (printSetting k)))
+  [ defFlag k'                      (PassFlag (setMode (printSetting k)))
   | k <- ["Project version",
           "Booter version",
           "Stage",
@@ -565,20 +565,20 @@ mode_flags =
         replaceSpace c   = c
   ] ++
       ------- interfaces ----------------------------------------------------
-  [ Flag "-show-iface"  (HasArg (\f -> setMode (showInterfaceMode f)
+  [ defFlag "-show-iface"  (HasArg (\f -> setMode (showInterfaceMode f)
                                                "--show-iface"))
 
       ------- primary modes ------------------------------------------------
-  , Flag "c"            (PassFlag (\f -> do setMode (stopBeforeMode StopLn) f
-                                            addFlag "-no-link" f))
-  , Flag "M"            (PassFlag (setMode doMkDependHSMode))
-  , Flag "E"            (PassFlag (setMode (stopBeforeMode anyHsc)))
-  , Flag "C"            (PassFlag (setMode (stopBeforeMode HCc)))
-  , Flag "S"            (PassFlag (setMode (stopBeforeMode (As False))))
-  , Flag "-make"        (PassFlag (setMode doMakeMode))
-  , Flag "-interactive" (PassFlag (setMode doInteractiveMode))
-  , Flag "-abi-hash"    (PassFlag (setMode doAbiHashMode))
-  , Flag "e"            (SepArg   (\s -> setMode (doEvalMode s) "-e"))
+  , defFlag "c"            (PassFlag (\f -> do setMode (stopBeforeMode StopLn) f
+                                               addFlag "-no-link" f))
+  , defFlag "M"            (PassFlag (setMode doMkDependHSMode))
+  , defFlag "E"            (PassFlag (setMode (stopBeforeMode anyHsc)))
+  , defFlag "C"            (PassFlag (setMode (stopBeforeMode HCc)))
+  , defFlag "S"            (PassFlag (setMode (stopBeforeMode (As False))))
+  , defFlag "-make"        (PassFlag (setMode doMakeMode))
+  , defFlag "-interactive" (PassFlag (setMode doInteractiveMode))
+  , defFlag "-abi-hash"    (PassFlag (setMode doAbiHashMode))
+  , defFlag "e"            (SepArg   (\s -> setMode (doEvalMode s) "-e"))
   ]
 
 setMode :: Mode -> String -> EwM ModeM ()
@@ -612,6 +612,14 @@ setMode newMode newFlag = liftEwM $ do
                          errs)
                     -- Saying e.g. --interactive --interactive is OK
                     _ | oldFlag == newFlag -> ((oldMode, oldFlag), errs)
+
+                    -- --interactive and --show-options are used together
+                    (Right (Right DoInteractive), Left (ShowOptions _)) ->
+                      ((Left (ShowOptions True),
+                        "--interactive --show-options"), errs)
+                    (Left (ShowOptions _), (Right (Right DoInteractive))) ->
+                      ((Left (ShowOptions True),
+                        "--show-options --interactive"), errs)
                     -- Otherwise, complain
                     _ -> let err = flagMismatchErr oldFlag newFlag
                          in ((oldMode, oldFlag), err : errs)
@@ -711,20 +719,22 @@ showSupportedExtensions = mapM_ putStrLn supportedLanguagesAndExtensions
 showVersion :: IO ()
 showVersion = putStrLn (cProjectName ++ ", version " ++ cProjectVersion)
 
-showOptions :: IO ()
-showOptions = putStr (unlines availableOptions)
+showOptions :: Bool -> IO ()
+showOptions isInteractive = putStr (unlines availableOptions)
     where
-      availableOptions     = map ((:) '-') $
-                             getFlagNames mode_flags   ++
-                             getFlagNames flagsDynamic ++
-                             (filterUnwantedStatic . getFlagNames $ flagsStatic) ++
-                             flagsStaticNames
-      getFlagNames opts         = map getFlagName opts
-      getFlagName (Flag name _) = name
+      availableOptions = concat [
+        flagsForCompletion isInteractive,
+        map ('-':) (concat [
+            getFlagNames mode_flags
+          , (filterUnwantedStatic . getFlagNames $ flagsStatic)
+          , flagsStaticNames
+          ])
+        ]
+      getFlagNames opts         = map flagName opts
       -- this is a hack to get rid of two unwanted entries that get listed
       -- as static flags. Hopefully this hack will disappear one day together
       -- with static flags
-      filterUnwantedStatic      = filter (\x -> not (x `elem` ["f", "fno-"]))
+      filterUnwantedStatic      = filter (`notElem`["f", "fno-"])
 
 showGhcUsage :: DynFlags -> IO ()
 showGhcUsage = showUsage False