Locate Documentation html page using Haddock interface file

ghcide.cabal

@@ -50,7 +50,7 @@ library
         filepath,
         fingertree,
         Glob,
-        haddock-library >= 1.8,
+        haddock-library >= 1.7,
         hashable,
         haskell-lsp-types == 0.22.*,
         haskell-lsp == 0.22.*,
@@ -91,7 +91,8 @@ library
         cryptohash-sha1 >=0.11.100 && <0.12,
         hie-bios >= 0.7.1 && < 0.8.0,
         implicit-hie-cradle >= 0.2.0.1 && < 0.3,
-        base16-bytestring >=0.1.1 && <0.2
+        base16-bytestring >=0.1.1 && <0.2,
+        haddock-api >= 2.22.0
     if os(windows)
       build-depends:
         Win32
@@ -316,6 +317,7 @@ test-suite ghcide-tests
         ghcide,
         ghc-typelits-knownnat,
         haddock-library,
+        haddock-api,
         haskell-lsp,
         haskell-lsp-types,
         network-uri,

src/Development/IDE/Core/Rules.hs

@@ -567,8 +567,8 @@ getDocMapRule =
       let tdeps = transitiveModuleDeps deps
       parsedDeps <- uses_ GetParsedModule tdeps
 #endif
-
-      dkMap <- liftIO $ mkDocMap hsc parsedDeps rf tc
+      ShakeExtras{haddockLinkEnvs} <- getShakeExtras
+      dkMap <- liftIO $ mkDocMap hsc parsedDeps rf tc haddockLinkEnvs
       return ([],Just dkMap)
 
 -- Typechecks a module.

src/Development/IDE/Core/Shake.hs

@@ -62,8 +62,9 @@ module Development.IDE.Core.Shake(
     DelayedAction, mkDelayedAction,
     IdeAction(..), runIdeAction,
     mkUpdater,
+    LinkEnvsCache,
     -- Exposed for testing.
-    Q(..),
+    Q(..),    
     ) where
 
 import           Development.Shake hiding (ShakeValue, doesFileExist, Info)
@@ -126,6 +127,8 @@ import UniqSupply
 import PrelInfo
 import Data.Int (Int64)
 import qualified Data.HashSet as HSet
+import Name (Name)
+import Module (Module)
 
 -- information we stash inside the shakeExtra field
 data ShakeExtras = ShakeExtras
@@ -164,8 +167,16 @@ data ShakeExtras = ShakeExtras
     ,exportsMap :: Var ExportsMap
     -- | A work queue for actions added via 'runInShakeSession'
     ,actionQueue :: ActionQueue
+    -- | A mapping of haddock interface files' link environments
+    ,haddockLinkEnvs :: LinkEnvsCache
     }
 
+-- | Global cache of parsed haddock link envs (link env is a mapping of name to haddock module/file)
+type LinkEnvsCache = Var (HashMap FilePath (Maybe LinkEnv))
+
+-- copied and pasted LinkEnv definition from haddock-api to eliminate dependency on it in GHC lib
+type LinkEnv = Map Name Module
+
 -- | A mapping of module name to known files
 type KnownTargets = HashMap Target [NormalizedFilePath]
 
@@ -433,6 +444,7 @@ shakeOpen getLspId eventer withProgress withIndefiniteProgress logger debouncer
         exportsMap <- newVar mempty
 
         actionQueue <- newQueue
+        haddockLinkEnvs <- newVar HMap.empty
 
         pure (ShakeExtras{..}, cancel progressAsync)
     (shakeDbM, shakeClose) <-

src/Development/IDE/Plugin/Completions.hs

@@ -74,7 +74,8 @@ produceCompletions = do
               res <- liftIO $ tcRnImportDecls env imps
               case res of
                   (_, Just rdrEnv) -> do
-                      cdata <- liftIO $ cacheDataProducer env (ms_mod ms) rdrEnv imps parsedDeps
+                      ShakeExtras{haddockLinkEnvs} <- getShakeExtras
+                      cdata <- liftIO $ cacheDataProducer env (ms_mod ms) rdrEnv imps parsedDeps haddockLinkEnvs
                       return ([], Just cdata)
                   (_diag, _) ->
                       return ([], Nothing)

src/Development/IDE/Plugin/Completions/Logic.hs

@@ -230,8 +230,14 @@ mkPragmaCompl label insertText =
     Nothing Nothing Nothing Nothing Nothing (Just insertText) (Just Snippet)
     Nothing Nothing Nothing Nothing Nothing
 
-cacheDataProducer :: HscEnv -> Module -> GlobalRdrEnv -> [LImportDecl GhcPs] -> [ParsedModule] -> IO CachedCompletions
-cacheDataProducer packageState curMod rdrEnv limports deps = do
+cacheDataProducer :: HscEnv 
+  -> Module
+  -> GlobalRdrEnv
+  -> [LImportDecl GhcPs]
+  -> [ParsedModule]
+  -> LinkEnvsCache
+  -> IO CachedCompletions
+cacheDataProducer packageState curMod rdrEnv limports deps le = do
   let dflags = hsc_dflags packageState
       curModName = moduleName curMod
 
@@ -276,7 +282,7 @@ cacheDataProducer packageState curMod rdrEnv limports deps = do
 
       toCompItem :: Module -> ModuleName -> Name -> IO CompItem
       toCompItem m mn n = do
-        docs <- getDocumentationTryGhc packageState curMod deps n
+        docs <- getDocumentationTryGhc packageState curMod deps n le
         ty <- catchSrcErrors (hsc_dflags packageState) "completion" $ do
                 name' <- lookupName packageState m n
                 return $ name' >>= safeTyThingType