Commit 0bff9e67 authored by Julian Priestley's avatar Julian Priestley Committed by Ben Gamari

Don't add targets that can't be found in GHCi

When using the :add command in haxlsh/ghci, a module/file that can't
be found is still added to the list of targets, resulting in an error
message for the bad module/file for every subsequent usage of the
command. The add command should verify that the module/file can be
found before adding it to the list of targets.

Also add a ":show targets" command to show the currently added list of
commands, and an ":unadd" command to remove a target.

Test Plan:
Add a new GHCi testcase that checks that :add doesn't remember either
files or modules that could not be found, and that both the new :show
and :unadd commands work as expected.

Reviewers: simonmar, bgamari

Reviewed By: simonmar

Subscribers: rwbarton, thomie, carter

GHC Trac Issues: #14676

Differential Revision: https://phabricator.haskell.org/D4321
parent 0171e09e
......@@ -43,6 +43,7 @@ import GHCi.RemoteTypes
import GHCi.BreakArray
import DynFlags
import ErrUtils hiding (traceCmd)
import Finder
import GhcMonad ( modifySession )
import qualified GHC
import GHC ( LoadHowMuch(..), Target(..), TargetId(..), InteractiveImport(..),
......@@ -208,6 +209,7 @@ ghciCommands = map mkCmd [
("stepmodule",keepGoing stepModuleCmd, completeIdentifier),
("type", keepGoing' typeOfExpr, completeExpression),
("trace", keepGoing traceCmd, completeExpression),
("unadd", keepGoingPaths unAddModule, completeFilename),
("undef", keepGoing undefineMacro, completeMacro),
("unset", keepGoing unsetOptions, completeSetOptions),
("where", keepGoing whereCmd, noCompletion)
......@@ -305,6 +307,7 @@ defFullHelpText =
" :type <expr> show the type of <expr>\n" ++
" :type +d <expr> show the type of <expr>, defaulting type variables\n" ++
" :type +v <expr> show the type of <expr>, with its specified tyvars\n" ++
" :unadd <module> ... remove module(s) from the current target set\n" ++
" :undef <cmd> undefine user-defined command :<cmd>\n" ++
" :!<command> run the shell command <command>\n" ++
"\n" ++
......@@ -371,6 +374,7 @@ defFullHelpText =
" :show packages show the currently active package flags\n" ++
" :show paths show the currently active search paths\n" ++
" :show language show the currently active language flags\n" ++
" :show targets show the current set of targets\n" ++
" :show <setting> show value of <setting>, which is one of\n" ++
" [args, prog, editor, stop]\n" ++
" :showi language show language flags for interactive evaluation\n" ++
......@@ -1657,9 +1661,39 @@ addModule files = do
lift revertCAFs -- always revert CAFs on load/add.
files' <- mapM expandPath files
targets <- mapM (\m -> GHC.guessTarget m Nothing) files'
targets' <- filterM checkTarget targets
-- remove old targets with the same id; e.g. for :add *M
mapM_ GHC.removeTarget [ tid | Target tid _ _ <- targets' ]
mapM_ GHC.addTarget targets'
_ <- doLoadAndCollectInfo False LoadAllTargets
return ()
where
checkTarget :: Target -> InputT GHCi Bool
checkTarget (Target (TargetModule m) _ _) = checkTargetModule m
checkTarget (Target (TargetFile f _) _ _) = liftIO $ checkTargetFile f
checkTargetModule :: ModuleName -> InputT GHCi Bool
checkTargetModule m = do
hsc_env <- GHC.getSession
result <- liftIO $
Finder.findImportedModule hsc_env m (Just (fsLit "this"))
case result of
Found _ _ -> return True
_ -> (liftIO $ putStrLn $
"Module " ++ moduleNameString m ++ " not found") >> return False
checkTargetFile :: String -> IO Bool
checkTargetFile f = do
exists <- (doesFileExist f) :: IO Bool
unless exists $ putStrLn $ "File " ++ f ++ " not found"
return exists
-- | @:unadd@ command
unAddModule :: [FilePath] -> InputT GHCi ()
unAddModule files = do
files' <- mapM expandPath files
targets <- mapM (\m -> GHC.guessTarget m Nothing) files'
mapM_ GHC.removeTarget [ tid | Target tid _ _ <- targets ]
mapM_ GHC.addTarget targets
_ <- doLoadAndCollectInfo False LoadAllTargets
return ()
......@@ -2779,6 +2813,7 @@ showCmd str = do
, action "language" $ showLanguages
, hidden "languages" $ showLanguages -- backwards compat
, hidden "lang" $ showLanguages -- useful abbreviation
, action "targets" $ showTargets
]
case words str of
......@@ -2941,6 +2976,14 @@ showLanguages' show_all dflags =
Nothing -> Just Haskell2010
other -> other
showTargets :: GHCi ()
showTargets = mapM_ showTarget =<< GHC.getTargets
where
showTarget :: Target -> GHCi ()
showTarget (Target (TargetFile f _) _ _) = liftIO (putStrLn f)
showTarget (Target (TargetModule m) _ _) =
liftIO (putStrLn $ moduleNameString m)
-- -----------------------------------------------------------------------------
-- Completion
......
:add Notfound.hs
:add NotFound
:show targets
:add prog002/A1.hs
:show targets
:unadd prog002/A1.hs
:show targets
File Notfound.hs not found
Module NotFound not found
prog002/A1.hs
......@@ -263,3 +263,4 @@ test('T13407', normal, ghci_script, ['T13407.script'])
test('T13963', normal, ghci_script, ['T13963.script'])
test('T14342', [extra_hc_opts("-XOverloadedStrings -XRebindableSyntax")],
ghci_script, ['T14342.script'])
test('T14676', extra_files(['../prog002']), ghci_script, ['T14676.script'])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment