Rule inputs alternate hasinput class

ghcide/ghcide.cabal

@@ -135,6 +135,7 @@ library
     Development.IDE.Core.FileStore
     Development.IDE.Core.FileUtils
     Development.IDE.Core.IdeConfiguration
+    Development.IDE.Core.InputPath
     Development.IDE.Core.OfInterest
     Development.IDE.Core.PluginUtils
     Development.IDE.Core.PositionMapping

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

@@ -69,6 +69,7 @@ import           Language.LSP.VFS
 import           System.FilePath
 import           System.IO.Error
 import           System.IO.Unsafe
+import Development.IDE.Core.InputPath (InputPath (InputPath, unInputPath))
 
 
 data Log
@@ -88,16 +89,16 @@ instance Pretty Log where
       <+> pretty (fmap (fmap show) reverseDepPaths)
     LogShake msg -> pretty msg
 
-addWatchedFileRule :: Recorder (WithPriority Log) -> (NormalizedFilePath -> Action Bool) -> Rules ()
+addWatchedFileRule :: Recorder (WithPriority Log) -> (InputPath i -> Action Bool) -> Rules ()
 addWatchedFileRule recorder isWatched = defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \AddWatchedFile f -> do
   isAlreadyWatched <- isWatched f
-  isWp <- isWorkspaceFile f
+  isWp <- isWorkspaceFile $ unInputPath f
   if isAlreadyWatched then pure (Just True) else
     if not isWp then pure (Just False) else do
         ShakeExtras{lspEnv} <- getShakeExtras
         case lspEnv of
             Just env -> fmap Just $ liftIO $ LSP.runLspT env $
-                registerFileWatches [fromNormalizedFilePath f]
+                registerFileWatches [fromNormalizedFilePath (unInputPath f)]
             Nothing -> pure $ Just False
 
 
