diff --git a/Language/Haskell/GhcMod/Gap.hs b/Language/Haskell/GhcMod/Gap.hs index 41b06b1..c565d09 100644 --- a/Language/Haskell/GhcMod/Gap.hs +++ b/Language/Haskell/GhcMod/Gap.hs @@ -184,22 +184,24 @@ fOptions = [option | (option,_,_) <- fFlags] ---------------------------------------------------------------- ---------------------------------------------------------------- -setCtx :: [ModSummary] -> Ghc Bool +setCtx :: FilePath -> [ModSummary] -> Ghc ModSummary #if __GLASGOW_HASKELL__ >= 704 -setCtx ms = do +setCtx file mss = do #if __GLASGOW_HASKELL__ >= 706 let modName = IIModule . moduleName . ms_mod #else let modName = IIModule . ms_mod #endif - top <- map modName <$> filterM isTop ms + top <- map modName <$> filterM isTop mss setContext top - return (not . null $ top) + let [ms] = filter (\m -> ml_hs_file (ms_location m) == Just file) mss + return ms #else -setCtx ms = do - top <- map ms_mod <$> filterM isTop ms +setCtx file mss = do + top <- map ms_mod <$> filterM isTop mss setContext top [] - return (not . null $ top) + let [ms] = filter (\m -> ml_hs_file (ms_location m) == Just file) mss + return ms #endif where isTop mos = lookupMod ||> returnFalse diff --git a/Language/Haskell/GhcMod/Info.hs b/Language/Haskell/GhcMod/Info.hs index d79d0b6..7bb4afa 100644 --- a/Language/Haskell/GhcMod/Info.hs +++ b/Language/Haskell/GhcMod/Info.hs @@ -48,7 +48,7 @@ info :: Options info opt cradle file expr = inModuleContext opt cradle file exprToInfo "Cannot show info" where - exprToInfo = do + exprToInfo _ = do sdoc <- Gap.infoThing expr dflag <- G.getSessionDynFlags style <- getStyle @@ -86,10 +86,7 @@ typeOf :: Options typeOf opt cradle file lineNo colNo = inModuleContext opt cradle file exprToType errmsg where - exprToType = do - modGraph <- G.getModuleGraph - let ms = filter (\m -> G.ml_hs_file (G.ms_location m) == Just file) modGraph - modSum = head ms + exprToType modSum = do srcSpanTypes <- getSrcSpanType modSum lineNo colNo dflag <- G.getSessionDynFlags style <- getStyle @@ -138,12 +135,11 @@ pretty dflag style = showOneLine dflag style . Gap.typeForUser noWaringOptions :: [String] 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 void $ initializeFlagsWithCradle opt cradle noWaringOptions False setTargetFiles [file] void $ G.load LoadAllTargets - void $ G.depanal [] False >>= Gap.setCtx - action + G.depanal [] False >>= Gap.setCtx file >>= action where handler (SomeException _) = return errmsg