Merge branch 'master' into hls-wrapper-lsp-server

Author: smatting

exe/Plugins.hs

@@ -160,7 +160,7 @@ idePlugins recorder includeExamples = pluginDescToIdePlugins allPlugins
       CallHierarchy.descriptor :
 #endif
 #if class
-      Class.descriptor "class" :
+      Class.descriptor pluginRecorder "class" :
 #endif
 #if haddockComments
       HaddockComments.descriptor "haddockComments" :

ghcide/exe/Arguments.hs

@@ -15,6 +15,7 @@ data Arguments = Arguments
     ,argsOTMemoryProfiling          :: Bool
     ,argsTesting                    :: Bool
     ,argsDisableKick                :: Bool
+    ,argsVerifyCoreFile             :: Bool
     ,argsThreads                    :: Int
     ,argsVerbose                    :: Bool
     ,argsCommand                    :: Command
@@ -37,6 +38,7 @@ arguments plugins = Arguments
       <*> switch (long "ot-memory-profiling" <> help "Record OpenTelemetry info to the eventlog. Needs the -l RTS flag to have an effect")
       <*> switch (long "test" <> help "Enable additional lsp messages used by the testsuite")
       <*> switch (long "test-no-kick" <> help "Disable kick. Useful for testing cancellation")
+      <*> switch (long "verify-core-file" <> help "Verify core trips by roundtripping after serialization. Slow, only useful for testing purposes")
       <*> option auto (short 'j' <> help "Number of threads (0: automatic)" <> metavar "NUM" <> value 0 <> showDefault)
       <*> switch (short 'd' <> long "verbose" <> help "Include internal events in logging output")
       <*> (commandP plugins <|> lspCommand <|> checkCommand)

ghcide/exe/Main.hs

@@ -142,6 +142,7 @@ main = withTelemetryLogger $ \telemetryLogger -> do
                 , optCheckParents = pure $ checkParents config
                 , optCheckProject = pure $ checkProject config
                 , optRunSubset = not argsConservativeChangeTracking
+                , optVerifyCoreFile = argsVerifyCoreFile
                 }
         , IDEMain.argsMonitoring = OpenTelemetry.monitoring <> EKG.monitoring logger argsMonitoringPort
         }

ghcide/ghcide.cabal

@@ -180,6 +180,7 @@ library
         Development.IDE.GHC.Compat.Units
         Development.IDE.GHC.Compat.Util
         Development.IDE.Core.Compile
+        Development.IDE.GHC.CoreFile
         Development.IDE.GHC.Dump
         Development.IDE.GHC.Error
         Development.IDE.GHC.ExactPrint

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

@@ -150,7 +150,7 @@ getModificationTimeImpl missingFileDiags file = do
 --   But interface files are private, in that only HLS writes them.
 --   So we implement watching ourselves, and bypass the need for alwaysRerun.
 isInterface :: NormalizedFilePath -> Bool
-isInterface f = takeExtension (fromNormalizedFilePath f) `elem` [".hi", ".hi-boot"]
+isInterface f = takeExtension (fromNormalizedFilePath f) `elem` [".hi", ".hi-boot", ".hie", ".hie-boot", ".core"]
 
 -- | Reset the GetModificationTime state of interface files
 resetInterfaceStore :: ShakeExtras -> NormalizedFilePath -> STM ()

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

@@ -17,6 +17,7 @@ module Development.IDE.Core.RuleTypes(
     ) where
 
 import           Control.DeepSeq
+import           Control.Exception                            (assert)
 import           Control.Lens
 import           Data.Aeson.Types                             (Value)
 import           Data.Hashable
@@ -26,6 +27,7 @@ import           Data.Typeable
 import           Development.IDE.GHC.Compat                   hiding
                                                               (HieFileResult)
 import           Development.IDE.GHC.Compat.Util
+import           Development.IDE.GHC.CoreFile
 import           Development.IDE.GHC.Util
 import           Development.IDE.Graph
 import           Development.IDE.Import.DependencyInformation
@@ -35,9 +37,7 @@ import           GHC.Generics                                 (Generic)
 
 import qualified Data.Binary                                  as B
 import           Data.ByteString                              (ByteString)
-import qualified Data.ByteString.Lazy                         as LBS
 import           Data.Text                                    (Text)
-import           Data.Time
 import           Development.IDE.Import.FindImports           (ArtifactsLocation)
 import           Development.IDE.Spans.Common
 import           Development.IDE.Spans.LocalBindings