@@ -107,12 +108,12 @@ getModificationTimeRule recorder = defineEarlyCutoff (cmapWithPrio LogShake reco
 
 getModificationTimeImpl
   :: Bool
-  -> NormalizedFilePath
+  -> InputPath i
   -> Action (Maybe BS.ByteString, ([FileDiagnostic], Maybe FileVersion))
 getModificationTimeImpl missingFileDiags file = do
-    let file' = fromNormalizedFilePath file
+    let file' = fromNormalizedFilePath $ unInputPath file
     let wrap time = (Just $ LBS.toStrict $ B.encode $ toRational time, ([], Just $ ModificationTime time))
-    mbVf <- getVirtualFile file
+    mbVf <- getVirtualFile $ unInputPath file
     case mbVf of
         Just (virtualFileVersion -> ver) -> do
             alwaysRerun
@@ -124,7 +125,7 @@ getModificationTimeImpl missingFileDiags file = do
                         -- but also need a dependency on IsFileOfInterest to reinstall
                         -- alwaysRerun when the file becomes VFS
                     void (use_ IsFileOfInterest file)
-                else if isInterface file
+                else if isInterface (unInputPath file)
                     then -- interface files are tracked specially using the closed world assumption
                         pure ()
                     else -- in all other cases we will need to freshly check the file system
@@ -134,7 +135,7 @@ getModificationTimeImpl missingFileDiags file = do
                 `catch` \(e :: IOException) -> do
                     let err | isDoesNotExistError e = "File does not exist: " ++ file'
                             | otherwise = "IO error while reading " ++ file' ++ ", " ++ displayException e
-                        diag = ideErrorText file (T.pack err)
+                        diag = ideErrorText (unInputPath file) (T.pack err)
                     if isDoesNotExistError e && not missingFileDiags
                         then return (Nothing, ([], Nothing))
                         else return (Nothing, ([diag], Nothing))
@@ -174,19 +175,19 @@ getFileContentsRule :: Recorder (WithPriority Log) -> Rules ()
 getFileContentsRule recorder = define (cmapWithPrio LogShake recorder) $ \GetFileContents file -> getFileContentsImpl file
 
 getFileContentsImpl
-    :: NormalizedFilePath
+    :: InputPath i
     -> Action ([FileDiagnostic], Maybe (FileVersion, Maybe T.Text))
 getFileContentsImpl file = do
     -- need to depend on modification time to introduce a dependency with Cutoff
     time <- use_ GetModificationTime file
     res <- do
-        mbVirtual <- getVirtualFile file
+        mbVirtual <- getVirtualFile $ unInputPath file
         pure $ virtualFileText <$> mbVirtual
     pure ([], Just (time, res))
 
 -- | Returns the modification time and the contents.
 --   For VFS paths, the modification time is the current time.
-getFileContents :: NormalizedFilePath -> Action (UTCTime, Maybe T.Text)
+getFileContents :: InputPath i -> Action (UTCTime, Maybe T.Text)
 getFileContents f = do
     (fv, txt) <- use_ GetFileContents f
     modTime <- case modificationTime fv of
@@ -196,11 +197,11 @@ getFileContents f = do
         liftIO $ case foi of
           IsFOI Modified{} -> getCurrentTime
           _ -> do
-            posix <- getModTime $ fromNormalizedFilePath f
+            posix <- getModTime $ fromNormalizedFilePath $ unInputPath f
             pure $ posixSecondsToUTCTime posix
     return (modTime, txt)
 
-fileStoreRules :: Recorder (WithPriority Log) -> (NormalizedFilePath -> Action Bool) -> Rules ()
+fileStoreRules :: Recorder (WithPriority Log) -> (InputPath i -> Action Bool) -> Rules ()
 fileStoreRules recorder isWatched = do
     getModificationTimeRule recorder
     getFileContentsRule recorder
@@ -239,7 +240,7 @@ typecheckParentsAction recorder nfp = do
       Nothing -> logWith recorder Info $ LogCouldNotIdentifyReverseDeps nfp
       Just rs -> do
         logWith recorder Info $ LogTypeCheckingReverseDeps nfp revs
-        void $ uses GetModIface rs
+        void $ uses GetModIface (map InputPath rs)
 
 -- | Note that some keys have been modified and restart the session
 --   Only valid if the virtual file system was initialised by LSP, as that

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

@@ -0,0 +1,7 @@
+module Development.IDE.Core.InputPath where
+
+import Development.IDE.Graph.Internal.RuleInput (Input)
+import Language.LSP.Protocol.Types (NormalizedFilePath)
+
+newtype InputPath (i :: Input) =
+    InputPath { unInputPath :: NormalizedFilePath } deriving Eq

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

@@ -29,6 +29,7 @@ import           Development.IDE.GHC.Compat.Util
 import           Development.IDE.GHC.CoreFile
 import           Development.IDE.GHC.Util
 import           Development.IDE.Graph
+import           Development.IDE.Graph.Internal.RuleInput     (Input(ProjectHaskellFile, DependencyHaskellFile, NoFile), RuleInput, ValidInputs(ProjectHaskellFilesOnly, AllHaskellFiles, NoFiles))
 import           Development.IDE.Import.DependencyInformation
 import           Development.IDE.Types.HscEnvEq               (HscEnvEq)
 import           Development.IDE.Types.KnownTargets
@@ -65,28 +66,34 @@ encodeLinkableType (Just ObjectLinkable) = "2"
 
 -- | The parse tree for the file using GetFileContents
 type instance RuleResult GetParsedModule = ParsedModule
+type instance RuleInput GetParsedModule = AllHaskellFiles
 
 -- | The parse tree for the file using GetFileContents,
 -- all comments included using Opt_KeepRawTokenStream
 type instance RuleResult GetParsedModuleWithComments = ParsedModule
+type instance RuleInput GetParsedModuleWithComments = AllHaskellFiles
 
 type instance RuleResult GetModuleGraph = DependencyInformation
+type instance RuleInput GetModuleGraph = ProjectHaskellFilesOnly
 
 data GetKnownTargets = GetKnownTargets
   deriving (Show, Generic, Eq, Ord)
 instance Hashable GetKnownTargets
 instance NFData   GetKnownTargets
 type instance RuleResult GetKnownTargets = KnownTargets
+type instance RuleInput GetKnownTargets = NoFiles
 
 -- | Convert to Core, requires TypeCheck*
 type instance RuleResult GenerateCore = ModGuts
+type instance RuleInput GenerateCore = ProjectHaskellFilesOnly
 
 data GenerateCore = GenerateCore
     deriving (Eq, Show, Typeable, Generic)
 instance Hashable GenerateCore
 instance NFData   GenerateCore
 
 type instance RuleResult GetLinkable = LinkableResult
+type instance RuleInput GetLinkable = ProjectHaskellFilesOnly
 
 data LinkableResult
   = LinkableResult
@@ -112,6 +119,7 @@ instance Hashable GetImportMap
 instance NFData   GetImportMap
 
 type instance RuleResult GetImportMap = ImportMap
+type instance RuleInput GetImportMap = ProjectHaskellFilesOnly
 newtype ImportMap = ImportMap
   { importMap :: M.Map ModuleName NormalizedFilePath -- ^ Where are the modules imported by this file located?
   } deriving stock Show
@@ -232,12 +240,15 @@ instance Show HieAstResult where
 
 -- | The type checked version of this file, requires TypeCheck+
 type instance RuleResult TypeCheck = TcModuleResult
+type instance RuleInput TypeCheck = ProjectHaskellFilesOnly
 
 -- | The uncompressed HieAST
 type instance RuleResult GetHieAst = HieAstResult
+type instance RuleInput GetHieAst = AllHaskellFiles
 
 -- | A IntervalMap telling us what is in scope at each point
 type instance RuleResult GetBindings = Bindings
+type instance RuleInput GetBindings = ProjectHaskellFilesOnly
 
 data DocAndTyThingMap = DKMap {getDocMap :: !DocMap, getTyThingMap :: !TyThingMap}
 instance NFData DocAndTyThingMap where
@@ -247,39 +258,50 @@ instance Show DocAndTyThingMap where
     show = const "docmap"
 
 type instance RuleResult GetDocMap = DocAndTyThingMap
+type instance RuleInput GetDocMap = ProjectHaskellFilesOnly
 
 -- | A GHC session that we reuse.
 type instance RuleResult GhcSession = HscEnvEq
+type instance RuleInput GhcSession = ProjectHaskellFilesOnly
 
 -- | A GHC session preloaded with all the dependencies
 -- This rule is also responsible for calling ReportImportCycles for the direct dependencies
 type instance RuleResult GhcSessionDeps = HscEnvEq
+type instance RuleInput GhcSessionDeps = ProjectHaskellFilesOnly
 
 -- | 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)]
