[Git][ghc/ghc][wip/T13869] Improve GHCi response to unloading modules and reloading when no modules are present.

[Jade (@Jade)]

Jade pushed to branch wip/T13869 at Glasgow Haskell Compiler / GHC


Commits:
3fe20cf9 by Jade at 2024-01-23T11:55:16+01:00
Improve GHCi response to unloading modules and reloading when no modules are present.

Fixes #13869

- - - - -


1 changed file:

- ghc/GHCi/UI.hs


Changes:

=====================================
ghc/GHCi/UI.hs
=====================================
@@ -136,6 +136,7 @@ import Data.Time.Format ( formatTime, defaultTimeLocale )
 import Data.Version ( showVersion )
 import qualified Data.Semigroup as S
 import Prelude hiding ((<>))
+import qualified Prelude ((<>))
 
 import GHC.Utils.Exception as Exception hiding (catch, mask, handle)
 import Foreign hiding (void)
@@ -2187,7 +2188,7 @@ afterLoad ok retain_context = do
   revertCAFs  -- always revert CAFs on load.
   discardTickArrays
   loaded_mods <- getLoadedModules
-  modulesLoadedMsg ok loaded_mods
+  modulesLoadedMsg ok loaded_mods retain_context
   graph <- GHC.getModuleGraph
   setContextAfterLoad retain_context (Just graph)
 
@@ -2273,35 +2274,39 @@ keepPackageImports = filterM is_pkg_import
 
 
 
-modulesLoadedMsg :: GHC.GhcMonad m => SuccessFlag -> [GHC.ModSummary] -> m ()
-modulesLoadedMsg ok mods = do
+modulesLoadedMsg :: GHC.GhcMonad m => SuccessFlag -> [GHC.ModSummary] -> Bool -> m ()
+modulesLoadedMsg ok mods reload = do
   dflags <- getDynFlags
-  msg <- if gopt Opt_ShowLoadedModules dflags
-         then do
-               mod_names <- mapM mod_name mods
-               let mod_commas
-                     | null mods = text "none."
-                     | otherwise = hsep (punctuate comma mod_names) <> text "."
-               return $ status <> text ", modules loaded:" <+> mod_commas
-         else do
-               return $ status <> text ","
-                    <+> speakNOf (length mods) (text "module") <+> "loaded."
-
+  mod_names <- mapM mod_name mods
   when (verbosity dflags > 0) $ do
-     rendered_msg <- showSDocForUser' msg
+     let show_loaded_mods = gopt Opt_ShowLoadedModules dflags
+     rendered_msg <- showSDocForUser' (status <> comma <+> get_msg show_loaded_mods mod_names <> dot)
      liftIO $ putStrLn rendered_msg
   where
-    status = case ok of
-                  Failed    -> text "Failed"
-                  Succeeded -> text "Ok"
+    none_loaded   = null mods
+    reload_failed = reload && none_loaded
+
+    get_msg show_loaded_mods mod_ns
+      | reload_failed    = text "no modules to be reloaded"
+      | none_loaded      = text "unloaded all modules"
+      | show_loaded_mods = text "modules" <+> re_loaded <> colon <+> hsep (punctuate comma mod_ns)
+      | otherwise        = speakNOf (length mods) (text "module") <+> re_loaded
+
+    re_loaded = text $ re "loaded"
+    re | reload    = ("re" ++)
+       | otherwise = id
+
+    status = text $ case successIf (not reload_failed) Prelude.<> ok of
+                      Failed    -> "Failed"
+                      Succeeded -> "Ok"
 
     mod_name mod = do
         is_interpreted <- GHC.moduleIsBootOrNotObjectLinkable mod
-        return $ if is_interpreted
-                 then ppr (GHC.ms_mod mod)
-                 else ppr (GHC.ms_mod mod)
-                      <+> parens (text $ normalise $ msObjFilePath mod)
-                      -- Fix #9887
+        pure $ if is_interpreted
+               then ppr (GHC.ms_mod mod)
+               else ppr (GHC.ms_mod mod)
+                    <+> parens (text $ normalise $ msObjFilePath mod)
+                    -- Fix #9887
 
 -- | Run an 'ExceptT' wrapped 'GhcMonad' while handling source errors
 -- and printing 'throwE' strings to 'stderr'. If in expression



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3fe20cf9f6a4296729ac5c258f243a361931cf7c

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3fe20cf9f6a4296729ac5c258f243a361931cf7c
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240123/fb15b6d6/attachment-0001.html>