Save source files with HIE files

src/Development/IDE/Core/Compile.hs

@@ -73,6 +73,7 @@ import Control.Monad.Extra
 import Control.Monad.Except
 import Control.Monad.Trans.Except
 import Data.Bifunctor                           (first, second)
+import qualified Data.ByteString as BS
 import qualified Data.Text as T
 import           Data.IORef
 import           Data.List.Extra
@@ -276,13 +277,13 @@ atomicFileWrite targetPath write = do
   (tempFilePath, cleanUp) <- newTempFileWithin dir
   (write tempFilePath >> renameFile tempFilePath targetPath) `onException` cleanUp
 
-generateAndWriteHieFile :: HscEnv -> TypecheckedModule -> IO [FileDiagnostic]
-generateAndWriteHieFile hscEnv tcm =
+generateAndWriteHieFile :: HscEnv -> TypecheckedModule -> BS.ByteString -> IO [FileDiagnostic]
+generateAndWriteHieFile hscEnv tcm source =
   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 source
         atomicFileWrite targetPath $ flip GHC.writeHieFile hf
       _ ->
         return ()

src/Development/IDE/Core/RuleTypes.hs

@@ -123,6 +123,8 @@ type instance RuleResult IsFileOfInterest = Bool
 -- without needing to parse the entire source
 type instance RuleResult GetModSummary = ModSummary
 
+type instance RuleResult GetSourceFileSource = ByteString
+
 data GetParsedModule = GetParsedModule
     deriving (Eq, Show, Typeable, Generic)
 instance Hashable GetParsedModule
@@ -153,6 +155,12 @@ instance Hashable GetDependencies
 instance NFData   GetDependencies
 instance Binary   GetDependencies
 
+data GetSourceFileSource = GetSourceFileSource
+    deriving (Eq, Show, Typeable, Generic)
+instance Hashable GetSourceFileSource
+instance NFData   GetSourceFileSource
+instance Binary   GetSourceFileSource
+
 data TypeCheck = TypeCheck
     deriving (Eq, Show, Typeable, Generic)
 instance Hashable TypeCheck

src/Development/IDE/Core/Rules.hs

@@ -58,6 +58,7 @@ import Data.IntMap.Strict (IntMap)
 import Data.List
 import qualified Data.Set                                 as Set
 import qualified Data.Text                                as T
+import qualified Data.Text.Encoding                       as T
 import           Development.IDE.GHC.Error
 import           Development.Shake                        hiding (Diagnostic)
 import Development.IDE.Core.RuleTypes
@@ -185,11 +186,24 @@ getHomeHieFile f = do
       wait <- lift $ delayedAction $ mkDelayedAction "OutOfDateHie" L.Info $ do
         hsc <- hscEnv <$> use_ GhcSession f
         pm <- use_ GetParsedModule f
-        typeCheckRuleDefinition hsc pm DoGenerateInterfaceFiles
+        source <- getSourceFileSource f
+        typeCheckRuleDefinition hsc pm DoGenerateInterfaceFiles source
       _ <- MaybeT $ liftIO $ timeout 1 wait
       ncu <- mkUpdater
       liftIO $ loadHieFile ncu hie_f
 
+getSourceFileSourceRule :: Rules ()
+getSourceFileSourceRule = define $ \GetSourceFileSource nfp -> do
+    (_, msource) <- getFileContents nfp
+    case msource of
+        Nothing -> do
+            source <- readFile' (fromNormalizedFilePath nfp)
+            let bsSource = T.encodeUtf8 $ T.pack source
+            pure ([], Just bsSource)
+        Just source -> pure ([], Just (T.encodeUtf8 source))
+
+getSourceFileSource :: NormalizedFilePath -> Action BS.ByteString
+getSourceFileSource nfp = use_ GetSourceFileSource nfp
 
 getPackageHieFile :: ShakeExtras
                   -> Module             -- ^ Package Module to load .hie file for
@@ -493,9 +507,10 @@ typeCheckRule :: Rules ()
 typeCheckRule = define $ \TypeCheck file -> do
     pm <- use_ GetParsedModule file
     hsc  <- hscEnv <$> use_ GhcSessionDeps file
+    source <- getSourceFileSource file
     -- do not generate interface files as this rule is called
     -- for files of interest on every keystroke
-    typeCheckRuleDefinition hsc pm SkipGenerationOfInterfaceFiles
+    typeCheckRuleDefinition hsc pm SkipGenerationOfInterfaceFiles source
 
 data GenerateInterfaceFiles
     = DoGenerateInterfaceFiles
@@ -510,16 +525,17 @@ typeCheckRuleDefinition
     :: HscEnv
     -> ParsedModule
     -> GenerateInterfaceFiles -- ^ Should generate .hi and .hie files ?
+    -> BS.ByteString
     -> Action (IdeResult TcModuleResult)
-typeCheckRuleDefinition hsc pm generateArtifacts = do
+typeCheckRuleDefinition hsc pm generateArtifacts source = do
   setPriority priorityTypeCheck
   IdeOptions { optDefer = defer } <- getIdeOptions
 
   addUsageDependencies $ liftIO $ do
     res <- typecheckModule defer hsc pm
     case res of
       (diags, Just (hsc,tcm)) | DoGenerateInterfaceFiles <- generateArtifacts -> do
-        diagsHie <- generateAndWriteHieFile hsc (tmrModule tcm)
+        diagsHie <- generateAndWriteHieFile hsc (tmrModule tcm) source
         diagsHi  <- generateAndWriteHiFile hsc tcm
         return (diags <> diagsHi <> diagsHie, Just tcm)
       (diags, res) ->
@@ -746,9 +762,10 @@ regenerateHiFile sess f = do
     case mb_pm of
         Nothing -> return (diags, Nothing)
         Just pm -> do
+            source <- getSourceFileSource f
             -- Invoke typechecking directly to update it without incurring a dependency
             -- on the parsed module and the typecheck rules
-            (diags', tmr) <- typeCheckRuleDefinition hsc pm DoGenerateInterfaceFiles
+            (diags', tmr) <- typeCheckRuleDefinition hsc pm DoGenerateInterfaceFiles source
             -- Bang pattern is important to avoid leaking 'tmr'
             let !res = extractHiFileResult tmr
             return (diags <> diags', res)
@@ -770,6 +787,7 @@ mainRule :: Rules ()
 mainRule = do
     getParsedModuleRule
     getLocatedImportsRule
+    getSourceFileSourceRule
     getDependencyInformationRule
     reportImportCyclesRule
     getDependenciesRule