Goto dependency definition

.github/actions/setup-build/action.yml

@@ -7,7 +7,10 @@ inputs:
   cabal:
     description: "Cabal version"
     required: false
-    default: "3.8.1.0"
+      # TODO: We should change this to 3.11 or latest once version 3.11 is released.
+      # For now we need the functionality in cabal head that generates HIE files
+      # for dependencies.
+    default: "head"
   os:
     description: "Operating system: Linux, Windows or macOS"
     required: true
@@ -31,7 +34,7 @@ runs:
         sudo chown -R $USER /usr/local/.ghcup
       shell: bash
 
-    - uses: haskell/actions/setup@v2.4.7
+    - uses: haskell-actions/setup@v2.5.0
       id: HaskEnvSetup
       with:
         ghc-version  : ${{ inputs.ghc   }}

.github/workflows/bench.yml

@@ -121,7 +121,7 @@ jobs:
         example: ['cabal', 'lsp-types']
 
     steps:
-    - uses: haskell/actions/setup@v2.4.7
+    - uses: haskell-actions/setup@v2.5.0
       with:
         ghc-version  : ${{ matrix.ghc   }}
         cabal-version: ${{ matrix.cabal }}

cabal.project

@@ -34,6 +34,11 @@ packages:
          ./plugins/hls-refactor-plugin
          ./plugins/hls-overloaded-record-dot-plugin
 
+source-repository-package
+  type:git
+  location: https://github.com/wz1000/HieDb.git
+  tag: 7bd029804a91c795d9dc29dd98df00905f486df7
+
 -- Standard location for temporary packages needed for particular environments
 -- For example it is used in the project gitlab mirror to help in the MAcOS M1 build script
 -- See https://github.com/haskell/haskell-language-server/blob/master/.gitlab-ci.yml

ghcide/ghcide.cabal

@@ -72,7 +72,7 @@ library
         hls-plugin-api == 2.3.0.0,
         lens,
         list-t,
-        hiedb == 0.4.3.*,
+        hiedb ^>= 0.4.3.0,
         lsp-types ^>= 2.0.2.0,
         lsp ^>= 2.2.0.0 ,
         mtl,
@@ -154,6 +154,7 @@ library
         Development.IDE.Core.Actions
         Development.IDE.Main.HeapStats
         Development.IDE.Core.Debouncer
+        Development.IDE.Core.Dependencies
         Development.IDE.Core.FileStore
         Development.IDE.Core.FileUtils
         Development.IDE.Core.IdeConfiguration
@@ -238,7 +239,7 @@ library
         -- We eventually want to build with Werror fully, but we haven't
         -- finished purging the warnings, so some are set to not be errors
         -- for now
-        ghc-options: -Werror 
+        ghc-options: -Werror
                      -Wwarn=unused-packages
                      -Wwarn=unrecognised-pragmas
                      -Wwarn=dodgy-imports
@@ -248,7 +249,7 @@ library
                      -Wwarn=incomplete-patterns
                      -Wwarn=overlapping-patterns
                      -Wwarn=incomplete-record-updates
-    
+
     -- ambiguous-fields is only understood by GHC >= 9.2, so we only disable it
     -- then. The above comment goes for here too -- this should be understood to
     -- be temporary until we can remove these warnings.
@@ -438,6 +439,7 @@ test-suite ghcide-tests
         ReferenceTests
         GarbageCollectionTests
         OpenCloseTest
+        Dependency
     default-extensions:
         BangPatterns
         DeriveFunctor

ghcide/session-loader/Development/IDE/Session.hs

@@ -48,6 +48,7 @@ import           Data.Proxy
 import qualified Data.Text                            as T
 import           Data.Time.Clock
 import           Data.Version
+import qualified Development.IDE.Core.Rules           as Rules
 import           Development.IDE.Core.RuleTypes
 import           Development.IDE.Core.Shake           hiding (Log, Priority,
                                                        knownTargets, withHieDb)
@@ -135,6 +136,7 @@ data Log
   | LogNoneCradleFound FilePath
   | LogNewComponentCache !(([FileDiagnostic], Maybe HscEnvEq), DependencyInfo)
   | LogHieBios HieBios.Log
+  | LogRules Rules.Log
 deriving instance Show Log
 
 instance Pretty Log where