+type instance RuleInput GetLocatedImports = ProjectHaskellFilesOnly
 
 -- | This rule is used to report import cycles. It depends on GetModuleGraph.
 -- We cannot report the cycles directly from GetModuleGraph since
 -- we can only report diagnostics for the current file.
 type instance RuleResult ReportImportCycles = ()
+type instance RuleInput ReportImportCycles = ProjectHaskellFilesOnly
 
 -- | Read the module interface file from disk. Throws an error for VFS files.
 --   This is an internal rule, use 'GetModIface' instead.
 type instance RuleResult GetModIfaceFromDisk = HiFileResult
+type instance RuleInput GetModIfaceFromDisk = ProjectHaskellFilesOnly
 
 -- | GetModIfaceFromDisk and index the `.hie` file into the database.
 --   This is an internal rule, use 'GetModIface' instead.
 type instance RuleResult GetModIfaceFromDiskAndIndex = HiFileResult
+type instance RuleInput GetModIfaceFromDiskAndIndex = ProjectHaskellFilesOnly
 
 -- | Get a module interface details, either from an interface file or a typechecked module
 type instance RuleResult GetModIface = HiFileResult
+type instance RuleInput GetModIface = AllHaskellFiles
 
 -- | 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)
+type instance RuleInput GetFileContents = AllHaskellFiles
 
 type instance RuleResult GetFileExists = Bool
+type instance RuleInput GetFileExists = AllHaskellFiles
 
 type instance RuleResult AddWatchedFile = Bool
+type instance RuleInput AddWatchedFile = ProjectHaskellFilesOnly
 
 
 -- The Shake key type for getModificationTime queries
@@ -309,6 +331,7 @@ pattern GetModificationTime = GetModificationTime_ {missingFileDiagnostics=True}
 
 -- | Get the modification time of a file.
 type instance RuleResult GetModificationTime = FileVersion
+type instance RuleInput GetModificationTime = AllHaskellFiles
 
 -- | Either the mtime from disk or an LSP version
 --   LSP versions always compare as greater than on disk versions
@@ -351,6 +374,7 @@ instance Hashable IsFileOfInterestResult
 instance NFData   IsFileOfInterestResult
 
 type instance RuleResult IsFileOfInterest = IsFileOfInterestResult
+type instance RuleInput IsFileOfInterest = AllHaskellFiles
 
 data ModSummaryResult = ModSummaryResult
   { msrModSummary  :: !ModSummary
@@ -373,9 +397,11 @@ instance NFData ModSummaryResult where
 -- | Generate a ModSummary that has enough information to be used to get .hi and .hie files.
 -- without needing to parse the entire source
 type instance RuleResult GetModSummary = ModSummaryResult
+type instance RuleInput GetModSummary = AllHaskellFiles
 
 -- | Generate a ModSummary with the timestamps and preprocessed content elided, for more successful early cutoff
 type instance RuleResult GetModSummaryWithoutTimestamps = ModSummaryResult
+type instance RuleInput GetModSummaryWithoutTimestamps = AllHaskellFiles
 
 data GetParsedModule = GetParsedModule
     deriving (Eq, Show, Typeable, Generic)
@@ -394,6 +420,7 @@ instance NFData   GetLocatedImports
 
 -- | Does this module need to be compiled?
 type instance RuleResult NeedsCompilation = Maybe LinkableType
+type instance RuleInput NeedsCompilation = ProjectHaskellFilesOnly
 
 data NeedsCompilation = NeedsCompilation
     deriving (Eq, Show, Typeable, Generic)
@@ -487,6 +514,7 @@ instance Hashable GetClientSettings
 instance NFData   GetClientSettings
 
 type instance RuleResult GetClientSettings = Hashed (Maybe Value)
+type instance RuleInput GetClientSettings = NoFiles
 
 data AddWatchedFile = AddWatchedFile deriving (Eq, Show, Typeable, Generic)
 instance Hashable AddWatchedFile
@@ -497,6 +525,7 @@ instance NFData   AddWatchedFile
 -- thread killed exception issues, so we lift it to a full rule.
 -- https://github.com/digital-asset/daml/pull/2808#issuecomment-529639547
 type instance RuleResult GhcSessionIO = IdeGhcSession
+type instance RuleInput GhcSessionIO = ProjectHaskellFilesOnly
 
 data IdeGhcSession = IdeGhcSession
   { loadSessionFun :: FilePath -> IO (IdeResult HscEnvEq, [FilePath])