Two recompilation avoidance related bugs

1. Recompilation avoidance regresses in GHC 9.4 due to interactions between GHC and HLS's implementations.
   Avoid this by filtering out the information that causes the conflict
   See https://gitlab.haskell.org/ghc/ghc/-/issues/22744.

2. The recompilation avoidance info GHC stores in interfaces can blow up to be
   extremely large when deserialised from disk. See https://gitlab.haskell.org/ghc/ghc/-/issues/22744
   Deduplicate these filepaths.

Author: wz1000

.hlint.yaml

@@ -55,6 +55,7 @@
     within:
     - Development.IDE.Core.Shake
     - Development.IDE.GHC.Util
+    - Development.IDE.Core.FileStore
     - Development.IDE.Plugin.CodeAction.Util
     - Development.IDE.Graph.Internal.Database
     - Development.IDE.Graph.Internal.Paths

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

@@ -70,7 +70,7 @@ import           Data.Time                         (UTCTime (..))
 import           Data.Tuple.Extra                  (dupe)
 import           Data.Unique                       as Unique
 import           Debug.Trace
-import           Development.IDE.Core.FileStore    (resetInterfaceStore)
+import           Development.IDE.Core.FileStore    (resetInterfaceStore, shareFilePath)
 import           Development.IDE.Core.Preprocessor
 import           Development.IDE.Core.RuleTypes
 import           Development.IDE.Core.Shake
@@ -435,6 +435,30 @@ tcRnModule hsc_env tc_helpers pmod = do
 -- anywhere. So we zero it out.
 -- The field is not serialized or deserialised from disk, so we don't need to remove it
 -- while reading an iface from disk, only if we just generated an iface in memory
+--
+
+
+
+-- | See https://github.com/haskell/haskell-language-server/issues/3450
+-- GHC's recompilation avoidance in the presense of TH is less precise than
+-- HLS. To avoid GHC from pessimising HLS, we filter out certain dependency information
+-- that we track ourselves. See also Note [Recompilation avoidance in the presence of TH]
+filterUsages :: [Usage] -> [Usage]
+#if MIN_VERSION_ghc(9,3,0)
+filterUsages = filter $ \case UsageHomeModuleInterface{} -> False
+                              _ -> True
+#else
+filterUsages = id
+#endif
+
+-- | Mitigation for https://gitlab.haskell.org/ghc/ghc/-/issues/22744
+shareUsages :: ModIface -> ModIface
+shareUsages iface = iface {mi_usages = usages}
+  where usages = map go (mi_usages iface)
+        go usg@UsageFile{} = usg {usg_file_path = fp}
+          where !fp = shareFilePath (usg_file_path usg)
+        go usg = usg
+
 
 mkHiFileResultNoCompile :: HscEnv -> TcModuleResult -> IO HiFileResult
 mkHiFileResultNoCompile session tcm = do
@@ -444,7 +468,7 @@ mkHiFileResultNoCompile session tcm = do
   details <- makeSimpleDetails hsc_env_tmp tcGblEnv
   sf <- finalSafeMode (ms_hspp_opts ms) tcGblEnv
   iface' <- mkIfaceTc hsc_env_tmp sf details ms tcGblEnv
-  let iface = iface' { mi_globals = Nothing } -- See Note [Clearing mi_globals after generating an iface]
+  let iface = iface' { mi_globals = Nothing, mi_usages = filterUsages (mi_usages iface') } -- See Note [Clearing mi_globals after generating an iface]
   pure $! mkHiFileResult ms iface details (tmrRuntimeModules tcm) Nothing
 
 mkHiFileResultCompile
@@ -486,7 +510,7 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do
   let !partial_iface = force (mkPartialIface session details simplified_guts)
   final_iface' <- mkFullIface session partial_iface
 #endif
-  let final_iface = final_iface' {mi_globals = Nothing} -- See Note [Clearing mi_globals after generating an iface]
+  let final_iface = final_iface' {mi_globals = Nothing, mi_usages = filterUsages (mi_usages final_iface')} -- See Note [Clearing mi_globals after generating an iface]
 
   -- Write the core file now
   core_file <- case mguts of
@@ -1462,7 +1486,8 @@ loadInterface session ms linkableNeeded RecompilationInfo{..} = do
           regenerate linkableNeeded
 
     case (mb_checked_iface, recomp_iface_reqd) of
-      (Just iface, UpToDate) -> do
+      (Just iface', UpToDate) -> do
+             let iface = shareUsages iface'
              details <- liftIO $ mkDetailsFromIface sessionWithMsDynFlags iface
              -- parse the runtime dependencies from the annotations
              let runtime_deps

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

@@ -18,6 +18,7 @@ module Development.IDE.Core.FileStore(
     getModTime,
     isWatchSupported,
     registerFileWatches,
+    shareFilePath,
     Log(..)
     ) where
 
@@ -28,6 +29,8 @@ import           Control.Exception
 import           Control.Monad.Extra
 import           Control.Monad.IO.Class
 import qualified Data.ByteString                              as BS
+import qualified Data.HashMap.Strict                          as HashMap
+import           Data.IORef
 import qualified Data.Text                                    as T
 import qualified Data.Text.Utf16.Rope                         as Rope
 import           Data.Time
@@ -76,6 +79,7 @@ import qualified Language.LSP.Types                           as LSP
 import qualified Language.LSP.Types.Capabilities              as LSP
 import           Language.LSP.VFS
 import           System.FilePath
+import           System.IO.Unsafe
 
 data Log
   = LogCouldNotIdentifyReverseDeps !NormalizedFilePath
@@ -297,3 +301,17 @@ isWatchSupported = do
               , Just True <- _dynamicRegistration
                 -> True
               | otherwise -> False
+
+filePathMap :: IORef (HashMap.HashMap FilePath FilePath)
+filePathMap = unsafePerformIO $ newIORef HashMap.empty
+{-# NOINLINE filePathMap #-}
+
+shareFilePath :: FilePath -> FilePath
+shareFilePath k = unsafePerformIO $ do
+  atomicModifyIORef' filePathMap $ \km ->
+    let new_key = HashMap.lookup k km
+    in case new_key of
+          Just v -> (km, v)
+          Nothing -> (HashMap.insert k k km, k)
+{-# NOINLINE shareFilePath  #-}
+ 

ghcide/src/Development/IDE/GHC/Compat.hs

@@ -43,6 +43,8 @@ module Development.IDE.GHC.Compat(
     myCoreToStgExpr,
 #endif
 
+    Usage(..),
+
     FastStringCompat,
     bytesFS,
     mkFastStringByteString,
@@ -167,9 +169,9 @@ import           GHC.Runtime.Context                   (icInteractiveModule)
 import           GHC.Unit.Home.ModInfo                 (HomePackageTable,
                                                         lookupHpt)
 #if MIN_VERSION_ghc(9,3,0)
-import GHC.Unit.Module.Deps (Dependencies(dep_direct_mods))
+import GHC.Unit.Module.Deps (Dependencies(dep_direct_mods), Usage(..))
 #else
-import GHC.Unit.Module.Deps (Dependencies(dep_mods))
+import GHC.Unit.Module.Deps (Dependencies(dep_mods), Usage(..))
 #endif
 #else
 import           GHC.CoreToByteCode                    (coreExprToBCOs)