@@ -205,6 +207,7 @@ instance Pretty Log where
     LogNewComponentCache componentCache ->
       "New component cache HscEnvEq:" <+> viaShow componentCache
     LogHieBios msg -> pretty msg
+    LogRules msg -> pretty msg
 
 -- | Bump this version number when making changes to the format of the data stored in hiedb
 hiedbDataVersion :: String
@@ -607,7 +610,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
 
           -- New HscEnv for the component in question, returns the new HscEnvEq and
           -- a mapping from FilePath to the newly created HscEnvEq.
-          let new_cache = newComponentCache recorder optExtensions hieYaml _cfp hscEnv uids
+          let new_cache = newComponentCache recorder extras optExtensions hieYaml _cfp hscEnv uids
           (cs, res) <- new_cache new
           -- Modified cache targets for everything else in the hie.yaml file
           -- which now uses the same EPS and so on
@@ -813,14 +816,15 @@ setNameCache nc hsc = hsc { hsc_NC = nc }
 -- | Create a mapping from FilePaths to HscEnvEqs
 newComponentCache
          :: Recorder (WithPriority Log)
+         -> ShakeExtras
          -> [String]       -- File extensions to consider
          -> Maybe FilePath -- Path to cradle
          -> NormalizedFilePath -- Path to file that caused the creation of this component
          -> HscEnv
          -> [(UnitId, DynFlags)]
          -> ComponentInfo
          -> IO ( [TargetDetails], (IdeResult HscEnvEq, DependencyInfo))
-newComponentCache recorder exts cradlePath cfp hsc_env uids ci = do
+newComponentCache recorder extras exts cradlePath cfp hsc_env uids ci = do
     let df = componentDynFlags ci
     hscEnv' <-
 #if MIN_VERSION_ghc(9,3,0)
@@ -843,7 +847,7 @@ newComponentCache recorder exts cradlePath cfp hsc_env uids ci = do
 #endif
 
     let newFunc = maybe newHscEnvEqPreserveImportPaths newHscEnvEq cradlePath
-    henv <- newFunc hscEnv' uids
+    henv <- newFunc (cmapWithPrio LogRules recorder) extras hscEnv' uids
     let targetEnv = ([], Just henv)
         targetDepends = componentDependencyInfo ci
         res = (targetEnv, targetDepends)

ghcide/src/Development/IDE/Core/Actions.hs

@@ -10,13 +10,20 @@ module Development.IDE.Core.Actions
 , lookupMod
 ) where
 
+import           Control.Concurrent.MVar              (MVar, newEmptyMVar,
+                                                       putMVar, readMVar)
+import           Control.Concurrent.STM               (atomically)
+import           Control.Concurrent.STM.TQueue        (unGetTQueue)
 import           Control.Monad.Extra                  (mapMaybeM)
 import           Control.Monad.Reader
 import           Control.Monad.Trans.Maybe
+import qualified Data.ByteString                      as BS
+import           Data.Function                        ((&))
 import qualified Data.HashMap.Strict                  as HM
 import           Data.Maybe
 import qualified Data.Text                            as T
 import           Data.Tuple.Extra
+import           Development.IDE.Core.Compile         (loadHieFile)
 import           Development.IDE.Core.OfInterest
 import           Development.IDE.Core.PluginUtils
 import           Development.IDE.Core.PositionMapping
@@ -29,22 +36,98 @@ import qualified Development.IDE.Spans.AtPoint        as AtPoint
 import           Development.IDE.Types.HscEnvEq       (hscEnv)
 import           Development.IDE.Types.Location
 import qualified HieDb
+import           Ide.Types                            (dependenciesDirectory,
+                                                       hlsDirectory)
 import           Language.LSP.Protocol.Types          (DocumentHighlight (..),
                                                        SymbolInformation (..),
                                                        normalizedFilePathToUri,
                                                        uriToNormalizedFilePath)
