@@ -12,6 +12,7 @@ import Control.Applicative.Combinators
1212import Control.Exception (catch)
1313import Control.Monad
1414import Control.Monad.IO.Class (liftIO)
15+import Data.Aeson (Value)
1516import Data.Char (toLower)
1617import Data.Foldable
1718import Data.List
@@ -429,21 +430,28 @@ codeLensesTests = testGroup "code lenses"
429430
430431watchedFilesTests :: TestTree
431432watchedFilesTests = testGroup "watched files"
432− [ testSession "workspace file" $ do
433− _ <- openDoc' "A.hs" "haskell" "module A where"
434− RequestMessage{_params = RegistrationParams (List regs)} <- skipManyTill anyMessage (message @RegisterCapabilityRequest)
435− let watchedFileRegs =
436− [ args | Registration _id WorkspaceDidChangeWatchedFiles args <- regs ]
437− liftIO $ assertBool "watches workspace files" $ not $ null watchedFileRegs
438− , testSession "non workspace file" $ do
439− _ <- openDoc' "/tmp/A.hs" "haskell" "module A where"
440− msgs <- manyTill (Just <$> message @RegisterCapabilityRequest <|> Nothing <$ anyMessage) (message @WorkDoneProgressEndNotification)
441− let watchedFileRegs =
442− [ args
443− | Just (RequestMessage{_params = RegistrationParams (List regs)}) <- msgs
444− , Registration _id WorkspaceDidChangeWatchedFiles args <- regs
445− ]
446− liftIO $ watchedFileRegs @?= []
433+ [ testSession' "workspace files" $ \sessionDir -> do
434+ liftIO $ writeFile (sessionDir </> "hie.yaml") $ "cradle: {direct: {arguments: [\"-isrc\"]}}"
435+ _ <- openDoc' "A.hs" "haskell" "{-#LANGUAGE NoImplicitPrelude #-}\nmodule A where\nimport B"
436+ watchedFileRegs <- getWatchedFilesSubscriptionsUntilProgressEnd
437+
438+ -- Expect 6 subscriptions (A does not get any because it's VFS):
439+ -- - /path-to-workspace/B.hs
440+ -- - /path-to-workspace/B.lhs
441+ -- - B.hs
442+ -- - B.lhs
443+ -- - src/B.hs
444+ -- - src/B.lhs
445+ liftIO $ length watchedFileRegs @?= 6
446+
447+ , testSession' "non workspace file" $ \sessionDir -> do
448+ liftIO $ writeFile (sessionDir </> "hie.yaml") $ "cradle: {direct: {arguments: [\"-i/tmp\"]}}"
449+ _ <- openDoc' "A.hs" "haskell" "{-# LANGUAGE NoImplicitPrelude#-}\nmodule A where\nimport B"
450+ watchedFileRegs <- getWatchedFilesSubscriptionsUntilProgressEnd
451+
452+ -- Expect 4 subscriptions:
453+ liftIO $ length watchedFileRegs @?= 4
454+
447455 -- TODO add a test for didChangeWorkspaceFolder
448456 ]
449457
@@ -2229,3 +2237,12 @@ nthLine i r
22292237 | i == 0 && Rope.rows r == 0 = r
22302238 | i >= Rope.rows r = error $ "Row number out of bounds: " <> show i <> "/" <> show (Rope.rows r)
22312239 | otherwise = Rope.takeWhile (/= '\n') $ fst $ Rope.splitAtLine 1 $ snd $ Rope.splitAtLine (i - 1) r
2240+
2241+getWatchedFilesSubscriptionsUntilProgressEnd :: Session [Maybe Value]
2242+getWatchedFilesSubscriptionsUntilProgressEnd = do
2243+ msgs <- manyTill (Just <$> message @RegisterCapabilityRequest <|> Nothing <$ anyMessage) (message @WorkDoneProgressEndNotification)
2244+ return
2245+ [ args
2246+ | Just (RequestMessage{_params = RegistrationParams (List regs)}) <- msgs
2247+ , Registration _id WorkspaceDidChangeWatchedFiles args <- regs
2248+ ]