git.iko.soy/ghcide
on master help sign in
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 <moritz.kiefer@purelyfunctional.org> * Update test/exe/Main.hs Co-authored-by: Moritz Kiefer <moritz.kiefer@purelyfunctional.org> Co-authored-by: Moritz Kiefer <moritz.kiefer@purelyfunctional.org>

commitbc25ea79ab73067e4ea8d4ae4c1d7e3d9144163e authorMatthew Pickering <matthewtpickering@gmail.com> dateThu 21 May 2020, 10:26 (6 years ago) parenta1cb4eb
2 files changed+50−1
compare with master
unifiedsplit
src/Development/IDE/Core/Rules.hs+13−1 test/exe/Main.hs+37
src/Development/IDE/Core/Rules.hs+13−1
@@ -426,7 +426,7 @@ typeCheckRuleDefinition file pm generateArtifacts = do
426426 setPriority priorityTypeCheck
427427 IdeOptions { optDefer = defer } <- getIdeOptions
428428
429− liftIO $ do
429+ addUsageDependencies $ liftIO $ do
430430 res <- typecheckModule defer hsc (zipWith unpack mirs bytecodes) pm
431431 case res of
432432 (diags, Just (hsc,tcm)) | DoGenerateInterfaceFiles <- generateArtifacts -> do
@@ -440,6 +440,18 @@ typeCheckRuleDefinition file pm generateArtifacts = do
440440 uses_th_qq dflags =
441441 xopt LangExt.TemplateHaskell dflags || xopt LangExt.QuasiQuotes dflags
442442
443+ addUsageDependencies :: Action (a, Maybe TcModuleResult) -> Action (a, Maybe TcModuleResult)
444+ addUsageDependencies a = do
445+ r@(_, mtc) <- a
446+ forM_ mtc $ \tc -> do
447+ let used_files = mapMaybe udep (mi_usages (hm_iface (tmrModInfo tc)))
448+ udep (UsageFile fp _h) = Just fp
449+ udep _ = Nothing
450+ -- Add a dependency on these files which are added by things like
451+ -- qAddDependentFile
452+ void $ uses_ GetModificationTime (map toNormalizedFilePath' used_files)
453+ return r
454+
443455
444456generateCore :: RunSimplifier -> NormalizedFilePath -> Action (IdeResult (SafeHaskellMode, CgGuts, ModDetails))
445457generateCore runSimplifier file = do
test/exe/Main.hs+37
@@ -73,6 +73,7 @@ main = defaultMainWithRerun $ testGroup "HIE"
7373 , positionMappingTests
7474 , watchedFilesTests
7575 , cradleTests
76+ , dependentFileTest
7677 ]
7778
7879initializeResponseTests :: TestTree
@@ -2046,6 +2047,42 @@ loadCradleOnlyonce = testGroup "load cradle only once"
20462047 liftIO $ length msgs @?= 0
20472048
20482049
2050+dependentFileTest :: TestTree
2051+dependentFileTest = testGroup "addDependentFile"
2052+ [testGroup "file-changed" [testSession' "test" test]
2053+ ]
2054+ where
2055+ test dir = do
2056+ -- If the file contains B then no type error
2057+ -- otherwise type error
2058+ liftIO $ writeFile (dir </> "dep-file.txt") "A"
2059+ let fooContent = T.unlines
2060+ [ "{-# LANGUAGE TemplateHaskell #-}"
2061+ , "module Foo where"
2062+ , "import Language.Haskell.TH.Syntax"
2063+ , "foo :: Int"
2064+ , "foo = 1 + $(do"
2065+ , " qAddDependentFile \"dep-file.txt\""
2066+ , " f <- qRunIO (readFile \"dep-file.txt\")"
2067+ , " if f == \"B\" then [| 1 |] else lift f)"
2068+ ]
2069+ let bazContent = T.unlines ["module Baz where", "import Foo"]
2070+ _ <-createDoc "Foo.hs" "haskell" fooContent
2071+ doc <- createDoc "Baz.hs" "haskell" bazContent
2072+ expectDiagnostics
2073+ [("Foo.hs", [(DsError, (4, 6), "Couldn't match expected type")])]
2074+ -- Now modify the dependent file
2075+ liftIO $ writeFile (dir </> "dep-file.txt") "B"
2076+ let change = TextDocumentContentChangeEvent
2077+ { _range = Just (Range (Position 2 0) (Position 2 6))
2078+ , _rangeLength = Nothing
2079+ , _text = "f = ()"
2080+ }
2081+ -- Modifying Baz will now trigger Foo to be rebuilt as well
2082+ changeDoc doc [change]
2083+ expectDiagnostics [("Foo.hs", [])]
2084+
2085+
20492086cradleLoadedMessage :: Session FromServerMessage
20502087cradleLoadedMessage = satisfy $ \case
20512088 NotCustomServer (NotificationMessage _ (CustomServerMethod m) _) -> m == cradleLoadedMethod