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

cosmetic change.

Browse Source
This commit is contained in:
Kazu Yamamoto 2011-01-14 11:18:33 +09:00
parent 34f360fef7
commit 2f804f5de1
1 changed files with 20 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
Info.hs
View File

@ -23,9 +23,9 @@ typeExpr :: Options -> ModuleString -> Expression -> FilePath -> IO String
typeExpr _ modstr expr file = (++ "\n") <$> typeOf file modstr expr typeExpr _ modstr expr file = (++ "\n") <$> typeOf file modstr expr
typeOf :: FilePath -> ModuleString -> Expression -> IO String typeOf :: FilePath -> ModuleString -> Expression -> IO String
typeOf fileName modstr expr = typeOf fileName modstr expr = inModuleContext fileName modstr exprToType
inModuleContext fileName modstr (pretty <$> exprType expr)
where where
exprToType = pretty <$> exprType expr
pretty = showSDocForUser neverQualify . pprTypeForUser False pretty = showSDocForUser neverQualify . pprTypeForUser False
---------------------------------------------------------------- ----------------------------------------------------------------
@ -34,15 +34,20 @@ infoExpr :: Options -> ModuleString -> Expression -> FilePath -> IO String
infoExpr _ modstr expr file = (++ "\n") <$> info file modstr expr infoExpr _ modstr expr file = (++ "\n") <$> info file modstr expr
info :: FilePath -> ModuleString -> FilePath -> IO String info :: FilePath -> ModuleString -> FilePath -> IO String
info fileName modstr expr = inModuleContext fileName modstr (infoThing expr) info fileName modstr expr = inModuleContext fileName modstr exprToInfo
where where
-- ghc/InteractiveUI.hs exprToInfo = infoThing expr
infoThing str = do
names <- parseName str ----------------------------------------------------------------
mb_stuffs <- mapM getInfo names -- from ghc/InteractiveUI.hs
let filtered = filterOutChildren (\(t,_f,_i) -> t) (catMaybes mb_stuffs)
unqual <- getPrintUnqual infoThing :: String -> Ghc String
return $ showSDocForUser unqual $ vcat (intersperse (text "") $ map (pprInfo False) filtered) infoThing str = do
names <- parseName str
mb_stuffs <- mapM getInfo names
let filtered = filterOutChildren (\(t,_f,_i) -> t) (catMaybes mb_stuffs)
unqual <- getPrintUnqual
return $ showSDocForUser unqual $ vcat (intersperse (text "") $ map (pprInfo False) filtered)
filterOutChildren :: (a -> TyThing) -> [a] -> [a] filterOutChildren :: (a -> TyThing) -> [a] -> [a]
filterOutChildren get_thing xs filterOutChildren get_thing xs
@ -69,19 +74,13 @@ inModuleContext fileName modstr action = withGHC valid
initSession ["-w"] initSession ["-w"]
setTargetFile fileName setTargetFile fileName
loadWithLogger (\_ -> return ()) LoadAllTargets loadWithLogger (\_ -> return ()) LoadAllTargets
ok <- setContextFromTarget mif setContextFromTarget action invalid
if ok
then action
else invalid
invalid = do invalid = do
initSession ["-w"] initSession ["-w"]
dummyModule setTargetBuffer
loadWithLogger defaultWarnErrLogger LoadAllTargets loadWithLogger defaultWarnErrLogger LoadAllTargets
ok <- setContextFromTarget mif setContextFromTarget action (return errorMessage)
if ok setTargetBuffer = do
then action
else return errorMessage
dummyModule = do
modgraph <- depanal [mkModuleName modstr] True modgraph <- depanal [mkModuleName modstr] True
let imports = concatMap (map (showSDoc . ppr . unLoc)) $ let imports = concatMap (map (showSDoc . ppr . unLoc)) $
map ms_imps modgraph ++ map ms_srcimps modgraph map ms_imps modgraph ++ map ms_srcimps modgraph
@ -90,6 +89,7 @@ inModuleContext fileName modstr action = withGHC valid
importsBuf <- liftIO . stringToStringBuffer . unlines $ header importsBuf <- liftIO . stringToStringBuffer . unlines $ header
clkTime <- liftIO getClockTime clkTime <- liftIO getClockTime
setTargets [Target (TargetModule $ mkModuleName modstr) True (Just (importsBuf, clkTime))] setTargets [Target (TargetModule $ mkModuleName modstr) True (Just (importsBuf, clkTime))]
mif m t e = m >>= \ok -> if ok then t else e
sanitize = fromMaybe "SomeModule" . listToMaybe . words sanitize = fromMaybe "SomeModule" . listToMaybe . words
errorMessage = "Couldn't determine type" errorMessage = "Couldn't determine type"