-- (c) The GHC Team 2005-2006
--
-----------------------------------------------------------------------------
-module InteractiveUI ( interactiveUI ) where
+module InteractiveUI ( interactiveUI, ghciWelcomeMsg ) where
#include "HsVersions.h"
import qualified GHC
import GHC ( Session, LoadHowMuch(..), Target(..), TargetId(..),
Type, Module, ModuleName, TyThing(..), Phase,
- BreakIndex, Name, SrcSpan, Resume, SingleStep )
+ BreakIndex, SrcSpan, Resume, SingleStep )
import DynFlags
import Packages
import PackageConfig
import PprTyThing
import Outputable hiding (printForUser)
import Module -- for ModuleEnv
+import Name
-- Other random utilities
import Digraph
-----------------------------------------------------------------------------
-ghciWelcomeMsg =
- " ___ ___ _\n"++
- " / _ \\ /\\ /\\/ __(_)\n"++
- " / /_\\// /_/ / / | | GHC Interactive, version " ++ cProjectVersion ++ ", for Haskell 98.\n"++
- "/ /_\\\\/ __ / /___| | http://www.haskell.org/ghc/\n"++
- "\\____/\\/ /_/\\____/|_| Type :? for help.\n"
-
-ghciShortWelcomeMsg =
- "GHCi, version " ++ cProjectVersion ++
- ": http://www.haskell.org/ghc/ :? for help"
+ghciWelcomeMsg :: String
+ghciWelcomeMsg = "GHCi, version " ++ cProjectVersion ++
+ ": http://www.haskell.org/ghc/ :? for help"
type Command = (String, String -> GHCi Bool, Bool, String -> IO [String])
cmdName (n,_,_,_) = n
-- initialise the console if necessary
io setUpConsole
- let msg = if dopt Opt_ShortGhciBanner dflags
- then ghciShortWelcomeMsg
- else ghciWelcomeMsg
- when (verbosity dflags >= 1) $ io $ putStrLn msg
-
-- enter the interactive loop
interactiveLoop is_tty show_prompt
Just expr -> do
case run_result of
GHC.RunOk names -> do
show_types <- isOptionSet ShowType
- when show_types $ mapM_ (showTypeOfName session) names
+ when show_types $ printTypeOfNames session names
GHC.RunBreak _ names mb_info -> do
resumes <- io $ GHC.getResumeContext session
printForUser $ ptext SLIT("Stopped at") <+>
ppr (GHC.resumeSpan (head resumes))
- mapM_ (showTypeOfName session) names
+ printTypeOfNames session names
maybe (return ()) runBreakCmd mb_info
-- run the command set with ":set stop <cmd>"
st <- getGHCiState
| otherwise -> do enqueueCommands [cmd]; return ()
where cmd = onBreakCmd loc
-showTypeOfName :: Session -> Name -> GHCi ()
-showTypeOfName session n
+printTypeOfNames :: Session -> [Name] -> GHCi ()
+printTypeOfNames session names
+ = mapM_ (printTypeOfName session) $ sortBy compareNames names
+
+compareNames :: Name -> Name -> Ordering
+n1 `compareNames` n2 = compareWith n1 `compare` compareWith n2
+ where compareWith n = (getOccString n, getSrcSpan n)
+
+printTypeOfName :: Session -> Name -> GHCi ()
+printTypeOfName session n
= do maybe_tything <- io (GHC.lookupName session n)
- case maybe_tything of
- Nothing -> return ()
- Just thing -> showTyThing thing
+ case maybe_tything of
+ Nothing -> return ()
+ Just thing -> printTyThing thing
specialCommand :: String -> GHCi Bool
specialCommand ('!':str) = shellEscape (dropWhile isSpace str)
-- 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, str `isPrefixOf` s ] of
[] -> return Nothing
c:_ -> return (Just c)
checkModule m = do
let modl = GHC.mkModuleName m
session <- getSession
- result <- io (GHC.checkModule session modl)
+ result <- io (GHC.checkModule session modl False)
case result of
Nothing -> io $ putStrLn "Nothing"
Just r -> io $ putStrLn (showSDoc (
s <- getSession
unqual <- io (GHC.getPrintUnqual s)
bindings <- io (GHC.getBindings s)
- mapM_ showTyThing bindings
+ mapM_ printTyThing $ sortBy compareTyThings bindings
return ()
-showTyThing (AnId id) = do
+compareTyThings :: TyThing -> TyThing -> Ordering
+t1 `compareTyThings` t2 = getName t1 `compareNames` getName t2
+
+printTyThing :: TyThing -> GHCi ()
+printTyThing (AnId id) = do
ty' <- cleanType (GHC.idType id)
printForUser $ ppr id <> text " :: " <> ppr ty'
-showTyThing _ = return ()
+printTyThing _ = return ()
-- if -fglasgow-exts is on we show the foralls, otherwise we don't.
cleanType :: Type -> GHCi Type
s <- getSession
(names, ix, span) <- io $ GHC.back s
printForUser $ ptext SLIT("Logged breakpoint at") <+> ppr span
- mapM_ (showTypeOfName s) names
+ printTypeOfNames s names
-- run the command set with ":set stop <cmd>"
st <- getGHCiState
enqueueCommands [stop st]
printForUser $ (if (ix == 0)
then ptext SLIT("Stopped at")
else ptext SLIT("Logged breakpoint at")) <+> ppr span
- mapM_ (showTypeOfName s) names
+ printTypeOfNames s names
-- run the command set with ":set stop <cmd>"
st <- getGHCiState
enqueueCommands [stop st]
-- If the highlight flag is True, also highlight the span using
-- start_bold/end_bold.
listAround span do_highlight = do
- pwd <- getEnv "PWD"
- contents <- BS.readFile (pwd `joinFileName` unpackFS file)
+ contents <- BS.readFile (unpackFS file)
let
lines = BS.split '\n' contents
these_lines = take (line2 - line1 + 1 + pad_before + pad_after) $