+import           Language.LSP.Server                  (resRootPath)
+import           System.Directory                     (createDirectoryIfMissing,
+                                                       doesFileExist,
+                                                       getPermissions,
+                                                       setOwnerExecutable,
+                                                       setOwnerWritable,
+                                                       setPermissions)
+import           System.FilePath                      (takeDirectory, (<.>),
+                                                       (</>))
 
 
--- | Eventually this will lookup/generate URIs for files in dependencies, but not in the
--- project. Right now, this is just a stub.
+-- | Generates URIs for files in dependencies, but not in the
+-- project. Dependency files are produced from an HIE file and
+-- placed in the .hls/dependencies directory.
 lookupMod
   :: HieDbWriter -- ^ access the database
   -> FilePath -- ^ The `.hie` file we got from the database
   -> ModuleName
   -> Unit
   -> Bool -- ^ Is this file a boot file?
   -> MaybeT IdeAction Uri
-lookupMod _dbchan _hie_f _mod _uid _boot = MaybeT $ pure Nothing
+lookupMod HieDbWriter{indexQueue} hieFile moduleName uid _boot = MaybeT $ do
+  -- We need the project root directory to determine where to put
+  -- the .hls directory.
+  mProjectRoot <- (resRootPath =<<) <$> asks lspEnv
+  case mProjectRoot of
+    Nothing -> pure Nothing
+    Just projectRoot -> do
+      -- Database writes happen asynchronously. We use an MVar to mark
+      -- completion of the database update.
+      completionToken <- liftIO newEmptyMVar
+      -- Write out the contents of the dependency source to the
+      -- .hls/dependencies directory, generate a URI for that
+      -- location, and update the HieDb database with the source
+      -- file location.
+      moduleUri <- writeAndIndexSource projectRoot completionToken
+      -- Wait for the database update to be completed.
+      -- Reading the completionToken is blocked until it has
+      -- a value.
+      liftIO $ readMVar completionToken
+      pure $ Just moduleUri
+  where
+    writeAndIndexSource :: FilePath -> MVar () -> IdeAction Uri
+    writeAndIndexSource projectRoot completionToken = do
+      fileExists <- liftIO $ doesFileExist writeOutPath
+      -- No need to write out the file if it already exists.
+      if fileExists then pure () else do
+        nc <- asks ideNc
+        liftIO $ do
+          -- Create the directory where we will put the source.
+          createDirectoryIfMissing True $ takeDirectory writeOutPath
+          -- Load a raw Bytestring of the source from the HIE file.
+          moduleSource <- hie_hs_src <$> loadHieFile (mkUpdater nc) hieFile
+          -- Write the source into the .hls/dependencies directory.
+          BS.writeFile writeOutPath moduleSource
+          fileDefaultPermissions <- getPermissions writeOutPath
+          let filePermissions = fileDefaultPermissions
+                              & setOwnerWritable False
+                              & setOwnerExecutable False
+          -- Set the source file to readonly permissions.
+          setPermissions writeOutPath filePermissions
+      liftIO $ atomically $
+        unGetTQueue indexQueue $ \withHieDb -> do
+          withHieDb $ \db ->
+            -- Add a source file to the database row for
+            -- the HIE file.
+            HieDb.addSrcFile db hieFile writeOutPath False
+          -- Mark completion of the database update.
+          putMVar completionToken ()
+      pure moduleUri
+      where
+        -- The source will be written out in a directory from the
+        -- name and hash of the package the dependency module is
+        -- found in. The name and hash are both parts of the UnitId.
+        writeOutDir :: FilePath
+        writeOutDir = projectRoot </> hlsDirectory </> dependenciesDirectory </> show uid
+        -- The module name is separated into directories, with the
+        -- last part of the module name giving the name of the
+        -- haskell file with a .hs extension.
+        writeOutFile :: FilePath
+        writeOutFile = moduleNameSlashes moduleName <.> "hs"
+        writeOutPath :: FilePath
+        writeOutPath = writeOutDir </> writeOutFile
+        moduleUri :: Uri
+        moduleUri = AtPoint.toUri writeOutPath
+
 
 
 -- IMPORTANT NOTE : make sure all rules `useWithStaleFastMT`d by these have a "Persistent Stale" rule defined,
@@ -61,11 +144,21 @@ getAtPoint file pos = runMaybeT $ do
   opts <- liftIO $ getIdeOptionsIO ide
 
   (hf, mapping) <- useWithStaleFastMT GetHieAst file
