Add custom cache layer for session loading

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

@@ -70,6 +70,7 @@ import NameCache
 import Packages
 import Control.Exception (evaluate)
 import Data.Void
+import Control.Applicative (Alternative((<|>)))
 
 
 data CacheDirs = CacheDirs
@@ -113,6 +114,11 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do
   hscEnvs <- newVar Map.empty :: IO (Var HieMap)
   -- Mapping from a Filepath to HscEnv
   fileToFlags <- newVar Map.empty :: IO (Var FlagsMap)
+  -- Mapping from a Filepath to its 'hie.yaml' location.
+  -- Should hold the same Filepaths as 'fileToFlags', otherwise
+  -- they are inconsistent. So, everywhere you modify 'fileToFlags',
+  -- you have to modify 'filesMap' as well.
+  filesMap <- newVar HM.empty :: IO (Var FilesMap)
   -- Version of the mappings above
   version <- newVar 0
   let returnWithVersion fun = IdeGhcSession fun <$> liftIO (readVar version)
@@ -271,6 +277,8 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do
 
           modifyVar_ fileToFlags $ \var -> do
               pure $ Map.insert hieYaml (HM.fromList (concatMap toFlagsMap all_targets)) var
+          modifyVar_ filesMap $ \var -> do
+              evaluate $ HM.union var (HM.fromList (zip (map fst $ concatMap toFlagsMap all_targets) (repeat hieYaml)))
 
           extendKnownTargets all_targets
 
@@ -329,6 +337,8 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do
                let res = (map (renderCradleError ncfp) err, Nothing)
                modifyVar_ fileToFlags $ \var -> do
                  pure $ Map.insertWith HM.union hieYaml (HM.singleton ncfp (res, dep_info)) var
+               modifyVar_ filesMap $ \var -> do
+                 evaluate $ HM.insert ncfp hieYaml var
                return (res, maybe [] pure hieYaml ++ concatMap cradleErrorDependencies err)
 
     -- This caches the mapping from hie.yaml + Mod.hs -> [String]
@@ -358,8 +368,10 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do
     -- before attempting to do so.
     let getOptions :: FilePath -> IO (IdeResult HscEnvEq, [FilePath])
         getOptions file = do
+            ncfp <- toNormalizedFilePath' <$> canonicalizePath file
+            cachedHieYamlLocation <- HM.lookup ncfp <$> readVar filesMap
             hieYaml <- cradleLoc file
-            sessionOpts (hieYaml, file) `catch` \e ->
+            sessionOpts (join cachedHieYamlLocation <|> hieYaml, file) `catch` \e ->
                 return (([renderPackageSetupException file e], Nothing), maybe [] pure hieYaml)
 
     returnWithVersion $ \file -> do
@@ -543,7 +555,11 @@ renderCradleError nfp (CradleError _ _ec t) =
 -- See Note [Multi Cradle Dependency Info]
 type DependencyInfo = Map.Map FilePath (Maybe UTCTime)
 type HieMap = Map.Map (Maybe FilePath) (HscEnv, [RawComponentInfo])
+-- | Maps a "hie.yaml" location to all its Target Filepaths and options.
 type FlagsMap = Map.Map (Maybe FilePath) (HM.HashMap NormalizedFilePath (IdeResult HscEnvEq, DependencyInfo))
+-- | Maps a Filepath to its respective "hie.yaml" location.
+-- It aims to be the reverse of 'FlagsMap'.
+type FilesMap = HM.HashMap NormalizedFilePath (Maybe FilePath)
 
 -- This is pristine information about a component
 data RawComponentInfo = RawComponentInfo