HasNoDiagnostics

Author: pepeiborra

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

@@ -44,6 +44,7 @@ newtype OfInterestVar = OfInterestVar (Var (HashMap NormalizedFilePath FileOfInt
 instance IsIdeGlobal OfInterestVar
 
 type instance RuleResult GetFilesOfInterest = HashMap NormalizedFilePath FileOfInterestStatus
+instance HasNoDiagnostics GetFilesOfInterest
 
 data GetFilesOfInterest = GetFilesOfInterest
     deriving (Eq, Show, Typeable, Generic)

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

@@ -49,6 +49,16 @@ import           GHC.Serialized                               (Serialized)
 import           Language.LSP.Types                           (NormalizedFilePath)
 import           TcRnMonad                                    (TcGblEnv)
 
+-- | A class to signal when a rule will never produce diagnostics and thus
+--   can be excluded from the diagnostic loop
+class HasNoDiagnostics k where
+    hasDiagnostics :: k -> Bool
+    hasDiagnostics _ = False
+
+-- | The default instance always returns "I have diagnostics"
+instance {-# OVERLAPPABLE #-} HasNoDiagnostics a where
+  hasDiagnostics = const True
+
 data LinkableType = ObjectLinkable | BCOLinkable
   deriving (Eq,Ord,Show, Generic)
 instance Hashable LinkableType
@@ -69,19 +79,23 @@ type instance RuleResult GetParsedModuleWithComments = ParsedModule
 -- This rule will succeed even if there is an error, e.g., a module could not be located,
 -- a module could not be parsed or an import cycle.
 type instance RuleResult GetDependencyInformation = DependencyInformation
+instance HasNoDiagnostics GetDependencyInformation
 
 -- | Transitive module and pkg dependencies based on the information produced by GetDependencyInformation.
 -- This rule is also responsible for calling ReportImportCycles for each file in the transitive closure.
 type instance RuleResult GetDependencies = TransitiveDependencies
+instance HasNoDiagnostics GetDependencies
 
 type instance RuleResult GetModuleGraph = DependencyInformation
+instance HasNoDiagnostics GetModuleGraph -- 'defineNoFile' rules have no diagnostics
 
 data GetKnownTargets = GetKnownTargets
   deriving (Show, Generic, Eq, Ord)
 instance Hashable GetKnownTargets
 instance NFData   GetKnownTargets
 instance Binary   GetKnownTargets
 type instance RuleResult GetKnownTargets = KnownTargets
+instance HasNoDiagnostics GetKnownTargets
 
 -- | Convert to Core, requires TypeCheck*
 type instance RuleResult GenerateCore = ModGuts
@@ -99,6 +113,7 @@ instance NFData   GetImportMap
 instance Binary   GetImportMap
 
 type instance RuleResult GetImportMap = ImportMap
+instance HasNoDiagnostics GetImportMap
 newtype ImportMap = ImportMap
   { importMap :: M.Map ModuleName NormalizedFilePath -- ^ Where are the modules imported by this file located?
   } deriving stock Show
@@ -212,6 +227,7 @@ type instance RuleResult GetHieAst = HieAstResult
 
 -- | A IntervalMap telling us what is in scope at each point
 type instance RuleResult GetBindings = Bindings
+instance HasNoDiagnostics GetBindings
 
 data DocAndKindMap = DKMap {getDocMap :: !DocMap, getKindMap :: !KindMap}
 instance NFData DocAndKindMap where
@@ -221,12 +237,14 @@ instance Show DocAndKindMap where
     show = const "docmap"
 
 type instance RuleResult GetDocMap = DocAndKindMap
+instance HasNoDiagnostics GetDocMap
 
 -- | A GHC session that we reuse.
 type instance RuleResult GhcSession = HscEnvEq
 
 -- | A GHC session preloaded with all the dependencies
 type instance RuleResult GhcSessionDeps = HscEnvEq
+instance HasNoDiagnostics GhcSessionDeps
 
 -- | Resolve the imports in a module to the file path of a module in the same package
 type instance RuleResult GetLocatedImports = [(Located ModuleName, Maybe ArtifactsLocation)]
@@ -243,13 +261,15 @@ type instance RuleResult GetModIfaceFromDisk = HiFileResult
 -- | GetModIfaceFromDisk and index the `.hie` file into the database.
 --   This is an internal rule, use 'GetModIface' instead.
 type instance RuleResult GetModIfaceFromDiskAndIndex = HiFileResult
+instance HasNoDiagnostics GetModIfaceFromDiskAndIndex
 
 -- | Get a module interface details, either from an interface file or a typechecked module
 type instance RuleResult GetModIface = HiFileResult
 
 -- | Get a module interface details, without the Linkable
 -- For better early cuttoff
 type instance RuleResult GetModIfaceWithoutLinkable = HiFileResult
+instance HasNoDiagnostics GetModIfaceWithoutLinkable
 
 -- | Get the contents of a file, either dirty (if the buffer is modified) or Nothing to mean use from disk.
 type instance RuleResult GetFileContents = (FileVersion, Maybe Text)
@@ -279,6 +299,8 @@ pattern GetModificationTime = GetModificationTime_ {missingFileDiagnostics=True}
 
 -- | Get the modification time of a file.
 type instance RuleResult GetModificationTime = FileVersion
+instance HasNoDiagnostics GetModificationTime where
+    hasDiagnostics GetModificationTime_{..} = missingFileDiagnostics
 
 data FileVersion
     = VFSVersion !Int
@@ -335,6 +357,7 @@ type instance RuleResult GetModSummary = ModSummaryResult
 
 -- | Generate a ModSummary with the timestamps and preprocessed content elided, for more successful early cutoff
 type instance RuleResult GetModSummaryWithoutTimestamps = ModSummaryResult
+instance HasNoDiagnostics GetModSummaryWithoutTimestamps
 
 data GetParsedModule = GetParsedModule
     deriving (Eq, Show, Typeable, Generic)

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

@@ -1133,3 +1133,4 @@ instance NFData   IsHiFileStable
 instance Binary   IsHiFileStable
 
 type instance RuleResult IsHiFileStable = SourceModified
+instance HasNoDiagnostics IsHiFileStable

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

@@ -22,6 +22,7 @@
 -- * The 'Values' type stores a map of keys to values. These values are
 --   always stored as real Haskell values, whereas Shake serialises all 'A' values
 --   between runs. To deserialise a Shake value, we just consult Values.
+{-# LANGUAGE FlexibleInstances         #-}
 module Development.IDE.Core.Shake(
     IdeState, shakeExtras,
     ShakeExtras(..), getShakeExtras, getShakeExtrasRules,
@@ -369,6 +370,7 @@ mappingForVersion allMappings file ver =
 type IdeRule k v =
   ( Shake.RuleResult k ~ v
   , Shake.ShakeValue k
+  , HasNoDiagnostics k
   , Show v
   , Typeable v
   , NFData v
@@ -921,7 +923,8 @@ defineEarlyCutoff op = addBuiltinRule noLint noIdentity $ \(Q (key, file)) (old
                     -- No changes in the dependencies and we have
                     -- an existing result.
                     Just (v, diags) -> do
-                        updateFileDiagnostics file (Key key) extras $ map (\(_,y,z) -> (y,z)) $ Vector.toList diags
+                        when (hasDiagnostics key) $
+                            updateFileDiagnostics file (Key key) extras $ map (\(_,y,z) -> (y,z)) $ Vector.toList diags
                         return $ Just $ RunResult ChangedNothing old $ A v
                     _ -> return Nothing
             _ -> return Nothing
@@ -946,7 +949,8 @@ defineEarlyCutoff op = addBuiltinRule noLint noIdentity $ \(Q (key, file)) (old
                                     (toShakeValue ShakeResult bs, Failed b)
                     Just v -> pure (maybe ShakeNoCutoff ShakeResult bs, Succeeded (vfsVersion =<< modTime) v)
                 liftIO $ setValues state key file res (Vector.fromList diags)
-                updateFileDiagnostics file (Key key) extras $ map (\(_,y,z) -> (y,z)) diags
+                when (hasDiagnostics key) $
+                    updateFileDiagnostics file (Key key) extras $ map (\(_,y,z) -> (y,z)) diags
                 let eq = case (bs, fmap decodeShakeValue old) of
                         (ShakeResult a, Just (ShakeResult b)) -> a == b
                         (ShakeStale a, Just (ShakeStale b))   -> a == b

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

@@ -83,6 +83,7 @@ instance Hashable GetAnnotatedParsedSource
 instance NFData GetAnnotatedParsedSource
 instance Binary GetAnnotatedParsedSource
 type instance RuleResult GetAnnotatedParsedSource = Annotated ParsedSource
+instance HasNoDiagnostics GetAnnotatedParsedSource
 
 -- | Get the latest version of the annotated parse source with comments.
 getAnnotatedParsedSourceRule :: Rules ()

ghcide/src/Development/IDE/Plugin/Completions.hs

@@ -93,6 +93,8 @@ dropListFromImportDecl iDecl = let
 -- | Produce completions info for a file
 type instance RuleResult LocalCompletions = CachedCompletions
 type instance RuleResult NonLocalCompletions = CachedCompletions
+instance HasNoDiagnostics LocalCompletions
+instance HasNoDiagnostics NonLocalCompletions
 
 data LocalCompletions = LocalCompletions
     deriving (Eq, Show, Typeable, Generic)