-  env <- hscEnv . fst <$> useWithStaleFastMT GhcSession file
-  dkMap <- lift $ maybe (DKMap mempty mempty) fst <$> runMaybeT (useWithStaleFastMT GetDocMap file)
+  -- The HscEnv and DKMap are not strictly necessary for hover
+  -- to work, so we only calculate them for project files, not
+  -- for dependency files. They provide information that will
+  -- not be displayed in dependency files. See the atPoint
+  -- function in ghcide/src/Development/IDE/Spans/AtPoint.hs
+  -- for the specifics of how they are used.
+  (mEnv, mDkMap) <- case getSourceFileOrigin file of
+    FromDependency -> pure (Nothing, Nothing)
+    FromProject -> do
+      env <- hscEnv . fst <$> useWithStaleFastMT GhcSession file
+      dkMap <- lift $ maybe (DKMap mempty mempty) fst <$> runMaybeT (useWithStaleFastMT GetDocMap file)
+      pure (Just env, Just dkMap)
 
   !pos' <- MaybeT (return $ fromCurrentPosition mapping pos)
-  MaybeT $ liftIO $ fmap (first (toCurrentRange mapping =<<)) <$> AtPoint.atPoint opts hf dkMap env pos'
+  MaybeT $ liftIO $ fmap (first (toCurrentRange mapping =<<)) <$> AtPoint.atPoint opts hf mDkMap mEnv pos'
 
 -- | For each Location, determine if we have the PositionMapping
 -- for the correct file. If not, get the correct position mapping
@@ -104,7 +197,9 @@ getDefinition file pos = runMaybeT $ do
     ide@ShakeExtras{ withHieDb, hiedbWriter } <- ask
     opts <- liftIO $ getIdeOptionsIO ide
     (HAR _ hf _ _ _, mapping) <- useWithStaleFastMT GetHieAst file
-    (ImportMap imports, _) <- useWithStaleFastMT GetImportMap file
+    (ImportMap imports, _) <- case getSourceFileOrigin file of
+      FromProject    -> useWithStaleFastMT GetImportMap file
+      FromDependency -> pure (ImportMap mempty, PositionMapping idDelta)
     !pos' <- MaybeT (pure $ fromCurrentPosition mapping pos)
     locations <- AtPoint.gotoDefinition withHieDb (lookupMod hiedbWriter) opts imports hf pos'
     MaybeT $ Just <$> toCurrentLocations mapping file locations

ghcide/src/Development/IDE/Core/Compile.hs

@@ -925,34 +925,32 @@ spliceExpressions Splices{..} =
 -- TVar to 0 in order to set it up for a fresh indexing session. Otherwise, we
 -- can just increment the 'indexCompleted' TVar and exit.
 --
-indexHieFile :: ShakeExtras -> ModSummary -> NormalizedFilePath -> Util.Fingerprint -> Compat.HieFile -> IO ()
-indexHieFile se mod_summary srcPath !hash hf = do
+indexHieFile :: ShakeExtras -> NormalizedFilePath -> HieDb.SourceFile -> Util.Fingerprint -> Compat.HieFile -> IO ()
+indexHieFile se hiePath sourceFile !hash hf = do
  IdeOptions{optProgressStyle} <- getIdeOptionsIO se
  atomically $ do
   pending <- readTVar indexPending
-  case HashMap.lookup srcPath pending of
+  case HashMap.lookup hiePath pending of
     Just pendingHash | pendingHash == hash -> pure () -- An index is already scheduled
     _ -> do
       -- hiedb doesn't use the Haskell src, so we clear it to avoid unnecessarily keeping it around
       let !hf' = hf{hie_hs_src = mempty}
-      modifyTVar' indexPending $ HashMap.insert srcPath hash
+      modifyTVar' indexPending $ HashMap.insert hiePath hash
       writeTQueue indexQueue $ \withHieDb -> do
         -- We are now in the worker thread
         -- Check if a newer index of this file has been scheduled, and if so skip this one
         newerScheduled <- atomically $ do
           pendingOps <- readTVar indexPending
-          pure $ case HashMap.lookup srcPath pendingOps of
+          pure $ case HashMap.lookup hiePath pendingOps of
             Nothing          -> False
             -- If the hash in the pending list doesn't match the current hash, then skip
             Just pendingHash -> pendingHash /= hash
         unless newerScheduled $ do
           -- Using bracket, so even if an exception happen during withHieDb call,
           -- the `post` (which clean the progress indicator) will still be called.
           bracket_ (pre optProgressStyle) post $
