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

simplifying modSummary.

Browse Source
This commit is contained in:
Kazu Yamamoto 2014-04-11 12:41:39 +09:00
parent 3ed59464f0
commit 196450af9f
2 changed files with 13 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
Language/Haskell/GhcMod/Gap.hs
View File

@ -184,22 +184,24 @@ fOptions = [option | (option,_,_) <- fFlags]
---------------------------------------------------------------- ----------------------------------------------------------------
---------------------------------------------------------------- ----------------------------------------------------------------
setCtx :: [ModSummary] -> Ghc Bool setCtx :: FilePath -> [ModSummary] -> Ghc ModSummary
#if __GLASGOW_HASKELL__ >= 704 #if __GLASGOW_HASKELL__ >= 704
setCtx ms = do setCtx file mss = do
#if __GLASGOW_HASKELL__ >= 706 #if __GLASGOW_HASKELL__ >= 706
let modName = IIModule . moduleName . ms_mod let modName = IIModule . moduleName . ms_mod
#else #else
let modName = IIModule . ms_mod let modName = IIModule . ms_mod
#endif #endif
top <- map modName <$> filterM isTop ms top <- map modName <$> filterM isTop mss
setContext top setContext top
return (not . null $ top) let [ms] = filter (\m -> ml_hs_file (ms_location m) == Just file) mss
return ms
#else #else
setCtx ms = do setCtx file mss = do
top <- map ms_mod <$> filterM isTop ms top <- map ms_mod <$> filterM isTop mss
setContext top [] setContext top []
return (not . null $ top) let [ms] = filter (\m -> ml_hs_file (ms_location m) == Just file) mss
return ms
#endif #endif
where where
isTop mos = lookupMod ||> returnFalse isTop mos = lookupMod ||> returnFalse

12
Language/Haskell/GhcMod/Info.hs
View File

@ -48,7 +48,7 @@ info :: Options
info opt cradle file expr = info opt cradle file expr =
inModuleContext opt cradle file exprToInfo "Cannot show info" inModuleContext opt cradle file exprToInfo "Cannot show info"
where where
exprToInfo = do exprToInfo _ = do
sdoc <- Gap.infoThing expr sdoc <- Gap.infoThing expr
dflag <- G.getSessionDynFlags dflag <- G.getSessionDynFlags
style <- getStyle style <- getStyle
@ -86,10 +86,7 @@ typeOf :: Options
typeOf opt cradle file lineNo colNo = typeOf opt cradle file lineNo colNo =
inModuleContext opt cradle file exprToType errmsg inModuleContext opt cradle file exprToType errmsg
where where
exprToType = do exprToType modSum = do
modGraph <- G.getModuleGraph
let ms = filter (\m -> G.ml_hs_file (G.ms_location m) == Just file) modGraph
modSum = head ms
srcSpanTypes <- getSrcSpanType modSum lineNo colNo srcSpanTypes <- getSrcSpanType modSum lineNo colNo
dflag <- G.getSessionDynFlags dflag <- G.getSessionDynFlags
style <- getStyle style <- getStyle
@ -138,12 +135,11 @@ pretty dflag style = showOneLine dflag style . Gap.typeForUser
noWaringOptions :: [String] noWaringOptions :: [String]
noWaringOptions = ["-w:"] noWaringOptions = ["-w:"]
inModuleContext :: Options -> Cradle -> FilePath -> Ghc String -> String -> Ghc String inModuleContext :: Options -> Cradle -> FilePath -> (G.ModSummary -> Ghc String) -> String -> Ghc String
inModuleContext opt cradle file action errmsg = ghandle handler $ do inModuleContext opt cradle file action errmsg = ghandle handler $ do
void $ initializeFlagsWithCradle opt cradle noWaringOptions False void $ initializeFlagsWithCradle opt cradle noWaringOptions False
setTargetFiles [file] setTargetFiles [file]
void $ G.load LoadAllTargets void $ G.load LoadAllTargets
void $ G.depanal [] False >>= Gap.setCtx G.depanal [] False >>= Gap.setCtx file >>= action
action
where where
handler (SomeException _) = return errmsg handler (SomeException _) = return errmsg