haskell-language-server 2.3.0.0 → 2.4.0.0
raw patch · 73 files changed
+86/−2012 lines, 73 filesdep ~ghcidedep ~hls-alternate-number-format-plugindep ~hls-cabal-fmt-pluginPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: ghcide, hls-alternate-number-format-plugin, hls-cabal-fmt-plugin, hls-cabal-plugin, hls-call-hierarchy-plugin, hls-change-type-signature-plugin, hls-class-plugin, hls-code-range-plugin, hls-eval-plugin, hls-explicit-fixity-plugin, hls-explicit-imports-plugin, hls-explicit-record-fields-plugin, hls-floskell-plugin, hls-fourmolu-plugin, hls-gadt-plugin, hls-hlint-plugin, hls-module-name-plugin, hls-ormolu-plugin, hls-overloaded-record-dot-plugin, hls-plugin-api, hls-pragmas-plugin, hls-qualify-imported-names-plugin, hls-refactor-plugin, hls-rename-plugin, hls-retrie-plugin, hls-splice-plugin, hls-stylish-haskell-plugin, hls-test-utils
API changes (from Hackage documentation)
Files
- ChangeLog.md +21/−1
- haskell-language-server.cabal +38/−48
- test/functional/Command.hs +0/−32
- test/functional/Completion.hs +0/−380
- test/functional/Deferred.hs +0/−171
- test/functional/Definition.hs +0/−89
- test/functional/Diagnostic.hs +0/−24
- test/functional/Format.hs +4/−27
- test/functional/FunctionalBadProject.hs +1/−1
- test/functional/FunctionalCodeAction.hs +0/−416
- test/functional/Highlight.hs +0/−22
- test/functional/Main.hs +7/−29
- test/functional/Progress.hs +3/−4
- test/functional/Reference.hs +0/−31
- test/functional/Symbol.hs +0/−150
- test/functional/TypeDefinition.hs +0/−42
- test/testdata/CodeActionImport.hs +0/−2
- test/testdata/CodeActionImportPostQualified.hs +0/−4
- test/testdata/CodeActionImportQualified.hs +0/−2
- test/testdata/CodeActionOnly.hs +0/−3
- test/testdata/CodeActionRename.hs +0/−2
- test/testdata/FuncTest.hs +0/−13
- test/testdata/FuncTestError.hs +0/−15
- test/testdata/FuncTestFail.hs +0/−2
- test/testdata/Highlight.hs +0/−5
- test/testdata/Hover.hs +0/−2
- test/testdata/References.hs +0/−9
- test/testdata/Symbols.hs +0/−14
- test/testdata/TopLevelSignature.hs +0/−5
- test/testdata/TypedHoles.hs +0/−3
- test/testdata/TypedHoles2.hs +0/−6
- test/testdata/UnusedTerm.hs +0/−6
- test/testdata/addPackageTest/cabal-exe/AddPackage.hs +0/−3
- test/testdata/addPackageTest/cabal-exe/add-package-test.cabal +0/−14
- test/testdata/addPackageTest/cabal-lib/AddPackage.hs +0/−4
- test/testdata/addPackageTest/cabal-lib/add-package-test.cabal +0/−14
- test/testdata/addPackageTest/hpack-exe/app/Asdf.hs +0/−5
- test/testdata/addPackageTest/hpack-exe/asdf.cabal +0/−37
- test/testdata/addPackageTest/hpack-lib/app/Asdf.hs +0/−7
- test/testdata/addPackageTest/invalid/AddPackage.hs +0/−2
- test/testdata/badProjects/cabal/Foo.hs +0/−4
- test/testdata/badProjects/cabal/bad-cabal.cabal +0/−16
- test/testdata/completion/AssociatedTypeFamily.hs +0/−8
- test/testdata/completion/Context.hs +0/−4
- test/testdata/completion/DupRecFields.hs +0/−5
- test/testdata/completion/FunctionCompletions.hs +0/−8
- test/testdata/completion/RecordDotSyntax.hs +0/−28
- test/testdata/completion/completions.cabal +0/−10
- test/testdata/completion/hie.yaml +0/−2
- test/testdata/context/ExampleContext.hs +0/−20
- test/testdata/context/Foo/Bar.hs +0/−3
- test/testdata/definition/Bar.hs +0/−9
- test/testdata/definition/Foo.hs +0/−6
- test/testdata/definition/definitions.cabal +0/−10
- test/testdata/definition/hie.yaml +0/−5
- test/testdata/diagnostics/hie.yaml +5/−0
- test/testdata/format/hie.yaml +4/−0
- test/testdata/gototest/hie.yaml +0/−6
- test/testdata/gototest/src/Lib.hs +0/−40
- test/testdata/gototest/src/Lib2.hs +0/−13
- test/testdata/hie.yaml +0/−12
- test/testdata/hieBiosMainIs/hie.yaml +2/−0
- test/testdata/liquid/Evens.hs +0/−41
- test/testdata/redundantImportTest/hie.yaml +0/−5
- test/testdata/redundantImportTest/src/CodeActionRedundant.hs +0/−10
- test/testdata/redundantImportTest/src/MultipleImports.hs +0/−6
- test/testdata/redundantImportTest/test.cabal +0/−18
- test/testdata/testdata.cabal +0/−37
- test/testdata/wErrorTest/cabal.project +0/−1
- test/testdata/wErrorTest/hie.yaml +0/−4
- test/testdata/wErrorTest/src/WError.hs +0/−3
- test/testdata/wErrorTest/test.cabal +0/−18
- test/utils/Test/Hls/Command.hs +1/−14
ChangeLog.md view
@@ -1,6 +1,26 @@ # Changelog for haskell-language-server -## 2.3.0.0.0+## 2.4.0.0++* Initial support for GHC 9.8.1, without plugins dependent on `ghc-exactprint`+* Fix broken Windows binaries (#3822)++### Pull Requests++- Remove constraint on stm-hamt+ ([#3829](https://github.com/haskell/haskell-language-server/pull/3829)) by @iMichka+- Cleanup func-test suite+ ([#3828](https://github.com/haskell/haskell-language-server/pull/3828)) by @fendor+- Bump haskell/actions from 2.4.6 to 2.4.7 in /.github/actions/setup-build+ ([#3824](https://github.com/haskell/haskell-language-server/pull/3824)) by @dependabot[bot]+- Bump haskell/actions from 2.4.6 to 2.4.7+ ([#3823](https://github.com/haskell/haskell-language-server/pull/3823)) by @dependabot[bot]+- Release 2.3.0.0+ ([#3818](https://github.com/haskell/haskell-language-server/pull/3818)) by @wz1000+- GHC 9.8 support+ ([#3727](https://github.com/haskell/haskell-language-server/pull/3727)) by @wz1000++## 2.3.0.0 * Binaries for GHC 9.6.3 * Drop support for GHC 8.10
haskell-language-server.cabal view
@@ -1,7 +1,7 @@ cabal-version: 3.0 category: Development name: haskell-language-server-version: 2.3.0.0+version: 2.4.0.0 synopsis: LSP server for GHC description: Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>@@ -198,129 +198,129 @@ common cabalfmt if flag(cabalfmt)- build-depends: hls-cabal-fmt-plugin == 2.3.0.0+ build-depends: hls-cabal-fmt-plugin == 2.4.0.0 cpp-options: -Dhls_cabalfmt common cabal if flag(cabal)- build-depends: hls-cabal-plugin == 2.3.0.0+ build-depends: hls-cabal-plugin == 2.4.0.0 cpp-options: -Dhls_cabal common class- if flag(class)- build-depends: hls-class-plugin == 2.3.0.0+ if flag(class) && (impl(ghc < 9.8.0) || flag(ignore-plugins-ghc-bounds))+ build-depends: hls-class-plugin == 2.4.0.0 cpp-options: -Dhls_class common callHierarchy if flag(callHierarchy)- build-depends: hls-call-hierarchy-plugin == 2.3.0.0+ build-depends: hls-call-hierarchy-plugin == 2.4.0.0 cpp-options: -Dhls_callHierarchy common eval if flag(eval)- build-depends: hls-eval-plugin == 2.3.0.0+ build-depends: hls-eval-plugin == 2.4.0.0 cpp-options: -Dhls_eval common importLens if flag(importLens)- build-depends: hls-explicit-imports-plugin == 2.3.0.0+ build-depends: hls-explicit-imports-plugin == 2.4.0.0 cpp-options: -Dhls_importLens common rename- if flag(rename)- build-depends: hls-rename-plugin == 2.3.0.0+ if flag(rename) && (impl(ghc < 9.8.0) || flag(ignore-plugins-ghc-bounds))+ build-depends: hls-rename-plugin == 2.4.0.0 cpp-options: -Dhls_rename common retrie- if flag(retrie)- build-depends: hls-retrie-plugin == 2.3.0.0+ if flag(retrie) && (impl(ghc < 9.8.0) || flag(ignore-plugins-ghc-bounds))+ build-depends: hls-retrie-plugin == 2.4.0.0 cpp-options: -Dhls_retrie common hlint- if flag(hlint)- build-depends: hls-hlint-plugin == 2.3.0.0+ if flag(hlint) && (impl(ghc < 9.8.0) || flag(ignore-plugins-ghc-bounds))+ build-depends: hls-hlint-plugin == 2.4.0.0 cpp-options: -Dhls_hlint common moduleName if flag(moduleName)- build-depends: hls-module-name-plugin == 2.3.0.0+ build-depends: hls-module-name-plugin == 2.4.0.0 cpp-options: -Dhls_moduleName common pragmas if flag(pragmas)- build-depends: hls-pragmas-plugin == 2.3.0.0+ build-depends: hls-pragmas-plugin == 2.4.0.0 cpp-options: -Dhls_pragmas common splice- if flag(splice)- build-depends: hls-splice-plugin == 2.3.0.0+ if flag(splice) && (impl(ghc < 9.8.0) || flag(ignore-plugins-ghc-bounds))+ build-depends: hls-splice-plugin == 2.4.0.0 cpp-options: -Dhls_splice common alternateNumberFormat if flag(alternateNumberFormat)- build-depends: hls-alternate-number-format-plugin == 2.3.0.0+ build-depends: hls-alternate-number-format-plugin == 2.4.0.0 cpp-options: -Dhls_alternateNumberFormat common qualifyImportedNames if flag(qualifyImportedNames)- build-depends: hls-qualify-imported-names-plugin == 2.3.0.0+ build-depends: hls-qualify-imported-names-plugin == 2.4.0.0 cpp-options: -Dhls_qualifyImportedNames common codeRange if flag(codeRange)- build-depends: hls-code-range-plugin == 2.3.0.0+ build-depends: hls-code-range-plugin == 2.4.0.0 cpp-options: -Dhls_codeRange common changeTypeSignature if flag(changeTypeSignature)- build-depends: hls-change-type-signature-plugin == 2.3.0.0+ build-depends: hls-change-type-signature-plugin == 2.4.0.0 cpp-options: -Dhls_changeTypeSignature common gadt- if flag(gadt)- build-depends: hls-gadt-plugin == 2.3.0.0+ if flag(gadt) && (impl(ghc < 9.8.0) || flag(ignore-plugins-ghc-bounds))+ build-depends: hls-gadt-plugin == 2.4.0.0 cpp-options: -Dhls_gadt common explicitFixity if flag(explicitFixity)- build-depends: hls-explicit-fixity-plugin == 2.3.0.0+ build-depends: hls-explicit-fixity-plugin == 2.4.0.0 cpp-options: -DexplicitFixity common explicitFields if flag(explicitFields)- build-depends: hls-explicit-record-fields-plugin == 2.3.0.0+ build-depends: hls-explicit-record-fields-plugin == 2.4.0.0 cpp-options: -DexplicitFields common overloadedRecordDot if flag(overloadedRecordDot) && (impl(ghc >= 9.2.0) || flag(ignore-plugins-ghc-bounds))- build-depends: hls-overloaded-record-dot-plugin == 2.3.0.0+ build-depends: hls-overloaded-record-dot-plugin == 2.4.0.0 cpp-options: -Dhls_overloaded_record_dot -- formatters common floskell if flag(floskell) && impl(ghc < 9.5)- build-depends: hls-floskell-plugin == 2.3.0.0+ build-depends: hls-floskell-plugin == 2.4.0.0 cpp-options: -Dhls_floskell common fourmolu- if flag(fourmolu)- build-depends: hls-fourmolu-plugin == 2.3.0.0+ if flag(fourmolu) && (impl(ghc < 9.8.0) || flag(ignore-plugins-ghc-bounds))+ build-depends: hls-fourmolu-plugin == 2.4.0.0 cpp-options: -Dhls_fourmolu common ormolu if flag(ormolu) && impl(ghc < 9.7)- build-depends: hls-ormolu-plugin == 2.3.0.0+ build-depends: hls-ormolu-plugin == 2.4.0.0 cpp-options: -Dhls_ormolu common stylishHaskell- if flag(stylishHaskell)- build-depends: hls-stylish-haskell-plugin == 2.3.0.0+ if flag(stylishHaskell) && (impl(ghc < 9.8.0) || flag(ignore-plugins-ghc-bounds))+ build-depends: hls-stylish-haskell-plugin == 2.4.0.0 cpp-options: -Dhls_stylishHaskell common refactor- if flag(refactor)- build-depends: hls-refactor-plugin == 2.3.0.0+ if flag(refactor) && (impl(ghc < 9.8.0) || flag(ignore-plugins-ghc-bounds))+ build-depends: hls-refactor-plugin == 2.4.0.0 cpp-options: -Dhls_refactor library@@ -372,12 +372,12 @@ , cryptohash-sha1 , data-default , ghc- , ghcide == 2.3.0.0+ , ghcide == 2.4.0.0 , githash >=0.1.6.1 , lsp >= 2.2.0.0 , hie-bios , hiedb- , hls-plugin-api == 2.3.0.0+ , hls-plugin-api == 2.4.0.0 , optparse-applicative , optparse-simple , process@@ -516,7 +516,7 @@ , lens-aeson , ghcide , ghcide-test-utils- , hls-test-utils == 2.3.0.0+ , hls-test-utils == 2.4.0.0 , lsp-types , aeson , hls-plugin-api@@ -529,21 +529,11 @@ main-is: Main.hs other-modules:- Command- Completion Config- Deferred- Definition- Diagnostic Format FunctionalBadProject- FunctionalCodeAction HieBios- Highlight Progress- Reference- Symbol- TypeDefinition Test.Hls.Command Test.Hls.Flags
− test/functional/Command.hs
@@ -1,32 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Command (tests) where--import Control.Lens hiding (List)-import Data.Char-import qualified Data.Text as T-import qualified Language.LSP.Protocol.Lens as L-import Language.LSP.Protocol.Types as LSP-import Test.Hls-import Test.Hls.Command-import Test.Hls.Flags (requiresEvalPlugin)--tests :: TestTree-tests = testGroup "commands" [- testCase "are prefixed" $- runSession hlsCommand fullCaps "test/testdata/" $ do- TResponseMessage _ _ (Right res) <- initializeResponse- let cmds = res ^. L.capabilities . L.executeCommandProvider . _Just . L.commands- f x = (T.length (T.takeWhile isNumber x) >= 1) && (T.count ":" x >= 2)- liftIO $ do- all f cmds @? "All prefixed"- not (null cmds) @? "Commands aren't empty"- , requiresEvalPlugin $ testCase "get de-prefixed" $- runSession hlsCommand fullCaps "test/testdata/" $ do- TResponseMessage _ _ (Left err) <- request- SMethod_WorkspaceExecuteCommand- (ExecuteCommandParams Nothing "34133:eval:evalCommand" (Just []))- let ResponseError _ msg _ = err- -- We expect an error message about the dud arguments, but we can- -- check that we found the right plugin.- liftIO $ "while parsing args for evalCommand in plugin eval" `T.isInfixOf` msg @? "Has error message"- ]
− test/functional/Completion.hs
@@ -1,380 +0,0 @@-{-# LANGUAGE OverloadedLabels #-}-{-# LANGUAGE OverloadedLists #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-module Completion(tests) where--import Control.Lens hiding ((.=))-import Data.Aeson (toJSON)-import Data.Foldable (find)-import Data.Functor (void)-import qualified Data.Map as Map-import Data.Row.Records (focus)-import qualified Data.Text as T-import Ide.Plugin.Config (maxCompletions, plcConfig, plugins)-import Language.LSP.Protocol.Lens hiding (applyEdit, length)-import Test.Hls-import Test.Hls.Command--tests :: TestTree-tests = testGroup "completions" [- testCase "works" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do- doc <- openDoc "Completion.hs" "haskell"-- let te = TextEdit (Range (Position 5 7) (Position 5 24)) "put"- _ <- applyEdit doc te-- compls <- getAndResolveCompletions doc (Position 5 9)- item <- getCompletionByLabel "putStrLn" compls- liftIO $ do- item ^. label @?= "putStrLn"- item ^. kind @?= Just CompletionItemKind_Function- item ^. detail @?= Just ":: String -> IO ()\nfrom Prelude"- item ^. insertTextFormat @?= Just InsertTextFormat_Snippet- item ^. insertText @?= Just "putStrLn"-- , testCase "itemCompletion/resolve works" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do- doc <- openDoc "Completion.hs" "haskell"-- let te = TextEdit (Range (Position 5 7) (Position 5 24)) "put"- _ <- applyEdit doc te-- compls <- getAndResolveCompletions doc (Position 5 9)- item <- getCompletionByLabel "putStrLn" compls- liftIO $ do- item ^. label @?= "putStrLn"- item ^. kind @?= Just CompletionItemKind_Function- item ^. detail @?= Just ":: String -> IO ()\nfrom Prelude"- item ^. insertTextFormat @?= Just InsertTextFormat_Snippet- item ^. insertText @?= Just "putStrLn"-- , testCase "completes imports" $ runSession (hlsCommand <> " --test") fullCaps "test/testdata/completion" $ do- doc <- openDoc "Completion.hs" "haskell"-- waitForKickDone-- let te = TextEdit (Range (Position 1 17) (Position 1 26)) "Data.M"- _ <- applyEdit doc te-- compls <- getAndResolveCompletions doc (Position 1 23)- item <- getCompletionByLabel "Maybe" compls- liftIO $ do- item ^. label @?= "Maybe"- item ^. detail @?= Just "Data.Maybe"- item ^. kind @?= Just CompletionItemKind_Module-- , testCase "completes qualified imports" $ runSession (hlsCommand <> " --test") fullCaps "test/testdata/completion" $ do- doc <- openDoc "Completion.hs" "haskell"-- _ <- waitForKickDone-- let te = TextEdit (Range (Position 2 17) (Position 2 25)) "Data.L"- _ <- applyEdit doc te-- compls <- getAndResolveCompletions doc (Position 2 24)- item <- getCompletionByLabel "List" compls- liftIO $ do- item ^. label @?= "List"- item ^. detail @?= Just "Data.List"- item ^. kind @?= Just CompletionItemKind_Module-- , testCase "completes with no prefix" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do- doc <- openDoc "Completion.hs" "haskell"-- compls <- getAndResolveCompletions doc (Position 5 7)- liftIO $ assertBool "Expected completions" $ not $ null compls-- , expectFailIfBeforeGhc92 "record dot syntax is introduced in GHC 9.2"- $ testGroup "recorddotsyntax"- [ testCase "shows field selectors" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do- doc <- openDoc "RecordDotSyntax.hs" "haskell"-- let te = TextEdit (Range (Position 25 0) (Position 25 5)) "z = x.a"- _ <- applyEdit doc te-- compls <- getAndResolveCompletions doc (Position 25 6)- item <- getCompletionByLabel "a" compls-- liftIO $ do- item ^. label @?= "a"- , testCase "shows field selectors for nested field" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do- doc <- openDoc "RecordDotSyntax.hs" "haskell"-- let te = TextEdit (Range (Position 27 0) (Position 27 8)) "z2 = x.c.z"- _ <- applyEdit doc te-- compls <- getAndResolveCompletions doc (Position 27 9)- item <- getCompletionByLabel "z" compls-- liftIO $ do- item ^. label @?= "z"- ]-- -- See https://github.com/haskell/haskell-ide-engine/issues/903- , testCase "strips compiler generated stuff from completions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do- doc <- openDoc "DupRecFields.hs" "haskell"-- let te = TextEdit (Range (Position 5 0) (Position 5 2)) "acc"- _ <- applyEdit doc te-- compls <- getAndResolveCompletions doc (Position 5 4)- item <- getCompletionByLabel "accessor" compls- liftIO $ do- item ^. label @?= "accessor"- item ^. kind @?= Just CompletionItemKind_Function- , testCase "have implicit foralls on basic polymorphic types" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do- doc <- openDoc "Completion.hs" "haskell"-- let te = TextEdit (Range (Position 5 7) (Position 5 9)) "id"- _ <- applyEdit doc te- compls <- getAndResolveCompletions doc (Position 5 9)- item <- getCompletionByLabel "id" compls- liftIO $ do- item ^. detail @?= Just ":: a -> a\nfrom Prelude"-- , testCase "have implicit foralls with multiple type variables" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do- doc <- openDoc "Completion.hs" "haskell"-- let te = TextEdit (Range (Position 5 7) (Position 5 24)) "flip"- _ <- applyEdit doc te- compls <- getAndResolveCompletions doc (Position 5 11)- item <- getCompletionByLabel "flip" compls- liftIO $- item ^. detail @?= Just ":: (a -> b -> c) -> b -> a -> c\nfrom Prelude"-- , testCase "maxCompletions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do- doc <- openDoc "Completion.hs" "haskell"-- compls <- getAndResolveCompletions doc (Position 5 7)- liftIO $ length compls @?= maxCompletions def-- , testCase "import function completions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do- doc <- openDoc "FunctionCompletions.hs" "haskell"-- let te = TextEdit (Range (Position 0 30) (Position 0 41)) "A"- _ <- applyEdit doc te-- compls <- getAndResolveCompletions doc (Position 0 31)- item <- getCompletionByLabel "Alternative" compls- liftIO $ do- item ^. label @?= "Alternative"- item ^. kind @?= Just CompletionItemKind_Function- item ^. detail @?= Just "Control.Applicative"-- , testCase "import second function completion" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do- doc <- openDoc "FunctionCompletions.hs" "haskell"-- let te = TextEdit (Range (Position 0 39) (Position 0 39)) ", l"- _ <- applyEdit doc te-- compls <- getAndResolveCompletions doc (Position 0 42)- item <- getCompletionByLabel "liftA" compls- liftIO $ do- item ^. label @?= "liftA"- item ^. kind @?= Just CompletionItemKind_Function- item ^. detail @?= Just "Control.Applicative"-- , testCase "completes locally defined associated type family" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do- doc <- openDoc "AssociatedTypeFamily.hs" "haskell"-- compls <- getAndResolveCompletions doc (Position 5 20)- item <- getCompletionByLabel "Fam" compls- liftIO $ do- item ^. label @?= "Fam"- item ^. kind @?= Just CompletionItemKind_Struct-- , contextTests- , snippetTests- ]--snippetTests :: TestTree-snippetTests = testGroup "snippets" [- testCase "work for argumentless constructors" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do- doc <- openDoc "Completion.hs" "haskell"-- let te = TextEdit (Range (Position 5 7) (Position 5 24)) "Nothing"- _ <- applyEdit doc te-- compls <- getAndResolveCompletions doc (Position 5 14)- item <- getCompletionByLabel "Nothing" compls- liftIO $ do- item ^. insertTextFormat @?= Just InsertTextFormat_Snippet- item ^. insertText @?= Just "Nothing"-- , testCase "work for polymorphic types" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do- doc <- openDoc "Completion.hs" "haskell"-- let te = TextEdit (Range (Position 5 7) (Position 5 24)) "fold"- _ <- applyEdit doc te-- compls <- getAndResolveCompletions doc (Position 5 11)- item <- getCompletionByLabel "foldl" compls- liftIO $ do- item ^. label @?= "foldl"- item ^. kind @?= Just CompletionItemKind_Function- item ^. insertTextFormat @?= Just InsertTextFormat_Snippet- item ^. insertText @?= Just "foldl"-- , testCase "work for complex types" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do- doc <- openDoc "Completion.hs" "haskell"-- let te = TextEdit (Range (Position 5 7) (Position 5 24)) "mapM"- _ <- applyEdit doc te-- compls <- getAndResolveCompletions doc (Position 5 11)- item <- getCompletionByLabel "mapM" compls- liftIO $ do- item ^. label @?= "mapM"- item ^. kind @?= Just CompletionItemKind_Function- item ^. insertTextFormat @?= Just InsertTextFormat_Snippet- item ^. insertText @?= Just "mapM"-- , testCase "work for infix functions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do- doc <- openDoc "Completion.hs" "haskell"-- let te = TextEdit (Range (Position 5 7) (Position 5 24)) "even `filte"- _ <- applyEdit doc te-- compls <- getAndResolveCompletions doc (Position 5 18)- item <- getCompletionByLabel "filter" compls- liftIO $ do- item ^. label @?= "filter"- item ^. kind @?= Just CompletionItemKind_Function- item ^. insertTextFormat @?= Just InsertTextFormat_PlainText- item ^. insertText @?= Nothing-- , testCase "work for infix functions in backticks" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do- doc <- openDoc "Completion.hs" "haskell"-- let te = TextEdit (Range (Position 5 7) (Position 5 24)) "even `filte`"- _ <- applyEdit doc te-- compls <- getAndResolveCompletions doc (Position 5 18)- item <- getCompletionByLabel "filter" compls- liftIO $ do- item ^. label @?= "filter"- item ^. kind @?= Just CompletionItemKind_Function- item ^. insertTextFormat @?= Just InsertTextFormat_PlainText- item ^. insertText @?= Nothing-- , testCase "work for qualified infix functions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do- doc <- openDoc "Completion.hs" "haskell"-- let te = TextEdit (Range (Position 5 7) (Position 5 24)) "\"\" `Data.List.interspe"- _ <- applyEdit doc te-- compls <- getAndResolveCompletions doc (Position 5 29)- item <- getCompletionByLabel "intersperse" compls- liftIO $ do- item ^. label @?= "intersperse"- item ^. kind @?= Just CompletionItemKind_Function- item ^. insertTextFormat @?= Just InsertTextFormat_PlainText- item ^. insertText @?= Nothing-- , testCase "work for qualified infix functions in backticks" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do- doc <- openDoc "Completion.hs" "haskell"-- let te = TextEdit (Range (Position 5 7) (Position 5 24)) "\"\" `Data.List.interspe`"- _ <- applyEdit doc te-- compls <- getAndResolveCompletions doc (Position 5 29)- item <- getCompletionByLabel "intersperse" compls- liftIO $ do- item ^. label @?= "intersperse"- item ^. kind @?= Just CompletionItemKind_Function- item ^. insertTextFormat @?= Just InsertTextFormat_PlainText- item ^. insertText @?= Nothing-- , testCase "respects lsp configuration" $ runSessionWithConfig (def {ignoreConfigurationRequests=False}) hlsCommand fullCaps "test/testdata/completion" $ do- void configurationRequest- doc <- openDoc "Completion.hs" "haskell"-- let config = def { plugins = Map.insert "ghcide-completions" (def { plcConfig = [("snippetsOn", (toJSON False))]}) (plugins def) }-- setHlsConfig config-- checkNoSnippets doc-- , testCase "respects client capabilities" $ runSession hlsCommand noSnippetsCaps "test/testdata/completion" $ do- doc <- openDoc "Completion.hs" "haskell"-- checkNoSnippets doc- , testCase "works for record fields sharing the single signature" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do- doc <- openDoc "FieldsSharingSignature.hs" "haskell"-- let te = TextEdit (Range (Position 1 0) (Position 1 2)) "MkF"- _ <- applyEdit doc te-- compls <- getAndResolveCompletions doc (Position 1 6)- item <- case find (\c -> (c ^. label == "MkFoo") && maybe False ("MkFoo {" `T.isPrefixOf`) (c ^. insertText)) compls of- Just c -> pure c- Nothing -> liftIO . assertFailure $ "Completion with label 'MkFoo' and insertText starting with 'MkFoo {' not found among " <> show compls- liftIO $ do- item ^. insertTextFormat @?= Just InsertTextFormat_Snippet- item ^. insertText @?= Just "MkFoo {arg1=${1:_arg1}, arg2=${2:_arg2}, arg3=${3:_arg3}, arg4=${4:_arg4}, arg5=${5:_arg5}}"- ]- where- checkNoSnippets doc = do- let te = TextEdit (Range (Position 5 7) (Position 5 24)) "fold"- _ <- applyEdit doc te-- compls <- getAndResolveCompletions doc (Position 5 11)- item <- getCompletionByLabel "foldl" compls- liftIO $ do- item ^. label @?= "foldl"- item ^. kind @?= Just CompletionItemKind_Function- item ^. insertTextFormat @?= Just InsertTextFormat_PlainText- item ^. insertText @?= Nothing-- noSnippetsCaps =- ( textDocument- . _Just- . completion- . _Just- . completionItem- . _Just- . focus #snippetSupport- ?~ False- )- fullCaps--contextTests :: TestTree-contextTests = testGroup "contexts" [- testCase "only provides type suggestions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do- doc <- openDoc "Context.hs" "haskell"-- compls <- getAndResolveCompletions doc (Position 2 17)- liftIO $ do- compls `shouldContainCompl` "Integer"- compls `shouldNotContainCompl` "interact"-- , testCase "only provides value suggestions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do- doc <- openDoc "Context.hs" "haskell"-- compls <- getAndResolveCompletions doc (Position 3 10)- liftIO $ do- compls `shouldContainCompl` "abs"- compls `shouldNotContainCompl` "Applicative"-- , testCase "completes qualified type suggestions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do- doc <- openDoc "Context.hs" "haskell"-- compls <- getAndResolveCompletions doc (Position 2 26)- liftIO $ do- compls `shouldNotContainCompl` "forkOn"- compls `shouldContainCompl` "MVar"- compls `shouldContainCompl` "Chan"- ]--shouldContainCompl :: [CompletionItem] -> T.Text -> Assertion-compls `shouldContainCompl` lbl =- any ((== lbl) . (^. label)) compls- @? "Should contain completion: " ++ show lbl--shouldNotContainCompl :: [CompletionItem] -> T.Text -> Assertion-compls `shouldNotContainCompl` lbl =- all ((/= lbl) . (^. label)) compls- @? "Should not contain completion: " ++ show lbl--expectFailIfBeforeGhc92 :: String -> TestTree -> TestTree-expectFailIfBeforeGhc92 = knownBrokenForGhcVersions [GHC90]
− test/functional/Deferred.hs
@@ -1,171 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE OverloadedStrings #-}-module Deferred(tests) where--import Control.Lens hiding (List)--- import Control.Monad--- import Data.Maybe-import Language.LSP.Protocol.Lens hiding (id, length, message)-import Language.LSP.Protocol.Types (Null (Null))--- import qualified Language.LSP.Types.Lens as LSP-import Test.Hls-import Test.Hls.Command---tests :: TestTree-tests = testGroup "deferred responses" [-- --TODO: DOes not compile- -- testCase "do not affect hover requests" $ runSession hlsCommand fullCaps "test/testdata" $ do- -- doc <- openDoc "FuncTest.hs" "haskell"-- -- id1 <- sendRequest TextDocumentHover (TextDocumentPositionParams doc (Position 4 2) Nothing)-- -- skipMany anyNotification- -- hoverRsp <- message :: Session HoverResponse- -- liftIO $ hoverRsp ^? result . _Just . _Just . contents @?= Nothing- -- liftIO $ hoverRsp ^. LSP.id @?= responseId id1-- -- id2 <- sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams doc Nothing)- -- symbolsRsp <- skipManyTill anyNotification message :: Session DocumentSymbolsResponse- -- liftIO $ symbolsRsp ^. LSP.id @?= responseId id2-- -- id3 <- sendRequest TextDocumentHover (TextDocumentPositionParams doc (Position 4 2) Nothing)- -- hoverRsp2 <- skipManyTill anyNotification message :: Session HoverResponse- -- liftIO $ hoverRsp2 ^. LSP.id @?= responseId id3-- -- let contents2 = hoverRsp2 ^? result . _Just . _Just . contents- -- liftIO $ contents2 `shouldNotSatisfy` null-- -- -- Now that we have cache the following request should be instant- -- let highlightParams = TextDocumentPositionParams doc (Position 7 0) Nothing- -- highlightRsp <- request TextDocumentDocumentHighlight highlightParams- -- let (Just (List locations)) = highlightRsp ^. result- -- liftIO $ locations @?= [ DocumentHighlight- -- { _range = Range- -- { _start = Position {_line = 7, _character = 0}- -- , _end = Position {_line = 7, _character = 2}- -- }- -- , _kind = Just HkWrite- -- }- -- , DocumentHighlight- -- { _range = Range- -- { _start = Position {_line = 7, _character = 0}- -- , _end = Position {_line = 7, _character = 2}- -- }- -- , _kind = Just HkWrite- -- }- -- , DocumentHighlight- -- { _range = Range- -- { _start = Position {_line = 5, _character = 6}- -- , _end = Position {_line = 5, _character = 8}- -- }- -- , _kind = Just HkRead- -- }- -- , DocumentHighlight- -- { _range = Range- -- { _start = Position {_line = 7, _character = 0}- -- , _end = Position {_line = 7, _character = 2}- -- }- -- , _kind = Just HkWrite- -- }- -- , DocumentHighlight- -- { _range = Range- -- { _start = Position {_line = 7, _character = 0}- -- , _end = Position {_line = 7, _character = 2}- -- }- -- , _kind = Just HkWrite- -- }- -- , DocumentHighlight- -- { _range = Range- -- { _start = Position {_line = 5, _character = 6}- -- , _end = Position {_line = 5, _character = 8}- -- }- -- , _kind = Just HkRead- -- }- -- ]-- testCase "instantly respond to failed modules with no cache" $ runSession hlsCommand fullCaps "test/testdata" $ do- doc <- openDoc "FuncTestFail.hs" "haskell"- defs <- getDefinitions doc (Position 1 11)- liftIO $ defs @?= InR (InR Null)-- -- TODO: the benefits of caching parsed modules is doubted.- -- TODO: add issue link- -- , testCase "respond to untypecheckable modules with parsed module cache" $- -- runSession hlsCommand fullCaps "test/testdata" $ do- -- doc <- openDoc "FuncTestFail.hs" "haskell"- -- (Left (sym:_)) <- getDocumentSymbols doc- -- liftIO $ sym ^. name @?= "main"-- -- TODO does not compile- -- , testCase "returns hints as diagnostics" $ runSession hlsCommand fullCaps "test/testdata" $ do- -- _ <- openDoc "FuncTest.hs" "haskell"-- -- cwd <- liftIO getCurrentDirectory- -- let testUri = filePathToUri $ cwd </> "test/testdata/FuncTest.hs"-- -- diags <- publishDiagnosticsNotification- -- liftIO $ diags ^? params @?= (Just $ PublishDiagnosticsParams- -- { _uri = testUri- -- , _diagnostics = List- -- [ Diagnostic- -- (Range (Position 9 6) (Position 10 18))- -- (Just DsInfo)- -- (Just (StringValue "Redundant do"))- -- (Just "hlint")- -- "Redundant do\nFound:\n do putStrLn \"hello\"\nWhy not:\n putStrLn \"hello\"\n"- -- Nothing- -- ]- -- }- -- )- -- let args' = H.fromList [("pos", toJSON (Position 7 0)), ("file", toJSON testUri)]- -- args = List [Object args']- --- -- executeRsp <- request WorkspaceExecuteCommand (ExecuteCommandParams "hare:demote" (Just args) Nothing)- -- liftIO $ executeRsp ^. result @?= Just (Object H.empty)-- -- editReq <- message :: Session ApplyWorkspaceEditRequest- -- let expectedTextEdits = List [TextEdit (Range (Position 6 0) (Position 7 6)) " where\n bb = 5"]- -- expectedTextDocEdits = List [TextDocumentEdit (VersionedTextDocumentIdentifier testUri (Just 0)) expectedTextEdits]- -- liftIO $ editReq ^. params . edit @?= WorkspaceEdit- -- Nothing- -- (Just expectedTextDocEdits)- -- , multiServerTests- , multiMainTests- ]----TODO: Does not compile--- multiServerTests :: TestTree--- multiServerTests = testGroup "multi-server setup" [--- testCase "doesn't have clashing commands on two servers" $ do--- let getCommands = runSession hlsCommand fullCaps "test/testdata" $ do--- rsp <- initializeResponse--- let uuids = rsp ^? result . _Just . capabilities . executeCommandProvider . _Just . commands--- return $ fromJust uuids--- List uuids1 <- getCommands--- List uuids2 <- getCommands--- liftIO $ forM_ (zip uuids1 uuids2) (uncurry shouldNotBe)--- ]--multiMainTests :: TestTree-multiMainTests = testGroup "multiple main modules" [- ignoreTestBecause "Broken: Unexpected ConduitParser.empty" $- testCase "Can load one file at a time, when more than one Main module exists"- $ runSession hlsCommand fullCaps "test/testdata" $ do- _doc <- openDoc "ApplyRefact2.hs" "haskell"- _diagsRspHlint <- skipManyTill anyNotification (message SMethod_TextDocumentPublishDiagnostics)- diagsRspGhc <- skipManyTill anyNotification (message SMethod_TextDocumentPublishDiagnostics)- let diags = diagsRspGhc ^. params . diagnostics-- liftIO $ length diags @?= 2-- _doc2 <- openDoc "HaReRename.hs" "haskell"- _diagsRspHlint2 <- skipManyTill anyNotification (message SMethod_TextDocumentPublishDiagnostics)- -- errMsg <- skipManyTill anyNotification notification :: Session ShowMessageNotification- diagsRsp2 <- skipManyTill anyNotification (message SMethod_TextDocumentPublishDiagnostics)- let diags2 = diagsRsp2 ^. params . diagnostics-- liftIO $ show diags2 @?= "[]"- ]
− test/functional/Definition.hs
@@ -1,89 +0,0 @@-module Definition (tests) where--import Control.Lens-import Language.LSP.Protocol.Lens-import System.Directory-import Test.Hls-import Test.Hls.Command--tests :: TestTree-tests = testGroup "definitions" [symbolTests, moduleTests]--symbolTests :: TestTree-symbolTests = testGroup "gotoDefinition on symbols"- -- gotoDefinition where the definition is in the same file- [ testCase "gotoDefinition in this file" $ runSession hlsCommand fullCaps "test/testdata" $ do- doc <- openDoc "References.hs" "haskell"- defs <- getDefinitions doc (Position 7 8)- let expRange = Range (Position 4 0) (Position 4 3)- liftIO $ defs @?= InL (Definition (InR [Location (doc ^. uri) expRange]))-- -- gotoDefinition where the definition is in a different file- , testCase "gotoDefinition in other file" $ runSession hlsCommand fullCaps "test/testdata/definition" $ do- doc <- openDoc "Foo.hs" "haskell"- defs <- getDefinitions doc (Position 4 11)- let expRange = Range (Position 2 0) (Position 2 1)- liftIO $ do- fp <- canonicalizePath "test/testdata/definition/Bar.hs"- defs @?= InL (Definition (InR [Location (filePathToUri fp) expRange]))-- -- gotoDefinition where the definition is in a different file and the- -- definition in the other file is on a line number that is greater- -- than the number of lines in the file we are requesting from- , testCase "gotoDefinition in other file past lines in this file" $ runSession hlsCommand fullCaps "test/testdata/definition" $ do- doc <- openDoc "Foo.hs" "haskell"- defs <- getDefinitions doc (Position 5 13)- let expRange = Range (Position 8 0) (Position 8 1)- liftIO $ do- fp <- canonicalizePath "test/testdata/definition/Bar.hs"- defs @?= InL (Definition (InR [Location (filePathToUri fp) expRange]))- ]-- -- -------------------------------------moduleTests :: TestTree-moduleTests = testGroup "gotoDefinition on modules"- [ ignoreTestBecause "Broken: file:///Users/jwindsor/src/haskell-language-server/test/testdata/Bar.hs" $- testCase "goto's imported modules" $ runSession hlsCommand fullCaps "test/testdata/definition" $ do- doc <- openDoc "Foo.hs" "haskell"- defs <- getDefinitions doc (Position 2 8)- liftIO $ do- fp <- canonicalizePath "test/testdata/definition/Bar.hs"- defs @?= InL (Definition (InR [Location (filePathToUri fp) zeroRange]))-- , ignoreTestBecause "Broken: file:///Users/jwindsor/src/haskell-language-server/test/testdata/Bar.hs" $- testCase "goto's exported modules" $ runSession hlsCommand fullCaps "test/testdata/definition" $ do- doc <- openDoc "Foo.hs" "haskell"- defs <- getDefinitions doc (Position 0 15)- liftIO $ do- fp <- canonicalizePath "test/testdata/definition/Bar.hs"- defs @?= InL (Definition (InR [Location (filePathToUri fp) zeroRange]))-- , ignoreTestBecause "Broken: file:///Users/jwindsor/src/haskell-language-server/test/testdata/Bar.hs" $- testCase "goto's imported modules that are loaded" $ runSession hlsCommand fullCaps "test/testdata/definition" $ do- doc <- openDoc "Foo.hs" "haskell"- _ <- openDoc "Bar.hs" "haskell"- defs <- getDefinitions doc (Position 2 8)- liftIO $ do- fp <- canonicalizePath "test/testdata/definition/Bar.hs"- defs @?= InL (Definition (InR [Location (filePathToUri fp) zeroRange]))-- , ignoreTestBecause "Broken: file:///Users/jwindsor/src/haskell-language-server/test/testdata/Bar.hs" $- testCase "goto's imported modules that are loaded, and then closed" $- runSession hlsCommand fullCaps "test/testdata/definition" $ do- doc <- openDoc "Foo.hs" "haskell"- otherDoc <- openDoc "Bar.hs" "haskell"- closeDoc otherDoc- defs <- getDefinitions doc (Position 2 8)- _ <- waitForDiagnostics- liftIO $ putStrLn "D"- liftIO $ do- fp <- canonicalizePath "test/testdata/definition/Bar.hs"- defs @?= InL (Definition (InR [Location (filePathToUri fp) zeroRange]))- liftIO $ putStrLn "E" -- AZ-- noDiagnostics- ]--zeroRange :: Range-zeroRange = Range (Position 0 0) (Position 0 0)
− test/functional/Diagnostic.hs
@@ -1,24 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Diagnostic (tests) where--import Control.Lens hiding (List)-import qualified Language.LSP.Protocol.Lens as L-import Test.Hls-import Test.Hls.Command---- -----------------------------------------------------------------------tests :: TestTree-tests = testGroup "diagnostics providers" [ warningTests ]---warningTests :: TestTree-warningTests = testGroup "Warnings are warnings" [- testCase "Overrides -Werror" $- runSession hlsCommand fullCaps "test/testdata/wErrorTest" $ do- doc <- openDoc "src/WError.hs" "haskell"- [diag] <- waitForDiagnosticsFrom doc- liftIO $ diag ^. L.severity @?= Just DiagnosticSeverity_Warning- ]-
test/functional/Format.hs view
@@ -4,10 +4,8 @@ import Control.Lens ((^.)) import Control.Monad.IO.Class-import qualified Data.ByteString.Lazy as BS import Data.Functor (void) import qualified Data.Text as T-import qualified Data.Text.Encoding as T import qualified Data.Text.IO as T import Ide.Types import qualified Language.LSP.Protocol.Lens as L@@ -19,34 +17,13 @@ requiresOrmoluPlugin) tests :: TestTree-tests = testGroup "format document" [- requiresOrmoluPlugin $ goldenGitDiff "works" "test/testdata/format/Format.formatted_document.hs" $ runSession hlsCommand fullCaps "test/testdata/format" $ do- doc <- openDoc "Format.hs" "haskell"- formatDoc doc (FormattingOptions 2 True Nothing Nothing Nothing)- BS.fromStrict . T.encodeUtf8 <$> documentContents doc- , requiresOrmoluPlugin $ goldenGitDiff "works with custom tab size" "test/testdata/format/Format.formatted_document_with_tabsize.hs" $ runSession hlsCommand fullCaps "test/testdata/format" $ do- doc <- openDoc "Format.hs" "haskell"- formatDoc doc (FormattingOptions 5 True Nothing Nothing Nothing)- BS.fromStrict . T.encodeUtf8 <$> documentContents doc- , rangeTests- , providerTests- ]--rangeTests :: TestTree-rangeTests = requiresOrmoluPlugin $ testGroup "format range" [- goldenGitDiff "works" "test/testdata/format/Format.formatted_range.hs" $ runSession hlsCommand fullCaps "test/testdata/format" $ do- doc <- openDoc "Format.hs" "haskell"- formatRange doc (FormattingOptions 2 True Nothing Nothing Nothing) (Range (Position 5 0) (Position 7 10))- BS.fromStrict . T.encodeUtf8 <$> documentContents doc- , goldenGitDiff "works with custom tab size" "test/testdata/format/Format.formatted_range_with_tabsize.hs" $ runSession hlsCommand fullCaps "test/testdata/format" $ do- doc <- openDoc "Format.hs" "haskell"- formatRange doc (FormattingOptions 5 True Nothing Nothing Nothing) (Range (Position 8 0) (Position 11 19))- BS.fromStrict . T.encodeUtf8 <$> documentContents doc+tests = testGroup "format document"+ [ providerTests ] providerTests :: TestTree-providerTests = testGroup "formatting provider" [- testCase "respects none" $ runSessionWithConfig (formatConfig "none") hlsCommand fullCaps "test/testdata/format" $ do+providerTests = testGroup "lsp formatting provider"+ [ testCase "respects none" $ runSessionWithConfig (formatConfig "none") hlsCommand fullCaps "test/testdata/format" $ do void configurationRequest doc <- openDoc "Format.hs" "haskell" resp <- request SMethod_TextDocumentFormatting $ DocumentFormattingParams Nothing doc (FormattingOptions 2 True Nothing Nothing Nothing)
test/functional/FunctionalBadProject.hs view
@@ -16,7 +16,7 @@ doc <- openDoc "src/MyLib.hs" "haskell" [diag] <- waitForDiagnosticsFrom doc liftIO $ assertBool "missing module name" $ "MyLib" `T.isInfixOf` (diag ^. L.message)- liftIO $ assertBool "module missing context" $ "may not be listed" `T.isInfixOf` (diag ^. L.message)+ liftIO $ assertBool "module missing context" $ "may not be listed" `T.isInfixOf` (diag ^. L.message) , testCase "Missing module diagnostic - no matching prefix" $ do runSession hlsCommand fullCaps "test/testdata/missingModuleTest/noPrefixMatch/" $ do doc <- openDoc "app/Other.hs" "haskell"
− test/functional/FunctionalCodeAction.hs
@@ -1,416 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE OverloadedStrings #-}--module FunctionalCodeAction (tests) where--import Control.Lens hiding (List)-import Control.Monad-import Data.Aeson.Lens (_Object)-import Data.List-import Data.Maybe-import qualified Data.Text as T-import Development.IDE.Core.Compile (sourceTypecheck)-import Development.IDE.Test (configureCheckProject)-import Ide.Plugin.Config-import qualified Language.LSP.Protocol.Lens as L-import Language.LSP.Test as Test-import Test.Hls-import Test.Hls.Command-import Test.Hspec.Expectations--{-# ANN module ("HLint: ignore Reduce duplication"::String) #-}--tests :: TestTree-tests = testGroup "code actions" [-#if hls_refactor- importTests- , ignoreInEnv [HostOS Windows, GhcVer GHC94] "Diagnostic failure for Windows-ghc9.4.2" importQualifiedTests- , ignoreInEnv [HostOS Windows, GhcVer GHC94] "Diagnostic failure for Windows-ghc9.4.2" importQualifiedPostTests- , packageTests- , redundantImportTests- , renameTests- , signatureTests- , typedHoleTests- , unusedTermTests-#endif- ]--renameTests :: TestTree-renameTests = testGroup "rename suggestions" [- testCase "works" $ runSession hlsCommand noLiteralCaps "test/testdata" $ do- doc <- openDoc "CodeActionRename.hs" "haskell"-- _ <- waitForDiagnosticsFromSource doc (T.unpack sourceTypecheck)-- cars <- getAllCodeActions doc- replaceButStrLn <- liftIO $ inspectCommand cars ["Replace with", "putStrLn"]- executeCommand replaceButStrLn- _ <- anyRequest-- x:_ <- T.lines <$> documentContents doc- liftIO $ x @?= "main = putStrLn \"hello\""-- , testCase "doesn't give both documentChanges and changes"- $ runSession hlsCommand noLiteralCaps "test/testdata" $ do- configureCheckProject False- doc <- openDoc "CodeActionRename.hs" "haskell"-- _ <- waitForDiagnosticsFromSource doc (T.unpack sourceTypecheck)-- cars <- getAllCodeActions doc- cmd <- liftIO $ inspectCommand cars ["Replace with", "putStrLn"]- let mbArgs = cmd ^. L.arguments- case mbArgs of- Just [args] -> liftIO $ do- let editParams = args ^. ix "fallbackWorkspaceEdit" . _Object- (editParams & has (ix "changes")) @? "Contains changes"- not (editParams & has (ix "documentChanges")) @? "Doesn't contain documentChanges"- _ -> error $ "Unexpected arguments: " ++ show mbArgs-- executeCommand cmd- _ <- anyRequest-- x1:x2:_ <- T.lines <$> documentContents doc- liftIO $- x1 == "main = putStrLn \"hello\""- || x2 == "foo = putStrLn \"world\""- @? "One of the typos got fixed"- ]--importTests :: TestTree-importTests = testGroup "import suggestions" [- testCase "import works with 3.8 code action kinds" $ runSessionWithConfig (def {lspConfig = hlsConfigToClientConfig testConfig}) hlsCommand fullCaps "test/testdata" $ do- doc <- openDoc "CodeActionImport.hs" "haskell"-- (diag:_) <- waitForDiagnosticsFrom doc- liftIO $ diag ^. L.message @?= "Variable not in scope: when :: Bool -> IO () -> IO ()"-- actionsOrCommands <- getAllCodeActions doc- let actns = map fromAction actionsOrCommands-- importControlMonad <- liftIO $ inspectCodeAction actionsOrCommands ["import Control.Monad"]- liftIO $ do- expectCodeAction actionsOrCommands ["import Control.Monad (when)"]- length actns >= 10 @? "There are some actions"-- executeCodeAction importControlMonad-- contents <- documentContents doc- liftIO $ contents @?= "import Control.Monad\nmain :: IO ()\nmain = when True $ putStrLn \"hello\""- ]--importQualifiedTests :: TestTree-importQualifiedTests = testGroup "import qualified prefix suggestions" [- testCase "qualified import works with 3.8 code action kinds" $ runSessionWithConfig (def {lspConfig = hlsConfigToClientConfig testConfig}) hlsCommand fullCaps "test/testdata" $ do- doc <- openDoc "CodeActionImportQualified.hs" "haskell"- (diag:_) <- waitForDiagnosticsFrom doc- liftIO $ diag ^. L.message @?=- if ghcVersion >= GHC96- then "Variable not in scope: Control.when :: Bool -> IO () -> IO ()\nNB: no module named ‘Control’ is imported."- else "Not in scope: ‘Control.when’\nNo module named ‘Control’ is imported."-- actionsOrCommands <- getAllCodeActions doc- let actns = map fromAction actionsOrCommands-- let importQualifiedSuggestion = "import qualified Control.Monad as Control"- importControlMonadQualified <- liftIO $ inspectCodeAction actionsOrCommands [importQualifiedSuggestion]- liftIO $ do- dontExpectCodeAction actionsOrCommands ["import Control.Monad (when)"]- length actns >= 5 @? "There are some actions"-- executeCodeAction importControlMonadQualified-- contents <- documentContents doc- liftIO $ contents @?= "import qualified Control.Monad as Control\nmain :: IO ()\nmain = Control.when True $ putStrLn \"hello\"\n"- ]--importQualifiedPostTests :: TestTree-importQualifiedPostTests = testGroup "import qualified postfix suggestions" [- testCase "qualified import in postfix position works with 3.8 code action kinds" $ runSessionWithConfig (def {lspConfig = hlsConfigToClientConfig testConfig}) hlsCommand fullCaps "test/testdata" $ do- doc <- openDoc "CodeActionImportPostQualified.hs" "haskell"- (diag:_) <- waitForDiagnosticsFrom doc- liftIO $ diag ^. L.message @?=- if ghcVersion >= GHC96- then "Variable not in scope: Control.when :: Bool -> IO () -> IO ()\nNB: no module named ‘Control’ is imported."- else "Not in scope: ‘Control.when’\nNo module named ‘Control’ is imported."-- actionsOrCommands <- getAllCodeActions doc- let actns = map fromAction actionsOrCommands-- let importQualifiedPostSuggestion = "import Control.Monad qualified as Control"- importControlMonadQualified <- liftIO $ inspectCodeAction actionsOrCommands [importQualifiedPostSuggestion]- liftIO $ do- dontExpectCodeAction actionsOrCommands ["import qualified Control.Monad as Control", "import Control.Monad (when)"]- length actns >= 5 @? "There are some actions"-- executeCodeAction importControlMonadQualified-- contents <- documentContents doc- liftIO $ T.lines contents !! 2 @?= "import Control.Monad qualified as Control"- ]--packageTests :: TestTree-packageTests = testGroup "add package suggestions" [- ignoreTestBecause "no support for adding dependent packages via code action" $ testCase "adds to .cabal files" $ do- runSession hlsCommand fullCaps "test/testdata/addPackageTest/cabal-exe" $ do- doc <- openDoc "AddPackage.hs" "haskell"-- -- ignore the first empty hlint diagnostic publish- [_,diag:_] <- count 2 $ waitForDiagnosticsFrom doc-- let prefixes = [ "Could not load module `Data.Text'" -- Windows && GHC >= 8.6- , "Could not find module `Data.Text'" -- Windows- , "Could not load module ‘Data.Text’" -- GHC >= 8.6- , "Could not find module ‘Data.Text’"- ]- in liftIO $ any (`T.isPrefixOf` (diag ^. L.message)) prefixes @? "Contains prefix"-- acts <- getAllCodeActions doc- case acts of- (InR action:_) -> do- liftIO $ do- action ^. L.title @?= "Add text as a dependency"- action ^. L.kind @?= Just CodeActionKind_QuickFix- "package:add" `T.isSuffixOf` (action ^. L.command . _Just . L.command) @? "Command contains package:add"-- executeCodeAction action-- _ -> error $ "Unexpected code actions: " ++ show acts-- contents <- skipManyTill anyMessage $ getDocumentEdit . TextDocumentIdentifier =<< getDocUri "add-package-test.cabal"- liftIO $- any (\l -> "text -any" `T.isSuffixOf` l || "text : {} -any" `T.isSuffixOf` l) (T.lines contents) @? "Contains text package"-- , ignoreTestBecause "no support for adding dependent packages via code action" $ testCase "adds to hpack package.yaml files" $- runSession hlsCommand fullCaps "test/testdata/addPackageTest/hpack-exe" $ do- doc <- openDoc "app/Asdf.hs" "haskell"-- -- ignore the first empty hlint diagnostic publish- [_,_:diag:_] <- count 2 $ waitForDiagnosticsFrom doc-- let prefixes =- [ "Could not load module `Codec.Compression.GZip'" -- Windows && GHC >= 8.6- , "Could not find module `Codec.Compression.GZip'" -- Windows- , "Could not load module ‘Codec.Compression.GZip’" -- GHC >= 8.6- , "Could not find module ‘Codec.Compression.GZip’"- ]- in liftIO $ any (`T.isPrefixOf` (diag ^. L.message)) prefixes @? "Diagnostic contains message"-- mActions <- getAllCodeActions doc- let allActions = map fromAction mActions- action <- case allActions of- (a:_) -> pure a- _ -> liftIO $ assertFailure "Expected non-empty list of actions"-- liftIO $ do- action ^. L.title @?= "Add zlib as a dependency"- forM_ allActions $ \a -> a ^. L.kind @?= Just CodeActionKind_QuickFix- forM_ allActions $ \a -> "package:add" `T.isSuffixOf` (a ^. L.command . _Just . L.command) @? "Command contains package:add"-- executeCodeAction action-- contents <- skipManyTill anyMessage $ getDocumentEdit . TextDocumentIdentifier =<< getDocUri "package.yaml"- liftIO $ do- "zlib" `T.isSuffixOf` (T.lines contents !! 3) @? "Contains zlib"- "zlib" `T.isSuffixOf` (T.lines contents !! 21) @? "Does not contain zlib in unrelated component"- ]--redundantImportTests :: TestTree-redundantImportTests = testGroup "redundant import code actions" [- testCase "remove solitary redundant imports" $- runSession hlsCommand fullCaps "test/testdata/redundantImportTest/" $ do- doc <- openDoc "src/CodeActionRedundant.hs" "haskell"-- diags <- waitForDiagnosticsFromSource doc (T.unpack sourceTypecheck)- liftIO $ expectDiagnostic diags [ "The import of", "Data.List", "is redundant" ]- liftIO $ expectDiagnostic diags [ "Empty", "from module", "Data.Sequence" ]-- mActions <- getAllCodeActions doc-- let allActions = map fromAction mActions- actionTitles = map (view L.title) allActions-- liftIO $ actionTitles `shouldContain`- [ "Remove import"- , "Remove Empty from import"- , "Remove all redundant imports"- ]-- let mbRemoveAction = find (\x -> x ^. L.title == "Remove all redundant imports") allActions-- case mbRemoveAction of- Just removeAction -> do- liftIO $ do- forM_ allActions $ \a -> a ^. L.kind @?= Just CodeActionKind_QuickFix- forM_ allActions $ \a -> a ^. L.command @?= Nothing- forM_ allActions $ \a -> isJust (a ^. L.edit) @? "Has edit"-- executeCodeAction removeAction-- Nothing -> error $ "Unexpected code actions: " ++ show allActions-- -- No command/applyworkspaceedit should be here, since action- -- provides workspace edit property which skips round trip to- -- the server- contents <- documentContents doc- liftIO $ contents @?= T.unlines- [ "{-# OPTIONS_GHC -Wunused-imports #-}"- , "{-# LANGUAGE PatternSynonyms #-}"- , "module CodeActionRedundant where"- , "-- We need a non-reduntant import in the import list"- , "-- to properly test the removal of the singular redundant item"- , "import Data.Sequence (singleton)"- , "main :: IO ()"- , "main = putStrLn \"hello\""- , " where unused = Data.Sequence.singleton 42"- ]-- , testCase "doesn't touch other imports" $ runSession hlsCommand noLiteralCaps "test/testdata/redundantImportTest/" $ do- doc <- openDoc "src/MultipleImports.hs" "haskell"- _ <- waitForDiagnosticsFromSource doc (T.unpack sourceTypecheck)- cas <- getAllCodeActions doc- cmd <- liftIO $ inspectCommand cas ["redundant import"]- executeCommand cmd- _ <- anyRequest- contents <- documentContents doc- liftIO $ T.lines contents @?=- [ "{-# OPTIONS_GHC -Wunused-imports #-}"- , "module MultipleImports where"- , "import Data.Maybe"- , "foo :: Int"- , "foo = fromJust (Just 3)"- ]- ]---typedHoleTests :: TestTree-typedHoleTests = testGroup "typed hole code actions" [- testCase "works" $- runSessionWithConfig (def {lspConfig = hlsConfigToClientConfig testConfig}) hlsCommand fullCaps "test/testdata" $ do- doc <- openDoc "TypedHoles.hs" "haskell"- _ <- waitForDiagnosticsFromSource doc (T.unpack sourceTypecheck)- cas <- getAllCodeActions doc- liftIO $ do- expectCodeAction cas ["replace _ with minBound"]- expectCodeAction cas ["replace _ with foo _"]- replaceWithMaxBound <- liftIO $ inspectCodeAction cas ["replace _ with maxBound"]-- executeCodeAction replaceWithMaxBound-- contents <- documentContents doc-- liftIO $ contents @?= T.concat- [ "module TypedHoles where\n"- , "foo :: [Int] -> Int\n"- , "foo x = maxBound"- ]-- , testCase "shows more suggestions" $- runSessionWithConfig (def {lspConfig = hlsConfigToClientConfig testConfig}) hlsCommand fullCaps "test/testdata" $ do- doc <- openDoc "TypedHoles2.hs" "haskell"- _ <- waitForDiagnosticsFromSource doc (T.unpack sourceTypecheck)- cas <- getAllCodeActions doc-- liftIO $ do- expectCodeAction cas ["replace _ with foo2 _"]- expectCodeAction cas ["replace _ with A _"]- replaceWithStuff <- liftIO $ inspectCodeAction cas ["replace _ with stuff _"]-- executeCodeAction replaceWithStuff-- contents <- documentContents doc-- liftIO $ T.lines contents @?=- [ "module TypedHoles2 (foo2) where"- , "newtype A = A Int"- , "foo2 :: [A] -> A"- , "foo2 x = (stuff _)"- , " where"- , " stuff (A a) = A (a + 1)"- ]- ]--signatureTests :: TestTree-signatureTests = testGroup "missing top level signature code actions" [- testCase "Adds top level signature" $- runSession hlsCommand fullCaps "test/testdata/" $ do- doc <- openDoc "TopLevelSignature.hs" "haskell"-- _ <- waitForDiagnosticsFromSource doc (T.unpack sourceTypecheck)- cas <- getAllCodeActions doc-- liftIO $ expectCodeAction cas ["add signature: main :: IO ()"]-- replaceWithStuff <- liftIO $ inspectCodeAction cas ["add signature"]- executeCodeAction replaceWithStuff-- contents <- documentContents doc-- let expected = [ "{-# OPTIONS_GHC -Wall #-}"- , "module TopLevelSignature where"- , "main :: IO ()"- , "main = do"- , " putStrLn \"Hello\""- , " return ()"- ]-- liftIO $ T.lines contents @?= expected- ]--unusedTermTests :: TestTree-unusedTermTests = testGroup "unused term code actions" [- ignoreTestBecause "no support for prefixing unused names with _" $ testCase "Prefixes with '_'" $- runSession hlsCommand fullCaps "test/testdata/" $ do- doc <- openDoc "UnusedTerm.hs" "haskell"-- _ <- waitForDiagnosticsFromSource doc (T.unpack sourceTypecheck)- cars <- getAllCodeActions doc- prefixImUnused <- liftIO $ inspectCodeAction cars ["Prefix imUnused with _"]-- executeCodeAction prefixImUnused-- edit <- skipManyTill anyMessage $ getDocumentEdit doc-- let expected = [ "{-# OPTIONS_GHC -Wall #-}"- , "module UnusedTerm () where"- , "_imUnused :: Int -> Int"- , "_imUnused 1 = 1"- , "_imUnused 2 = 2"- , "_imUnused _ = 3"- ]-- liftIO $ edit @?= T.unlines expected-- -- See https://microsoft.github.io/language-server-protocol/specifications/specification-3-15/#textDocument_codeAction- -- `CodeActionContext`- , testCase "respect 'only' parameter" $ runSession hlsCommand fullCaps "test/testdata" $ do- doc <- openDoc "CodeActionOnly.hs" "haskell"- _ <- waitForDiagnosticsFrom doc- diags <- getCurrentDiagnostics doc- let params = CodeActionParams Nothing Nothing doc (Range (Position 1 0) (Position 4 0)) caContext- caContext = CodeActionContext diags (Just [CodeActionKind_Refactor]) Nothing- caContextAllActions = CodeActionContext diags Nothing Nothing- -- Verify that we get code actions of at least two different kinds.- TResponseMessage _ _ (Right res)- <- request SMethod_TextDocumentCodeAction (params & L.context .~ caContextAllActions)- liftIO $ do- let cas = map fromAction $ absorbNull res- kinds = map (^. L.kind) cas- assertBool "Test precondition failed" $ Just CodeActionKind_QuickFix `elem` kinds- -- Verify that that when we set the only parameter, we only get actions- -- of the right kind.- TResponseMessage _ _ (Right res) <- request SMethod_TextDocumentCodeAction params- liftIO $ do- let cas = map fromAction $ absorbNull res- kinds = map (^. L.kind) cas- assertBool "Quick fixes should have been filtered out"- $ Just CodeActionKind_QuickFix `notElem` kinds- ]--testConfig :: Config-testConfig = def {- formattingProvider = "none"- }--
− test/functional/Highlight.hs
@@ -1,22 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Highlight (tests) where--import Test.Hls-import Test.Hls.Command--tests :: TestTree-tests = testGroup "highlight" [- testCase "works" $ runSession (hlsCommand ++ " --test") fullCaps "test/testdata" $ do- doc <- openDoc "Highlight.hs" "haskell"- _ <- waitForDiagnosticsFrom doc- highlights <- getHighlights doc (Position 2 2)- liftIO $ do- let hls =- [ DocumentHighlight (mkRange 2 0 2 3) (Just DocumentHighlightKind_Write)- , DocumentHighlight (mkRange 4 22 4 25) (Just DocumentHighlightKind_Read)- , DocumentHighlight (mkRange 3 6 3 9) (Just DocumentHighlightKind_Read)- , DocumentHighlight (mkRange 1 0 1 3) (Just DocumentHighlightKind_Read)]- mapM_ (\x -> x `elem` highlights @? "Contains highlight") hls- ]- where- mkRange sl sc el ec = Range (Position sl sc) (Position el ec)
test/functional/Main.hs view
@@ -1,39 +1,17 @@ module Main where -import Command-import Completion import Config-import Deferred-import Definition-import Diagnostic import Format import FunctionalBadProject-import FunctionalCodeAction import HieBios-import Highlight import Progress-import Reference-import Symbol import Test.Hls-import TypeDefinition main :: IO ()-main = defaultTestRunner- $ testGroup- "haskell-language-server"- [ Command.tests- , Completion.tests- , Config.tests- , ignoreInEnv [HostOS Windows, GhcVer GHC90] "Tests gets stuck in ci" $ Deferred.tests- , Definition.tests- , Diagnostic.tests- , ignoreInEnv [HostOS Windows, GhcVer GHC90, GhcVer GHC92] "Tests gets stuck in ci" $ Format.tests- , FunctionalBadProject.tests- , FunctionalCodeAction.tests- , HieBios.tests- , Highlight.tests- , ignoreInEnv [HostOS Windows, GhcVer GHC90] "Tests gets stuck in ci" $ Progress.tests- , Reference.tests- , ignoreInEnv [HostOS Windows, GhcVer GHC90] "Tests gets stuck in ci" $ Symbol.tests- , TypeDefinition.tests- ]+main = defaultTestRunner $ testGroup "haskell-language-server"+ [ Config.tests+ , ignoreInEnv [HostOS Windows, GhcVer GHC90, GhcVer GHC92] "Tests gets stuck in ci" $ Format.tests+ , FunctionalBadProject.tests+ , HieBios.tests+ , ignoreInEnv [HostOS Windows, GhcVer GHC90] "Tests gets stuck in ci" $ Progress.tests+ ]
test/functional/Progress.hs view
@@ -18,7 +18,6 @@ import Ide.Types import Language.LSP.Protocol.Capabilities import qualified Language.LSP.Protocol.Lens as L-import System.FilePath ((</>)) import Test.Hls import Test.Hls.Command import Test.Hls.Flags@@ -29,10 +28,10 @@ testGroup "window/workDoneProgress" [ testCase "sends indefinite progress notifications" $- runSession hlsCommand progressCaps "test/testdata" $ do- let path = "diagnostics" </> "Foo.hs"+ runSession hlsCommand progressCaps "test/testdata/diagnostics" $ do+ let path = "Foo.hs" _ <- openDoc path "haskell"- expectProgressMessages [pack ("Setting up testdata (for " ++ path ++ ")"), "Processing", "Indexing"] []+ expectProgressMessages [pack ("Setting up diagnostics (for " ++ path ++ ")"), "Processing", "Indexing"] [] , requiresEvalPlugin $ testCase "eval plugin sends progress reports" $ runSession hlsCommand progressCaps "plugins/hls-eval-plugin/test/testdata" $ do doc <- openDoc "T1.hs" "haskell"
− test/functional/Reference.hs
@@ -1,31 +0,0 @@-module Reference (tests) where--import Control.Lens-import Data.Coerce-import Data.List-import Language.LSP.Protocol.Lens-import Test.Hls-import Test.Hls.Command--tests :: TestTree-tests = testGroup "references" [- ignoreTestBecause "Broken" $ testCase "works with definitions" $ runSession hlsCommand fullCaps "test/testdata" $ do- doc <- openDoc "References.hs" "haskell"- let pos = Position 2 7 -- foo = bar <--- refs <- getReferences doc pos True- liftIO $ map (Location (doc ^. uri)) [- mkRange 4 0 4 3- , mkRange 8 11 8 14- , mkRange 7 7 7 10- , mkRange 4 14 4 17- , mkRange 4 0 4 3- , mkRange 2 6 2 9- ] `isInfixOf` coerce refs @? "Contains references"- -- TODO: Respect withDeclaration parameter- -- ignoreTestBecause "Broken" $ testCase "works without definitions" $ runSession hlsCommand fullCaps "test/testdata" $ do- -- doc <- openDoc "References.hs" "haskell"- -- let pos = Position 2 7 -- foo = bar <--- -- refs <- getReferences doc pos False- -- liftIO $ refs `shouldNotContain` [Location (doc ^. uri) (mkRange 4 0 4 3)]- ]- where mkRange sl sc el ec = Range (Position sl sc) (Position el ec)
− test/functional/Symbol.hs
@@ -1,150 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Symbol (tests) where--import Control.Lens (_Just, ix, (^?))-import Data.List-import Language.LSP.Protocol.Capabilities-import qualified Language.LSP.Protocol.Lens as L-import Language.LSP.Test as Test-import Test.Hls-import Test.Hls.Command--tests :: TestTree-tests = testGroup "document symbols" [- pre310Tests- , v310Tests- ]--v310Tests :: TestTree-v310Tests = testGroup "3.10 hierarchical document symbols" [- testCase "provides nested data types and constructors" $ runSession hlsCommand fullCaps "test/testdata" $ do- doc <- openDoc "Symbols.hs" "haskell"- Right symbs <- getDocumentSymbols doc-- let myData = DocumentSymbol "MyData" Nothing SymbolKind_Struct Nothing Nothing myDataR myDataSR (Just [a, b])- a = DocumentSymbol "A" Nothing SymbolKind_Constructor Nothing Nothing aR aSR Nothing- b = DocumentSymbol "B" Nothing SymbolKind_Constructor Nothing Nothing bR bSR Nothing- let myData' = symbs ^? ix 0 . L.children . _Just . ix 2-- liftIO $ Just myData == myData' @? "Contains symbol"-- , ignoreTestBecause "extracting symbols from nested wheres not supported" $ testCase "provides nested where functions" $ runSession hlsCommand fullCaps "test/testdata" $ do- doc <- openDoc "Symbols.hs" "haskell"- Right symbs <- getDocumentSymbols doc-- let foo = DocumentSymbol "foo" Nothing SymbolKind_Function Nothing Nothing fooR fooSR (Just [bar])- bar = DocumentSymbol "bar" Nothing SymbolKind_Function Nothing Nothing barR barSR (Just [dog, cat])- dog = DocumentSymbol "dog" Nothing SymbolKind_Variable Nothing Nothing dogR dogSR (Just mempty)- cat = DocumentSymbol "cat" Nothing SymbolKind_Variable Nothing Nothing catR catSR (Just mempty)- let foo' = symbs ^? ix 0 . L.children . _Just . ix 1-- liftIO $ Just foo == foo' @? "Contains symbol"-- , ignoreTestBecause "extracting pattern synonym symbols not supported" $ testCase "provides pattern synonyms" $ runSession hlsCommand fullCaps "test/testdata" $ do- doc <- openDoc "Symbols.hs" "haskell"- Right symbs <- getDocumentSymbols doc-- let testPattern = DocumentSymbol "TestPattern"- Nothing SymbolKind_Function Nothing Nothing testPatternR testPatternSR (Just mempty)- let testPattern' = symbs ^? ix 0 . L.children . _Just . ix 3-- liftIO $ Just testPattern == testPattern' @? "Contains symbol"-- , testCase "provides imports" $ runSession hlsCommand fullCaps "test/testdata" $ do- doc <- openDoc "Symbols.hs" "haskell"- Right symbs <- getDocumentSymbols doc-- let imports = DocumentSymbol "imports" Nothing SymbolKind_Module Nothing Nothing importsR importsSR (Just [importDataMaybe])- importDataMaybe = DocumentSymbol "import Data.Maybe" Nothing SymbolKind_Module Nothing Nothing importDataMaybeR importDataMaybeSR Nothing- let imports' = symbs ^? ix 0 . L.children . _Just . ix 0-- liftIO $ Just imports == imports' @? "Contains symbol"- ]--pre310Tests :: TestTree-pre310Tests = testGroup "pre 3.10 symbol information" [- testCase "provides nested data types and constructors" $ runSession hlsCommand oldCaps "test/testdata" $ do- doc@(TextDocumentIdentifier testUri) <- openDoc "Symbols.hs" "haskell"- Left symbs <- getDocumentSymbols doc-- let myData = SymbolInformation "MyData" SymbolKind_Struct Nothing (Just "Symbols") Nothing (Location testUri myDataR)- a = SymbolInformation "A" SymbolKind_Constructor Nothing (Just "MyData") Nothing (Location testUri aR)- b = SymbolInformation "B" SymbolKind_Constructor Nothing (Just "MyData") Nothing (Location testUri bR)-- liftIO $ [myData, a, b] `isInfixOf` symbs @? "Contains symbols"-- , ignoreTestBecause "extracting symbols from nested wheres not supported" $ testCase "provides nested where functions" $ runSession hlsCommand oldCaps "test/testdata" $ do- doc@(TextDocumentIdentifier testUri) <- openDoc "Symbols.hs" "haskell"- Left symbs <- getDocumentSymbols doc-- let foo = SymbolInformation "foo" SymbolKind_Function Nothing (Just "Symbols") Nothing (Location testUri fooR)- bar = SymbolInformation "bar" SymbolKind_Function Nothing (Just "foo") Nothing (Location testUri barR)- dog = SymbolInformation "dog" SymbolKind_Variable Nothing (Just "bar") Nothing (Location testUri dogR)- cat = SymbolInformation "cat" SymbolKind_Variable Nothing (Just "bar") Nothing (Location testUri catR)-- -- Order is important!- liftIO $ [foo, bar, dog, cat] `isInfixOf` symbs @? "Contains symbols"-- , ignoreTestBecause "extracting pattern synonym symbols not supported" $ testCase "provides pattern synonyms" $ runSession hlsCommand oldCaps "test/testdata" $ do- doc@(TextDocumentIdentifier testUri) <- openDoc "Symbols.hs" "haskell"- Left symbs <- getDocumentSymbols doc-- let testPattern = SymbolInformation "TestPattern"- SymbolKind_Function Nothing (Just "Symbols") Nothing (Location testUri testPatternR)-- liftIO $ testPattern `elem` symbs @? "Contains symbols"-- , testCase "provides imports" $ runSession hlsCommand oldCaps "test/testdata" $ do- doc@(TextDocumentIdentifier testUri) <- openDoc "Symbols.hs" "haskell"- Left symbs <- getDocumentSymbols doc-- let imports = SymbolInformation "imports" SymbolKind_Module Nothing (Just "Symbols") Nothing (Location testUri importsR)- importDataMaybe = SymbolInformation "import Data.Maybe" SymbolKind_Module Nothing (Just "imports") Nothing (Location testUri importDataMaybeR)-- liftIO $ [imports, importDataMaybe] `isInfixOf` symbs @? "Contains symbol"- ]--oldCaps :: ClientCapabilities-oldCaps = capsForVersion (LSPVersion 3 9)---- Some common ranges and selection ranges in Symbols.hs-importsR :: Range-importsR = Range (Position 3 0) (Position 3 17)-importsSR :: Range-importsSR = Range (Position 3 0) (Position 3 17)-importDataMaybeR :: Range-importDataMaybeR = Range (Position 3 0) (Position 3 17)-importDataMaybeSR :: Range-importDataMaybeSR = Range (Position 3 0) (Position 3 17)-fooSR :: Range-fooSR = Range (Position 5 0) (Position 7 43)-fooR :: Range-fooR = Range (Position 5 0) (Position 7 43)-barSR :: Range-barSR = Range (Position 6 8) (Position 6 11)-barR :: Range-barR = Range (Position 6 8) (Position 7 43)-dogSR :: Range-dogSR = Range (Position 7 17) (Position 7 20)-dogR :: Range-dogR = Range (Position 7 16) (Position 7 43)-catSR :: Range-catSR = Range (Position 7 22) (Position 7 25)-catR :: Range-catR = Range (Position 7 16) (Position 7 43)-myDataSR :: Range-myDataSR = Range (Position 9 0) (Position 10 22)-myDataR :: Range-myDataR = Range (Position 9 0) (Position 10 22)-aSR :: Range-aSR = Range (Position 9 14) (Position 9 15)-aR :: Range-aR = Range (Position 9 14) (Position 9 19)-bSR :: Range-bSR = Range (Position 10 14) (Position 10 15)-bR :: Range-bR = Range (Position 10 14) (Position 10 22)-testPatternSR :: Range-testPatternSR = Range (Position 13 8) (Position 13 19)-testPatternR :: Range-testPatternR = Range (Position 13 0) (Position 13 27)
− test/functional/TypeDefinition.hs
@@ -1,42 +0,0 @@-module TypeDefinition (tests) where--import Data.Tuple.Extra (first3)-import System.FilePath ((</>))-import Test.Hls-import Test.Hls.Command--tests :: TestTree-tests = testGroup "type definitions" [- testCase "finds local definition of record variable"- $ getTypeDefinitionTest' 10 23 7 0- , testCase "finds local definition of newtype variable"- $ getTypeDefinitionTest' 15 21 12 0- , testCase "finds local definition of sum type variable"- $ getTypeDefinitionTest' 20 13 17 0- , testCase "finds local definition of sum type constructor"- $ getTypeDefinitionTest' 23 7 17 0- , testCase "finds non-local definition of type def"- $ getTypeDefinitionTest' 29 19 26 0- , testCase "find local definition of type def"- $ getTypeDefinitionTest' 34 16 31 0- , testCase "find type-definition of type def in component"- $ getTypeDefinitionTest ("src/Lib2.hs", 12, 20) [("src/Lib.hs", 7, 0)]- , testCase "find definition of parameterized data type"- $ getTypeDefinitionTest ("src/Lib.hs", 39, 19) [ ("src/Lib.hs", 36, 0)- , ("src/Lib.hs", 38, 0)]- ]--definitionsPath :: FilePath-definitionsPath = "test/testdata/gototest"--getTypeDefinitionTest :: SymbolLocation -> [SymbolLocation] -> Assertion-getTypeDefinitionTest (symbolFile, symbolLine, symbolCol) definitionLocations =- failIfSessionTimeout . runSession (hlsCommand ++ " --test") fullCaps definitionsPath $ do- doc <- openDoc symbolFile "haskell"- InL (Definition (InR defs)) <- getTypeDefinitions doc $ Position symbolLine symbolCol- liftIO $ defs `expectSameLocations` map (first3 (definitionsPath </>)) definitionLocations--getTypeDefinitionTest' :: UInt -> UInt -> UInt -> UInt -> Assertion-getTypeDefinitionTest' symbolLine symbolCol definitionLine definitionCol =- getTypeDefinitionTest ("src/Lib.hs", symbolLine, symbolCol)- [("src/Lib.hs", definitionLine, definitionCol)]
− test/testdata/CodeActionImport.hs
@@ -1,2 +0,0 @@-main :: IO ()-main = when True $ putStrLn "hello"
− test/testdata/CodeActionImportPostQualified.hs
@@ -1,4 +0,0 @@-{-# LANGUAGE ImportQualifiedPost #-}-{-# OPTIONS_GHC -Wprepositive-qualified-module #-}-main :: IO ()-main = Control.when True $ putStrLn "hello"
− test/testdata/CodeActionImportQualified.hs
@@ -1,2 +0,0 @@-main :: IO ()-main = Control.when True $ putStrLn "hello"
− test/testdata/CodeActionOnly.hs
@@ -1,3 +0,0 @@-module CodeActionOnly where-foo = bar- where bar = id Nothing
− test/testdata/CodeActionRename.hs
@@ -1,2 +0,0 @@-main = butStrLn "hello"-foo = putStrn "world"
− test/testdata/FuncTest.hs
@@ -1,13 +0,0 @@-module Main where--main = putStrLn "hello"--foo :: Int-foo = bb--bb = 5--baz = do- putStrLn "hello"--f x = x+1
− test/testdata/FuncTestError.hs
@@ -1,15 +0,0 @@-module Main where--main = putStrLn "hello"--foo :: Int-foo = bb--bb = 5--bug -- no hlint returned because of this, despite redundant do below--baz = do- putStrLn "hello"--f x = x+1
− test/testdata/FuncTestFail.hs
@@ -1,2 +0,0 @@-main :: IO Int-main = return "yow
− test/testdata/Highlight.hs
@@ -1,5 +0,0 @@-module Highlight where-foo :: Int-foo = 3-bar = foo- where baz = let x = foo in id x
− test/testdata/Hover.hs
@@ -1,2 +0,0 @@-main :: IO Int-main = return $ sum [1,2,3]
− test/testdata/References.hs
@@ -1,9 +0,0 @@-main = return ()--foo = bar--bar = let x = bar 42 in const "hello"--baz = do- x <- bar 23- return $ bar 14
− test/testdata/Symbols.hs
@@ -1,14 +0,0 @@-{-# LANGUAGE PatternSynonyms #-}-module Symbols where--import Data.Maybe--foo = bar- where bar = 42 + dog- where (dog, cat) = (1234, "meow")--data MyData = A Int- | B String--pattern TestPattern :: Int -> MyData-pattern TestPattern x = A x
− test/testdata/TopLevelSignature.hs
@@ -1,5 +0,0 @@-{-# OPTIONS_GHC -Wall #-}-module TopLevelSignature where-main = do- putStrLn "Hello"- return ()
− test/testdata/TypedHoles.hs
@@ -1,3 +0,0 @@-module TypedHoles where-foo :: [Int] -> Int-foo x = _
− test/testdata/TypedHoles2.hs
@@ -1,6 +0,0 @@-module TypedHoles2 (foo2) where-newtype A = A Int-foo2 :: [A] -> A-foo2 x = _- where- stuff (A a) = A (a + 1)
− test/testdata/UnusedTerm.hs
@@ -1,6 +0,0 @@-{-# OPTIONS_GHC -Wall #-}-module UnusedTerm () where-imUnused :: Int -> Int-imUnused 1 = 1-imUnused 2 = 2-imUnused _ = 3
− test/testdata/addPackageTest/cabal-exe/AddPackage.hs
@@ -1,3 +0,0 @@-import Data.Text-foo = pack "I'm a Text"-main = putStrLn "hello"
− test/testdata/addPackageTest/cabal-exe/add-package-test.cabal
@@ -1,14 +0,0 @@-name: add-package-test-version: 0.1.0.0-license: BSD3-author: Luke Lau-maintainer: luke_lau@icloud.com-build-type: Simple-extra-source-files: ChangeLog.md-cabal-version: >=1.10--executable AddPackage- exposed-modules: ./.- main-is: AddPackage.hs- build-depends: base >=4.7 && <5- default-language: Haskell2010
− test/testdata/addPackageTest/cabal-lib/AddPackage.hs
@@ -1,4 +0,0 @@-module AddPackage where --import Data.Text-foo = pack "I'm a Text"
− test/testdata/addPackageTest/cabal-lib/add-package-test.cabal
@@ -1,14 +0,0 @@-name: add-package-test-version: 0.1.0.0-license: BSD3-author: Luke Lau-maintainer: luke_lau@icloud.com-build-type: Simple-extra-source-files: ChangeLog.md-cabal-version: >=1.10--library- exposed-modules: AddPackage- build-depends: base >=4.7 && <5- -- hs-source-dirs:- default-language: Haskell2010
− test/testdata/addPackageTest/hpack-exe/app/Asdf.hs
@@ -1,5 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--import Codec.Compression.GZip--main = return $ compress "hello"
− test/testdata/addPackageTest/hpack-exe/asdf.cabal
@@ -1,37 +0,0 @@-cabal-version: 1.12---- This file has been generated from package.yaml by hpack version 0.32.0.------ see: https://github.com/sol/hpack------ hash: 69241e1f4f912f034502d225d2017f035c38062080733108c11cd3d111cb9007--name: asdf-version: 0.1.0.0-description: Please see the README on GitHub at <https://github.com/githubuser/asdf#readme>-homepage: https://github.com/githubuser/asdf#readme-bug-reports: https://github.com/githubuser/asdf/issues-author: Author name here-maintainer: example@example.com-copyright: 2018 Author name here-license: BSD3-build-type: Simple-extra-source-files:- README.md- ChangeLog.md--source-repository head- type: git- location: https://github.com/githubuser/asdf--executable asdf-exe- main-is: Main.hs- other-modules:- Asdf- Paths_asdf- hs-source-dirs:- app- ghc-options: -threaded -rtsopts -with-rtsopts=-N- build-depends:- base >=4.7 && <5- default-language: Haskell2010
− test/testdata/addPackageTest/hpack-lib/app/Asdf.hs
@@ -1,7 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Asdf where--import Codec.Compression.GZip--main = return $ compress "hello"
− test/testdata/addPackageTest/invalid/AddPackage.hs
@@ -1,2 +0,0 @@-import Data.Text-foo = pack "I'm a Text"
− test/testdata/badProjects/cabal/Foo.hs
@@ -1,4 +0,0 @@-module Foo where--foo :: Int-foo = 3
− test/testdata/badProjects/cabal/bad-cabal.cabal
@@ -1,16 +0,0 @@-name: bad-cabal-version: 0.1.0.0-license: BSD3-author: Alan Zimmerman-maintainer: alan.zimm@gmail.com-build-type: Simple-extra-source-files: ChangeLog.md-cabal-version: >=1.10--library- exposed-modules: Foo- build-depends: base >=4.7 && <5- -- missing dependency- , does-not-exist- -- hs-source-dirs:- default-language: Haskell2010
− test/testdata/completion/AssociatedTypeFamily.hs
@@ -1,8 +0,0 @@-{-# LANGUAGE TypeFamilies #-}-module AssociatedTypeFamily () where--class C a where- type Fam a--x :: C a => a -> Fam a-x = undefined
− test/testdata/completion/Context.hs
@@ -1,4 +0,0 @@-module Context where-import Control.Concurrent as Conc-foo :: Int -> Int -> Conc.MVar-foo x = abs 42
− test/testdata/completion/DupRecFields.hs
@@ -1,5 +0,0 @@-{-# LANGUAGE DuplicateRecordFields #-}-module DupRecFields where--newtype One = One { accessor :: Int }-newtype Two = Two { accessor :: Int }
− test/testdata/completion/FunctionCompletions.hs
@@ -1,8 +0,0 @@-import Control.Applicative (Alternative)-import qualified Data.List--main :: IO ()-main = putStrLn "hello"--foo :: Either a b -> Either a b-foo = id
− test/testdata/completion/RecordDotSyntax.hs
@@ -1,28 +0,0 @@-{-# LANGUAGE OverloadedRecordDot #-}-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE NoFieldSelectors #-}--module Test where--import qualified Data.Maybe as M--data MyRecord = MyRecord1- { a :: String- , b :: Integer- , c :: MyChild- }- | MyRecord2 { a2 :: String- , b2 :: Integer- , c2 :: MyChild- } deriving (Eq, Show)--newtype MyChild = MyChild- { z :: String- } deriving (Eq, Show)--x = MyRecord1 { a = "Hello", b = 12, c = MyChild { z = "there" } }--y = x.a ++ show x.b --y2 = x.c.z -
− test/testdata/completion/completions.cabal
@@ -1,10 +0,0 @@-name: completions-version: 0.1.0.0-cabal-version: 2.0-build-type: Simple--executable compl-exe- other-modules: DupRecFields, Context- main-is: Completion.hs- default-language: Haskell2010- build-depends: base
test/testdata/completion/hie.yaml view
@@ -2,6 +2,4 @@ direct: arguments: - "Completion"- - "Context"- - "DupRecFields" - "FieldsSharingSignature"
− test/testdata/context/ExampleContext.hs
@@ -1,20 +0,0 @@-module ExampleContext (foo) where--import Data.List (find)-import Control.Monad hiding (fix)--foo :: Int -> Int-foo xs = bar xs + 1- where- bar :: Int -> Int- bar x = x + 2--data Foo a = Foo a - deriving (Show)--class Bar a where- bar :: a -> Integer--instance Integral a => Bar (Foo a) where- bar (Foo a) = toInteger a-
− test/testdata/context/Foo/Bar.hs
@@ -1,3 +0,0 @@-module Foo.Bar where--
− test/testdata/definition/Bar.hs
@@ -1,9 +0,0 @@-module Bar where--a = 42---- These blank lines are here--- to ensure that b is defined--- on a line number larger than--- the number of lines in Foo.hs.-b = 43
− test/testdata/definition/Foo.hs
@@ -1,6 +0,0 @@-module Foo (module Bar) where--import Bar--fortyTwo = a-fortyThree = b
− test/testdata/definition/definitions.cabal
@@ -1,10 +0,0 @@-name: definitions-version: 0.1.0.0-cabal-version: 2.0-build-type: Simple--library- exposed-modules: Foo- other-modules: Bar- default-language: Haskell2010- build-depends: base
− test/testdata/definition/hie.yaml
@@ -1,5 +0,0 @@-cradle:- direct:- arguments:- - "Foo"- - "Bar"
+ test/testdata/diagnostics/hie.yaml view
@@ -0,0 +1,5 @@+cradle:+ direct:+ arguments:+ - Foo+ - -Wmissing-signatures
+ test/testdata/format/hie.yaml view
@@ -0,0 +1,4 @@+cradle:+ direct:+ arguments:+ - Format
− test/testdata/gototest/hie.yaml
@@ -1,6 +0,0 @@-cradle:- direct:- arguments:- - "-i src/"- - "Lib"- - "Lib2"
− test/testdata/gototest/src/Lib.hs
@@ -1,40 +0,0 @@-module Lib-- where--someFunc :: IO ()-someFunc = putStrLn "someFunc"--data DataType = DataType Int--dataTypeId :: DataType -> DataType-dataTypeId dataType = dataType--newtype NewType = NewType Int--newTypeId :: NewType -> NewType-newTypeId newType = newType--data Enu = First | Second--enuId :: Enu -> Enu-enuId enu = enu--toNum :: Enu -> Int-toNum First = 1-toNum Second = 2--type MyInt = Int--myIntId :: MyInt -> MyInt-myIntId myInt = myInt--type TypEnu = Enu--typEnuId :: TypEnu -> TypEnu-typEnuId enu = enu--data Parameter a = Parameter a--parameterId :: Parameter a -> Parameter a-parameterId pid = pid
− test/testdata/gototest/src/Lib2.hs
@@ -1,13 +0,0 @@-module Lib2 where--import Lib--g = do- someFunc- print x- where z = 1+2- y = z+z- x = y*z--otherId :: DataType -> DataType-otherId dataType = dataType
− test/testdata/hie.yaml
@@ -1,12 +0,0 @@-cradle:- direct:- arguments:- - "-Wmissing-signatures"- - "CodeActionImport"- - "CodeActionOnly"- - "CodeActionRename"- - "Highlight"- - "Symbols"- - "TopLevelSignature"- - "TypedHoles"- - "TypedHoles2"
+ test/testdata/hieBiosMainIs/hie.yaml view
@@ -0,0 +1,2 @@+cradle:+ cabal:
− test/testdata/liquid/Evens.hs
@@ -1,41 +0,0 @@-module Main where--{-@ type Even = {v:Int | v mod 2 = 0} @-}--{-@ weAreEven :: [Even] @-}-weAreEven = [(0-10), (0-4), 0, 2, 666]--{-@ notEven :: Even @-}-notEven = 7--{-@ isEven :: n:Nat -> {v:Bool | (v <=> (n mod 2 == 0))} @-}-isEven :: Int -> Bool-isEven 0 = True-isEven 1 = False-isEven n = not (isEven (n-1))--{-@ evens :: n:Nat -> [Even] @-}-evens n = [i | i <- range 0 n, isEven i]--{-@ range :: lo:Int -> hi:Int -> [{v:Int | (lo <= v && v < hi)}] / [hi -lo] @-}-range lo hi- | lo < hi = lo : range (lo+1) hi- | otherwise = []--{-@ shift :: [Even] -> Even -> [Even] @-}-shift xs k = [x + k | x <- xs]--{-@ double :: [Nat] -> [Even] @-}-double xs = [x + x | x <- xs]---------notEven :: Int-weAreEven :: [Int]-shift :: [Int] -> Int -> [Int]-double :: [Int] -> [Int]-range :: Int -> Int -> [Int]--main = putStrLn "hello"
− test/testdata/redundantImportTest/hie.yaml
@@ -1,5 +0,0 @@-cradle:- direct:- arguments:- - "src/CodeActionRedundant"- - "src/MultipleImports"
− test/testdata/redundantImportTest/src/CodeActionRedundant.hs
@@ -1,10 +0,0 @@-{-# OPTIONS_GHC -Wunused-imports #-}-{-# LANGUAGE PatternSynonyms #-}-module CodeActionRedundant where-import Data.List--- We need a non-reduntant import in the import list--- to properly test the removal of the singular redundant item-import Data.Sequence (pattern Empty, singleton)-main :: IO ()-main = putStrLn "hello"- where unused = Data.Sequence.singleton 42
− test/testdata/redundantImportTest/src/MultipleImports.hs
@@ -1,6 +0,0 @@-{-# OPTIONS_GHC -Wunused-imports #-}-module MultipleImports where-import Data.Foldable-import Data.Maybe-foo :: Int-foo = fromJust (Just 3)
− test/testdata/redundantImportTest/test.cabal
@@ -1,18 +0,0 @@-name: test-version: 0.1.0.0--- synopsis:--- description:-license: BSD3-author: Author name here-maintainer: example@example.com-copyright: 2017 Author name here-category: Web-build-type: Simple-cabal-version: >=1.10--library- exposed-modules: CodeActionRedundant, MultipleImports- hs-source-dirs: src- build-depends: base >= 4.7 && < 5- default-language: Haskell2010- ghc-options: -Wall -fwarn-unused-imports
− test/testdata/testdata.cabal
@@ -1,37 +0,0 @@-name: testdata-version: 0.1.0.0-cabal-version: 2.0-build-type: Simple--executable codeactionrename- build-depends: base- main-is: CodeActionRename.hs- default-language: Haskell2010--executable codeactiononly- build-depends: base- main-is: CodeActionOnly.hs- default-language: Haskell2010----executable hover- build-depends: base- main-is: Hover.hs- default-language: Haskell2010--executable symbols- build-depends: base- main-is: Symbols.hs- default-language: Haskell2010--executable functests- build-depends: base- main-is: FuncTest.hs- default-language: Haskell2010--executable evens- build-depends: base- main-is: Evens.hs- hs-source-dirs: liquid- default-language: Haskell2010
− test/testdata/wErrorTest/cabal.project
@@ -1,1 +0,0 @@-packages: test.cabal
− test/testdata/wErrorTest/hie.yaml
@@ -1,4 +0,0 @@-cradle:- cabal:- - path: "src"- component: "lib:test"
− test/testdata/wErrorTest/src/WError.hs
@@ -1,3 +0,0 @@-module WError where-{-# ANN module "HLint: ignore" #-}-main = undefined
− test/testdata/wErrorTest/test.cabal
@@ -1,18 +0,0 @@-name: test-version: 0.1.0.0--- synopsis:--- description:-license: BSD3-author: Author name here-maintainer: example@example.com-copyright: 2017 Author name here-category: Web-build-type: Simple-cabal-version: >=1.10--library- exposed-modules: WError- hs-source-dirs: src- build-depends: base >= 4.7 && < 5- default-language: Haskell2010- ghc-options: -Wall -Werror
test/utils/Test/Hls/Command.hs view
@@ -1,19 +1,12 @@ module Test.Hls.Command- ( hlsCommand,- hlsCommandExamplePlugin,- hlsCommandVomit,- logFilePath,+ ( hlsCommand ) where import Data.Maybe (fromMaybe) import System.Environment (lookupEnv) import System.IO.Unsafe (unsafePerformIO)-import Test.Hls -logFilePath :: String-logFilePath = "hls-" ++ show ghcVersion ++ ".log"- -- | The command to execute the version of hls for the current compiler. -- -- Both @stack test@ and @cabal new-test@ setup the environment so @hls@ is@@ -24,9 +17,3 @@ hlsCommand = unsafePerformIO $ do testExe <- fromMaybe "haskell-language-server" <$> lookupEnv "HLS_TEST_EXE" pure $ testExe ++ " --lsp -d -j4"--hlsCommandVomit :: String-hlsCommandVomit = hlsCommand ++ " --vomit"--hlsCommandExamplePlugin :: String-hlsCommandExamplePlugin = hlsCommand ++ " --example"