Merge pull request #375 from bgamari/set

Print DynFlags when :set is used without arguments

src/IHaskell/Eval/Evaluate.hs

@@ -403,12 +403,11 @@ evalCommand _ (Module contents) state = wrapExecution state $ do
 -- | Directives set via `:set`.
 evalCommand output (Directive SetDynFlag flags) state =
   case words flags of
-    
     [] -> do
-      write "Help for setting flags"
+      flags <- getSessionDynFlags
       return EvalOut {
           evalStatus = Success,
-        evalResult = Display [plain "You can use the :set command to set IHaskell flags, and GHC flags"],
+          evalResult = Display [plain $ showSDoc flags $ vcat [pprDynFlags False flags, pprLanguages False flags]],
           evalState = state,
           evalPager = "",
           evalComms = []

src/IHaskell/Eval/Util.hs

@@ -18,9 +18,11 @@ module IHaskell.Eval.Util (
 
   -- * Pretty printing
   doc,
+  pprDynFlags,
+  pprLanguages
   ) where
 
-import           ClassyPrelude
+import           ClassyPrelude hiding ((<>))
 
 -- GHC imports.
 import           DynFlags
@@ -75,6 +77,83 @@ extensionFlag ext =
     -- In that case, we disable the extension.
     flagMatchesNo ext (name, _, _) = ext == "No" ++ name
 
+#if !MIN_VERSION_ghc(7,10,0)
+flagSpecName :: FlagSpec a -> String
+flagSpecName (name,_,_) = name
+
+flagSpecFlag :: FlagSpec a -> a
+flagSpecFlag (_,flag,_) = flag
+#endif
+
+-- | Pretty-print dynamic flags (taken from 'InteractiveUI' module of `ghc-bin`)
+pprDynFlags :: Bool       -- ^ Whether to include flags which are on by default
+            -> DynFlags
+            -> SDoc
+pprDynFlags show_all dflags =
+  vcat [
+     text "GHCi-specific dynamic flag settings:" $$
+         nest 2 (vcat (map (setting gopt) ghciFlags)),
+     text "other dynamic, non-language, flag settings:" $$
+         nest 2 (vcat (map (setting gopt) others)),
+     text "warning settings:" $$
+         nest 2 (vcat (map (setting wopt) DynFlags.fWarningFlags))
+  ]
+  where
+        setting test flag
+          | quiet     = empty
+          | 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)
+
+        fstr   str = text "-f"    <> text str
+        fnostr str = text "-fno-" <> text str
+
+        (ghciFlags,others)  = partition (\f -> flagSpecFlag f `elem` flgs)
+                                        DynFlags.fFlags
+        flgs = [ Opt_PrintExplicitForalls
+               , Opt_PrintExplicitKinds
+               , Opt_PrintBindResult
+               , Opt_BreakOnException
+               , Opt_BreakOnError
+               , Opt_PrintEvldWithShow
+               ]
+
+-- | Pretty-print the base language and active options (taken from `InteractiveUI` module of `ghc-bin`)
+pprLanguages :: Bool      -- ^ Whether to include flags which are on by default
+             -> DynFlags
+             -> SDoc
+pprLanguages show_all dflags =
+  vcat
+     [ text "base language is: " <>
+         case language dflags of
+           Nothing          -> text "Haskell2010"
+           Just Haskell98   -> text "Haskell98"
+           Just Haskell2010 -> text "Haskell2010"
+     , (if show_all then text "all active language options:"
+                    else text "with the following modifiers:") $$
+          nest 2 (vcat (map (setting xopt) DynFlags.xFlags))
+     ]
+  where
+   setting test flag
+          | quiet     = empty
+          | 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 =
+       defaultDynFlags (settings dflags) `lang_set`
+         case language dflags of
+           Nothing -> Just Haskell2010
+           other   -> other
+
 -- | Set an extension and update flags.
 -- Return @Nothing@ on success. On failure, return an error message.
 setExtension :: GhcMonad m => String -> m (Maybe String)