leak.patch

--- a/src/Development/IDE/Core/Compile.hs
+++ b/src/Development/IDE/Core/Compile.hs
@@ -70,6 +70,7 @@ import           TcRnMonad (initIfaceLoad, tcg_th_coreplugins, tcg_src)
 import           TcIface                        (typecheckIface)
 import           TidyPgm
 
+import Data.ByteString (ByteString)
 import Control.Exception.Safe
 import Control.Monad.Extra
 import Control.Monad.Except
@@ -295,13 +296,13 @@ addHieFileToDb hiechan targetPath isBoot srcPath hf = do
     addRefsFromLoaded db targetPath isBoot srcPath time hf
     hPutStrLn stderr $ "Finished indexing .hie file: " ++ targetPath
 
-generateAndWriteHieFile :: HscEnv -> HieWriterChan -> TypecheckedModule -> IO ([FileDiagnostic],Maybe Compat.HieFile)
-generateAndWriteHieFile hscEnv hiechan tcm =
+generateAndWriteHieFile :: HscEnv -> HieWriterChan -> TypecheckedModule -> ByteString -> IO ([FileDiagnostic],Maybe Compat.HieFile)
+generateAndWriteHieFile hscEnv hiechan tcm contents  =
   handleGenerationErrors dflags "extended interface generation" $ do
     case tm_renamed_source tcm of
       Just rnsrc -> do
         hf <- runHsc hscEnv $
-          GHC.mkHieFile mod_summary (fst $ tm_internals_ tcm) rnsrc ""
+          GHC.mkHieFile mod_summary (fst $ tm_internals_ tcm) rnsrc contents
         addHieFileToDb hiechan targetPath isBoot path hf
         pure (Just hf)
       _ ->
diff --git a/src/Development/IDE/Core/RuleTypes.hs b/src/Development/IDE/Core/RuleTypes.hs
index 3cd7cf6..217f364 100644
--- a/src/Development/IDE/Core/RuleTypes.hs
+++ b/src/Development/IDE/Core/RuleTypes.hs
@@ -21,6 +21,7 @@ import qualified Data.Set as S
 import qualified Data.Map as M
 import           Development.Shake
 import           GHC.Generics                             (Generic)
+import           Data.ByteString (ByteString)
 
 import           GHC
 import Module (InstalledUnitId)
@@ -34,8 +35,18 @@ import Development.IDE.GHC.Compat (RefMap, HieFile(..))
 --   Foo+ means Foo for the dependencies
 --   Foo* means Foo for me and Foo+
 
+data ParsedModuleResult = ParsedModuleResult
+    { pmrModule     :: !ParsedModule
+    , pmrHash       :: !ByteString
+    }
+instance Show ParsedModuleResult where
+    show = show . pmrModule
+
+instance NFData ParsedModuleResult where
+    rnf (ParsedModuleResult pm hash) = rnf pm `seq` rnf hash
+
 -- | The parse tree for the file using GetFileContents
-type instance RuleResult GetParsedModule = ParsedModule
+type instance RuleResult GetParsedModule = ParsedModuleResult
 
 -- | The dependency information produced by following the imports recursively.
 -- This rule will succeed even if there is an error, e.g., a module could not be located,
@@ -86,7 +97,7 @@ type instance RuleResult TypeCheck = TcModuleResult
 data HieFileResult = HFR { hieFile :: !HieFile, refmap :: !RefMap }
 
 instance NFData HieFileResult where
-    rnf (HFR hf rm) = rnf hf `seq` rnf (M.keys rm)
+    rnf (HFR hf rm) = rnf hf `seq` rnf rm
 
 instance Show HieFileResult where
     show = show . hie_module . hieFile
diff --git a/src/Development/IDE/Core/Rules.hs b/src/Development/IDE/Core/Rules.hs
index 4d4157d..42387ed 100644
--- a/src/Development/IDE/Core/Rules.hs
+++ b/src/Development/IDE/Core/Rules.hs
@@ -219,7 +177,7 @@ workspaceSymbols query = runMaybeT $ do
 
 -- | Parse the contents of a daml file.
 getParsedModule :: NormalizedFilePath -> Action (Maybe ParsedModule)
-getParsedModule file = use GetParsedModule file
+getParsedModule file = fmap pmrModule <$> use GetParsedModule file
 
 ------------------------------------------------------------
 -- Rules
@@ -255,8 +213,11 @@ getParsedModuleRule = defineEarlyCutoff $ \GetParsedModule file -> do
 
     -- Parse again (if necessary) to capture Haddock parse errors
     if gopt Opt_Haddock dflags
