TyThing(..), Name, LoadHowMuch(..), Phase,
GhcException(..), showGhcException,
CheckedModule(..), SrcLoc )
+import DynFlags ( allFlags )
import Packages ( PackageState(..) )
import PackageConfig ( InstalledPackageInfo(..) )
import UniqFM ( eltsUFM )
"/ /_\\\\/ __ / /___| | http://www.haskell.org/ghc/\n"++
"\\____/\\/ /_/\\____/|_| Type :? for help.\n"
-type Command = (String, String -> GHCi Bool, String -> IO [String])
-cmdName (n,_,_) = n
+type Command = (String, String -> GHCi Bool, Bool, String -> IO [String])
+cmdName (n,_,_,_) = n
GLOBAL_VAR(commands, builtin_commands, [Command])
builtin_commands :: [Command]
builtin_commands = [
- ("add", keepGoingPaths addModule, completeFilename),
- ("browse", keepGoing browseCmd, completeModule),
- ("cd", keepGoing changeDirectory, completeFilename),
- ("def", keepGoing defineMacro, completeIdentifier),
- ("help", keepGoing help, completeNone),
- ("?", keepGoing help, completeNone),
- ("info", keepGoing info, completeIdentifier),
- ("load", keepGoingPaths loadModule_, completeHomeModuleOrFile),
- ("module", keepGoing setContext, completeModule),
- ("main", keepGoing runMain, completeIdentifier),
- ("reload", keepGoing reloadModule, completeNone),
- ("check", keepGoing checkModule, completeHomeModule),
- ("set", keepGoing setCmd, completeNone), -- ToDo
- ("show", keepGoing showCmd, completeNone),
- ("etags", keepGoing createETagsFileCmd, completeFilename),
- ("ctags", keepGoing createCTagsFileCmd, completeFilename),
- ("type", keepGoing typeOfExpr, completeIdentifier),
- ("kind", keepGoing kindOfType, completeIdentifier),
- ("unset", keepGoing unsetOptions, completeNone), -- ToDo
- ("undef", keepGoing undefineMacro, completeNone), -- ToDo
- ("quit", quit, completeNone)
+ ("add", keepGoingPaths addModule, False, completeFilename),
+ ("browse", keepGoing browseCmd, False, completeModule),
+ ("cd", keepGoing changeDirectory, False, completeFilename),
+ ("def", keepGoing defineMacro, False, completeIdentifier),
+ ("help", keepGoing help, False, completeNone),
+ ("?", keepGoing help, False, completeNone),
+ ("info", keepGoing info, False, completeIdentifier),
+ ("load", keepGoingPaths loadModule_, False, completeHomeModuleOrFile),
+ ("module", keepGoing setContext, False, completeModule),
+ ("main", keepGoing runMain, False, completeIdentifier),
+ ("reload", keepGoing reloadModule, False, completeNone),
+ ("check", keepGoing checkModule, False, completeHomeModule),
+ ("set", keepGoing setCmd, True, completeSetOptions),
+ ("show", keepGoing showCmd, False, completeNone),
+ ("etags", keepGoing createETagsFileCmd, False, completeFilename),
+ ("ctags", keepGoing createCTagsFileCmd, False, completeFilename),
+ ("type", keepGoing typeOfExpr, False, completeIdentifier),
+ ("kind", keepGoing kindOfType, False, completeIdentifier),
+ ("unset", keepGoing unsetOptions, True, completeSetOptions),
+ ("undef", keepGoing undefineMacro, False, completeMacro),
+ ("quit", quit, False, completeNone)
]
keepGoing :: (String -> GHCi ()) -> (String -> GHCi Bool)
" :set <option> ... set options\n" ++
" :set args <arg> ... set the arguments returned by System.getArgs\n" ++
" :set prog <progname> set the value returned by System.getProgName\n" ++
+ " :set prompt <prompt> set the prompt used in GHCi\n" ++
"\n" ++
" :show modules show the currently loaded modules\n" ++
" :show bindings show the current bindings made at the prompt\n" ++
startGHCi (runGHCi srcs maybe_expr)
GHCiState{ progname = "<interactive>",
args = [],
+ prompt = "%s> ",
session = session,
options = [] }
#endif
fileLoop :: Handle -> Bool -> GHCi ()
-fileLoop hdl prompt = do
+fileLoop hdl show_prompt = do
session <- getSession
(mod,imports) <- io (GHC.getContext session)
- when prompt (io (putStr (mkPrompt mod imports)))
+ st <- getGHCiState
+ when show_prompt (io (putStr (mkPrompt mod imports (prompt st))))
l <- io (IO.try (hGetLine hdl))
case l of
Left e | isEOFError e -> return ()
-- EOF.
Right l ->
case removeSpaces l of
- "" -> fileLoop hdl prompt
+ "" -> fileLoop hdl show_prompt
l -> do quit <- runCommand l
- if quit then return () else fileLoop hdl prompt
+ if quit then return () else fileLoop hdl show_prompt
stringLoop :: [String] -> GHCi ()
stringLoop [] = return ()
l -> do quit <- runCommand l
if quit then return () else stringLoop ss
-mkPrompt toplevs exports
- = showSDoc (hsep (map (\m -> char '*' <> pprModule m) toplevs)
- <+> hsep (map pprModule exports)
- <> text "> ")
+mkPrompt toplevs exports prompt
+ = showSDoc $ f prompt
+ where
+ f ('%':'s':xs) = perc_s <> f xs
+ f ('%':'%':xs) = char '%' <> f xs
+ f (x:xs) = char x <> f xs
+ f [] = empty
+
+ perc_s = hsep (map (\m -> char '*' <> pprModule m) toplevs) <+>
+ hsep (map pprModule exports)
+
#ifdef USE_READLINE
readlineLoop :: GHCi ()
(mod,imports) <- io (GHC.getContext session)
io yield
saveSession -- for use by completion
- l <- io (readline (mkPrompt mod imports)
+ st <- getGHCiState
+ l <- io (readline (mkPrompt mod imports (prompt st))
`finally` setNonBlockingFD 0)
-- readline sometimes puts stdin into blocking mode,
-- so we need to put it back for the IO library
case maybe_cmd of
Nothing -> io (hPutStr stdout ("unknown command ':" ++ cmd ++ "'\n"
++ shortHelpText) >> return False)
- Just (_,f,_) -> f (dropWhile isSpace rest)
+ Just (_,f,_,_) -> f (dropWhile isSpace rest)
lookupCommand :: String -> IO (Maybe Command)
lookupCommand str = do
-- look for exact match first, then the first prefix match
case [ c | c <- cmds, str == cmdName c ] of
c:_ -> return (Just c)
- [] -> case [ c | c@(s,_,_) <- cmds, prefixMatch str s ] of
+ [] -> case [ c | c@(s,_,_,_) <- cmds, prefixMatch str s ] of
[] -> return Nothing
c:_ -> return (Just c)
case maybe_hv of
Nothing -> return ()
Just hv -> io (writeIORef commands --
- (cmds ++ [(macro_name, keepGoing (runMacro hv), completeNone)]))
+ (cmds ++ [(macro_name, keepGoing (runMacro hv), False, completeNone)]))
runMacro :: GHC.HValue{-String -> IO String-} -> String -> GHCi ()
runMacro fun s = do
= case words str of
("args":args) -> setArgs args
("prog":prog) -> setProg prog
+ ("prompt":prompt) -> setPrompt (dropWhile isSpace $ drop 6 $ dropWhile isSpace str)
wds -> setOptions wds
setArgs args = do
setProg _ = do
io (hPutStrLn stderr "syntax: :set prog <progname>")
+setPrompt value = do
+ st <- getGHCiState
+ if null value
+ then io $ hPutStrLn stderr $ "syntax: :set prompt <prompt>, currently \"" ++ prompt st ++ "\""
+ else setGHCiState st{ prompt = remQuotes value }
+ where
+ remQuotes ('\"':xs) | not (null xs) && last xs == '\"' = init xs
+ remQuotes x = x
+
setOptions wds =
do -- first, deal with the GHCi opts (+s, +t, etc.)
let (plus_opts, minus_opts) = partition isPlus wds
-- -----------------------------------------------------------------------------
-- Completion
+completeNone :: String -> IO [String]
+completeNone w = return []
+
#ifdef USE_READLINE
completeWord :: String -> Int -> Int -> IO (Maybe (String, [String]))
completeWord w start end = do
_other
| Just c <- is_cmd line -> do
maybe_cmd <- lookupCommand c
+ let (n,w') = selectWord (words' 0 line)
case maybe_cmd of
Nothing -> return Nothing
- Just (_,_,complete) -> wrapCompleter complete w
+ Just (_,_,False,complete) -> wrapCompleter complete w
+ Just (_,_,True,complete) -> let complete' w = do rets <- complete w
+ return (map (drop n) rets)
+ in wrapCompleter complete' w'
| otherwise -> do
--printf "complete %s, start = %d, end = %d\n" w start end
wrapCompleter completeIdentifier w
+ where words' _ [] = []
+ words' n str = let (w,r) = break isSpace str
+ (s,r') = span isSpace r
+ in (n,w):words' (n+length w+length s) r'
+ -- In a Haskell expression we want to parse 'a-b' as three words
+ -- where a compiler flag (ie. -fno-monomorphism-restriction) should
+ -- only be a single word.
+ selectWord [] = (0,w)
+ selectWord ((offset,x):xs)
+ | offset+length x >= start = (start-offset,take (end-offset) x)
+ | otherwise = selectWord xs
is_cmd line
| ((':':w) : _) <- words (dropWhile isSpace line) = Just w
| otherwise = Nothing
-completeNone w = return []
-
completeCmd w = do
cmds <- readIORef commands
return (filter (w `isPrefixOf`) (map (':':) (map cmdName cmds)))
+completeMacro w = do
+ cmds <- readIORef commands
+ let cmds' = [ cmd | cmd <- map cmdName cmds, cmd `elem` map cmdName builtin_commands ]
+ return (filter (w `isPrefixOf`) cmds')
+
completeIdentifier w = do
s <- restoreSession
rdrs <- GHC.getRdrNamesInScope s
let home_mods = map GHC.ms_mod g
return (filter (w `isPrefixOf`) (map (showSDoc.ppr) home_mods))
+completeSetOptions w = do
+ return (filter (w `isPrefixOf`) options)
+ where options = "args":"prog":allFlags
+
completeFilename = Readline.filenameCompletionFunction
completeHomeModuleOrFile = unionComplete completeHomeModule completeFilename
= map GHC.mkModule (concat (map exposedModules (filter exposed (eltsUFM pkg_db))))
where
pkg_db = pkgIdMap (pkgState dflags)
+#else
+completeCmd = completeNone
+completeMacro = completeNone
+completeIdentifier = completeNone
+completeModule = completeNone
+completeHomeModule = completeNone
+completeSetOptions = completeNone
+completeFilename = completeNone
+completeHomeModuleOrFile=completeNone
#endif
-----------------------------------------------------------------------------
{
progname :: String,
args :: [String],
+ prompt :: String,
session :: GHC.Session,
options :: [GHCiOption]
}