Track dependencies when using qAddDependentFile (#516)

* Track dependencies when using qAddDependentFile

Closes #492

* Add test for qAddDependentFile

* Update test/exe/Main.hs

Co-authored-by: Moritz Kiefer <[email protected]>

* Update test/exe/Main.hs

Co-authored-by: Moritz Kiefer <[email protected]>

Co-authored-by: Moritz Kiefer <[email protected]>

Author: mpickering

src/Development/IDE/Core/Rules.hs

@@ -426,7 +426,7 @@ typeCheckRuleDefinition file pm generateArtifacts = do
   setPriority priorityTypeCheck
   IdeOptions { optDefer = defer } <- getIdeOptions
 
-  liftIO $ do
+  addUsageDependencies $ liftIO $ do
     res <- typecheckModule defer hsc (zipWith unpack mirs bytecodes) pm
     case res of
       (diags, Just (hsc,tcm)) | DoGenerateInterfaceFiles <- generateArtifacts -> do
@@ -440,6 +440,18 @@ typeCheckRuleDefinition file pm generateArtifacts = do
   uses_th_qq dflags =
     xopt LangExt.TemplateHaskell dflags || xopt LangExt.QuasiQuotes dflags
 
+  addUsageDependencies :: Action (a, Maybe TcModuleResult) -> Action (a, Maybe TcModuleResult)
+  addUsageDependencies a = do
+    r@(_, mtc) <- a
+    forM_ mtc $ \tc -> do
+      let used_files = mapMaybe udep (mi_usages (hm_iface (tmrModInfo tc)))
+          udep (UsageFile fp _h) = Just fp
+          udep _ = Nothing
+      -- Add a dependency on these files which are added by things like
+      -- qAddDependentFile
+      void $ uses_ GetModificationTime (map toNormalizedFilePath' used_files)
+    return r
+
 
 generateCore :: RunSimplifier -> NormalizedFilePath -> Action (IdeResult (SafeHaskellMode, CgGuts, ModDetails))
 generateCore runSimplifier file = do

test/exe/Main.hs

@@ -73,6 +73,7 @@ main = defaultMainWithRerun $ testGroup "HIE"
   , positionMappingTests
   , watchedFilesTests
   , cradleTests
+  , dependentFileTest
   ]
 
 initializeResponseTests :: TestTree
@@ -2046,6 +2047,42 @@ loadCradleOnlyonce = testGroup "load cradle only once"
             liftIO $ length msgs @?= 0
 
 
+dependentFileTest :: TestTree
+dependentFileTest = testGroup "addDependentFile"
+    [testGroup "file-changed" [testSession' "test" test]
+    ]
+    where
+      test dir = do
+        -- If the file contains B then no type error
+        -- otherwise type error
+        liftIO $ writeFile (dir </> "dep-file.txt") "A"
+        let fooContent = T.unlines
+              [ "{-# LANGUAGE TemplateHaskell #-}"
+              , "module Foo where"
+              , "import Language.Haskell.TH.Syntax"
+              , "foo :: Int"
+              , "foo = 1 + $(do"
+              , "               qAddDependentFile \"dep-file.txt\""
+              , "               f <- qRunIO (readFile \"dep-file.txt\")"
+              , "               if f == \"B\" then [| 1 |] else lift f)"
+              ]
+        let bazContent = T.unlines ["module Baz where", "import Foo"]
+        _ <-createDoc "Foo.hs" "haskell" fooContent
+        doc <- createDoc "Baz.hs" "haskell" bazContent
+        expectDiagnostics
+          [("Foo.hs", [(DsError, (4, 6), "Couldn't match expected type")])]
+        -- Now modify the dependent file
+        liftIO $ writeFile (dir </> "dep-file.txt") "B"
+        let change = TextDocumentContentChangeEvent
+              { _range = Just (Range (Position 2 0) (Position 2 6))
+              , _rangeLength = Nothing
+              , _text = "f = ()"
+              }
+        -- Modifying Baz will now trigger Foo to be rebuilt as well
+        changeDoc doc [change]
+        expectDiagnostics [("Foo.hs", [])]
+
+
 cradleLoadedMessage :: Session FromServerMessage
 cradleLoadedMessage = satisfy $ \case
         NotCustomServer (NotificationMessage _ (CustomServerMethod m) _) -> m == cradleLoadedMethod