-        then
-            liftIO mainParse
+        then do
+            (diags,mr) <- liftIO mainParse
+            case mr of
+              Just pmr -> pure (Just (pmrHash pmr), (diags, mr))
+              Nothing  -> pure (Nothing, (diags, mr))
         else do
             let hscHaddock = hsc{hsc_dflags = gopt_set dflags Opt_Haddock}
                 haddockParse = getParsedModuleDefinition hscHaddock opt comp_pkgs file contents
@@ -267,29 +228,29 @@ getParsedModuleRule = defineEarlyCutoff $ \GetParsedModule file -> do
             -- If we can parse Haddocks, might as well use them
             --
             -- HLINT INTEGRATION: might need to save the other parsed module too
-            ((fp,(diags,res)),(fph,(diagsh,resh))) <- liftIO $ concurrently mainParse haddockParse
+            ((diags,res),(diagsh,resh)) <- liftIO $ concurrently mainParse haddockParse
 
             -- Merge haddock and regular diagnostics so we can always report haddock
             -- parse errors
             let diagsM = mergeDiagnostics diags diagsh
             case resh of
-              Just _ -> pure (fph, (diagsM, resh))
+              Just pmr -> pure (Just (pmrHash pmr), (diagsM, resh))
               -- If we fail to parse haddocks, report the haddock diagnostics as well and
               -- return the non-haddock parse.
               -- This seems to be the correct behaviour because the Haddock flag is added
               -- by us and not the user, so our IDE shouldn't stop working because of it.
-              Nothing  -> pure (fp, (diagsM, res))
+              Nothing  -> case res of
+                Just pmr -> pure (Just (pmrHash pmr), (diagsM, res))
+                Nothing -> pure (Nothing,(diagsM,Nothing))
 
-getParsedModuleDefinition :: HscEnv -> IdeOptions -> [PackageName] -> NormalizedFilePath -> Maybe T.Text -> IO (Maybe ByteString, ([FileDiagnostic], Maybe ParsedModule))
+getParsedModuleDefinition :: HscEnv -> IdeOptions -> [PackageName] -> NormalizedFilePath -> Maybe T.Text -> IO (([FileDiagnostic], Maybe ParsedModuleResult))
 getParsedModuleDefinition packageState opt comp_pkgs file contents = do
     (diag, res) <- parseModule opt packageState comp_pkgs (fromNormalizedFilePath file) (fmap textToStringBuffer contents)
     case res of
-        Nothing -> pure (Nothing, (diag, Nothing))
+        Nothing -> pure (diag, Nothing)
         Just (contents, modu) -> do
-            mbFingerprint <- if isNothing $ optShakeFiles opt
-                then pure Nothing
-                else Just . fingerprintToBS <$> fingerprintFromStringBuffer contents
-            pure (mbFingerprint, (diag, Just modu))
+            fp <- fingerprintToBS <$> fingerprintFromStringBuffer contents
+            pure (diag, Just $ ParsedModuleResult modu fp)
 
 @@ -443,32 +395,40 @@ getDependenciesRule =
 getHieFileRule :: Rules ()
 getHieFileRule =
     define $ \GetHieFile f -> do
-      tcm <- use_ TypeCheck f
-      hf <- case tmrHieFile tcm of
-        Just hf -> pure ([],Just hf)
-        Nothing -> do
-          hsc  <- hscEnv <$> use_ GhcSession f
-          ShakeExtras{hiedbChan} <- getShakeExtras
-          liftIO $ generateAndWriteHieFile hsc hiedbChan (tmrModule tcm)
+      pm <- use_ GetParsedModule f
+      se <- getShakeExtras
+      (diags,hf) <- do
+        liftIO $ L.logInfo (logger se) $ "Regenerating HIE File: " <> T.pack (show f)
+        (diags,tcm) <- typeCheckRuleDefinition f pm DoGenerateInterfaceFiles
+        pure (diags, tmrHieFile =<< tcm)
       let refmap = generateReferencesMap . getAsts . hie_asts
-      pure $ fmap (\x -> HFR x $ refmap x) <$> hf
+      pure $ (diags, (\x -> HFR x (refmap x)) <$> hf)
 
 persistentHieFileRule :: Rules ()
 persistentHieFileRule = addPersistentRule GetHieFile $ \file -> runMaybeT $ do
+  res <- MaybeT $ readHieFileFromDisk file
+  let refmap = generateReferencesMap . getAsts . hie_asts $ res
+  pure $ HFR res refmap
 
 getDocMapRule :: Rules ()
 getDocMapRule =
     define $ \GetDocMap file -> do