-            withHieDb (\db -> HieDb.addRefsFromLoaded db targetPath (HieDb.RealFile $ fromNormalizedFilePath srcPath) hash hf')
+            withHieDb (\db -> HieDb.addRefsFromLoaded db (fromNormalizedFilePath hiePath) sourceFile hash hf')
   where
-    mod_location    = ms_location mod_summary
-    targetPath      = Compat.ml_hie_file mod_location
     HieDbWriter{..} = hiedbWriter se
 
     -- Get a progress token to report progress and update it for the current file
@@ -1016,15 +1014,17 @@ indexHieFile se mod_summary srcPath !hash hf = do
       mdone <- atomically $ do
         -- Remove current element from pending
         pending <- stateTVar indexPending $
-          dupe . HashMap.update (\pendingHash -> guard (pendingHash /= hash) $> pendingHash) srcPath
+          dupe . HashMap.update (\pendingHash -> guard (pendingHash /= hash) $> pendingHash) hiePath
         modifyTVar' indexCompleted (+1)
         -- If we are done, report and reset completed
         whenMaybe (HashMap.null pending) $
           swapTVar indexCompleted 0
       whenJust (lspEnv se) $ \env -> LSP.runLspT env $
         when (coerce $ ideTesting se) $
           LSP.sendNotification (LSP.SMethod_CustomMethod (Proxy @"ghcide/reference/ready")) $
-            toJSON $ fromNormalizedFilePath srcPath
+            toJSON $ case sourceFile of
+              HieDb.RealFile sourceFilePath -> sourceFilePath
+              HieDb.FakeFile _ -> fromNormalizedFilePath hiePath
       whenJust mdone $ \done ->
         modifyVar_ indexProgressToken $ \tok -> do
           whenJust (lspEnv se) $ \env -> LSP.runLspT env $
@@ -1045,7 +1045,7 @@ writeAndIndexHieFile hscEnv se mod_summary srcPath exports ast source =
       GHC.mkHieFile' mod_summary exports ast source
     atomicFileWrite se targetPath $ flip GHC.writeHieFile hf
     hash <- Util.getFileHash targetPath
-    indexHieFile se mod_summary srcPath hash hf
+    indexHieFile se (toNormalizedFilePath' targetPath) (HieDb.RealFile $ fromNormalizedFilePath srcPath) hash hf
   where
     dflags       = hsc_dflags hscEnv
     mod_location = ms_location mod_summary
@@ -1779,19 +1779,19 @@ pathToModuleName = mkModuleName . map rep
 
   - CPP clauses should be placed at the end of the imports section. The clauses
   should be ordered by the GHC version they target from earlier to later versions,
-  with negative if clauses coming before positive if clauses of the same 
-  version. (If you think about which GHC version a clause activates for this 
+  with negative if clauses coming before positive if clauses of the same
+  version. (If you think about which GHC version a clause activates for this
   should make sense `!MIN_VERSION_GHC(9,0,0)` refers to 8.10 and lower which is
-  a earlier version than `MIN_VERSION_GHC(9,0,0)` which refers to versions 9.0 
+  a earlier version than `MIN_VERSION_GHC(9,0,0)` which refers to versions 9.0
   and later). In addition there should be a space before and after each CPP
   clause.
 
-  - In if clauses that use `&&` and depend on more than one statement, the 
+  - In if clauses that use `&&` and depend on more than one statement, the
   positive statement should come before the negative statement. In addition the
   clause should come after the single positive clause for that GHC version.
 
-  - There shouldn't be multiple identical CPP statements. The use of odd or even 
+  - There shouldn't be multiple identical CPP statements. The use of odd or even
   GHC numbers is identical, with the only preference being to use what is
-  already there. (i.e. (`MIN_VERSION_GHC(9,2,0)` and `MIN_VERSION_GHC(9,1,0)` 
+  already there. (i.e. (`MIN_VERSION_GHC(9,2,0)` and `MIN_VERSION_GHC(9,1,0)`
   are functionally equivalent)
 -}