Reimplement Hover/GotoDefn in terms of Hie Files

Co-authored-by: Matthew Pickering <matthewtpickering@gmail.com>

ghcide.cabal

@@ -143,9 +143,7 @@ library
         Development.IDE.Import.FindImports
         Development.IDE.LSP.Notifications
         Development.IDE.Spans.AtPoint
-        Development.IDE.Spans.Calculate
         Development.IDE.Spans.Documentation
-        Development.IDE.Spans.Type
         Development.IDE.Plugin.CodeAction.PositionIndexed
         Development.IDE.Plugin.CodeAction.Rules
         Development.IDE.Plugin.CodeAction.RuleTypes

src/Development/IDE/Core/OfInterest.hs

@@ -79,5 +79,5 @@ modifyFilesOfInterest state f = do
     OfInterestVar var <- getIdeGlobalState state
     files <- modifyVar var $ pure . dupe . f
     logDebug (ideLogger state) $ "Set files of interest to: " <> T.pack (show $ HashSet.toList files)
-    let das = map (\nfp -> mkDelayedAction "OfInterest" (GetSpanInfo, nfp) Debug (use GetSpanInfo nfp)) (HashSet.toList files)
+    let das = map (\nfp -> mkDelayedAction "OfInterest" (GetHieFile, nfp) Debug (use GetHieFile nfp)) (HashSet.toList files)
     shakeRunInternal state das

src/Development/IDE/Core/RuleTypes.hs

@@ -25,7 +25,6 @@ import           GHC
 import Module (InstalledUnitId)
 import HscTypes (CgGuts, Linkable, HomeModInfo, ModDetails)
 
-import           Development.IDE.Spans.Type
 import           Development.IDE.Spans.Common
 import           Development.IDE.Import.FindImports (ArtifactsLocation)
 import Development.IDE.GHC.Compat (RefMap, HieFile)
@@ -81,7 +80,6 @@ instance Show HiFileResult where
 type instance RuleResult TypeCheck = TcModuleResult
 
 -- | Information about what spans occur where, requires TypeCheck
-type instance RuleResult GetSpanInfo = SpansInfo
 type instance RuleResult GetHieFile = HieFile
 
 newtype PRefMap = PRefMap {getRefMap :: RefMap}
@@ -173,7 +171,6 @@ instance Hashable TypeCheck
 instance NFData   TypeCheck
 instance Binary   TypeCheck
 
-
 data GetHieFile = GetHieFile
     deriving (Eq, Show, Typeable, Generic)
 instance Hashable GetHieFile
@@ -186,14 +183,9 @@ instance Hashable GetRefMap
 instance NFData   GetRefMap
 instance Binary   GetRefMap
 
-data GetSpanInfo = GetSpanInfo
-    deriving (Eq, Show, Typeable, Generic)
-instance Hashable GetSpanInfo
-instance NFData   GetSpanInfo
-instance Binary   GetSpanInfo
-
 data GetDocMap = GetDocMap
     deriving (Eq, Show, Typeable, Generic)
+
 instance Hashable GetDocMap
 instance NFData   GetDocMap
 instance Binary   GetDocMap

src/Development/IDE/Core/Rules.hs

@@ -38,7 +38,6 @@ import Control.Monad.Trans.Maybe
 import Development.IDE.Core.Compile
 import Development.IDE.Core.OfInterest
 import Development.IDE.Types.Options
-import Development.IDE.Spans.Calculate
 import Development.IDE.Spans.Documentation
 import Development.IDE.Import.DependencyInformation
 import Development.IDE.Import.FindImports
@@ -62,7 +61,6 @@ import qualified Data.Text                                as T
 import           Development.IDE.GHC.Error
 import           Development.Shake                        hiding (Diagnostic)
 import Development.IDE.Core.RuleTypes
-import Development.IDE.Spans.Type
 import qualified Data.ByteString.Char8 as BS
 import Development.IDE.Core.PositionMapping
 