-      hmi <- tmrModInfo <$> use_ TypeCheck file
+      hmi <- hirModIface <$> use_ GetModIface file
       hsc <- hscEnv <$> use_ GhcSession file
       HFR _ rf <- use_ GetHieFile file
 
@@ -514,16 +474,17 @@ data GenerateInterfaceFiles
 -- retain the information forever in the shake graph.
 typeCheckRuleDefinition
     :: NormalizedFilePath     -- ^ Path to source file
-    -> ParsedModule
+    -> ParsedModuleResult
     -> GenerateInterfaceFiles -- ^ Should generate .hi and .hie files ?
     -> Action (IdeResult TcModuleResult)
-typeCheckRuleDefinition file pm generateArtifacts = do
+typeCheckRuleDefinition file pmr generateArtifacts = do
   deps <- use_ GetDependencies file
   hsc  <- hscEnv <$> use_ GhcSession file
   -- Figure out whether we need TemplateHaskell or QuasiQuotes support
   let graph_needs_th_qq = needsTemplateHaskellOrQQ $ hsc_mod_graph hsc
       file_uses_th_qq   = uses_th_qq $ ms_hspp_opts (pm_mod_summary pm)
       any_uses_th_qq    = graph_needs_th_qq || file_uses_th_qq
+      pm = pmrModule pmr
   mirs      <- uses_ GetModIface (transitiveModuleDeps deps)
   bytecodes <- if any_uses_th_qq
     then -- If we use TH or QQ, we must obtain the bytecode
@@ -539,7 +500,7 @@ typeCheckRuleDefinition file pm generateArtifacts = do
     res <- typecheckModule defer hsc (zipWith unpack mirs bytecodes) pm
     case res of
       (diags, Just (hsc,tcm)) | DoGenerateInterfaceFiles <- generateArtifacts -> do
-        (diagsHie,hf) <- generateAndWriteHieFile hsc hiedbChan (tmrModule tcm)
+        (diagsHie,hf) <- generateAndWriteHieFile hsc hiedbChan (tmrModule tcm) (pmrHash pmr)
         diagsHi  <- generateAndWriteHiFile hsc tcm
         return (diags <> diagsHi <> diagsHie, Just tcm{tmrHieFile=hf})
       (diags, res) -> return (diags, snd <$> res)
@@ -662,20 +623,21 @@ getModSummaryRule = define $ \GetModSummary f -> do
     return $ either (,Nothing) (([], ) . Just) modS
 
 getModIfaceRule :: Rules ()
-getModIfaceRule = define $ \GetModIface f -> do
-    fileOfInterest <- use_ IsFileOfInterest f
-    let useHiFile =
+getModIfaceRule = defineEarlyCutoff $ \GetModIface f -> do
+    -- fileOfInterest <- use_ IsFileOfInterest f
+    let useHiFile = True
           -- Never load interface files for files of interest
-          not fileOfInterest
+          -- not fileOfInterest
     mbHiFile <- if useHiFile then use GetHiFile f else return Nothing
     case mbHiFile of
-        Just x ->
-            return ([], Just x)
+        Just x -> do
+            let hash = fingerprintToBS $ getModuleHash $ hirModIface x
+            return (Just hash,([], Just x))
         Nothing
-          | fileOfInterest -> do
-            -- For files of interest only, create a Shake dependency on typecheck
-            tmr <- use TypeCheck f
-            return ([], extract tmr)
+          --  | fileOfInterest -> do
+          --    -- For files of interest only, create a Shake dependency on typecheck
+          --    tmr <- use TypeCheck f
+          --    return ([], extract tmr)
           | otherwise -> do
             -- the interface file does not exist or is out of date.
             -- Invoke typechecking directly to update it without incurring a dependency
@@ -689,14 +651,15 @@ getModIfaceRule = define $ \GetModIface f -> do
             (_, contents) <- getFileContents f
             -- Embed --haddocks in the interface file
             hsc <- pure hsc{hsc_dflags = gopt_set (hsc_dflags hsc) Opt_Haddock}
-            (_, (diags, mb_pm)) <- liftIO $ getParsedModuleDefinition hsc opt comp_pkgs f contents
+            (diags, mb_pm) <- liftIO $ getParsedModuleDefinition hsc opt comp_pkgs f contents
             case mb_pm of
