-- (c) The GHC Team 2005-2006
--
-----------------------------------------------------------------------------
-module InteractiveUI ( interactiveUI ) where
+module InteractiveUI ( interactiveUI, ghciWelcomeMsg ) where
#include "HsVersions.h"
import Packages
import PackageConfig
import UniqFM
+import HscTypes ( implicitTyThings )
import PprTyThing
import Outputable hiding (printForUser)
import Module -- for ModuleEnv
import StaticFlags
import Linker
import Util
+import NameSet
+import Maybes ( orElse )
import FastString
#ifndef mingw32_HOST_OS
-----------------------------------------------------------------------------
-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
" :info [<name> ...] display information about the given names\n" ++
" :kind <type> show the kind of <type>\n" ++
" :load <filename> ... load module(s) and their dependents\n" ++
- " :module [+/-] [*]<mod> ... set the context for expression evaluation\n" ++
" :main [<arguments> ...] run the main function with the given arguments\n" ++
+ " :module [+/-] [*]<mod> ... set the context for expression evaluation\n" ++
" :quit exit GHCi\n" ++
" :reload reload the current module set\n" ++
" :type <expr> show the type of <expr>\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
-- 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)
info s = do { let names = words s
; session <- getSession
; dflags <- getDynFlags
- ; let exts = dopt Opt_GlasgowExts dflags
- ; mapM_ (infoThing exts session) names }
+ ; let pefas = dopt Opt_PrintExplicitForalls dflags
+ ; mapM_ (infoThing pefas session) names }
where
- infoThing exts session str = io $ do
- names <- GHC.parseName session str
- let filtered = filterOutChildren names
- mb_stuffs <- mapM (GHC.getInfo session) filtered
+ infoThing pefas session str = io $ do
+ names <- GHC.parseName session str
+ mb_stuffs <- mapM (GHC.getInfo session) names
+ let filtered = filterOutChildren (\(t,f,i) -> t) (catMaybes mb_stuffs)
unqual <- GHC.getPrintUnqual session
putStrLn (showSDocForUser unqual $
vcat (intersperse (text "") $
- [ pprInfo exts stuff | Just stuff <- mb_stuffs ]))
+ map (pprInfo pefas) filtered))
-- Filter out names whose parent is also there Good
-- example is '[]', which is both a type and data
-- constructor in the same type
-filterOutChildren :: [Name] -> [Name]
-filterOutChildren names = filter (not . parent_is_there) names
- where parent_is_there n
--- | Just p <- GHC.nameParent_maybe n = p `elem` names
--- ToDo!!
- | otherwise = False
-
-pprInfo exts (thing, fixity, insts)
- = pprTyThingInContextLoc exts thing
+filterOutChildren :: (a -> TyThing) -> [a] -> [a]
+filterOutChildren get_thing xs
+ = [x | x <- xs, not (getName (get_thing x) `elemNameSet` implicits)]
+ where
+ implicits = mkNameSet [getName t | x <- xs, t <- implicitTyThings (get_thing x)]
+
+pprInfo :: PrintExplicitForalls -> (TyThing, Fixity, [GHC.Instance]) -> SDoc
+pprInfo pefas (thing, fixity, insts)
+ = pprTyThingInContextLoc pefas thing
$$ show_fixity fixity
$$ vcat (map GHC.pprInstance insts)
where
Just mod_info -> do
let names
| exports_only = GHC.modInfoExports mod_info
- | otherwise = fromMaybe [] (GHC.modInfoTopLevelScope mod_info)
+ | otherwise = GHC.modInfoTopLevelScope mod_info
+ `orElse` []
- filtered = filterOutChildren names
-
- things <- io $ mapM (GHC.lookupName s) filtered
+ mb_things <- io $ mapM (GHC.lookupName s) names
+ let filtered_things = filterOutChildren (\t -> t) (catMaybes mb_things)
dflags <- getDynFlags
- let exts = dopt Opt_GlasgowExts dflags
+ let pefas = dopt Opt_PrintExplicitForalls dflags
io (putStrLn (showSDocForUser unqual (
- vcat (map (pprTyThingInContext exts) (catMaybes things))
+ vcat (map (pprTyThingInContext pefas) filtered_things)
)))
-- ToDo: modInfoInstances currently throws an exception for
-- package modules. When it works, we can do this:
cleanType :: Type -> GHCi Type
cleanType ty = do
dflags <- getDynFlags
- if dopt Opt_GlasgowExts dflags
+ if dopt Opt_PrintExplicitForalls dflags
then return ty
else return $! GHC.dropForAlls ty
breakByModule session mod args@(arg1:rest)
| all isDigit arg1 = do -- looks like a line number
breakByModuleLine mod (read arg1) rest
- | otherwise = io $ putStrLn "Invalid arguments to :break"
+breakByModule session mod _
+ = breakSyntax
breakByModuleLine :: Module -> Int -> [String] -> GHCi ()
breakByModuleLine mod line args
| [] <- args = findBreakAndSet mod $ findBreakByLine line
| [col] <- args, all isDigit col =
findBreakAndSet mod $ findBreakByCoord Nothing (line, read col)
- | otherwise = io $ putStrLn "Invalid arguments to :break"
+ | otherwise = breakSyntax
+
+breakSyntax = throwDyn (CmdLineError "Syntax: :break [<mod>] <line> [<column>]")
findBreakAndSet :: Module -> (TickArray -> Maybe (Int, SrcSpan)) -> GHCi ()
findBreakAndSet mod lookupTickTree = do
-- 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) $
projects / ghc-hetmet.git / blobdiff