hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

user friendly messages.

Browse Source
This commit is contained in:
Kazu Yamamoto 2010-11-18 16:38:55 +09:00
parent 39409f2239
commit d81954d2c8
1 changed files with 24 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
Info.hs
View File

@ -1,6 +1,7 @@
module Info where module Info where
import Control.Applicative hiding (empty) import Control.Applicative hiding (empty)
import Control.Monad
import Data.Maybe import Data.Maybe
import GHC import GHC
import Outputable import Outputable
@ -29,8 +30,10 @@ typeOf fileName modstr expr = withGHC $ valid `gcatch` invalid
initSession ["-w"] initSession ["-w"]
setTargetFile fileName setTargetFile fileName
loadWithLogger (\_ -> return ()) x loadWithLogger (\_ -> return ()) x
setContextFromTarget ok <- setContextFromTarget
pretty <$> exprType expr if ok
then pretty <$> exprType expr
else return "Its type cannot be guessed"
pretty = showSDocForUser neverQualify . pprTypeForUser False pretty = showSDocForUser neverQualify . pprTypeForUser False
---------------------------------------------------------------- ----------------------------------------------------------------
@ -48,8 +51,10 @@ info fileName modstr expr = withGHC $ valid `gcatch` invalid
initSession ["-w"] initSession ["-w"]
setTargetFile fileName setTargetFile fileName
loadWithLogger (\_ -> return ()) x loadWithLogger (\_ -> return ()) x
setContextFromTarget ok <- setContextFromTarget
infoThing expr if ok
then infoThing expr
else return "Its info is not available"
-- ghc/InteractiveUI.hs -- ghc/InteractiveUI.hs
infoThing str = do infoThing str = do
names <- parseName str names <- parseName str
@ -77,16 +82,23 @@ pprInfo pefas (thing, fixity, insts)
---------------------------------------------------------------- ----------------------------------------------------------------
setContextFromTarget :: Ghc () setContextFromTarget :: Ghc Bool
setContextFromTarget = do setContextFromTarget = do
ms <- depanal [] False ms <- depanal [] False
mdls <- mapM toModule ms top <- map ms_mod <$> filterM isTop ms
setContext (catMaybes mdls) [] {-
where top is a set of this module and your-defined modules.
toModule ms = lookupMod `gcatch` nothing If this module has syntax errors, it cannot be specified.
where And if there is no your-defined modules, top is [].
lookupMod = lookupModule (ms_mod_name ms) Nothing >>= return . Just In this case, we cannot obtain the type of an expression, sigh.
nothing = constE $ return Nothing -}
setContext top []
return $ if top == [] then False else True
where
isTop ms = lookupMod `gcatch` returnFalse
where
lookupMod = lookupModule (ms_mod_name ms) Nothing >> return True
returnFalse = constE $ return False
---------------------------------------------------------------- ----------------------------------------------------------------