ghci: Refactor handling of :show
authorBen Gamari <bgamari.foss@gmail.com>
Sun, 29 Nov 2015 21:49:04 +0000 (22:49 +0100)
committerBen Gamari <ben@smart-cactus.org>
Sun, 29 Nov 2015 21:49:16 +0000 (22:49 +0100)
In so doing ensure that the help text can't fall out of sync with the
implementation.

Test Plan: Validate and play in ghci

Reviewers: austin, thomie

Reviewed By: austin, thomie

Subscribers: thomie

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

GHC Trac Issues: #11111

ghc/InteractiveUI.hs

index 026d6ea..393de5c 100644 (file)
@@ -2333,27 +2333,45 @@ showCmd :: String -> GHCi ()
 showCmd ""   = showOptions False
 showCmd "-a" = showOptions True
 showCmd str = do
-  st <- getGHCiState
-  case words str of
-        ["args"]     -> liftIO $ putStrLn (show (GhciMonad.args st))
-        ["prog"]     -> liftIO $ putStrLn (show (progname st))
-        ["editor"]   -> liftIO $ putStrLn (show (editor st))
-        ["stop"]     -> liftIO $ putStrLn (show (stop st))
-        ["imports"]  -> showImports
-        ["modules" ] -> showModules
-        ["bindings"] -> showBindings
-        ["linker"]   ->
-            do dflags <- getDynFlags
-               liftIO $ showLinkerState dflags
-        ["breaks"]   -> showBkptTable
-        ["context"]  -> showContext
-        ["packages"]  -> showPackages
-        ["paths"]     -> showPaths
-        ["languages"] -> showLanguages -- backwards compat
-        ["language"]  -> showLanguages
-        ["lang"]      -> showLanguages -- useful abbreviation
-        _ -> throwGhcException (CmdLineError ("syntax:  :show [ args | prog | editor | stop | modules\n" ++
-                                              "               | bindings | breaks | context | packages | language ]"))
+    st <- getGHCiState
+    dflags <- getDynFlags
+
+    let lookupCmd :: String -> Maybe (GHCi ())
+        lookupCmd name = lookup name $ map (\(_,b,c) -> (b,c)) cmds
+
+        -- (show in help?, command name, action)
+        action :: String -> GHCi () -> (Bool, String, GHCi ())
+        action name m = (True, name, m)
+
+        hidden :: String -> GHCi () -> (Bool, String, GHCi ())
+        hidden name m = (False, name, m)
+
+        cmds =
+            [ action "args"       $ liftIO $ putStrLn (show (GhciMonad.args st))
+            , action "prog"       $ liftIO $ putStrLn (show (progname st))
+            , action "editor"     $ liftIO $ putStrLn (show (editor st))
+            , action "stop"       $ liftIO $ putStrLn (show (stop st))
+            , action "imports"    $ showImports
+            , action "modules"    $ showModules
+            , action "bindings"   $ showBindings
+            , action "linker"     $ getDynFlags >>= liftIO . showLinkerState
+            , action "breaks"     $ showBkptTable
+            , action "context"    $ showContext
+            , action "packages"   $ showPackages
+            , action "paths"      $ showPaths
+            , action "language"   $ showLanguages
+            , hidden "languages"  $ showLanguages -- backwards compat
+            , hidden "lang"       $ showLanguages -- useful abbreviation
+            ]
+
+    case words str of
+      [w] | Just action <- lookupCmd w -> action
+
+      _ -> let helpCmds = [ text name | (True, name, _) <- cmds ]
+           in throwGhcException $ CmdLineError $ showSDoc dflags
+              $ hang (text "syntax:") 4
+              $ hang (text ":show") 6
+              $ brackets (fsep $ punctuate (text " |") helpCmds)
 
 showiCmd :: String -> GHCi ()
 showiCmd str = do