From ab8a872554965cd663ef01907b8621de393bc26c Mon Sep 17 00:00:00 2001 From: Zubin Duggal Date: Wed, 6 May 2020 19:51:36 +0530 Subject: [PATCH] Show documentation on hover for symbols defined in the same module This required two separate fixes: 1. When parsing a module, if parsing haddocks succeeds, then use them Previously, even though we were parsing modules twice, with and without haddocks, we were just returning the result of parsing without haddocks. The reason for this was that Opt_KeepRawTokenStream and Opt_Haddock do not interact nicely. We decided that for now it was better to fix an actual issue and then solve the problem when hlint requires a module with Opt_KeepRawTokenStream. 2. When loading the iface before generating the DocMap, use the ModIface in the HomeModInfo, and not the one in the ModInfo field of the TypecheckedModule, since that one does not exist. --- src/Development/IDE/Core/RuleTypes.hs | 3 ++ src/Development/IDE/Core/Rules.hs | 42 +++++++++++++++------- src/Development/IDE/Spans/Documentation.hs | 7 ++-- 3 files changed, 35 insertions(+), 17 deletions(-) diff --git a/src/Development/IDE/Core/RuleTypes.hs b/src/Development/IDE/Core/RuleTypes.hs index cc99c283f..244274e66 100644 --- a/src/Development/IDE/Core/RuleTypes.hs +++ b/src/Development/IDE/Core/RuleTypes.hs @@ -51,6 +51,9 @@ type instance RuleResult GetModuleGraph = DependencyInformation -- that module. data TcModuleResult = TcModuleResult { tmrModule :: TypecheckedModule + -- ^ warning, the ModIface in the tm_checked_module_info of the + -- TypecheckedModule will always be Nothing, use the ModIface in the + -- HomeModInfo instead , tmrModInfo :: HomeModInfo , tmrHieFile :: Maybe HieFile } diff --git a/src/Development/IDE/Core/Rules.hs b/src/Development/IDE/Core/Rules.hs index 91e172da5..cb743b805 100644 --- a/src/Development/IDE/Core/Rules.hs +++ b/src/Development/IDE/Core/Rules.hs @@ -34,6 +34,7 @@ import Data.Binary import Util import Data.Bifunctor (second) import Control.Monad.Extra +import Control.Applicative import Control.Monad.Trans.Class import Control.Monad.Trans.Maybe import Development.IDE.Core.Compile @@ -235,6 +236,12 @@ priorityGenerateCore = Priority (-1) priorityFilesOfInterest :: Priority priorityFilesOfInterest = Priority (-2) +-- | IMPORTANT FOR HLINT INTEGRATION: +-- We currently parse the module both with and without Opt_Haddock, and +-- return the one with Haddocks if it -- succeeds. However, this may not work +-- for hlint, and we might need to save the one without haddocks too. +-- See https://github.com/digital-asset/ghcide/pull/350#discussion_r370878197 +-- and https://github.com/mpickering/ghcide/pull/22#issuecomment-625070490 getParsedModuleRule :: Rules () getParsedModuleRule = defineEarlyCutoff $ \GetParsedModule file -> do sess <- use_ GhcSession file @@ -254,18 +261,27 @@ getParsedModuleRule = defineEarlyCutoff $ \GetParsedModule file -> do liftIO mainParse else do let hscHaddock = hsc{hsc_dflags = gopt_set dflags Opt_Haddock} - haddockParse = do - (_, (!diagsHaddock, _)) <- - getParsedModuleDefinition hscHaddock opt comp_pkgs file contents - return diagsHaddock + haddockParse = getParsedModuleDefinition hscHaddock opt comp_pkgs file contents + + -- parse twice, with and without Haddocks, concurrently + -- we cannot ignore Haddock parse errors because files of + -- non-interest are always parsed with Haddocks + -- If we can parse Haddocks, might as well use them + -- + -- HLINT INTEGRATION: might need to save the other parsed module too + ((fp,(diags,res)),(fph,(diagsh,resh))) <- liftIO $ concurrently mainParse haddockParse + + -- Merge haddock and regular diagnostics so we can always report haddock + -- parse errors + let diagsM = mergeDiagnostics diags diagsh + case resh of + Just _ -> pure (fph, (diagsM, resh)) + -- If we fail to parse haddocks, report the haddock diagnostics as well and + -- return the non-haddock parse. + -- This seems to be the correct behaviour because the Haddock flag is added + -- by us and not the user, so our IDE shouldn't stop working because of it. + Nothing -> pure (fp, (diagsM, res)) - ((fingerPrint, (diags, res)), diagsHaddock) <- - -- parse twice, with and without Haddocks, concurrently - -- we cannot ignore Haddock parse errors because files of - -- non-interest are always parsed with Haddocks - liftIO $ concurrently mainParse haddockParse - - return (fingerPrint, (mergeDiagnostics diags diagsHaddock, res)) getParsedModuleDefinition :: HscEnv -> IdeOptions -> [PackageName] -> NormalizedFilePath -> Maybe T.Text -> IO (Maybe ByteString, ([FileDiagnostic], Maybe ParsedModule)) getParsedModuleDefinition packageState opt comp_pkgs file contents = do @@ -440,7 +456,7 @@ getRefMapRule = getDocMapRule :: Rules () getDocMapRule = define $ \GetDocMap file -> do - tc <- tmrModule <$> use_ TypeCheck file + hmi <- tmrModInfo <$> use_ TypeCheck file hsc <- hscEnv <$> use_ GhcSession file PRefMap rf <- use_ GetRefMap file @@ -457,7 +473,7 @@ getDocMapRule = ifaces <- uses_ GetModIface tdeps - docMap <- liftIO $ evalGhcEnv hsc $ mkDocMap parsedDeps rf tc (map hirModIface ifaces) + docMap <- liftIO $ evalGhcEnv hsc $ mkDocMap parsedDeps rf hmi (map hirModIface ifaces) return ([],Just $ PDocMap docMap) -- Typechecks a module. diff --git a/src/Development/IDE/Spans/Documentation.hs b/src/Development/IDE/Spans/Documentation.hs index bb695604d..657965545 100644 --- a/src/Development/IDE/Spans/Documentation.hs +++ b/src/Development/IDE/Spans/Documentation.hs @@ -32,13 +32,12 @@ mkDocMap :: GhcMonad m => [ParsedModule] -> RefMap - -> TypecheckedModule + -> HomeModInfo -> [ModIface] -> m DocMap -mkDocMap sources rm TypecheckedModule{..} deps = +mkDocMap sources rm hmi deps = do mapM_ (`loadDepModule` Nothing) (reverse deps) - forM_ (modInfoIface tm_checked_module_info) $ \modIface -> - modifySession (loadModuleHome $ HomeModInfo modIface (snd tm_internals_) Nothing) + modifySession (loadModuleHome hmi) foldrM go M.empty names where go n map = do