@@ -91,6 +91,26 @@ data GenerateCore = GenerateCore
 instance Hashable GenerateCore
 instance NFData   GenerateCore
 
+type instance RuleResult GetLinkable = LinkableResult
+
+data LinkableResult
+  = LinkableResult
+  { linkableHomeMod :: !HomeModInfo
+  , linkableHash    :: !ByteString
+  -- ^ The hash of the core file
+  }
+
+instance Show LinkableResult where
+    show = show . mi_module . hm_iface . linkableHomeMod
+
+instance NFData LinkableResult where
+    rnf = rwhnf
+
+data GetLinkable = GetLinkable
+    deriving (Eq, Show, Typeable, Generic)
+instance Hashable GetLinkable
+instance NFData   GetLinkable
+
 data GetImportMap = GetImportMap
     deriving (Eq, Show, Typeable, Generic)
 instance Hashable GetImportMap
@@ -138,9 +158,10 @@ data TcModuleResult = TcModuleResult
     -- ^ Typechecked splice information
     , tmrDeferedError    :: !Bool
     -- ^ Did we defer any type errors for this module?
-    , tmrRuntimeModules  :: !(ModuleEnv UTCTime)
+    , tmrRuntimeModules  :: !(ModuleEnv ByteString)
         -- ^ Which modules did we need at runtime while compiling this file?
         -- Used for recompilation checking in the presence of TH
+        -- Stores the hash of their core file
     }
 instance Show TcModuleResult where
     show = show . pm_mod_summary . tmrParsed
@@ -155,30 +176,29 @@ data HiFileResult = HiFileResult
     { hirModSummary :: !ModSummary
     -- Bang patterns here are important to stop the result retaining
     -- a reference to a typechecked module
-    , hirHomeMod    :: !HomeModInfo
-    -- ^ Includes the Linkable iff we need object files
-    , hirIfaceFp    :: ByteString
+    , hirModIface   :: !ModIface
+    , hirModDetails :: ModDetails
+    -- ^ Populated lazily
+    , hirIfaceFp    :: !ByteString
     -- ^ Fingerprint for the ModIface
-    , hirLinkableFp :: ByteString
-    -- ^ Fingerprint for the Linkable
-    , hirRuntimeModules :: !(ModuleEnv UTCTime)
+    , hirRuntimeModules :: !(ModuleEnv ByteString)
     -- ^ same as tmrRuntimeModules
+    , hirCoreFp     :: !(Maybe (CoreFile, ByteString))
+    -- ^ If we wrote a core file for this module, then its contents (lazily deserialised)
+    -- along with its hash
     }
 
 hiFileFingerPrint :: HiFileResult -> ByteString
-hiFileFingerPrint HiFileResult{..} = hirIfaceFp <> hirLinkableFp
-
-mkHiFileResult :: ModSummary -> HomeModInfo -> ModuleEnv UTCTime -> HiFileResult
-mkHiFileResult hirModSummary hirHomeMod hirRuntimeModules = HiFileResult{..}
+hiFileFingerPrint HiFileResult{..} = hirIfaceFp <> maybe "" snd hirCoreFp
+
+mkHiFileResult :: ModSummary -> ModIface -> ModDetails -> ModuleEnv ByteString -> Maybe (CoreFile, ByteString) -> HiFileResult
+mkHiFileResult hirModSummary hirModIface hirModDetails hirRuntimeModules hirCoreFp =
+    assert (case hirCoreFp of Just (CoreFile{cf_iface_hash}, _)
+                                -> getModuleHash hirModIface == cf_iface_hash
+                              _ -> True)
+    HiFileResult{..}
   where
-    hirIfaceFp = fingerprintToBS . getModuleHash . hm_iface $ hirHomeMod -- will always be two bytes
-    hirLinkableFp = case hm_linkable hirHomeMod of
-      Nothing -> ""
-      Just (linkableTime -> l)  -> LBS.toStrict $
-        B.encode (fromEnum $ utctDay l, fromEnum $ utctDayTime l)
-
-hirModIface :: HiFileResult -> ModIface
-hirModIface = hm_iface . hirHomeMod
+    hirIfaceFp = fingerprintToBS . getModuleHash $ hirModIface -- will always be two bytes
 
 instance NFData HiFileResult where
     rnf = rwhnf