44
55module DependentFileTest (tests ) where
66
7+ import Config
78import Control.Monad.IO.Class (liftIO )
89import Data.Row
910import qualified Data.Text as T
@@ -16,19 +17,19 @@ import Language.LSP.Protocol.Types hiding
1617 SemanticTokensEdit (.. ),
1718 mkRange )
1819import Language.LSP.Test
19- import System.FilePath
20+ import Test.Hls.FileSystem ( FileSystem , toAbsFp )
2021import Test.Tasty
21- import TestUtils
2222
2323tests :: TestTree
2424tests = testGroup " addDependentFile"
25- [testGroup " file-changed" [testSession ' " test" test]
25+ [testGroup " file-changed" [testWithDummyPlugin ' " test" (mkIdeTestFs [] ) test]
2626 ]
2727 where
28+ test :: FileSystem -> Session ()
2829 test dir = do
2930 -- If the file contains B then no type error
3031 -- otherwise type error
31- let depFilePath = dir </> " dep-file.txt"
32+ let depFilePath = toAbsFp dir " dep-file.txt"
3233 liftIO $ writeFile depFilePath " A"
3334 let fooContent = T. unlines
3435 [ " {-# LANGUAGE TemplateHaskell #-}"
@@ -41,7 +42,7 @@ tests = testGroup "addDependentFile"
4142 , " if f == \" B\" then [| 1 |] else lift f)"
4243 ]
4344 let bazContent = T. unlines [" module Baz where" , " import Foo ()" ]
44- _ <- createDoc " Foo.hs" " haskell" fooContent
45+ _fooDoc <- createDoc " Foo.hs" " haskell" fooContent
4546 doc <- createDoc " Baz.hs" " haskell" bazContent
4647 expectDiagnostics
4748 [(" Foo.hs" , [(DiagnosticSeverity_Error , (4 ,11 ), " Couldn't match type" )])]
0 commit comments