mirror of
https://github.com/haskell/ghcide.git
synced 2024-09-11 13:57:06 +03:00
Use lsp-test-0.11 (#566)
Replace openDoc' with createDoc which sends out workspace/didChangedWatchedFiles notifications
This commit is contained in:
Luke Lau
GitHub
parent
a2e091c5ac
commit
cd6f62bbed
@ -263,7 +263,7 @@ test-suite ghcide-tests
|
||||
haskell-lsp-types,
|
||||
network-uri,
|
||||
lens,
|
||||
lsp-test >= 0.8,
|
||||
lsp-test >= 0.11.0.1 && < 0.12,
|
||||
parser-combinators,
|
||||
QuickCheck,
|
||||
quickcheck-instances,
|
||||
|
||||
@ -4,7 +4,7 @@ packages:
|
||||
extra-deps:
|
||||
- haskell-lsp-0.22.0.0
|
||||
- haskell-lsp-types-0.22.0.0
|
||||
- lsp-test-0.10.3.0
|
||||
- lsp-test-0.11.0.1
|
||||
- hie-bios-0.4.0
|
||||
- fuzzy-0.1.0.0
|
||||
- regex-pcre-builtin-0.95.1.1.8.43
|
||||
|
||||
@ -6,7 +6,7 @@ packages:
|
||||
extra-deps:
|
||||
- haskell-lsp-0.22.0.0
|
||||
- haskell-lsp-types-0.22.0.0
|
||||
- lsp-test-0.10.3.0
|
||||
- lsp-test-0.11.0.1
|
||||
- ghc-check-0.3.0.1
|
||||
|
||||
# for ghc-8.10
|
||||
|
||||
@ -7,7 +7,7 @@ extra-deps:
|
||||
- base-orphans-0.8.2
|
||||
- haskell-lsp-0.22.0.0
|
||||
- haskell-lsp-types-0.22.0.0
|
||||
- lsp-test-0.10.3.0
|
||||
- lsp-test-0.11.0.1
|
||||
- rope-utf16-splay-0.3.1.0
|
||||
- filepattern-0.1.1
|
||||
- js-dgtable-0.5.2
|
||||
|
||||
@ -4,7 +4,7 @@ packages:
|
||||
extra-deps:
|
||||
- haskell-lsp-0.22.0.0
|
||||
- haskell-lsp-types-0.22.0.0
|
||||
- lsp-test-0.10.3.0
|
||||
- lsp-test-0.11.0.1
|
||||
- ghc-check-0.3.0.1
|
||||
|
||||
nix:
|
||||
|
||||
215
test/exe/Main.hs
215
test/exe/Main.hs
@ -28,8 +28,7 @@ import Development.IDE.Test
|
||||
import Development.IDE.Test.Runfiles
|
||||
import Development.IDE.Types.Location
|
||||
import Development.Shake (getDirectoryFilesIO)
|
||||
import qualified Language.Haskell.LSP.Test as LSPTest
|
||||
import Language.Haskell.LSP.Test hiding (openDoc')
|
||||
import Language.Haskell.LSP.Test
|
||||
import Language.Haskell.LSP.Messages
|
||||
import Language.Haskell.LSP.Types
|
||||
import Language.Haskell.LSP.Types.Capabilities
|
||||
@ -52,7 +51,7 @@ import Data.Maybe
|
||||
main :: IO ()
|
||||
main = defaultMainWithRerun $ testGroup "HIE"
|
||||
[ testSession "open close" $ do
|
||||
doc <- openDoc' "Testing.hs" "haskell" ""
|
||||
doc <- createDoc "Testing.hs" "haskell" ""
|
||||
void (skipManyTill anyMessage message :: Session WorkDoneProgressCreateRequest)
|
||||
void (skipManyTill anyMessage message :: Session WorkDoneProgressBeginNotification)
|
||||
closeDoc doc
|
||||
@ -149,7 +148,7 @@ diagnosticTests :: TestTree
|
||||
diagnosticTests = testGroup "diagnostics"
|
||||
[ testSessionWait "fix syntax error" $ do
|
||||
let content = T.unlines [ "module Testing wher" ]
|
||||
doc <- openDoc' "Testing.hs" "haskell" content
|
||||
doc <- createDoc "Testing.hs" "haskell" content
|
||||
expectDiagnostics [("Testing.hs", [(DsError, (0, 15), "parse error")])]
|
||||
let change = TextDocumentContentChangeEvent
|
||||
{ _range = Just (Range (Position 0 15) (Position 0 19))
|
||||
@ -160,7 +159,7 @@ diagnosticTests = testGroup "diagnostics"
|
||||
expectDiagnostics [("Testing.hs", [])]
|
||||
, testSessionWait "introduce syntax error" $ do
|
||||
let content = T.unlines [ "module Testing where" ]
|
||||
doc <- openDoc' "Testing.hs" "haskell" content
|
||||
doc <- createDoc "Testing.hs" "haskell" content
|
||||
void $ skipManyTill anyMessage (message :: Session WorkDoneProgressCreateRequest)
|
||||
void $ skipManyTill anyMessage (message :: Session WorkDoneProgressBeginNotification)
|
||||
let change = TextDocumentContentChangeEvent
|
||||
@ -178,7 +177,7 @@ diagnosticTests = testGroup "diagnostics"
|
||||
, "bar :: Int -> Int -> Int"
|
||||
, "bar a b = cd + b"
|
||||
]
|
||||
_ <- openDoc' "Testing.hs" "haskell" content
|
||||
_ <- createDoc "Testing.hs" "haskell" content
|
||||
expectDiagnostics
|
||||
[ ( "Testing.hs"
|
||||
, [ (DsError, (2, 14), "Variable not in scope: ab")
|
||||
@ -192,7 +191,7 @@ diagnosticTests = testGroup "diagnostics"
|
||||
, "foo :: Int -> String -> Int"
|
||||
, "foo a b = a + b"
|
||||
]
|
||||
_ <- openDoc' "Testing.hs" "haskell" content
|
||||
_ <- createDoc "Testing.hs" "haskell" content
|
||||
expectDiagnostics
|
||||
[ ( "Testing.hs"
|
||||
, [(DsError, (2, 14), "Couldn't match type '[Char]' with 'Int'")]
|
||||
@ -204,7 +203,7 @@ diagnosticTests = testGroup "diagnostics"
|
||||
, "foo :: Int -> String"
|
||||
, "foo a = _ a"
|
||||
]
|
||||
_ <- openDoc' "Testing.hs" "haskell" content
|
||||
_ <- createDoc "Testing.hs" "haskell" content
|
||||
expectDiagnostics
|
||||
[ ( "Testing.hs"
|
||||
, [(DsError, (2, 8), "Found hole: _ :: Int -> String")]
|
||||
@ -226,8 +225,8 @@ diagnosticTests = testGroup "diagnostics"
|
||||
[ ("A.hs", [(DsError, (2,4), aMessage)])
|
||||
, ("B.hs", [(DsError, (3,4), bMessage)])]
|
||||
deferralTest title binding msg = testSessionWait title $ do
|
||||
_ <- openDoc' "A.hs" "haskell" $ sourceA binding
|
||||
_ <- openDoc' "B.hs" "haskell" sourceB
|
||||
_ <- createDoc "A.hs" "haskell" $ sourceA binding
|
||||
_ <- createDoc "B.hs" "haskell" sourceB
|
||||
expectDiagnostics $ expectedDs msg
|
||||
in
|
||||
[ deferralTest "type error" "True" "Couldn't match expected type"
|
||||
@ -237,12 +236,12 @@ diagnosticTests = testGroup "diagnostics"
|
||||
|
||||
, testSessionWait "remove required module" $ do
|
||||
let contentA = T.unlines [ "module ModuleA where" ]
|
||||
docA <- openDoc' "ModuleA.hs" "haskell" contentA
|
||||
docA <- createDoc "ModuleA.hs" "haskell" contentA
|
||||
let contentB = T.unlines
|
||||
[ "module ModuleB where"
|
||||
, "import ModuleA"
|
||||
]
|
||||
_ <- openDoc' "ModuleB.hs" "haskell" contentB
|
||||
_ <- createDoc "ModuleB.hs" "haskell" contentB
|
||||
let change = TextDocumentContentChangeEvent
|
||||
{ _range = Just (Range (Position 0 0) (Position 0 20))
|
||||
, _rangeLength = Nothing
|
||||
@ -255,20 +254,20 @@ diagnosticTests = testGroup "diagnostics"
|
||||
[ "module ModuleB where"
|
||||
, "import ModuleA"
|
||||
]
|
||||
_ <- openDoc' "ModuleB.hs" "haskell" contentB
|
||||
_ <- createDoc "ModuleB.hs" "haskell" contentB
|
||||
expectDiagnostics [("ModuleB.hs", [(DsError, (1, 7), "Could not find module")])]
|
||||
let contentA = T.unlines [ "module ModuleA where" ]
|
||||
_ <- openDoc' "ModuleA.hs" "haskell" contentA
|
||||
_ <- createDoc "ModuleA.hs" "haskell" contentA
|
||||
expectDiagnostics [("ModuleB.hs", [])]
|
||||
, testSessionWait "add missing module (non workspace)" $ do
|
||||
let contentB = T.unlines
|
||||
[ "module ModuleB where"
|
||||
, "import ModuleA"
|
||||
]
|
||||
_ <- openDoc'' "/tmp/ModuleB.hs" "haskell" contentB
|
||||
_ <- createDoc "/tmp/ModuleB.hs" "haskell" contentB
|
||||
expectDiagnostics [("/tmp/ModuleB.hs", [(DsError, (1, 7), "Could not find module")])]
|
||||
let contentA = T.unlines [ "module ModuleA where" ]
|
||||
_ <- openDoc'' "/tmp/ModuleA.hs" "haskell" contentA
|
||||
_ <- createDoc "/tmp/ModuleA.hs" "haskell" contentA
|
||||
expectDiagnostics [("/tmp/ModuleB.hs", [])]
|
||||
, testSessionWait "cyclic module dependency" $ do
|
||||
let contentA = T.unlines
|
||||
@ -279,8 +278,8 @@ diagnosticTests = testGroup "diagnostics"
|
||||
[ "module ModuleB where"
|
||||
, "import ModuleA"
|
||||
]
|
||||
_ <- openDoc' "ModuleA.hs" "haskell" contentA
|
||||
_ <- openDoc' "ModuleB.hs" "haskell" contentB
|
||||
_ <- createDoc "ModuleA.hs" "haskell" contentA
|
||||
_ <- createDoc "ModuleB.hs" "haskell" contentB
|
||||
expectDiagnostics
|
||||
[ ( "ModuleA.hs"
|
||||
, [(DsError, (1, 7), "Cyclic module dependency between ModuleA, ModuleB")]
|
||||
@ -301,9 +300,9 @@ diagnosticTests = testGroup "diagnostics"
|
||||
let contentBboot = T.unlines
|
||||
[ "module ModuleB where"
|
||||
]
|
||||
_ <- openDoc' "ModuleA.hs" "haskell" contentA
|
||||
_ <- openDoc' "ModuleB.hs" "haskell" contentB
|
||||
_ <- openDoc' "ModuleB.hs-boot" "haskell" contentBboot
|
||||
_ <- createDoc "ModuleA.hs" "haskell" contentA
|
||||
_ <- createDoc "ModuleB.hs" "haskell" contentB
|
||||
_ <- createDoc "ModuleB.hs-boot" "haskell" contentBboot
|
||||
expectDiagnostics []
|
||||
, testSessionWait "correct reference used with hs-boot" $ do
|
||||
let contentB = T.unlines
|
||||
@ -325,10 +324,10 @@ diagnosticTests = testGroup "diagnostics"
|
||||
-- resolved to the hs-boot file
|
||||
, "y = x"
|
||||
]
|
||||
_ <- openDoc' "ModuleB.hs" "haskell" contentB
|
||||
_ <- openDoc' "ModuleA.hs" "haskell" contentA
|
||||
_ <- openDoc' "ModuleA.hs-boot" "haskell" contentAboot
|
||||
_ <- openDoc' "ModuleC.hs" "haskell" contentC
|
||||
_ <- createDoc "ModuleB.hs" "haskell" contentB
|
||||
_ <- createDoc "ModuleA.hs" "haskell" contentA
|
||||
_ <- createDoc "ModuleA.hs-boot" "haskell" contentAboot
|
||||
_ <- createDoc "ModuleC.hs" "haskell" contentC
|
||||
expectDiagnostics []
|
||||
, testSessionWait "redundant import" $ do
|
||||
let contentA = T.unlines ["module ModuleA where"]
|
||||
@ -337,8 +336,8 @@ diagnosticTests = testGroup "diagnostics"
|
||||
, "module ModuleB where"
|
||||
, "import ModuleA"
|
||||
]
|
||||
_ <- openDoc' "ModuleA.hs" "haskell" contentA
|
||||
_ <- openDoc' "ModuleB.hs" "haskell" contentB
|
||||
_ <- createDoc "ModuleA.hs" "haskell" contentA
|
||||
_ <- createDoc "ModuleB.hs" "haskell" contentB
|
||||
expectDiagnostics
|
||||
[ ( "ModuleB.hs"
|
||||
, [(DsWarning, (2, 0), "The import of 'ModuleA' is redundant")]
|
||||
@ -360,8 +359,8 @@ diagnosticTests = testGroup "diagnostics"
|
||||
, "wrong1 = ThisList.map"
|
||||
, "wrong2 = BaseList.x"
|
||||
]
|
||||
_ <- openDoc' "Data/List.hs" "haskell" thisDataListContent
|
||||
_ <- openDoc' "Main.hs" "haskell" mainContent
|
||||
_ <- createDoc "Data/List.hs" "haskell" thisDataListContent
|
||||
_ <- createDoc "Main.hs" "haskell" mainContent
|
||||
expectDiagnostics
|
||||
[ ( "Main.hs"
|
||||
, [(DsError, (6, 9), "Not in scope: \8216ThisList.map\8217")
|
||||
@ -376,7 +375,7 @@ diagnosticTests = testGroup "diagnostics"
|
||||
, "foo :: Ord a => a -> Int"
|
||||
, "foo a = 1"
|
||||
]
|
||||
_ <- openDoc' "Foo.hs" "haskell" fooContent
|
||||
_ <- createDoc "Foo.hs" "haskell" fooContent
|
||||
expectDiagnostics
|
||||
[ ( "Foo.hs"
|
||||
-- The test is to make sure that warnings contain unqualified names
|
||||
@ -427,7 +426,7 @@ diagnosticTests = testGroup "diagnostics"
|
||||
, "foo :: Int"
|
||||
, "foo = 1 {-|-}"
|
||||
]
|
||||
_ <- openDoc' "Foo.hs" "haskell" fooContent
|
||||
_ <- createDoc "Foo.hs" "haskell" fooContent
|
||||
expectDiagnostics
|
||||
[ ( "Foo.hs"
|
||||
, [(DsError, (2, 8), "Parse error on input")
|
||||
@ -442,7 +441,7 @@ diagnosticTests = testGroup "diagnostics"
|
||||
, "value :: Maybe ()"
|
||||
, "value = [()]"
|
||||
]
|
||||
_ <- openDoc' (T.unpack name <> ".hs") "haskell" content
|
||||
_ <- createDoc (T.unpack name <> ".hs") "haskell" content
|
||||
notification <- skipManyTill anyMessage diagnostic
|
||||
let
|
||||
offenders =
|
||||
@ -479,7 +478,7 @@ watchedFilesTests :: TestTree
|
||||
watchedFilesTests = testGroup "watched files"
|
||||
[ testSession' "workspace files" $ \sessionDir -> do
|
||||
liftIO $ writeFile (sessionDir </> "hie.yaml") "cradle: {direct: {arguments: [\"-isrc\"]}}"
|
||||
_doc <- openDoc' "A.hs" "haskell" "{-#LANGUAGE NoImplicitPrelude #-}\nmodule A where\nimport WatchedFilesMissingModule"
|
||||
_doc <- createDoc "A.hs" "haskell" "{-#LANGUAGE NoImplicitPrelude #-}\nmodule A where\nimport WatchedFilesMissingModule"
|
||||
watchedFileRegs <- getWatchedFilesSubscriptionsUntil @PublishDiagnosticsNotification
|
||||
|
||||
-- Expect 6 subscriptions (A does not get any because it's VFS):
|
||||
@ -493,7 +492,7 @@ watchedFilesTests = testGroup "watched files"
|
||||
|
||||
, testSession' "non workspace file" $ \sessionDir -> do
|
||||
liftIO $ writeFile (sessionDir </> "hie.yaml") "cradle: {direct: {arguments: [\"-i/tmp\"]}}"
|
||||
_doc <- openDoc' "A.hs" "haskell" "{-# LANGUAGE NoImplicitPrelude#-}\nmodule A where\nimport WatchedFilesMissingModule"
|
||||
_doc <- createDoc "A.hs" "haskell" "{-# LANGUAGE NoImplicitPrelude#-}\nmodule A where\nimport WatchedFilesMissingModule"
|
||||
watchedFileRegs <- getWatchedFilesSubscriptionsUntil @PublishDiagnosticsNotification
|
||||
|
||||
-- Expect 4 subscriptions (/tmp does not get any as it is out of the workspace):
|
||||
@ -514,7 +513,7 @@ renameActionTests = testGroup "rename actions"
|
||||
, "foo :: Int -> Int"
|
||||
, "foo argName = argNme"
|
||||
]
|
||||
doc <- openDoc' "Testing.hs" "haskell" content
|
||||
doc <- createDoc "Testing.hs" "haskell" content
|
||||
_ <- waitForDiagnostics
|
||||
action <- findCodeAction doc (Range (Position 2 14) (Position 2 20)) "Replace with ‘argName’"
|
||||
executeCodeAction action
|
||||
@ -532,7 +531,7 @@ renameActionTests = testGroup "rename actions"
|
||||
, "foo :: Maybe a -> [a]"
|
||||
, "foo = maybToList"
|
||||
]
|
||||
doc <- openDoc' "Testing.hs" "haskell" content
|
||||
doc <- createDoc "Testing.hs" "haskell" content
|
||||
_ <- waitForDiagnostics
|
||||
action <- findCodeAction doc (Range (Position 3 6) (Position 3 16)) "Replace with ‘maybeToList’"
|
||||
executeCodeAction action
|
||||
@ -550,7 +549,7 @@ renameActionTests = testGroup "rename actions"
|
||||
, "foo :: Char -> Char -> Char -> Char"
|
||||
, "foo argument1 argument2 argument3 = argumentX"
|
||||
]
|
||||
doc <- openDoc' "Testing.hs" "haskell" content
|
||||
doc <- createDoc "Testing.hs" "haskell" content
|
||||
_ <- waitForDiagnostics
|
||||
_ <- findCodeActions doc (Range (Position 2 36) (Position 2 45))
|
||||
["Replace with ‘argument1’", "Replace with ‘argument2’", "Replace with ‘argument3’"]
|
||||
@ -562,7 +561,7 @@ renameActionTests = testGroup "rename actions"
|
||||
, "monus x y = max 0 (x - y)"
|
||||
, "foo x y = x `monnus` y"
|
||||
]
|
||||
doc <- openDoc' "Testing.hs" "haskell" content
|
||||
doc <- createDoc "Testing.hs" "haskell" content
|
||||
_ <- waitForDiagnostics
|
||||
actionsOrCommands <- getCodeActions doc (Range (Position 3 12) (Position 3 20))
|
||||
[fixTypo] <- pure [action | CACodeAction action@CodeAction{ _title = actionTitle } <- actionsOrCommands, "monus" `T.isInfixOf` actionTitle ]
|
||||
@ -585,7 +584,7 @@ typeWildCardActionTests = testGroup "type wildcard actions"
|
||||
, "func :: _"
|
||||
, "func x = x"
|
||||
]
|
||||
doc <- openDoc' "Testing.hs" "haskell" content
|
||||
doc <- createDoc "Testing.hs" "haskell" content
|
||||
_ <- waitForDiagnostics
|
||||
actionsOrCommands <- getCodeActions doc (Range (Position 2 1) (Position 2 10))
|
||||
let [addSignature] = [action | CACodeAction action@CodeAction { _title = actionTitle } <- actionsOrCommands
|
||||
@ -605,7 +604,7 @@ typeWildCardActionTests = testGroup "type wildcard actions"
|
||||
, "func :: _"
|
||||
, "func x y = x + y"
|
||||
]
|
||||
doc <- openDoc' "Testing.hs" "haskell" content
|
||||
doc <- createDoc "Testing.hs" "haskell" content
|
||||
_ <- waitForDiagnostics
|
||||
actionsOrCommands <- getCodeActions doc (Range (Position 2 1) (Position 2 10))
|
||||
let [addSignature] = [action | CACodeAction action@CodeAction { _title = actionTitle } <- actionsOrCommands
|
||||
@ -628,7 +627,7 @@ typeWildCardActionTests = testGroup "type wildcard actions"
|
||||
, " y = x * 2"
|
||||
, " in y"
|
||||
]
|
||||
doc <- openDoc' "Testing.hs" "haskell" content
|
||||
doc <- createDoc "Testing.hs" "haskell" content
|
||||
_ <- waitForDiagnostics
|
||||
actionsOrCommands <- getCodeActions doc (Range (Position 4 1) (Position 4 10))
|
||||
let [addSignature] = [action | CACodeAction action@CodeAction { _title = actionTitle } <- actionsOrCommands
|
||||
@ -653,7 +652,7 @@ removeImportTests = testGroup "remove import actions"
|
||||
let contentA = T.unlines
|
||||
[ "module ModuleA where"
|
||||
]
|
||||
_docA <- openDoc' "ModuleA.hs" "haskell" contentA
|
||||
_docA <- createDoc "ModuleA.hs" "haskell" contentA
|
||||
let contentB = T.unlines
|
||||
[ "{-# OPTIONS_GHC -Wunused-imports #-}"
|
||||
, "module ModuleB where"
|
||||
@ -661,7 +660,7 @@ removeImportTests = testGroup "remove import actions"
|
||||
, "stuffB :: Integer"
|
||||
, "stuffB = 123"
|
||||
]
|
||||
docB <- openDoc' "ModuleB.hs" "haskell" contentB
|
||||
docB <- createDoc "ModuleB.hs" "haskell" contentB
|
||||
_ <- waitForDiagnostics
|
||||
[CACodeAction action@CodeAction { _title = actionTitle }]
|
||||
<- getCodeActions docB (Range (Position 2 0) (Position 2 5))
|
||||
@ -679,7 +678,7 @@ removeImportTests = testGroup "remove import actions"
|
||||
let contentA = T.unlines
|
||||
[ "module ModuleA where"
|
||||
]
|
||||
_docA <- openDoc' "ModuleA.hs" "haskell" contentA
|
||||
_docA <- createDoc "ModuleA.hs" "haskell" contentA
|
||||
let contentB = T.unlines
|
||||
[ "{-# OPTIONS_GHC -Wunused-imports #-}"
|
||||
, "module ModuleB where"
|
||||
@ -687,7 +686,7 @@ removeImportTests = testGroup "remove import actions"
|
||||
, "stuffB :: Integer"
|
||||
, "stuffB = 123"
|
||||
]
|
||||
docB <- openDoc' "ModuleB.hs" "haskell" contentB
|
||||
docB <- createDoc "ModuleB.hs" "haskell" contentB
|
||||
_ <- waitForDiagnostics
|
||||
[CACodeAction action@CodeAction { _title = actionTitle }]
|
||||
<- getCodeActions docB (Range (Position 2 0) (Position 2 5))
|
||||
@ -709,14 +708,14 @@ removeImportTests = testGroup "remove import actions"
|
||||
, "stuffB = 123"
|
||||
, "stuffC = ()"
|
||||
]
|
||||
_docA <- openDoc' "ModuleA.hs" "haskell" contentA
|
||||
_docA <- createDoc "ModuleA.hs" "haskell" contentA
|
||||
let contentB = T.unlines
|
||||
[ "{-# OPTIONS_GHC -Wunused-imports #-}"
|
||||
, "module ModuleB where"
|
||||
, "import ModuleA (stuffA, stuffB, stuffC, stuffA)"
|
||||
, "main = print stuffB"
|
||||
]
|
||||
docB <- openDoc' "ModuleB.hs" "haskell" contentB
|
||||
docB <- createDoc "ModuleB.hs" "haskell" contentB
|
||||
_ <- waitForDiagnostics
|
||||
[CACodeAction action@CodeAction { _title = actionTitle }]
|
||||
<- getCodeActions docB (Range (Position 2 0) (Position 2 5))
|
||||
@ -738,14 +737,14 @@ removeImportTests = testGroup "remove import actions"
|
||||
, "stuffB :: Integer"
|
||||
, "stuffB = 123"
|
||||
]
|
||||
_docA <- openDoc' "ModuleA.hs" "haskell" contentA
|
||||
_docA <- createDoc "ModuleA.hs" "haskell" contentA
|
||||
let contentB = T.unlines
|
||||
[ "{-# OPTIONS_GHC -Wunused-imports #-}"
|
||||
, "module ModuleB where"
|
||||
, "import qualified ModuleA as A ((<?>), stuffB, (!!))"
|
||||
, "main = print A.stuffB"
|
||||
]
|
||||
docB <- openDoc' "ModuleB.hs" "haskell" contentB
|
||||
docB <- createDoc "ModuleB.hs" "haskell" contentB
|
||||
_ <- waitForDiagnostics
|
||||
[CACodeAction action@CodeAction { _title = actionTitle }]
|
||||
<- getCodeActions docB (Range (Position 2 0) (Position 2 5))
|
||||
@ -766,14 +765,14 @@ removeImportTests = testGroup "remove import actions"
|
||||
, "stuffB :: Integer"
|
||||
, "stuffB = 123"
|
||||
]
|
||||
_docA <- openDoc' "ModuleA.hs" "haskell" contentA
|
||||
_docA <- createDoc "ModuleA.hs" "haskell" contentA
|
||||
let contentB = T.unlines
|
||||
[ "{-# OPTIONS_GHC -Wunused-imports #-}"
|
||||
, "module ModuleB where"
|
||||
, "import ModuleA (A(..), stuffB)"
|
||||
, "main = print stuffB"
|
||||
]
|
||||
docB <- openDoc' "ModuleB.hs" "haskell" contentB
|
||||
docB <- createDoc "ModuleB.hs" "haskell" contentB
|
||||
_ <- waitForDiagnostics
|
||||
[CACodeAction action@CodeAction { _title = actionTitle }]
|
||||
<- getCodeActions docB (Range (Position 2 0) (Position 2 5))
|
||||
@ -793,14 +792,14 @@ removeImportTests = testGroup "remove import actions"
|
||||
, "data D = A | B"
|
||||
, "data E = F"
|
||||
]
|
||||
_docA <- openDoc' "ModuleA.hs" "haskell" contentA
|
||||
_docA <- createDoc "ModuleA.hs" "haskell" contentA
|
||||
let contentB = T.unlines
|
||||
[ "{-# OPTIONS_GHC -Wunused-imports #-}"
|
||||
, "module ModuleB where"
|
||||
, "import ModuleA (D(A,B), E(F))"
|
||||
, "main = B"
|
||||
]
|
||||
docB <- openDoc' "ModuleB.hs" "haskell" contentB
|
||||
docB <- createDoc "ModuleB.hs" "haskell" contentB
|
||||
_ <- waitForDiagnostics
|
||||
[CACodeAction action@CodeAction { _title = actionTitle }]
|
||||
<- getCodeActions docB (Range (Position 2 0) (Position 2 5))
|
||||
@ -941,8 +940,8 @@ extendImportTests = testGroup "extend import actions"
|
||||
]
|
||||
where
|
||||
template contentA contentB range expectedAction expectedContentB = do
|
||||
_docA <- openDoc' "ModuleA.hs" "haskell" contentA
|
||||
docB <- openDoc' "ModuleB.hs" "haskell" contentB
|
||||
_docA <- createDoc "ModuleA.hs" "haskell" contentA
|
||||
docB <- createDoc "ModuleB.hs" "haskell" contentB
|
||||
_ <- waitForDiagnostics
|
||||
CACodeAction action@CodeAction { _title = actionTitle } : _
|
||||
<- sortOn (\(CACodeAction CodeAction{_title=x}) -> x) <$>
|
||||
@ -992,7 +991,7 @@ suggestImportTests = testGroup "suggest import actions"
|
||||
after = T.unlines $ "module A where" : ["import " <> x | x <- imps] ++ [newImp] ++ def : other
|
||||
cradle = "cradle: {direct: {arguments: [-hide-all-packages, -package, base, -package, text, -package-env, -]}}"
|
||||
liftIO $ writeFileUTF8 (dir </> "hie.yaml") cradle
|
||||
doc <- openDoc' "Test.hs" "haskell" before
|
||||
doc <- createDoc "Test.hs" "haskell" before
|
||||
_diags <- waitForDiagnostics
|
||||
let defLine = length imps + 1
|
||||
range = Range (Position defLine 0) (Position defLine maxBound)
|
||||
@ -1052,7 +1051,7 @@ addExtensionTests = testGroup "add language extension actions"
|
||||
]
|
||||
where
|
||||
template initialContent range expectedAction expectedContents = do
|
||||
doc <- openDoc' "Module.hs" "haskell" initialContent
|
||||
doc <- createDoc "Module.hs" "haskell" initialContent
|
||||
_ <- waitForDiagnostics
|
||||
CACodeAction action@CodeAction { _title = actionTitle } : _
|
||||
<- sortOn (\(CACodeAction CodeAction{_title=x}) -> x) <$>
|
||||
@ -1075,7 +1074,7 @@ insertNewDefinitionTests = testGroup "insert new definition actions"
|
||||
[""
|
||||
,"someOtherCode = ()"
|
||||
]
|
||||
docB <- openDoc' "ModuleB.hs" "haskell" (T.unlines $ txtB ++ txtB')
|
||||
docB <- createDoc "ModuleB.hs" "haskell" (T.unlines $ txtB ++ txtB')
|
||||
_ <- waitForDiagnostics
|
||||
CACodeAction action@CodeAction { _title = actionTitle } : _
|
||||
<- sortOn (\(CACodeAction CodeAction{_title=x}) -> x) <$>
|
||||
@ -1099,7 +1098,7 @@ insertNewDefinitionTests = testGroup "insert new definition actions"
|
||||
[""
|
||||
,"someOtherCode = ()"
|
||||
]
|
||||
docB <- openDoc' "ModuleB.hs" "haskell" (T.unlines $ txtB ++ txtB')
|
||||
docB <- createDoc "ModuleB.hs" "haskell" (T.unlines $ txtB ++ txtB')
|
||||
_ <- waitForDiagnostics
|
||||
CACodeAction action@CodeAction { _title = actionTitle } : _
|
||||
<- sortOn (\(CACodeAction CodeAction{_title=x}) -> x) <$>
|
||||
@ -1138,8 +1137,8 @@ fixConstructorImportTests = testGroup "fix import actions"
|
||||
]
|
||||
where
|
||||
template contentA contentB range expectedAction expectedContentB = do
|
||||
_docA <- openDoc' "ModuleA.hs" "haskell" contentA
|
||||
docB <- openDoc' "ModuleB.hs" "haskell" contentB
|
||||
_docA <- createDoc "ModuleA.hs" "haskell" contentA
|
||||
docB <- createDoc "ModuleB.hs" "haskell" contentB
|
||||
_diags <- waitForDiagnostics
|
||||
CACodeAction action@CodeAction { _title = actionTitle } : _
|
||||
<- sortOn (\(CACodeAction CodeAction{_title=x}) -> x) <$>
|
||||
@ -1158,7 +1157,7 @@ importRenameActionTests = testGroup "import rename actions"
|
||||
[ "module Testing where"
|
||||
, "import Data.Mape"
|
||||
]
|
||||
doc <- openDoc' "Testing.hs" "haskell" content
|
||||
doc <- createDoc "Testing.hs" "haskell" content
|
||||
_ <- waitForDiagnostics
|
||||
actionsOrCommands <- getCodeActions doc (Range (Position 2 8) (Position 2 16))
|
||||
let [changeToMap] = [action | CACodeAction action@CodeAction{ _title = actionTitle } <- actionsOrCommands, ("Data." <> modname) `T.isInfixOf` actionTitle ]
|
||||
@ -1195,7 +1194,7 @@ fillTypedHoleTests = let
|
||||
newA newB newC = testSession (T.unpack actionTitle) $ do
|
||||
let originalCode = sourceCode oldA oldB oldC
|
||||
let expectedCode = sourceCode newA newB newC
|
||||
doc <- openDoc' "Testing.hs" "haskell" originalCode
|
||||
doc <- createDoc "Testing.hs" "haskell" originalCode
|
||||
_ <- waitForDiagnostics
|
||||
actionsOrCommands <- getCodeActions doc (Range (Position 9 0) (Position 9 maxBound))
|
||||
chosenAction <- liftIO $ pickActionWithTitle actionTitle actionsOrCommands
|
||||
@ -1243,7 +1242,7 @@ addSigActionTests = let
|
||||
def >:: sig = testSession (T.unpack def) $ do
|
||||
let originalCode = before def
|
||||
let expectedCode = after' def sig
|
||||
doc <- openDoc' "Sigs.hs" "haskell" originalCode
|
||||
doc <- createDoc "Sigs.hs" "haskell" originalCode
|
||||
_ <- waitForDiagnostics
|
||||
actionsOrCommands <- getCodeActions doc (Range (Position 3 1) (Position 3 maxBound))
|
||||
chosenAction <- liftIO $ pickActionWithTitle ("add signature: " <> sig) actionsOrCommands
|
||||
@ -1275,7 +1274,7 @@ addSigLensesTests = let
|
||||
sigSession withMissing def sig = testSession (T.unpack def) $ do
|
||||
let originalCode = before withMissing def
|
||||
let expectedCode = after' withMissing def sig
|
||||
doc <- openDoc' "Sigs.hs" "haskell" originalCode
|
||||
doc <- createDoc "Sigs.hs" "haskell" originalCode
|
||||
[CodeLens {_command = Just c}] <- getCodeLenses doc
|
||||
executeCommand c
|
||||
modifiedCode <- getDocumentEdit doc
|
||||
@ -1480,7 +1479,7 @@ pluginTests = (`xfail8101` "known broken (#556)")
|
||||
, "foo :: Int -> Int -> Int"
|
||||
, "foo a b = a + c"
|
||||
]
|
||||
_ <- openDoc' "Testing.hs" "haskell" content
|
||||
_ <- createDoc "Testing.hs" "haskell" content
|
||||
expectDiagnostics
|
||||
[ ( "Testing.hs",
|
||||
[(DsError, (8, 14), "Variable not in scope: c")]
|
||||
@ -1507,7 +1506,7 @@ cppTests =
|
||||
run $ expectError content (2, 1)
|
||||
)
|
||||
, testSessionWait "cpp-ghcide" $ do
|
||||
_ <- openDoc' "A.hs" "haskell" $ T.unlines
|
||||
_ <- createDoc "A.hs" "haskell" $ T.unlines
|
||||
["{-# LANGUAGE CPP #-}"
|
||||
,"main ="
|
||||
,"#ifdef __GHCIDE__"
|
||||
@ -1521,7 +1520,7 @@ cppTests =
|
||||
where
|
||||
expectError :: T.Text -> Cursor -> Session ()
|
||||
expectError content cursor = do
|
||||
_ <- openDoc' "Testing.hs" "haskell" content
|
||||
_ <- createDoc "Testing.hs" "haskell" content
|
||||
expectDiagnostics
|
||||
[ ( "Testing.hs",
|
||||
[(DsError, cursor, "error: unterminated")]
|
||||
@ -1537,7 +1536,7 @@ preprocessorTests = testSessionWait "preprocessor" $ do
|
||||
, "module Testing where"
|
||||
, "y = x + z" -- plugin replaces x with y, making this have only one diagnostic
|
||||
]
|
||||
_ <- openDoc' "Testing.hs" "haskell" content
|
||||
_ <- createDoc "Testing.hs" "haskell" content
|
||||
expectDiagnostics
|
||||
[ ( "Testing.hs",
|
||||
[(DsError, (2, 8), "Variable not in scope: z")]
|
||||
@ -1570,8 +1569,8 @@ safeTests =
|
||||
,"safeId = trustWorthyId"
|
||||
]
|
||||
|
||||
_ <- openDoc' "A.hs" "haskell" sourceA
|
||||
_ <- openDoc' "B.hs" "haskell" sourceB
|
||||
_ <- createDoc "A.hs" "haskell" sourceA
|
||||
_ <- createDoc "B.hs" "haskell" sourceB
|
||||
expectNoMoreDiagnostics 1 ]
|
||||
|
||||
thTests :: TestTree
|
||||
@ -1599,8 +1598,8 @@ thTests =
|
||||
"b :: Integer",
|
||||
"b = $(litE $ IntegerL $ a) + n"
|
||||
]
|
||||
_ <- openDoc' "A.hs" "haskell" sourceA
|
||||
_ <- openDoc' "B.hs" "haskell" sourceB
|
||||
_ <- createDoc "A.hs" "haskell" sourceA
|
||||
_ <- createDoc "B.hs" "haskell" sourceB
|
||||
expectDiagnostics [ ( "B.hs", [(DsError, (6, 29), "Variable not in scope: n")] ) ]
|
||||
, testSessionWait "newtype-closure" $ do
|
||||
let sourceA =
|
||||
@ -1620,8 +1619,8 @@ thTests =
|
||||
,"import A"
|
||||
,"b :: Int"
|
||||
,"b = $( a )" ]
|
||||
_ <- openDoc' "A.hs" "haskell" sourceA
|
||||
_ <- openDoc' "B.hs" "haskell" sourceB
|
||||
_ <- createDoc "A.hs" "haskell" sourceA
|
||||
_ <- createDoc "B.hs" "haskell" sourceB
|
||||
return ()
|
||||
]
|
||||
|
||||
@ -1630,7 +1629,7 @@ completionTests
|
||||
= testGroup "completion"
|
||||
[ testSessionWait "variable" $ do
|
||||
let source = T.unlines ["module A where", "f = hea"]
|
||||
docId <- openDoc' "A.hs" "haskell" source
|
||||
docId <- createDoc "A.hs" "haskell" source
|
||||
compls <- getCompletions docId (Position 1 7)
|
||||
liftIO $ map dropDocs compls @?=
|
||||
[complItem "head" (Just CiFunction) (Just "[a] -> a")]
|
||||
@ -1642,7 +1641,7 @@ completionTests
|
||||
]
|
||||
, testSessionWait "constructor" $ do
|
||||
let source = T.unlines ["module A where", "f = Tru"]
|
||||
docId <- openDoc' "A.hs" "haskell" source
|
||||
docId <- createDoc "A.hs" "haskell" source
|
||||
compls <- getCompletions docId (Position 1 7)
|
||||
liftIO $ map dropDocs compls @?=
|
||||
[ complItem "True" (Just CiConstructor) (Just "Bool")
|
||||
@ -1654,7 +1653,7 @@ completionTests
|
||||
]
|
||||
, testSessionWait "type" $ do
|
||||
let source = T.unlines ["{-# OPTIONS_GHC -Wall #-}", "module A () where", "f :: ()", "f = ()"]
|
||||
docId <- openDoc' "A.hs" "haskell" source
|
||||
docId <- createDoc "A.hs" "haskell" source
|
||||
expectDiagnostics [ ("A.hs", [(DsWarning, (3,0), "not used")]) ]
|
||||
changeDoc docId [TextDocumentContentChangeEvent Nothing Nothing $ T.unlines ["{-# OPTIONS_GHC -Wall #-}", "module A () where", "f :: Bo", "f = True"]]
|
||||
compls <- getCompletions docId (Position 2 7)
|
||||
@ -1671,7 +1670,7 @@ completionTests
|
||||
checkDocText "Bool" boolDocs [ "Defined in 'Prelude'" ]
|
||||
, testSessionWait "qualified" $ do
|
||||
let source = T.unlines ["{-# OPTIONS_GHC -Wunused-binds #-}", "module A () where", "f = ()"]
|
||||
docId <- openDoc' "A.hs" "haskell" source
|
||||
docId <- createDoc "A.hs" "haskell" source
|
||||
expectDiagnostics [ ("A.hs", [(DsWarning, (2, 0), "not used")]) ]
|
||||
changeDoc docId [TextDocumentContentChangeEvent Nothing Nothing $ T.unlines ["{-# OPTIONS_GHC -Wunused-binds #-}", "module A () where", "f = Prelude.hea"]]
|
||||
compls <- getCompletions docId (Position 2 15)
|
||||
@ -1685,7 +1684,7 @@ completionTests
|
||||
]
|
||||
, testSessionWait "keyword" $ do
|
||||
let source = T.unlines ["module A where", "f = newty"]
|
||||
docId <- openDoc' "A.hs" "haskell" source
|
||||
docId <- createDoc "A.hs" "haskell" source
|
||||
compls <- getCompletions docId (Position 1 9)
|
||||
liftIO $ compls @?= [keywordItem "newtype"]
|
||||
, testSessionWait "type context" $ do
|
||||
@ -1694,7 +1693,7 @@ completionTests
|
||||
, "module A () where"
|
||||
, "f = f"
|
||||
]
|
||||
docId <- openDoc' "A.hs" "haskell" source
|
||||
docId <- createDoc "A.hs" "haskell" source
|
||||
expectDiagnostics [("A.hs", [(DsWarning, (2, 0), "not used")])]
|
||||
changeDoc docId
|
||||
[ TextDocumentContentChangeEvent Nothing Nothing $ T.unlines
|
||||
@ -1762,7 +1761,7 @@ outlineTests = testGroup
|
||||
"outline"
|
||||
[ testSessionWait "type class" $ do
|
||||
let source = T.unlines ["module A where", "class A a where a :: a -> Bool"]
|
||||
docId <- openDoc' "A.hs" "haskell" source
|
||||
docId <- createDoc "A.hs" "haskell" source
|
||||
symbols <- getDocumentSymbols docId
|
||||
liftIO $ symbols @?= Left
|
||||
[ moduleSymbol
|
||||
@ -1775,7 +1774,7 @@ outlineTests = testGroup
|
||||
]
|
||||
, testSessionWait "type class instance " $ do
|
||||
let source = T.unlines ["class A a where", "instance A () where"]
|
||||
docId <- openDoc' "A.hs" "haskell" source
|
||||
docId <- createDoc "A.hs" "haskell" source
|
||||
symbols <- getDocumentSymbols docId
|
||||
liftIO $ symbols @?= Left
|
||||
[ classSymbol "A a" (R 0 0 0 15) []
|
||||
@ -1783,7 +1782,7 @@ outlineTests = testGroup
|
||||
]
|
||||
, testSessionWait "type family" $ do
|
||||
let source = T.unlines ["{-# language TypeFamilies #-}", "type family A"]
|
||||
docId <- openDoc' "A.hs" "haskell" source
|
||||
docId <- createDoc "A.hs" "haskell" source
|
||||
symbols <- getDocumentSymbols docId
|
||||
liftIO $ symbols @?= Left [docSymbolD "A" "type family" SkClass (R 1 0 1 13)]
|
||||
, testSessionWait "type family instance " $ do
|
||||
@ -1792,7 +1791,7 @@ outlineTests = testGroup
|
||||
, "type family A a"
|
||||
, "type instance A () = ()"
|
||||
]
|
||||
docId <- openDoc' "A.hs" "haskell" source
|
||||
docId <- createDoc "A.hs" "haskell" source
|
||||
symbols <- getDocumentSymbols docId
|
||||
liftIO $ symbols @?= Left
|
||||
[ docSymbolD "A a" "type family" SkClass (R 1 0 1 15)
|
||||
@ -1800,7 +1799,7 @@ outlineTests = testGroup
|
||||
]
|
||||
, testSessionWait "data family" $ do
|
||||
let source = T.unlines ["{-# language TypeFamilies #-}", "data family A"]
|
||||
docId <- openDoc' "A.hs" "haskell" source
|
||||
docId <- createDoc "A.hs" "haskell" source
|
||||
symbols <- getDocumentSymbols docId
|
||||
liftIO $ symbols @?= Left [docSymbolD "A" "data family" SkClass (R 1 0 1 11)]
|
||||
, testSessionWait "data family instance " $ do
|
||||
@ -1809,7 +1808,7 @@ outlineTests = testGroup
|
||||
, "data family A a"
|
||||
, "data instance A () = A ()"
|
||||
]
|
||||
docId <- openDoc' "A.hs" "haskell" source
|
||||
docId <- createDoc "A.hs" "haskell" source
|
||||
symbols <- getDocumentSymbols docId
|
||||
liftIO $ symbols @?= Left
|
||||
[ docSymbolD "A a" "data family" SkClass (R 1 0 1 11)
|
||||
@ -1817,36 +1816,36 @@ outlineTests = testGroup
|
||||
]
|
||||
, testSessionWait "constant" $ do
|
||||
let source = T.unlines ["a = ()"]
|
||||
docId <- openDoc' "A.hs" "haskell" source
|
||||
docId <- createDoc "A.hs" "haskell" source
|
||||
symbols <- getDocumentSymbols docId
|
||||
liftIO $ symbols @?= Left
|
||||
[docSymbol "a" SkFunction (R 0 0 0 6)]
|
||||
, testSessionWait "pattern" $ do
|
||||
let source = T.unlines ["Just foo = Just 21"]
|
||||
docId <- openDoc' "A.hs" "haskell" source
|
||||
docId <- createDoc "A.hs" "haskell" source
|
||||
symbols <- getDocumentSymbols docId
|
||||
liftIO $ symbols @?= Left
|
||||
[docSymbol "Just foo" SkFunction (R 0 0 0 18)]
|
||||
, testSessionWait "pattern with type signature" $ do
|
||||
let source = T.unlines ["{-# language ScopedTypeVariables #-}", "a :: () = ()"]
|
||||
docId <- openDoc' "A.hs" "haskell" source
|
||||
docId <- createDoc "A.hs" "haskell" source
|
||||
symbols <- getDocumentSymbols docId
|
||||
liftIO $ symbols @?= Left
|
||||
[docSymbol "a :: ()" SkFunction (R 1 0 1 12)]
|
||||
, testSessionWait "function" $ do
|
||||
let source = T.unlines ["a x = ()"]
|
||||
docId <- openDoc' "A.hs" "haskell" source
|
||||
docId <- createDoc "A.hs" "haskell" source
|
||||
symbols <- getDocumentSymbols docId
|
||||
liftIO $ symbols @?= Left [docSymbol "a" SkFunction (R 0 0 0 8)]
|
||||
, testSessionWait "type synonym" $ do
|
||||
let source = T.unlines ["type A = Bool"]
|
||||
docId <- openDoc' "A.hs" "haskell" source
|
||||
docId <- createDoc "A.hs" "haskell" source
|
||||
symbols <- getDocumentSymbols docId
|
||||
liftIO $ symbols @?= Left
|
||||
[docSymbol' "A" SkTypeParameter (R 0 0 0 13) (R 0 5 0 6)]
|
||||
, testSessionWait "datatype" $ do
|
||||
let source = T.unlines ["data A = C"]
|
||||
docId <- openDoc' "A.hs" "haskell" source
|
||||
docId <- createDoc "A.hs" "haskell" source
|
||||
symbols <- getDocumentSymbols docId
|
||||
liftIO $ symbols @?= Left
|
||||
[ docSymbolWithChildren "A"
|
||||
@ -1856,7 +1855,7 @@ outlineTests = testGroup
|
||||
]
|
||||
, testSessionWait "import" $ do
|
||||
let source = T.unlines ["import Data.Maybe"]
|
||||
docId <- openDoc' "A.hs" "haskell" source
|
||||
docId <- createDoc "A.hs" "haskell" source
|
||||
symbols <- getDocumentSymbols docId
|
||||
liftIO $ symbols @?= Left
|
||||
[docSymbolWithChildren "imports"
|
||||
@ -1867,7 +1866,7 @@ outlineTests = testGroup
|
||||
]
|
||||
, testSessionWait "multiple import" $ do
|
||||
let source = T.unlines ["", "import Data.Maybe", "", "import Control.Exception", ""]
|
||||
docId <- openDoc' "A.hs" "haskell" source
|
||||
docId <- createDoc "A.hs" "haskell" source
|
||||
symbols <- getDocumentSymbols docId
|
||||
liftIO $ symbols @?= Left
|
||||
[docSymbolWithChildren "imports"
|
||||
@ -1882,7 +1881,7 @@ outlineTests = testGroup
|
||||
[ "{-# language ForeignFunctionInterface #-}"
|
||||
, "foreign import ccall \"a\" a :: Int"
|
||||
]
|
||||
docId <- openDoc' "A.hs" "haskell" source
|
||||
docId <- createDoc "A.hs" "haskell" source
|
||||
symbols <- getDocumentSymbols docId
|
||||
liftIO $ symbols @?= Left [docSymbolD "a" "import" SkObject (R 1 0 1 33)]
|
||||
, testSessionWait "foreign export" $ do
|
||||
@ -1890,7 +1889,7 @@ outlineTests = testGroup
|
||||
[ "{-# language ForeignFunctionInterface #-}"
|
||||
, "foreign export ccall odd :: Int -> Bool"
|
||||
]
|
||||
docId <- openDoc' "A.hs" "haskell" source
|
||||
docId <- createDoc "A.hs" "haskell" source
|
||||
symbols <- getDocumentSymbols docId
|
||||
liftIO $ symbols @?= Left [docSymbolD "odd" "export" SkObject (R 1 0 1 39)]
|
||||
]
|
||||
@ -2022,13 +2021,13 @@ loadCradleOnlyonce = testGroup "load cradle only once"
|
||||
test dir
|
||||
implicit dir = test dir
|
||||
test _dir = do
|
||||
doc <- openDoc' "B.hs" "haskell" "module B where\nimport Data.Foo"
|
||||
doc <- createDoc "B.hs" "haskell" "module B where\nimport Data.Foo"
|
||||
msgs <- someTill (skipManyTill anyMessage cradleLoadedMessage) (skipManyTill anyMessage (message @PublishDiagnosticsNotification))
|
||||
liftIO $ length msgs @?= 1
|
||||
changeDoc doc [TextDocumentContentChangeEvent Nothing Nothing "module B where\nimport Data.Maybe"]
|
||||
msgs <- manyTill (skipManyTill anyMessage cradleLoadedMessage) (skipManyTill anyMessage (message @PublishDiagnosticsNotification))
|
||||
liftIO $ length msgs @?= 0
|
||||
_ <- openDoc' "A.hs" "haskell" "module A where\nimport LoadCradleBar"
|
||||
_ <- createDoc "A.hs" "haskell" "module A where\nimport LoadCradleBar"
|
||||
msgs <- manyTill (skipManyTill anyMessage cradleLoadedMessage) (skipManyTill anyMessage (message @PublishDiagnosticsNotification))
|
||||
liftIO $ length msgs @?= 0
|
||||
|
||||
@ -2050,7 +2049,7 @@ sessionDepsArePickedUp = testSession'
|
||||
(dir </> "hie.yaml")
|
||||
"cradle: {direct: {arguments: []}}"
|
||||
-- Open without OverloadedStrings and expect an error.
|
||||
doc <- openDoc' "Foo.hs" "haskell" fooContent
|
||||
doc <- createDoc "Foo.hs" "haskell" fooContent
|
||||
expectDiagnostics
|
||||
[("Foo.hs", [(DsError, (3, 6), "Couldn't match expected type")])]
|
||||
-- Update hie.yaml to enable OverloadedStrings.
|
||||
@ -2153,7 +2152,7 @@ runInDir dir s = do
|
||||
openTestDataDoc :: FilePath -> Session TextDocumentIdentifier
|
||||
openTestDataDoc path = do
|
||||
source <- liftIO $ readFileUtf8 $ "test/data" </> path
|
||||
openDoc' path "haskell" source
|
||||
createDoc path "haskell" source
|
||||
|
||||
findCodeActions :: TextDocumentIdentifier -> Range -> [T.Text] -> Session [CodeAction]
|
||||
findCodeActions doc range expectedTitles = do
|
||||
@ -2194,20 +2193,6 @@ unitTests = do
|
||||
uriToFilePath' uri @?= Just ""
|
||||
]
|
||||
|
||||
-- | Wrapper around 'LSPTest.openDoc'' that sends file creation events
|
||||
openDoc' :: FilePath -> String -> T.Text -> Session TextDocumentIdentifier
|
||||
openDoc' fp name contents = do
|
||||
res@(TextDocumentIdentifier uri) <- LSPTest.openDoc' fp name contents
|
||||
-- Needed as ghcide sets up and relies on WatchedFiles but lsp-test does not track them
|
||||
sendNotification WorkspaceDidChangeWatchedFiles (DidChangeWatchedFilesParams $ List [FileEvent uri FcCreated])
|
||||
return res
|
||||
|
||||
-- | Version of 'LSPTest.openDoc'' that does not send WatchedFiles events for files outside the workspace
|
||||
openDoc'' :: FilePath -> String -> T.Text -> Session TextDocumentIdentifier
|
||||
-- At the moment this is just LSPTest.openDoc' but it may change in the future
|
||||
-- when/if lsp-test implements WatchedFiles
|
||||
openDoc'' = LSPTest.openDoc'
|
||||
|
||||
positionMappingTests :: TestTree
|
||||
positionMappingTests =
|
||||
testGroup "position mapping"
|
||||
|
||||
@ -19,7 +19,7 @@ import Control.Monad.IO.Class
|
||||
import Data.Foldable
|
||||
import qualified Data.Map.Strict as Map
|
||||
import qualified Data.Text as T
|
||||
import Language.Haskell.LSP.Test hiding (message, openDoc')
|
||||
import Language.Haskell.LSP.Test hiding (message)
|
||||
import qualified Language.Haskell.LSP.Test as LspTest
|
||||
import Language.Haskell.LSP.Types
|
||||
import Language.Haskell.LSP.Types.Lens as Lsp
|
||||
|
||||
Loading…
Reference in New Issue
Block a user