-                Nothing -> return (diags, Nothing)
+                Nothing -> return (Nothing,(diags, Nothing))
                 Just pm -> do
                     (diags', tmr) <- typeCheckRuleDefinition f pm DoGenerateInterfaceFiles
                     -- Bang pattern is important to avoid leaking 'tmr'
                     let !res = extract tmr
-                    return (diags <> diags', res)
+                        !hash = fingerprintToBS . getModuleHash . hirModIface <$> res
+                    return (hash,(diags <> diags', res))
     where
       extract Nothing = Nothing
       extract (Just tmr) =
diff --git a/src/Development/IDE/GHC/Orphans.hs b/src/Development/IDE/GHC/Orphans.hs
index f7abd0e..1e6ab86 100644
--- a/src/Development/IDE/GHC/Orphans.hs
+++ b/src/Development/IDE/GHC/Orphans.hs
@@ -71,3 +71,9 @@ instance Show HieFile where
 
 instance NFData HieFile where
     rnf = rwhnf
+
+instance NFData a => NFData (IdentifierDetails a) where
+    rnf (IdentifierDetails a b) = rnf a `seq` rnf (length b)
+
+instance NFData RealSrcSpan where
+    rnf = rwhnf
diff --git a/src/Development/IDE/LSP/Outline.hs b/src/Development/IDE/LSP/Outline.hs
index e4d9aaf..fbcf64a 100644
--- a/src/Development/IDE/LSP/Outline.hs
+++ b/src/Development/IDE/LSP/Outline.hs
@@ -20,6 +20,7 @@ import           Data.Text                      ( Text
                                                 )
 import qualified Data.Text                     as T
 import           Development.IDE.Core.Rules
+import           Development.IDE.Core.RuleTypes
 import           Development.IDE.Core.Shake
 import           Development.IDE.GHC.Compat
 import           Development.IDE.GHC.Error      ( srcSpanToRange )
@@ -43,7 +44,7 @@ moduleOutline _lsp ideState DocumentSymbolParams { _textDocument = TextDocumentI
       mb_decls <- fmap fst <$> runIdeAction "Outline" (shakeExtras ideState) (useWithStaleFast GetParsedModule fp)
       pure $ Right $ case mb_decls of
         Nothing -> DSDocumentSymbols (List [])
-        Just ParsedModule { pm_parsed_source = L _ltop HsModule { hsmodName, hsmodDecls, hsmodImports } }
+        Just (pmrModule -> ParsedModule { pm_parsed_source = L _ltop HsModule { hsmodName, hsmodDecls, hsmodImports } })
           -> let
                declSymbols  = mapMaybe documentSymbolForDecl hsmodDecls
                moduleSymbol = hsmodName <&> \(L l m) ->
diff --git a/src/Development/IDE/Plugin/Completions.hs b/src/Development/IDE/Plugin/Completions.hs
index 1e16044..f2669bf 100644
--- a/src/Development/IDE/Plugin/Completions.hs
+++ b/src/Development/IDE/Plugin/Completions.hs
@@ -90,7 +90,7 @@ getCompletionsLSP lsp ide
               pm <- useWithStaleFast GetParsedModule npath
               pure (opts, liftA2 (,) compls pm)
           case compls of
-            Just ((cci', _), (pm, mapping)) -> do
+            Just ((cci', _), (ParsedModuleResult pm _, mapping)) -> do
               let !position' = fromCurrentPosition mapping position
               pfix <- maybe (return Nothing) (flip VFS.getCompletionPrefix cnts) position'
               case (pfix, completionContext) of
@@ -108,5 +108,5 @@ getCompletionsLSP lsp ide
 
 setHandlersCompletion :: PartialHandlers c
 setHandlersCompletion = PartialHandlers $ \WithMessage{..} x -> return x{
-    LSP.completionHandler = withResponse RspCompletion getCompletionsLSP
+    LSP.completionHandler = Nothing -- withResponse RspCompletion getCompletionsLSP
     }
diff --git a/src/Development/IDE/Spans/Documentation.hs b/src/Development/IDE/Spans/Documentation.hs
index 6579655..9872b65 100644
--- a/src/Development/IDE/Spans/Documentation.hs
+++ b/src/Development/IDE/Spans/Documentation.hs
@@ -32,12 +32,12 @@ mkDocMap
   :: GhcMonad m
   => [ParsedModule]
   -> RefMap
-  -> HomeModInfo
+  -> ModIface
   -> [ModIface]
   -> m DocMap
 mkDocMap sources rm hmi deps =
   do mapM_ (`loadDepModule` Nothing) (reverse deps)
-     modifySession (loadModuleHome hmi)
+     loadDepModule hmi Nothing
      foldrM go M.empty names
   where
     go n map = do