@@ -121,24 +119,27 @@ getAtPoint :: NormalizedFilePath -> Position -> IdeAction (Maybe (Maybe Range, [
 getAtPoint file pos = fmap join $ runMaybeT $ do
   ide <- ask
   opts <- liftIO $ getIdeOptionsIO ide
-  (spans, mapping) <- useE  GetSpanInfo file
+
+  (hf, mapping) <- useE GetHieFile file
+  (PDocMap dm,_) <- useE GetDocMap file
+
   !pos' <- MaybeT (return $ fromCurrentPosition mapping pos)
-  return $ AtPoint.atPoint opts spans pos'
+  return $ AtPoint.atPoint opts hf dm pos'
 
 -- | Goto Definition.
 getDefinition :: NormalizedFilePath -> Position -> IdeAction (Maybe Location)
 getDefinition file pos = runMaybeT $ do
     ide <- ask
     opts <- liftIO $ getIdeOptionsIO ide
-    spans <- fst <$> useE GetSpanInfo file
-    AtPoint.gotoDefinition (getHieFile ide file) opts (spansExprs spans) pos
+    hf <- fst <$> useE GetHieFile file
+    AtPoint.gotoDefinition (getHieFile ide file) opts hf pos
 
 getTypeDefinition :: NormalizedFilePath -> Position -> IdeAction (Maybe Location)
 getTypeDefinition file pos = runMaybeT $ do
     ide <- ask
     opts <- liftIO $ getIdeOptionsIO ide
-    spans <- fst <$> useE GetSpanInfo file
-    AtPoint.gotoTypeDefinition (getHieFile ide file) opts (spansExprs spans) pos
+    hf <- fst <$> useE GetHieFile file
+    AtPoint.gotoTypeDefinition (getHieFile ide file) opts hf pos
 
 
 getHieFile
@@ -158,32 +159,33 @@ getHieFile ide file mod = do
 
 getHomeHieFile :: NormalizedFilePath -> MaybeT IdeAction HieFile
 getHomeHieFile f = do
-  ms <- fst <$> useE GetModSummary f
-  let normal_hie_f = toNormalizedFilePath' hie_f
-      hie_f = ml_hie_file $ ms_location ms
-
-  mbHieTimestamp <- either (\(_ :: IOException) -> Nothing) Just <$> (liftIO $ try $ getModificationTime hie_f)
-  srcTimestamp   <- MaybeT (either (\(_ :: IOException) -> Nothing) Just <$> (liftIO $ try $ getModificationTime $ fromNormalizedFilePath f))
-  liftIO $ print (mbHieTimestamp, srcTimestamp, hie_f, normal_hie_f)
-  let isUpToDate
-        | Just d <- mbHieTimestamp = d > srcTimestamp
-        | otherwise = False
-
-  if isUpToDate
-    then do
-      ncu <- mkUpdater
-      hf <- liftIO $ if isUpToDate then Just <$> loadHieFile ncu hie_f else pure Nothing
-      MaybeT $ return hf
-    else do
-      -- Could block here with a barrier rather than fail
-      b <- liftIO $ newBarrier
-      lift $ delayedAction (mkDelayedAction "OutOfDateHie" ("hie" :: T.Text, f) L.Info
-                              (do pm <- use_ GetParsedModule f
-                                  typeCheckRuleDefinition f pm DoGenerateInterfaceFiles
-                                  liftIO $ signalBarrier b ()))
-      () <- MaybeT $ liftIO $ timeout 1 $ waitBarrier b
-      ncu <- mkUpdater
-      liftIO $ loadHieFile ncu hie_f
+  hfr <- lift $ useWithStaleFast' GetHieFile f
+  case stale hfr of
+    Just (hf,_) -> pure hf -- We already have the file
+    Nothing -> do -- We don't have the file, so try loading it from disk
+      ms <- fst <$> useE GetModSummary f
+
+      let normal_hie_f = toNormalizedFilePath' hie_f
+          hie_f = ml_hie_file $ ms_location ms
+
+      mbHieTimestamp <- either (\(_ :: IOException) -> Nothing) Just <$> (liftIO $ try $ getModificationTime hie_f)
+      srcTimestamp   <- MaybeT (either (\(_ :: IOException) -> Nothing) Just <$> (liftIO $ try $ getModificationTime $ fromNormalizedFilePath f))
+
+      liftIO $ print (mbHieTimestamp, srcTimestamp, hie_f, normal_hie_f)
+      let isUpToDate
+            | Just d <- mbHieTimestamp = d > srcTimestamp
+            | otherwise = False
+
+      if isUpToDate
+        then do
+          upd <- mkUpdater
+          hf <- liftIO $ if isUpToDate then Just <$> loadHieFile upd hie_f else pure Nothing
+          MaybeT $ return hf
+        else do
+          -- If not on disk, wait for the barrier
+          -- Could block here with a barrier rather than fail
+          mhf <- liftIO $ timeout 1 $ waitBarrier (uptoDate hfr)
+          MaybeT $ pure $ join mhf
 
 
 getPackageHieFile :: IdeState
@@ -409,27 +411,6 @@ getDependenciesRule =
         let mbFingerprints = map (fingerprintString . fromNormalizedFilePath) allFiles <$ optShakeFiles opts
         return (fingerprintToBS . fingerprintFingerprints <$> mbFingerprints, ([], transitiveDeps depInfo file))
 
--- Source SpanInfo is used by AtPoint and Goto Definition.
-getSpanInfoRule :: Rules ()
-getSpanInfoRule =
-    define $ \GetSpanInfo file -> do
-        tc <- use_ TypeCheck file
-        packageState <- hscEnv <$> use_ GhcSession file
-        deps <- maybe (TransitiveDependencies [] [] []) fst <$> useWithStale GetDependencies file
-        let tdeps = transitiveModuleDeps deps
-#if MIN_GHC_API_VERSION(8,6,0) && !defined(GHC_LIB)
-        let parsedDeps = []
-#else
-        parsedDeps <- uses_ GetParsedModule tdeps
-#endif
-        ifaces <- uses_ GetModIface tdeps
-        (fileImports, _) <- use_ GetLocatedImports file
-        let imports = second (fmap artifactFilePath) <$> fileImports
-        x <- liftIO $ getSrcSpanInfos packageState imports tc parsedDeps (map hirModIface ifaces)
-        return ([], Just x)
-
-
-
 getHieFileRule :: Rules ()
 getHieFileRule =
     define $ \GetHieFile f -> do
@@ -704,7 +685,6 @@ mainRule = do
     reportImportCyclesRule
     getDependenciesRule
     typeCheckRule
-    getSpanInfoRule
     getHieFileRule
     getRefMapRule
     getDocMapRule