From a2a230675103036c91ca6d6b51c090970a420d3b Mon Sep 17 00:00:00 2001 From: Jeff Windsor Date: Sun, 3 May 2020 19:02:01 -0700 Subject: [PATCH 01/26] Initial Structure --- haskell-language-server.cabal | 30 ++++++++++++++++++++++++++++++ hie.yaml.stack | 3 +++ test/src/Ide/Plugin/Brittany.hs | 18 ++++++++++++++++++ test/src/Main.hs | 12 ++++++++++++ test/src/TestUtil.hs | 13 +++++++++++++ 5 files changed, 76 insertions(+) create mode 100644 test/src/Ide/Plugin/Brittany.hs create mode 100644 test/src/Main.hs create mode 100644 test/src/TestUtil.hs diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 3f6e66e5e8..53d62576e6 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -205,6 +205,36 @@ executable haskell-language-server-wrapper , process default-language: Haskell2010 +test-suite tasty + import: agpl + type: exitcode-stdio-1.0 + default-language: Haskell2010 + build-tool-depends: + haskell-language-server:haskell-language-server + , cabal-helper:cabal-helper-main + , ghcide:ghcide-test-preprocessor + build-depends: + base >=4.7 && <5 + , aeson + , data-default + , haskell-lsp-types + , lens + , tasty + , tasty-hunit + , text + , unordered-containers + hs-source-dirs: test/src + main-is: Main.hs + other-modules: + Ide.Plugin.Brittany, + TestUtil + ghc-options: + -Wall + -Wno-name-shadowing + -threaded -rtsopts -with-rtsopts=-N + if flag(pedantic) + ghc-options: -Werror -Wredundant-constraints + test-suite func-test import: agpl diff --git a/hie.yaml.stack b/hie.yaml.stack index c0df7dc8fa..414c8ad769 100644 --- a/hie.yaml.stack +++ b/hie.yaml.stack @@ -6,6 +6,9 @@ cradle: - path: "./test/functional/" component: "haskell-language-server:func-test" + - path: "./test/src/" + component: "haskell-language-server:tasty" + # This target does not currently work (stack 2.1.3) # - path: "./test/utils" # component: "haskell-language-server:lib:hls-test-utils" diff --git a/test/src/Ide/Plugin/Brittany.hs b/test/src/Ide/Plugin/Brittany.hs new file mode 100644 index 0000000000..2aacebe266 --- /dev/null +++ b/test/src/Ide/Plugin/Brittany.hs @@ -0,0 +1,18 @@ +module Ide.Plugin.Brittany where + +import Test.Tasty +import Test.Tasty.HUnit + +tests :: TestTree +tests = testGroup "Brittany" [ + someTruth + ] + +someTruth :: TestTree +someTruth = testCase "List comparison (different length)" $ + compare a b @?= GT + where + a :: [Int] + a = [1,2,3] + b :: [Int] + b = [1,2] \ No newline at end of file diff --git a/test/src/Main.hs b/test/src/Main.hs new file mode 100644 index 0000000000..fccf5b2247 --- /dev/null +++ b/test/src/Main.hs @@ -0,0 +1,12 @@ +module Main where + +import Test.Tasty +import Ide.Plugin.Brittany (tests) + +main :: IO () +main = defaultMain tree + +tree :: TestTree +tree = testGroup "HIE" [ + Ide.Plugin.Brittany.tests + ] \ No newline at end of file diff --git a/test/src/TestUtil.hs b/test/src/TestUtil.hs new file mode 100644 index 0000000000..a7bac26970 --- /dev/null +++ b/test/src/TestUtil.hs @@ -0,0 +1,13 @@ +module TestUtil where + +import Test.Tasty.HUnit ( (@?=), assertBool, Assertion) + +(===) :: (Eq a, Show a) => a -> a -> Assertion +(===) = (@?=) +infixl 1 === + +assertTrue :: Assertion +assertTrue = assertBool "Success" True + +assertFalse :: String -> Assertion +assertFalse msg = assertBool msg False \ No newline at end of file From 56363ddca6716e7e5fea832158e4ee5e93c27bbf Mon Sep 17 00:00:00 2001 From: Jeff Windsor Date: Sat, 9 May 2020 11:53:12 -0700 Subject: [PATCH 02/26] Incorporate hls-test-utils --- haskell-language-server.cabal | 7 +++++-- test/src/Main.hs | 14 +++++++++++++- test/{src/TestUtil.hs => utils/TastyUtils.hs} | 6 +++++- 3 files changed, 23 insertions(+), 4 deletions(-) rename test/{src/TestUtil.hs => utils/TastyUtils.hs} (79%) diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 53d62576e6..28fc1bc084 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -218,7 +218,9 @@ test-suite tasty , aeson , data-default , haskell-lsp-types + , hls-test-utils , lens + , lsp-test >= 0.10.0.0 , tasty , tasty-hunit , text @@ -226,8 +228,7 @@ test-suite tasty hs-source-dirs: test/src main-is: Main.hs other-modules: - Ide.Plugin.Brittany, - TestUtil + Ide.Plugin.Brittany ghc-options: -Wall -Wno-name-shadowing @@ -298,6 +299,7 @@ library hls-test-utils import: agpl hs-source-dirs: test/utils exposed-modules: TestUtils + , TastyUtils build-depends: base , haskell-language-server , haskell-lsp @@ -312,6 +314,7 @@ library hls-test-utils , hspec , hspec-core , stm + , tasty-hunit , text , unordered-containers , yaml diff --git a/test/src/Main.hs b/test/src/Main.hs index fccf5b2247..4c87a841c8 100644 --- a/test/src/Main.hs +++ b/test/src/Main.hs @@ -1,10 +1,22 @@ module Main where +import Control.Monad.IO.Class +import Language.Haskell.LSP.Test import Test.Tasty +import TestUtils +-- import TastyUtils + import Ide.Plugin.Brittany (tests) main :: IO () -main = defaultMain tree +main = do + setupBuildToolFiles + -- run a test session to warm up the cache to prevent timeouts in other tests + putStrLn "Warming up HIE cache..." + runSessionWithConfig (defaultConfig { messageTimeout = 120 }) hieCommand fullCaps "test/testdata" $ + liftIO $ putStrLn "HIE cache is warmed up" + + defaultMain tree tree :: TestTree tree = testGroup "HIE" [ diff --git a/test/src/TestUtil.hs b/test/utils/TastyUtils.hs similarity index 79% rename from test/src/TestUtil.hs rename to test/utils/TastyUtils.hs index a7bac26970..33498ea227 100644 --- a/test/src/TestUtil.hs +++ b/test/utils/TastyUtils.hs @@ -1,4 +1,8 @@ -module TestUtil where +module TastyUtils ( + (===) + ,assertTrue + ,assertFalse +) where import Test.Tasty.HUnit ( (@?=), assertBool, Assertion) From 4ec1817652abd7bc74d224076757e02367acba28 Mon Sep 17 00:00:00 2001 From: Jeff Windsor Date: Sat, 9 May 2020 13:37:37 -0700 Subject: [PATCH 03/26] Move to functional folder with first real test --- haskell-language-server.cabal | 65 ++------------------------------- test/functional/Commands.hs | 25 +++++++++++++ test/functional/Main.hs | 16 ++++---- test/src/Ide/Plugin/Brittany.hs | 18 --------- test/src/Main.hs | 24 ------------ test/utils/TastyUtils.hs | 27 ++++++++------ 6 files changed, 52 insertions(+), 123 deletions(-) create mode 100644 test/functional/Commands.hs delete mode 100644 test/src/Ide/Plugin/Brittany.hs delete mode 100644 test/src/Main.hs diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 28fc1bc084..9c57c2796f 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -205,7 +205,7 @@ executable haskell-language-server-wrapper , process default-language: Haskell2010 -test-suite tasty +test-suite func-test import: agpl type: exitcode-stdio-1.0 default-language: Haskell2010 @@ -225,10 +225,10 @@ test-suite tasty , tasty-hunit , text , unordered-containers - hs-source-dirs: test/src + hs-source-dirs: test/functional main-is: Main.hs other-modules: - Ide.Plugin.Brittany + Commands ghc-options: -Wall -Wno-name-shadowing @@ -236,65 +236,6 @@ test-suite tasty if flag(pedantic) ghc-options: -Werror -Wredundant-constraints - -test-suite func-test - import: agpl - type: exitcode-stdio-1.0 - default-language: Haskell2010 - build-tool-depends: hspec-discover:hspec-discover - , haskell-language-server:haskell-language-server - , cabal-helper:cabal-helper-main - , ghcide:ghcide-test-preprocessor - - build-depends: - base >=4.7 && <5 - , aeson - , data-default - , haskell-lsp-types - , hls-test-utils - , hspec - , lens - , lsp-test >= 0.10.0.0 - , text - , unordered-containers - other-modules: - -- CompletionSpec - -- , CommandSpec - -- , DeferredSpec - -- , DefinitionSpec - -- , DiagnosticsSpec - FormatSpec - -- , FunctionalBadProjectSpec - -- , FunctionalCodeActionsSpec - -- , FunctionalLiquidSpec - , FunctionalSpec - -- , HaReSpec - -- , HieBiosSpec - -- , HighlightSpec - -- , HoverSpec - , PluginSpec - -- , ProgressSpec - -- , ReferencesSpec - -- , RenameSpec - -- , SymbolsSpec - -- , TypeDefinitionSpec - , Utils - , Paths_haskell_language_server - - hs-source-dirs: - test/functional - ghc-options: - -Wall - -Wredundant-constraints - -Wno-name-shadowing - -threaded -rtsopts -with-rtsopts=-N - if flag(pedantic) - ghc-options: -Werror - main-is: Main.hs - -- other-modules: - -- Development.IDE.Test - -- Development.IDE.Test.Runfiles - library hls-test-utils import: agpl hs-source-dirs: test/utils diff --git a/test/functional/Commands.hs b/test/functional/Commands.hs new file mode 100644 index 0000000000..bd1fd95ded --- /dev/null +++ b/test/functional/Commands.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE OverloadedStrings #-} +module Commands (tests) where + +import Control.Lens hiding (List) +import Control.Monad.IO.Class +import qualified Data.Text as T +import Data.Char +import Language.Haskell.LSP.Test +import Language.Haskell.LSP.Types as LSP +import Language.Haskell.LSP.Types.Lens as LSP +import Test.Tasty +import Test.Tasty.HUnit +import TestUtils +import TastyUtils + +tests :: TestTree +tests = testGroup "Commands" [ + testCase "are prefixed" $ runSession hieCommand fullCaps "test/testdata/" $ do + ResponseMessage _ _ (Just res) Nothing <- initializeResponse + let List cmds = res ^. LSP.capabilities . executeCommandProvider . _Just . commands + f x = (T.length (T.takeWhile isNumber x) >= 1) && (T.count ":" x >= 2) + liftIO $ do + cmds `shouldSatisfy` all f + cmds `shouldNotSatisfy` null + ] diff --git a/test/functional/Main.hs b/test/functional/Main.hs index 312ab2b880..16b0d4f897 100644 --- a/test/functional/Main.hs +++ b/test/functional/Main.hs @@ -1,19 +1,19 @@ module Main where -import Control.Monad.IO.Class -import Language.Haskell.LSP.Test -import qualified FunctionalSpec -import Test.Hspec.Runner (hspecWith) -import TestUtils +import Control.Monad.IO.Class +import Language.Haskell.LSP.Test +import Test.Tasty +import TestUtils +import Commands main :: IO () main = do setupBuildToolFiles -- run a test session to warm up the cache to prevent timeouts in other tests putStrLn "Warming up HIE cache..." - putStrLn $ "hieCommand: " ++ hieCommand runSessionWithConfig (defaultConfig { messageTimeout = 120 }) hieCommand fullCaps "test/testdata" $ liftIO $ putStrLn "HIE cache is warmed up" - config <- getHspecFormattedConfig "functional" - withFileLogging logFilePath $ hspecWith config FunctionalSpec.spec + defaultMain $ testGroup "HIE" [ + Commands.tests + ] \ No newline at end of file diff --git a/test/src/Ide/Plugin/Brittany.hs b/test/src/Ide/Plugin/Brittany.hs deleted file mode 100644 index 2aacebe266..0000000000 --- a/test/src/Ide/Plugin/Brittany.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Ide.Plugin.Brittany where - -import Test.Tasty -import Test.Tasty.HUnit - -tests :: TestTree -tests = testGroup "Brittany" [ - someTruth - ] - -someTruth :: TestTree -someTruth = testCase "List comparison (different length)" $ - compare a b @?= GT - where - a :: [Int] - a = [1,2,3] - b :: [Int] - b = [1,2] \ No newline at end of file diff --git a/test/src/Main.hs b/test/src/Main.hs deleted file mode 100644 index 4c87a841c8..0000000000 --- a/test/src/Main.hs +++ /dev/null @@ -1,24 +0,0 @@ -module Main where - -import Control.Monad.IO.Class -import Language.Haskell.LSP.Test -import Test.Tasty -import TestUtils --- import TastyUtils - -import Ide.Plugin.Brittany (tests) - -main :: IO () -main = do - setupBuildToolFiles - -- run a test session to warm up the cache to prevent timeouts in other tests - putStrLn "Warming up HIE cache..." - runSessionWithConfig (defaultConfig { messageTimeout = 120 }) hieCommand fullCaps "test/testdata" $ - liftIO $ putStrLn "HIE cache is warmed up" - - defaultMain tree - -tree :: TestTree -tree = testGroup "HIE" [ - Ide.Plugin.Brittany.tests - ] \ No newline at end of file diff --git a/test/utils/TastyUtils.hs b/test/utils/TastyUtils.hs index 33498ea227..3733f23537 100644 --- a/test/utils/TastyUtils.hs +++ b/test/utils/TastyUtils.hs @@ -1,17 +1,22 @@ module TastyUtils ( - (===) - ,assertTrue - ,assertFalse + shouldSatisfy + ,shouldNotSatisfy ) where -import Test.Tasty.HUnit ( (@?=), assertBool, Assertion) +import Test.Tasty.HUnit -(===) :: (Eq a, Show a) => a -> a -> Assertion -(===) = (@?=) -infixl 1 === +-- (===) :: (Eq a, Show a) => a -> a -> Assertion +-- (===) = (@?=) +-- infixl 1 === -assertTrue :: Assertion -assertTrue = assertBool "Success" True +-- assertTrue :: Assertion +-- assertTrue = assertBool "Success" True -assertFalse :: String -> Assertion -assertFalse msg = assertBool msg False \ No newline at end of file +-- assertFalse :: String -> Assertion +-- assertFalse msg = assertBool msg False + +shouldSatisfy :: (HasCallStack, Show a) => a -> (a -> Bool) -> Assertion +v `shouldSatisfy` p = assertBool ("predicate failed on: " ++ show v) (p v) + +shouldNotSatisfy :: (HasCallStack, Show a) => a -> (a -> Bool) -> Assertion +v `shouldNotSatisfy` p = assertBool ("predicate succeeded on: " ++ show v) ((not . p) v) \ No newline at end of file From d1ab2d8657f6e51d835b2b0a00dafd15cb07dc34 Mon Sep 17 00:00:00 2001 From: Jeff Windsor Date: Sat, 9 May 2020 13:57:55 -0700 Subject: [PATCH 04/26] Commands (de-prefix failing) --- test/functional/Commands.hs | 23 ++++++++++++++++------- 1 file changed, 16 insertions(+), 7 deletions(-) diff --git a/test/functional/Commands.hs b/test/functional/Commands.hs index bd1fd95ded..5f9df3e836 100644 --- a/test/functional/Commands.hs +++ b/test/functional/Commands.hs @@ -15,11 +15,20 @@ import TastyUtils tests :: TestTree tests = testGroup "Commands" [ - testCase "are prefixed" $ runSession hieCommand fullCaps "test/testdata/" $ do - ResponseMessage _ _ (Just res) Nothing <- initializeResponse - let List cmds = res ^. LSP.capabilities . executeCommandProvider . _Just . commands - f x = (T.length (T.takeWhile isNumber x) >= 1) && (T.count ":" x >= 2) - liftIO $ do - cmds `shouldSatisfy` all f - cmds `shouldNotSatisfy` null + testCase "are prefixed" $ + runSession hieCommand fullCaps "test/testdata/" $ do + ResponseMessage _ _ (Just res) Nothing <- initializeResponse + let List cmds = res ^. LSP.capabilities . executeCommandProvider . _Just . commands + f x = (T.length (T.takeWhile isNumber x) >= 1) && (T.count ":" x >= 2) + liftIO $ do + cmds `shouldSatisfy` all f + cmds `shouldNotSatisfy` null + , testCase "get de-prefixed" $ + runSession hieCommand fullCaps "test/testdata/" $ do + ResponseMessage _ _ _ (Just err) <- request + WorkspaceExecuteCommand + (ExecuteCommandParams "1234:package:add" (Just (List [])) Nothing) :: Session ExecuteCommandResponse + let ResponseError _ msg _ = err + -- We expect an error message about the dud arguments, but should pickup "add" and "package" + liftIO $ msg `shouldSatisfy` T.isInfixOf "while parsing args for add in plugin package" ] From 7c4f6705694148fda804ffaae32e103f4ea5f712 Mon Sep 17 00:00:00 2001 From: Jeff Windsor Date: Sat, 9 May 2020 14:27:46 -0700 Subject: [PATCH 05/26] full test data --- test/testdata/ApplyRefact.hs | 4 + test/testdata/ApplyRefact2.hs | 2 + test/testdata/ApplyRefactError.hs | 2 + test/testdata/BrittanyCRLF.hs | 8 +- test/testdata/BrittanyLF.hs | 4 +- test/testdata/CodeActionImport.hs | 2 + test/testdata/CodeActionImportBrittany.hs | 3 + test/testdata/CodeActionImportList.hs | 6 + .../testdata/CodeActionImportListElaborate.hs | 9 + test/testdata/CodeActionOnly.hs | 3 + test/testdata/CodeActionRename.hs | 2 + test/testdata/FileWithWarning.hs | 7 + test/testdata/Format.hs | 4 +- test/testdata/FuncTest.hs | 13 ++ test/testdata/FuncTestError.hs | 15 ++ test/testdata/FuncTestFail.hs | 2 + test/testdata/GhcModCaseSplit.hs | 5 + test/testdata/HaReCase.hs | 10 ++ test/testdata/HaReDemote.hs | 6 + test/testdata/HaReGA1/HaReGA1.cabal | 10 ++ test/testdata/HaReGA1/HaReGA1.hs | 11 ++ test/testdata/HaReGA1/cabal.project | 1 + test/testdata/HaReLift.hs | 3 + test/testdata/HaReMoveDef.hs | 14 ++ test/testdata/HaReRename.hs | 6 + test/testdata/Highlight.hs | 5 + test/testdata/HlintNoRefactorings.hs | 4 + test/testdata/HlintParseFail.hs | 13 ++ test/testdata/HlintPragma.hs | 4 + test/testdata/Hover.hs | 2 + test/testdata/References.hs | 9 + test/testdata/Rename.hs | 6 + test/testdata/Symbols.hs | 14 ++ test/testdata/TopLevelSignature.hs | 5 + test/testdata/TypedHoles.hs | 3 + test/testdata/TypedHoles2.hs | 6 + test/testdata/Types.hs | 33 ++++ test/testdata/UnusedTerm.hs | 6 + .../addPackageTest/cabal-exe/AddPackage.hs | 3 + .../cabal-exe/add-package-test.cabal | 14 ++ .../addPackageTest/cabal-lib/AddPackage.hs | 4 + .../cabal-lib/add-package-test.cabal | 14 ++ .../addPackageTest/hpack-exe/app/Asdf.hs | 5 + .../addPackageTest/hpack-exe/asdf.cabal | 37 ++++ .../addPackageTest/hpack-lib/app/Asdf.hs | 7 + .../addPackageTest/invalid/AddPackage.hs | 2 + test/testdata/addPragmas/NeedsPragmas.hs | 15 ++ test/testdata/addPragmas/test.cabal | 18 ++ test/testdata/badProjects/cabal/Foo.hs | 4 + .../badProjects/cabal/bad-cabal.cabal | 16 ++ .../cabal-helper/implicit-exe/Setup.hs | 2 + .../cabal-helper/implicit-exe/cabal.project | 1 + .../implicit-exe/implicit-exe.cabal | 17 ++ .../cabal-helper/implicit-exe/src/Exe.hs | 4 + .../cabal-helper/implicit-exe/src/Lib.hs | 4 + .../testdata/cabal-helper/mono-repo/A/A.cabal | 15 ++ .../testdata/cabal-helper/mono-repo/A/Main.hs | 8 + .../cabal-helper/mono-repo/A/MyLib.hs | 4 + .../cabal-helper/mono-repo/A/Setup.hs | 2 + .../testdata/cabal-helper/mono-repo/B/B.cabal | 15 ++ .../testdata/cabal-helper/mono-repo/B/Main.hs | 8 + .../cabal-helper/mono-repo/B/MyLib.hs | 4 + .../cabal-helper/mono-repo/B/Setup.hs | 2 + .../testdata/cabal-helper/mono-repo/C/C.cabal | 9 + .../cabal-helper/mono-repo/C/MyLib.hs | 4 + .../cabal-helper/mono-repo/C/Setup.hs | 2 + .../cabal-helper/mono-repo/cabal.project | 4 + .../cabal-helper/multi-source-dirs/Setup.hs | 2 + .../multi-source-dirs/multi-source-dirs.cabal | 11 ++ .../multi-source-dirs/src/BetterLib.hs | 5 + .../multi-source-dirs/src/input/Lib.hs | 6 + .../cabal-helper/simple-cabal/MyLib.hs | 4 + .../cabal-helper/simple-cabal/Setup.hs | 2 + .../simple-cabal/simple-cabal-test.cabal | 10 ++ .../cabal-helper/simple-stack/MyLib.hs | 4 + .../cabal-helper/simple-stack/Setup.hs | 2 + .../simple-stack/simple-stack-test.cabal | 10 ++ .../cabal-helper/sub-package/Setup.hs | 2 + .../cabal-helper/sub-package/app/Main.hs | 8 + .../sub-package/plugins-api/PluginLib.hs | 4 + .../sub-package/plugins-api/Setup.hs | 2 + .../sub-package/plugins-api/plugins-api.cabal | 10 ++ .../cabal-helper/sub-package/src/MyLib.hs | 6 + .../sub-package/sub-package.cabal | 17 ++ test/testdata/completion/Completion.hs | 9 + test/testdata/completion/Context.hs | 4 + test/testdata/completion/DupRecFields.hs | 5 + test/testdata/completion/completions.cabal | 10 ++ test/testdata/context/ExampleContext.hs | 20 +++ test/testdata/context/Foo/Bar.hs | 3 + test/testdata/definition/Bar.hs | 3 + test/testdata/definition/Foo.hs | 3 + test/testdata/definition/definitions.cabal | 10 ++ test/testdata/gototest/Setup.hs | 2 + test/testdata/gototest/app/Main.hs | 7 + test/testdata/gototest/cabal.project | 3 + test/testdata/gototest/gototest.cabal | 24 +++ test/testdata/gototest/src/Lib.hs | 40 +++++ test/testdata/gototest/src/Lib2.hs | 13 ++ test/testdata/hieBiosError/Foo.hs | 1 + test/testdata/hieBiosMainIs/Main.hs | 4 + test/testdata/hieBiosMainIs/Setup.hs | 2 + .../hieBiosMainIs/hieBiosMainIs.cabal | 8 + test/testdata/liquid/Evens.hs | 41 +++++ .../src/CodeActionRedundant.hs | 4 + .../src/MultipleImports.hs | 5 + test/testdata/redundantImportTest/test.cabal | 18 ++ test/testdata/testdata.cabal | 158 +++++++++--------- test/testdata/typedHoleDiag.txt | 26 +++ test/testdata/typedHoleDiag2.txt | 17 ++ test/testdata/typedHoleDiag3.txt | 37 ++++ test/testdata/wErrorTest/src/WError.hs | 2 + test/testdata/wErrorTest/test.cabal | 18 ++ test/testdata/wrapper/8.8.1/Setup.hs | 2 + test/testdata/wrapper/8.8.1/cabal1.cabal | 25 +++ test/testdata/wrapper/8.8.1/src/Foo/Bar.hs | 3 + test/testdata/wrapper/8.8.1/src/main.hs | 7 + test/testdata/wrapper/ghc/dummy | 1 + test/testdata/wrapper/lts-14.18/Setup.hs | 2 + test/testdata/wrapper/lts-14.18/cabal1.cabal | 25 +++ .../testdata/wrapper/lts-14.18/src/Foo/Bar.hs | 3 + test/testdata/wrapper/lts-14.18/src/main.hs | 7 + 122 files changed, 1091 insertions(+), 92 deletions(-) create mode 100644 test/testdata/ApplyRefact.hs create mode 100644 test/testdata/ApplyRefact2.hs create mode 100644 test/testdata/ApplyRefactError.hs create mode 100644 test/testdata/CodeActionImport.hs create mode 100644 test/testdata/CodeActionImportBrittany.hs create mode 100644 test/testdata/CodeActionImportList.hs create mode 100644 test/testdata/CodeActionImportListElaborate.hs create mode 100644 test/testdata/CodeActionOnly.hs create mode 100644 test/testdata/CodeActionRename.hs create mode 100644 test/testdata/FileWithWarning.hs create mode 100644 test/testdata/FuncTest.hs create mode 100644 test/testdata/FuncTestError.hs create mode 100644 test/testdata/FuncTestFail.hs create mode 100644 test/testdata/GhcModCaseSplit.hs create mode 100644 test/testdata/HaReCase.hs create mode 100644 test/testdata/HaReDemote.hs create mode 100644 test/testdata/HaReGA1/HaReGA1.cabal create mode 100644 test/testdata/HaReGA1/HaReGA1.hs create mode 100644 test/testdata/HaReGA1/cabal.project create mode 100644 test/testdata/HaReLift.hs create mode 100644 test/testdata/HaReMoveDef.hs create mode 100644 test/testdata/HaReRename.hs create mode 100644 test/testdata/Highlight.hs create mode 100644 test/testdata/HlintNoRefactorings.hs create mode 100644 test/testdata/HlintParseFail.hs create mode 100644 test/testdata/HlintPragma.hs create mode 100644 test/testdata/Hover.hs create mode 100644 test/testdata/References.hs create mode 100644 test/testdata/Rename.hs create mode 100644 test/testdata/Symbols.hs create mode 100644 test/testdata/TopLevelSignature.hs create mode 100644 test/testdata/TypedHoles.hs create mode 100644 test/testdata/TypedHoles2.hs create mode 100644 test/testdata/Types.hs create mode 100644 test/testdata/UnusedTerm.hs create mode 100644 test/testdata/addPackageTest/cabal-exe/AddPackage.hs create mode 100644 test/testdata/addPackageTest/cabal-exe/add-package-test.cabal create mode 100644 test/testdata/addPackageTest/cabal-lib/AddPackage.hs create mode 100644 test/testdata/addPackageTest/cabal-lib/add-package-test.cabal create mode 100644 test/testdata/addPackageTest/hpack-exe/app/Asdf.hs create mode 100644 test/testdata/addPackageTest/hpack-exe/asdf.cabal create mode 100644 test/testdata/addPackageTest/hpack-lib/app/Asdf.hs create mode 100644 test/testdata/addPackageTest/invalid/AddPackage.hs create mode 100644 test/testdata/addPragmas/NeedsPragmas.hs create mode 100644 test/testdata/addPragmas/test.cabal create mode 100644 test/testdata/badProjects/cabal/Foo.hs create mode 100644 test/testdata/badProjects/cabal/bad-cabal.cabal create mode 100644 test/testdata/cabal-helper/implicit-exe/Setup.hs create mode 100644 test/testdata/cabal-helper/implicit-exe/cabal.project create mode 100644 test/testdata/cabal-helper/implicit-exe/implicit-exe.cabal create mode 100644 test/testdata/cabal-helper/implicit-exe/src/Exe.hs create mode 100644 test/testdata/cabal-helper/implicit-exe/src/Lib.hs create mode 100644 test/testdata/cabal-helper/mono-repo/A/A.cabal create mode 100644 test/testdata/cabal-helper/mono-repo/A/Main.hs create mode 100644 test/testdata/cabal-helper/mono-repo/A/MyLib.hs create mode 100644 test/testdata/cabal-helper/mono-repo/A/Setup.hs create mode 100644 test/testdata/cabal-helper/mono-repo/B/B.cabal create mode 100644 test/testdata/cabal-helper/mono-repo/B/Main.hs create mode 100644 test/testdata/cabal-helper/mono-repo/B/MyLib.hs create mode 100644 test/testdata/cabal-helper/mono-repo/B/Setup.hs create mode 100644 test/testdata/cabal-helper/mono-repo/C/C.cabal create mode 100644 test/testdata/cabal-helper/mono-repo/C/MyLib.hs create mode 100644 test/testdata/cabal-helper/mono-repo/C/Setup.hs create mode 100644 test/testdata/cabal-helper/mono-repo/cabal.project create mode 100644 test/testdata/cabal-helper/multi-source-dirs/Setup.hs create mode 100644 test/testdata/cabal-helper/multi-source-dirs/multi-source-dirs.cabal create mode 100644 test/testdata/cabal-helper/multi-source-dirs/src/BetterLib.hs create mode 100644 test/testdata/cabal-helper/multi-source-dirs/src/input/Lib.hs create mode 100644 test/testdata/cabal-helper/simple-cabal/MyLib.hs create mode 100644 test/testdata/cabal-helper/simple-cabal/Setup.hs create mode 100644 test/testdata/cabal-helper/simple-cabal/simple-cabal-test.cabal create mode 100644 test/testdata/cabal-helper/simple-stack/MyLib.hs create mode 100644 test/testdata/cabal-helper/simple-stack/Setup.hs create mode 100644 test/testdata/cabal-helper/simple-stack/simple-stack-test.cabal create mode 100644 test/testdata/cabal-helper/sub-package/Setup.hs create mode 100644 test/testdata/cabal-helper/sub-package/app/Main.hs create mode 100644 test/testdata/cabal-helper/sub-package/plugins-api/PluginLib.hs create mode 100644 test/testdata/cabal-helper/sub-package/plugins-api/Setup.hs create mode 100644 test/testdata/cabal-helper/sub-package/plugins-api/plugins-api.cabal create mode 100644 test/testdata/cabal-helper/sub-package/src/MyLib.hs create mode 100644 test/testdata/cabal-helper/sub-package/sub-package.cabal create mode 100644 test/testdata/completion/Completion.hs create mode 100644 test/testdata/completion/Context.hs create mode 100644 test/testdata/completion/DupRecFields.hs create mode 100644 test/testdata/completion/completions.cabal create mode 100644 test/testdata/context/ExampleContext.hs create mode 100644 test/testdata/context/Foo/Bar.hs create mode 100644 test/testdata/definition/Bar.hs create mode 100644 test/testdata/definition/Foo.hs create mode 100644 test/testdata/definition/definitions.cabal create mode 100644 test/testdata/gototest/Setup.hs create mode 100644 test/testdata/gototest/app/Main.hs create mode 100644 test/testdata/gototest/cabal.project create mode 100644 test/testdata/gototest/gototest.cabal create mode 100644 test/testdata/gototest/src/Lib.hs create mode 100644 test/testdata/gototest/src/Lib2.hs create mode 100644 test/testdata/hieBiosError/Foo.hs create mode 100644 test/testdata/hieBiosMainIs/Main.hs create mode 100644 test/testdata/hieBiosMainIs/Setup.hs create mode 100644 test/testdata/hieBiosMainIs/hieBiosMainIs.cabal create mode 100644 test/testdata/liquid/Evens.hs create mode 100644 test/testdata/redundantImportTest/src/CodeActionRedundant.hs create mode 100644 test/testdata/redundantImportTest/src/MultipleImports.hs create mode 100644 test/testdata/redundantImportTest/test.cabal create mode 100644 test/testdata/typedHoleDiag.txt create mode 100644 test/testdata/typedHoleDiag2.txt create mode 100644 test/testdata/typedHoleDiag3.txt create mode 100644 test/testdata/wErrorTest/src/WError.hs create mode 100644 test/testdata/wErrorTest/test.cabal create mode 100644 test/testdata/wrapper/8.8.1/Setup.hs create mode 100644 test/testdata/wrapper/8.8.1/cabal1.cabal create mode 100644 test/testdata/wrapper/8.8.1/src/Foo/Bar.hs create mode 100644 test/testdata/wrapper/8.8.1/src/main.hs create mode 100644 test/testdata/wrapper/ghc/dummy create mode 100644 test/testdata/wrapper/lts-14.18/Setup.hs create mode 100644 test/testdata/wrapper/lts-14.18/cabal1.cabal create mode 100644 test/testdata/wrapper/lts-14.18/src/Foo/Bar.hs create mode 100644 test/testdata/wrapper/lts-14.18/src/main.hs diff --git a/test/testdata/ApplyRefact.hs b/test/testdata/ApplyRefact.hs new file mode 100644 index 0000000000..984656fbcc --- /dev/null +++ b/test/testdata/ApplyRefact.hs @@ -0,0 +1,4 @@ + +main = (putStrLn "hello") + +foo x = (x + 1) diff --git a/test/testdata/ApplyRefact2.hs b/test/testdata/ApplyRefact2.hs new file mode 100644 index 0000000000..d83992f387 --- /dev/null +++ b/test/testdata/ApplyRefact2.hs @@ -0,0 +1,2 @@ +main = undefined +foo x = id x diff --git a/test/testdata/ApplyRefactError.hs b/test/testdata/ApplyRefactError.hs new file mode 100644 index 0000000000..89ad34d323 --- /dev/null +++ b/test/testdata/ApplyRefactError.hs @@ -0,0 +1,2 @@ +foo :: forall a. (a -> a) -> a -> a +foo f x = f $ x diff --git a/test/testdata/BrittanyCRLF.hs b/test/testdata/BrittanyCRLF.hs index 1bac0322e8..2ed3293b3d 100644 --- a/test/testdata/BrittanyCRLF.hs +++ b/test/testdata/BrittanyCRLF.hs @@ -1,5 +1,3 @@ -module BrittanyCRLF where - -foo :: Int -> String-> IO () -foo x y = do print x - return () +foo :: Int -> String-> IO () +foo x y = do print x + return 42 \ No newline at end of file diff --git a/test/testdata/BrittanyLF.hs b/test/testdata/BrittanyLF.hs index 3f54b9e4f2..4662d9b5a8 100644 --- a/test/testdata/BrittanyLF.hs +++ b/test/testdata/BrittanyLF.hs @@ -1,5 +1,3 @@ -module BrittanyLF where - foo :: Int -> String-> IO () foo x y = do print x - return () + return 42 \ No newline at end of file diff --git a/test/testdata/CodeActionImport.hs b/test/testdata/CodeActionImport.hs new file mode 100644 index 0000000000..95520bbd2f --- /dev/null +++ b/test/testdata/CodeActionImport.hs @@ -0,0 +1,2 @@ +main :: IO () +main = when True $ putStrLn "hello" \ No newline at end of file diff --git a/test/testdata/CodeActionImportBrittany.hs b/test/testdata/CodeActionImportBrittany.hs new file mode 100644 index 0000000000..af9cb0d2d4 --- /dev/null +++ b/test/testdata/CodeActionImportBrittany.hs @@ -0,0 +1,3 @@ +import qualified Data.Maybe +main :: IO () +main = when True $ putStrLn "hello" \ No newline at end of file diff --git a/test/testdata/CodeActionImportList.hs b/test/testdata/CodeActionImportList.hs new file mode 100644 index 0000000000..1a0d3ee3e8 --- /dev/null +++ b/test/testdata/CodeActionImportList.hs @@ -0,0 +1,6 @@ +-- | Main entry point to the program +main :: IO () +main = + when True + $ hPutStrLn stdout + $ fromMaybe "Good night, World!" (Just "Hello, World!") \ No newline at end of file diff --git a/test/testdata/CodeActionImportListElaborate.hs b/test/testdata/CodeActionImportListElaborate.hs new file mode 100644 index 0000000000..63f9056982 --- /dev/null +++ b/test/testdata/CodeActionImportListElaborate.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE NoImplicitPrelude #-} +import System.IO (IO) +import Data.List (find, head, last, tail, init, union, (\\), null, length, cons, uncons) +-- | Main entry point to the program +main :: IO () +main = + when True + $ hPutStrLn stderr + $ fromMaybe "Good night, World!" (Just "Hello, World!") \ No newline at end of file diff --git a/test/testdata/CodeActionOnly.hs b/test/testdata/CodeActionOnly.hs new file mode 100644 index 0000000000..1f8a403c8a --- /dev/null +++ b/test/testdata/CodeActionOnly.hs @@ -0,0 +1,3 @@ +module CodeActionOnly where +foo = bar + where bar = id Nothing \ No newline at end of file diff --git a/test/testdata/CodeActionRename.hs b/test/testdata/CodeActionRename.hs new file mode 100644 index 0000000000..457d983b88 --- /dev/null +++ b/test/testdata/CodeActionRename.hs @@ -0,0 +1,2 @@ +main = butStrLn "hello" +foo = putStrn "world" diff --git a/test/testdata/FileWithWarning.hs b/test/testdata/FileWithWarning.hs new file mode 100644 index 0000000000..226e659d9b --- /dev/null +++ b/test/testdata/FileWithWarning.hs @@ -0,0 +1,7 @@ + +main = putStrLn "hello" + +foo = x + +bar x = do + return (3 + x) diff --git a/test/testdata/Format.hs b/test/testdata/Format.hs index b3aff40f91..d4682acaa2 100644 --- a/test/testdata/Format.hs +++ b/test/testdata/Format.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE NoImplicitPrelude #-} module Format where foo :: Int -> Int foo 3 = 2 @@ -7,3 +6,6 @@ bar :: String -> IO String bar s = do x <- return "hello" return "asdf" + +data Baz = Baz { a :: Int, b :: String } + diff --git a/test/testdata/FuncTest.hs b/test/testdata/FuncTest.hs new file mode 100644 index 0000000000..99ee963164 --- /dev/null +++ b/test/testdata/FuncTest.hs @@ -0,0 +1,13 @@ +module Main where + +main = putStrLn "hello" + +foo :: Int +foo = bb + +bb = 5 + +baz = do + putStrLn "hello" + +f x = x+1 \ No newline at end of file diff --git a/test/testdata/FuncTestError.hs b/test/testdata/FuncTestError.hs new file mode 100644 index 0000000000..48b47a22b6 --- /dev/null +++ b/test/testdata/FuncTestError.hs @@ -0,0 +1,15 @@ +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 diff --git a/test/testdata/FuncTestFail.hs b/test/testdata/FuncTestFail.hs new file mode 100644 index 0000000000..ac61d11137 --- /dev/null +++ b/test/testdata/FuncTestFail.hs @@ -0,0 +1,2 @@ +main :: IO Int +main = return "yow diff --git a/test/testdata/GhcModCaseSplit.hs b/test/testdata/GhcModCaseSplit.hs new file mode 100644 index 0000000000..ad1ee0dd33 --- /dev/null +++ b/test/testdata/GhcModCaseSplit.hs @@ -0,0 +1,5 @@ + +main = putStrLn "hello" + +foo :: Maybe Int -> () +foo x = () diff --git a/test/testdata/HaReCase.hs b/test/testdata/HaReCase.hs new file mode 100644 index 0000000000..259cd8a597 --- /dev/null +++ b/test/testdata/HaReCase.hs @@ -0,0 +1,10 @@ + +main = putStrLn "hello" + +foo :: Int -> Int +foo x = if odd x + then + x + 3 + else + x + diff --git a/test/testdata/HaReDemote.hs b/test/testdata/HaReDemote.hs new file mode 100644 index 0000000000..0b6b8a85d7 --- /dev/null +++ b/test/testdata/HaReDemote.hs @@ -0,0 +1,6 @@ + +main = putStrLn "hello" + +foo x = y + 3 + +y = 7 diff --git a/test/testdata/HaReGA1/HaReGA1.cabal b/test/testdata/HaReGA1/HaReGA1.cabal new file mode 100644 index 0000000000..add265b777 --- /dev/null +++ b/test/testdata/HaReGA1/HaReGA1.cabal @@ -0,0 +1,10 @@ +name: HaReGA1 +version: 0.1.0.0 +cabal-version: >=2.0 +build-type: Simple + +executable harega + build-depends: base, parsec + main-is: HaReGA1.hs + default-language: Haskell2010 + diff --git a/test/testdata/HaReGA1/HaReGA1.hs b/test/testdata/HaReGA1/HaReGA1.hs new file mode 100644 index 0000000000..4a2b2a57c6 --- /dev/null +++ b/test/testdata/HaReGA1/HaReGA1.hs @@ -0,0 +1,11 @@ +module Main where +import Text.ParserCombinators.Parsec + +parseStr :: CharParser () String +parseStr = do + char '"' + str <- many1 (noneOf "\"") + char '"' + return str + +main = putStrLn "hello" diff --git a/test/testdata/HaReGA1/cabal.project b/test/testdata/HaReGA1/cabal.project new file mode 100644 index 0000000000..e6fdbadb43 --- /dev/null +++ b/test/testdata/HaReGA1/cabal.project @@ -0,0 +1 @@ +packages: . diff --git a/test/testdata/HaReLift.hs b/test/testdata/HaReLift.hs new file mode 100644 index 0000000000..bc22926de8 --- /dev/null +++ b/test/testdata/HaReLift.hs @@ -0,0 +1,3 @@ +module HaReLift where +foo = bar + where bar = "hello" \ No newline at end of file diff --git a/test/testdata/HaReMoveDef.hs b/test/testdata/HaReMoveDef.hs new file mode 100644 index 0000000000..f60053a6b1 --- /dev/null +++ b/test/testdata/HaReMoveDef.hs @@ -0,0 +1,14 @@ + +main = putStrLn "hello" + +lifting x = x + y + where + y = 4 + +liftToTop x = x + y + where + y = z + 4 + where + z = 7 + + diff --git a/test/testdata/HaReRename.hs b/test/testdata/HaReRename.hs new file mode 100644 index 0000000000..8183da35e7 --- /dev/null +++ b/test/testdata/HaReRename.hs @@ -0,0 +1,6 @@ + +main = putStrLn "hello" + +foo :: Int -> Int +foo x = x + 3 + diff --git a/test/testdata/Highlight.hs b/test/testdata/Highlight.hs new file mode 100644 index 0000000000..8d92d18779 --- /dev/null +++ b/test/testdata/Highlight.hs @@ -0,0 +1,5 @@ +module Highlight where +foo :: Int +foo = 3 +bar = foo + where baz = let x = foo in x diff --git a/test/testdata/HlintNoRefactorings.hs b/test/testdata/HlintNoRefactorings.hs new file mode 100644 index 0000000000..6721feb768 --- /dev/null +++ b/test/testdata/HlintNoRefactorings.hs @@ -0,0 +1,4 @@ +main = putStrLn "hello" + +foo x = putStrLn x +bar y = id 42 \ No newline at end of file diff --git a/test/testdata/HlintParseFail.hs b/test/testdata/HlintParseFail.hs new file mode 100644 index 0000000000..6730e7e601 --- /dev/null +++ b/test/testdata/HlintParseFail.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeInType #-} +module Test where + +import Data.Singletons.Prelude +import Data.Singletons.TypeLits +import Data.Type.Equality ((:~:) (..), (:~~:) (..)) + +data instance Sing (z :: (a :~: b)) where + SRefl :: Sing Refl + diff --git a/test/testdata/HlintPragma.hs b/test/testdata/HlintPragma.hs new file mode 100644 index 0000000000..d308479ed1 --- /dev/null +++ b/test/testdata/HlintPragma.hs @@ -0,0 +1,4 @@ +{-# ANN module ("hlint: ignore Redundant do" :: String) #-} + +main = do + putStrLn ("hello") diff --git a/test/testdata/Hover.hs b/test/testdata/Hover.hs new file mode 100644 index 0000000000..977816c68f --- /dev/null +++ b/test/testdata/Hover.hs @@ -0,0 +1,2 @@ +main :: IO Int +main = return $ sum [1,2,3] diff --git a/test/testdata/References.hs b/test/testdata/References.hs new file mode 100644 index 0000000000..34eb8c4e25 --- /dev/null +++ b/test/testdata/References.hs @@ -0,0 +1,9 @@ +main = return () + +foo = bar + +bar = let x = bar 42 in const "hello" + +baz = do + x <- bar 23 + return $ bar 14 diff --git a/test/testdata/Rename.hs b/test/testdata/Rename.hs new file mode 100644 index 0000000000..19f566795f --- /dev/null +++ b/test/testdata/Rename.hs @@ -0,0 +1,6 @@ +main = do + x <- return $ foo 42 + return (foo x) +foo :: Int -> Int +foo x = x + 1 +bar = (+ 1) . foo diff --git a/test/testdata/Symbols.hs b/test/testdata/Symbols.hs new file mode 100644 index 0000000000..4b36275306 --- /dev/null +++ b/test/testdata/Symbols.hs @@ -0,0 +1,14 @@ +{-# 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 diff --git a/test/testdata/TopLevelSignature.hs b/test/testdata/TopLevelSignature.hs new file mode 100644 index 0000000000..71322f2edc --- /dev/null +++ b/test/testdata/TopLevelSignature.hs @@ -0,0 +1,5 @@ +{-# OPTIONS_GHC -Wall #-} +module TopLevelSignature where +main = do + putStrLn "Hello" + return () diff --git a/test/testdata/TypedHoles.hs b/test/testdata/TypedHoles.hs new file mode 100644 index 0000000000..a471d611b3 --- /dev/null +++ b/test/testdata/TypedHoles.hs @@ -0,0 +1,3 @@ +module TypedHoles where +foo :: [Int] -> Int +foo x = _ \ No newline at end of file diff --git a/test/testdata/TypedHoles2.hs b/test/testdata/TypedHoles2.hs new file mode 100644 index 0000000000..cc10d249cf --- /dev/null +++ b/test/testdata/TypedHoles2.hs @@ -0,0 +1,6 @@ +module TypedHoles2 (foo2) where +newtype A = A Int +foo2 :: [A] -> A +foo2 x = _ + where + stuff (A a) = A (a + 1) diff --git a/test/testdata/Types.hs b/test/testdata/Types.hs new file mode 100644 index 0000000000..8d6b4338bb --- /dev/null +++ b/test/testdata/Types.hs @@ -0,0 +1,33 @@ +module Types where + +import Control.Applicative + +foo :: Maybe Int -> Int +foo (Just x) = x +foo Nothing = 0 + +bar :: Maybe Int -> Int +bar x = case x of + Just y -> y + 1 + Nothing -> 0 + +maybeMonad :: Maybe Int -> Maybe Int +maybeMonad x = do + y <- x + let z = return (y + 10) + b <- z + return (b + y) + +funcTest :: (a -> a) -> a -> a +funcTest f a = f a + +compTest :: (b -> c) -> (a -> b) -> a -> c +compTest f g = let h = f . g in h + +monadStuff :: (a -> b) -> IO a -> IO b +monadStuff f action = f <$> action + +data Test + = TestC Int + | TestM String + deriving (Show, Eq, Ord) \ No newline at end of file diff --git a/test/testdata/UnusedTerm.hs b/test/testdata/UnusedTerm.hs new file mode 100644 index 0000000000..e49c2e8d07 --- /dev/null +++ b/test/testdata/UnusedTerm.hs @@ -0,0 +1,6 @@ +{-# OPTIONS_GHC -Wall #-} +module UnusedTerm () where +imUnused :: Int -> Int +imUnused 1 = 1 +imUnused 2 = 2 +imUnused _ = 3 diff --git a/test/testdata/addPackageTest/cabal-exe/AddPackage.hs b/test/testdata/addPackageTest/cabal-exe/AddPackage.hs new file mode 100644 index 0000000000..e1bbc6678d --- /dev/null +++ b/test/testdata/addPackageTest/cabal-exe/AddPackage.hs @@ -0,0 +1,3 @@ +import Data.Text +foo = pack "I'm a Text" +main = putStrLn "hello" diff --git a/test/testdata/addPackageTest/cabal-exe/add-package-test.cabal b/test/testdata/addPackageTest/cabal-exe/add-package-test.cabal new file mode 100644 index 0000000000..edd2a92a70 --- /dev/null +++ b/test/testdata/addPackageTest/cabal-exe/add-package-test.cabal @@ -0,0 +1,14 @@ +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 \ No newline at end of file diff --git a/test/testdata/addPackageTest/cabal-lib/AddPackage.hs b/test/testdata/addPackageTest/cabal-lib/AddPackage.hs new file mode 100644 index 0000000000..24015b598e --- /dev/null +++ b/test/testdata/addPackageTest/cabal-lib/AddPackage.hs @@ -0,0 +1,4 @@ +module AddPackage where + +import Data.Text +foo = pack "I'm a Text" \ No newline at end of file diff --git a/test/testdata/addPackageTest/cabal-lib/add-package-test.cabal b/test/testdata/addPackageTest/cabal-lib/add-package-test.cabal new file mode 100644 index 0000000000..f979fe1f64 --- /dev/null +++ b/test/testdata/addPackageTest/cabal-lib/add-package-test.cabal @@ -0,0 +1,14 @@ +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 diff --git a/test/testdata/addPackageTest/hpack-exe/app/Asdf.hs b/test/testdata/addPackageTest/hpack-exe/app/Asdf.hs new file mode 100644 index 0000000000..fdd639ffe3 --- /dev/null +++ b/test/testdata/addPackageTest/hpack-exe/app/Asdf.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE OverloadedStrings #-} + +import Codec.Compression.GZip + +main = return $ compress "hello" \ No newline at end of file diff --git a/test/testdata/addPackageTest/hpack-exe/asdf.cabal b/test/testdata/addPackageTest/hpack-exe/asdf.cabal new file mode 100644 index 0000000000..e39c61d39c --- /dev/null +++ b/test/testdata/addPackageTest/hpack-exe/asdf.cabal @@ -0,0 +1,37 @@ +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 +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 diff --git a/test/testdata/addPackageTest/hpack-lib/app/Asdf.hs b/test/testdata/addPackageTest/hpack-lib/app/Asdf.hs new file mode 100644 index 0000000000..ec4b229117 --- /dev/null +++ b/test/testdata/addPackageTest/hpack-lib/app/Asdf.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Asdf where + +import Codec.Compression.GZip + +main = return $ compress "hello" \ No newline at end of file diff --git a/test/testdata/addPackageTest/invalid/AddPackage.hs b/test/testdata/addPackageTest/invalid/AddPackage.hs new file mode 100644 index 0000000000..963020508b --- /dev/null +++ b/test/testdata/addPackageTest/invalid/AddPackage.hs @@ -0,0 +1,2 @@ +import Data.Text +foo = pack "I'm a Text" \ No newline at end of file diff --git a/test/testdata/addPragmas/NeedsPragmas.hs b/test/testdata/addPragmas/NeedsPragmas.hs new file mode 100644 index 0000000000..e82ad67ec2 --- /dev/null +++ b/test/testdata/addPragmas/NeedsPragmas.hs @@ -0,0 +1,15 @@ + +import GHC.Generics + +main = putStrLn "hello" + +type Foo = Int + +instance Show Foo where + show x = undefined + +instance Show (Int,String) where + show = undefined + +data FFF a = FFF Int String a + deriving (Generic,Functor,Traversable) diff --git a/test/testdata/addPragmas/test.cabal b/test/testdata/addPragmas/test.cabal new file mode 100644 index 0000000000..68ab327aec --- /dev/null +++ b/test/testdata/addPragmas/test.cabal @@ -0,0 +1,18 @@ +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 + +executable p + main-is: NeedsPragmas.hs + hs-source-dirs: . + build-depends: base >= 4.7 && < 5 + default-language: Haskell2010 + ghc-options: -Wall \ No newline at end of file diff --git a/test/testdata/badProjects/cabal/Foo.hs b/test/testdata/badProjects/cabal/Foo.hs new file mode 100644 index 0000000000..d2c06e960d --- /dev/null +++ b/test/testdata/badProjects/cabal/Foo.hs @@ -0,0 +1,4 @@ +module Foo where + +foo :: Int +foo = 3 diff --git a/test/testdata/badProjects/cabal/bad-cabal.cabal b/test/testdata/badProjects/cabal/bad-cabal.cabal new file mode 100644 index 0000000000..28414e8314 --- /dev/null +++ b/test/testdata/badProjects/cabal/bad-cabal.cabal @@ -0,0 +1,16 @@ +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 diff --git a/test/testdata/cabal-helper/implicit-exe/Setup.hs b/test/testdata/cabal-helper/implicit-exe/Setup.hs new file mode 100644 index 0000000000..9a994af677 --- /dev/null +++ b/test/testdata/cabal-helper/implicit-exe/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/test/testdata/cabal-helper/implicit-exe/cabal.project b/test/testdata/cabal-helper/implicit-exe/cabal.project new file mode 100644 index 0000000000..bfe6289656 --- /dev/null +++ b/test/testdata/cabal-helper/implicit-exe/cabal.project @@ -0,0 +1 @@ +packages: ./ \ No newline at end of file diff --git a/test/testdata/cabal-helper/implicit-exe/implicit-exe.cabal b/test/testdata/cabal-helper/implicit-exe/implicit-exe.cabal new file mode 100644 index 0000000000..3aca1b42fa --- /dev/null +++ b/test/testdata/cabal-helper/implicit-exe/implicit-exe.cabal @@ -0,0 +1,17 @@ +cabal-version: >=1.10 +name: implicit-exe +version: 0.1.0.0 +license-file: LICENSE +build-type: Simple + +library + exposed-modules: Lib + hs-source-dirs: src + build-depends: base + default-language: Haskell2010 + + +executable implicit-exe + main-is: src/Exe.hs + build-depends: base, implicit-exe + default-language: Haskell2010 \ No newline at end of file diff --git a/test/testdata/cabal-helper/implicit-exe/src/Exe.hs b/test/testdata/cabal-helper/implicit-exe/src/Exe.hs new file mode 100644 index 0000000000..ed41929e78 --- /dev/null +++ b/test/testdata/cabal-helper/implicit-exe/src/Exe.hs @@ -0,0 +1,4 @@ + +import Lib (someFunc) + +main = someFunc \ No newline at end of file diff --git a/test/testdata/cabal-helper/implicit-exe/src/Lib.hs b/test/testdata/cabal-helper/implicit-exe/src/Lib.hs new file mode 100644 index 0000000000..f51af83e20 --- /dev/null +++ b/test/testdata/cabal-helper/implicit-exe/src/Lib.hs @@ -0,0 +1,4 @@ +module Lib (someFunc) where + +someFunc :: IO () +someFunc = putStrLn "someFunc" diff --git a/test/testdata/cabal-helper/mono-repo/A/A.cabal b/test/testdata/cabal-helper/mono-repo/A/A.cabal new file mode 100644 index 0000000000..e70b43fc1d --- /dev/null +++ b/test/testdata/cabal-helper/mono-repo/A/A.cabal @@ -0,0 +1,15 @@ +cabal-version: >=1.10 +name: A +version: 0.1.0.0 +build-type: Simple + +library + exposed-modules: MyLib + build-depends: base + default-language: Haskell2010 + +executable A + main-is: Main.hs + other-modules: MyLib + build-depends: base, A + default-language: Haskell2010 diff --git a/test/testdata/cabal-helper/mono-repo/A/Main.hs b/test/testdata/cabal-helper/mono-repo/A/Main.hs new file mode 100644 index 0000000000..60d904e8c1 --- /dev/null +++ b/test/testdata/cabal-helper/mono-repo/A/Main.hs @@ -0,0 +1,8 @@ +module Main where + +import qualified MyLib (someFunc) + +main :: IO () +main = do + putStrLn "Hello, Haskell!" + MyLib.someFunc diff --git a/test/testdata/cabal-helper/mono-repo/A/MyLib.hs b/test/testdata/cabal-helper/mono-repo/A/MyLib.hs new file mode 100644 index 0000000000..e657c4403f --- /dev/null +++ b/test/testdata/cabal-helper/mono-repo/A/MyLib.hs @@ -0,0 +1,4 @@ +module MyLib (someFunc) where + +someFunc :: IO () +someFunc = putStrLn "someFunc" diff --git a/test/testdata/cabal-helper/mono-repo/A/Setup.hs b/test/testdata/cabal-helper/mono-repo/A/Setup.hs new file mode 100644 index 0000000000..9a994af677 --- /dev/null +++ b/test/testdata/cabal-helper/mono-repo/A/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/test/testdata/cabal-helper/mono-repo/B/B.cabal b/test/testdata/cabal-helper/mono-repo/B/B.cabal new file mode 100644 index 0000000000..4093e1d0f6 --- /dev/null +++ b/test/testdata/cabal-helper/mono-repo/B/B.cabal @@ -0,0 +1,15 @@ +cabal-version: >=1.10 +name: B +version: 0.1.0.0 +build-type: Simple + +library + exposed-modules: MyLib + build-depends: base + default-language: Haskell2010 + +executable B + main-is: Main.hs + other-modules: MyLib + build-depends: base, B + default-language: Haskell2010 diff --git a/test/testdata/cabal-helper/mono-repo/B/Main.hs b/test/testdata/cabal-helper/mono-repo/B/Main.hs new file mode 100644 index 0000000000..60d904e8c1 --- /dev/null +++ b/test/testdata/cabal-helper/mono-repo/B/Main.hs @@ -0,0 +1,8 @@ +module Main where + +import qualified MyLib (someFunc) + +main :: IO () +main = do + putStrLn "Hello, Haskell!" + MyLib.someFunc diff --git a/test/testdata/cabal-helper/mono-repo/B/MyLib.hs b/test/testdata/cabal-helper/mono-repo/B/MyLib.hs new file mode 100644 index 0000000000..e657c4403f --- /dev/null +++ b/test/testdata/cabal-helper/mono-repo/B/MyLib.hs @@ -0,0 +1,4 @@ +module MyLib (someFunc) where + +someFunc :: IO () +someFunc = putStrLn "someFunc" diff --git a/test/testdata/cabal-helper/mono-repo/B/Setup.hs b/test/testdata/cabal-helper/mono-repo/B/Setup.hs new file mode 100644 index 0000000000..9a994af677 --- /dev/null +++ b/test/testdata/cabal-helper/mono-repo/B/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/test/testdata/cabal-helper/mono-repo/C/C.cabal b/test/testdata/cabal-helper/mono-repo/C/C.cabal new file mode 100644 index 0000000000..db5e380f49 --- /dev/null +++ b/test/testdata/cabal-helper/mono-repo/C/C.cabal @@ -0,0 +1,9 @@ +cabal-version: >=1.10 +name: C +version: 0.1.0.0 +build-type: Simple + +library + exposed-modules: MyLib + build-depends: base + default-language: Haskell2010 diff --git a/test/testdata/cabal-helper/mono-repo/C/MyLib.hs b/test/testdata/cabal-helper/mono-repo/C/MyLib.hs new file mode 100644 index 0000000000..e657c4403f --- /dev/null +++ b/test/testdata/cabal-helper/mono-repo/C/MyLib.hs @@ -0,0 +1,4 @@ +module MyLib (someFunc) where + +someFunc :: IO () +someFunc = putStrLn "someFunc" diff --git a/test/testdata/cabal-helper/mono-repo/C/Setup.hs b/test/testdata/cabal-helper/mono-repo/C/Setup.hs new file mode 100644 index 0000000000..9a994af677 --- /dev/null +++ b/test/testdata/cabal-helper/mono-repo/C/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/test/testdata/cabal-helper/mono-repo/cabal.project b/test/testdata/cabal-helper/mono-repo/cabal.project new file mode 100644 index 0000000000..cf2eab3e10 --- /dev/null +++ b/test/testdata/cabal-helper/mono-repo/cabal.project @@ -0,0 +1,4 @@ +packages: + ./A/ + ./B/ + ./C/ \ No newline at end of file diff --git a/test/testdata/cabal-helper/multi-source-dirs/Setup.hs b/test/testdata/cabal-helper/multi-source-dirs/Setup.hs new file mode 100644 index 0000000000..9a994af677 --- /dev/null +++ b/test/testdata/cabal-helper/multi-source-dirs/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/test/testdata/cabal-helper/multi-source-dirs/multi-source-dirs.cabal b/test/testdata/cabal-helper/multi-source-dirs/multi-source-dirs.cabal new file mode 100644 index 0000000000..58568683dd --- /dev/null +++ b/test/testdata/cabal-helper/multi-source-dirs/multi-source-dirs.cabal @@ -0,0 +1,11 @@ +cabal-version: >=1.10 +name: multi-source-dirs +version: 0.1.0.0 +license-file: LICENSE +build-type: Simple + +library + exposed-modules: Lib, BetterLib + hs-source-dirs: src, src/input + build-depends: base + default-language: Haskell2010 diff --git a/test/testdata/cabal-helper/multi-source-dirs/src/BetterLib.hs b/test/testdata/cabal-helper/multi-source-dirs/src/BetterLib.hs new file mode 100644 index 0000000000..0784c76d48 --- /dev/null +++ b/test/testdata/cabal-helper/multi-source-dirs/src/BetterLib.hs @@ -0,0 +1,5 @@ +module BetterLib where + + +foo = 3 +bar = "String" \ No newline at end of file diff --git a/test/testdata/cabal-helper/multi-source-dirs/src/input/Lib.hs b/test/testdata/cabal-helper/multi-source-dirs/src/input/Lib.hs new file mode 100644 index 0000000000..6c37234910 --- /dev/null +++ b/test/testdata/cabal-helper/multi-source-dirs/src/input/Lib.hs @@ -0,0 +1,6 @@ +module Lib where + +foobar = 15 + +fizbuzz :: Int -> String +fizbuzz n = "Fizz" \ No newline at end of file diff --git a/test/testdata/cabal-helper/simple-cabal/MyLib.hs b/test/testdata/cabal-helper/simple-cabal/MyLib.hs new file mode 100644 index 0000000000..e657c4403f --- /dev/null +++ b/test/testdata/cabal-helper/simple-cabal/MyLib.hs @@ -0,0 +1,4 @@ +module MyLib (someFunc) where + +someFunc :: IO () +someFunc = putStrLn "someFunc" diff --git a/test/testdata/cabal-helper/simple-cabal/Setup.hs b/test/testdata/cabal-helper/simple-cabal/Setup.hs new file mode 100644 index 0000000000..9a994af677 --- /dev/null +++ b/test/testdata/cabal-helper/simple-cabal/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/test/testdata/cabal-helper/simple-cabal/simple-cabal-test.cabal b/test/testdata/cabal-helper/simple-cabal/simple-cabal-test.cabal new file mode 100644 index 0000000000..3c8be5d868 --- /dev/null +++ b/test/testdata/cabal-helper/simple-cabal/simple-cabal-test.cabal @@ -0,0 +1,10 @@ +cabal-version: >=1.10 +name: simple-cabal-test +version: 0.1.0.0 +license-file: LICENSE +build-type: Simple + +library + exposed-modules: MyLib + build-depends: base + default-language: Haskell2010 diff --git a/test/testdata/cabal-helper/simple-stack/MyLib.hs b/test/testdata/cabal-helper/simple-stack/MyLib.hs new file mode 100644 index 0000000000..e657c4403f --- /dev/null +++ b/test/testdata/cabal-helper/simple-stack/MyLib.hs @@ -0,0 +1,4 @@ +module MyLib (someFunc) where + +someFunc :: IO () +someFunc = putStrLn "someFunc" diff --git a/test/testdata/cabal-helper/simple-stack/Setup.hs b/test/testdata/cabal-helper/simple-stack/Setup.hs new file mode 100644 index 0000000000..9a994af677 --- /dev/null +++ b/test/testdata/cabal-helper/simple-stack/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/test/testdata/cabal-helper/simple-stack/simple-stack-test.cabal b/test/testdata/cabal-helper/simple-stack/simple-stack-test.cabal new file mode 100644 index 0000000000..264baebfd1 --- /dev/null +++ b/test/testdata/cabal-helper/simple-stack/simple-stack-test.cabal @@ -0,0 +1,10 @@ +cabal-version: >=1.10 +name: simple-stack-test +version: 0.1.0.0 +license-file: LICENSE +build-type: Simple + +library + exposed-modules: MyLib + build-depends: base + default-language: Haskell2010 diff --git a/test/testdata/cabal-helper/sub-package/Setup.hs b/test/testdata/cabal-helper/sub-package/Setup.hs new file mode 100644 index 0000000000..9a994af677 --- /dev/null +++ b/test/testdata/cabal-helper/sub-package/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/test/testdata/cabal-helper/sub-package/app/Main.hs b/test/testdata/cabal-helper/sub-package/app/Main.hs new file mode 100644 index 0000000000..60d904e8c1 --- /dev/null +++ b/test/testdata/cabal-helper/sub-package/app/Main.hs @@ -0,0 +1,8 @@ +module Main where + +import qualified MyLib (someFunc) + +main :: IO () +main = do + putStrLn "Hello, Haskell!" + MyLib.someFunc diff --git a/test/testdata/cabal-helper/sub-package/plugins-api/PluginLib.hs b/test/testdata/cabal-helper/sub-package/plugins-api/PluginLib.hs new file mode 100644 index 0000000000..55a7098c23 --- /dev/null +++ b/test/testdata/cabal-helper/sub-package/plugins-api/PluginLib.hs @@ -0,0 +1,4 @@ +module PluginLib (someFunc) where + +someFunc :: IO () +someFunc = putStrLn "someFunc" diff --git a/test/testdata/cabal-helper/sub-package/plugins-api/Setup.hs b/test/testdata/cabal-helper/sub-package/plugins-api/Setup.hs new file mode 100644 index 0000000000..9a994af677 --- /dev/null +++ b/test/testdata/cabal-helper/sub-package/plugins-api/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/test/testdata/cabal-helper/sub-package/plugins-api/plugins-api.cabal b/test/testdata/cabal-helper/sub-package/plugins-api/plugins-api.cabal new file mode 100644 index 0000000000..223fa73b95 --- /dev/null +++ b/test/testdata/cabal-helper/sub-package/plugins-api/plugins-api.cabal @@ -0,0 +1,10 @@ +cabal-version: >=1.10 +name: plugins-api +version: 0.1.0.0 +license-file: LICENSE +build-type: Simple + +library + exposed-modules: PluginLib + build-depends: base + default-language: Haskell2010 diff --git a/test/testdata/cabal-helper/sub-package/src/MyLib.hs b/test/testdata/cabal-helper/sub-package/src/MyLib.hs new file mode 100644 index 0000000000..53ea5c6332 --- /dev/null +++ b/test/testdata/cabal-helper/sub-package/src/MyLib.hs @@ -0,0 +1,6 @@ +module MyLib (someFunc) where + +import qualified PluginLib as L + +someFunc :: IO () +someFunc = L.someFunc diff --git a/test/testdata/cabal-helper/sub-package/sub-package.cabal b/test/testdata/cabal-helper/sub-package/sub-package.cabal new file mode 100644 index 0000000000..ba36f1b4d1 --- /dev/null +++ b/test/testdata/cabal-helper/sub-package/sub-package.cabal @@ -0,0 +1,17 @@ +cabal-version: >=1.10 +name: sub-package +version: 0.1.0.0 +license-file: LICENSE +build-type: Simple + +library + exposed-modules: MyLib + build-depends: base, plugins-api + hs-source-dirs: src + default-language: Haskell2010 + +executable sub-package + main-is: Main.hs + build-depends: base, sub-package + hs-source-dirs: app + default-language: Haskell2010 diff --git a/test/testdata/completion/Completion.hs b/test/testdata/completion/Completion.hs new file mode 100644 index 0000000000..d6480903b6 --- /dev/null +++ b/test/testdata/completion/Completion.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE OverloadedStrings #-} +import Data.Maybe +import qualified Data.List + +main :: IO () +main = putStrLn "hello" + +foo :: Either a b -> Either a b +foo = id \ No newline at end of file diff --git a/test/testdata/completion/Context.hs b/test/testdata/completion/Context.hs new file mode 100644 index 0000000000..45c5befb10 --- /dev/null +++ b/test/testdata/completion/Context.hs @@ -0,0 +1,4 @@ +module Context where +import Control.Concurrent as Conc +foo :: Int -> Int +foo x = abs 42 \ No newline at end of file diff --git a/test/testdata/completion/DupRecFields.hs b/test/testdata/completion/DupRecFields.hs new file mode 100644 index 0000000000..8ba3148d3a --- /dev/null +++ b/test/testdata/completion/DupRecFields.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE DuplicateRecordFields #-} +module DupRecFields where + +newtype One = One { accessor :: Int } +newtype Two = Two { accessor :: Int } diff --git a/test/testdata/completion/completions.cabal b/test/testdata/completion/completions.cabal new file mode 100644 index 0000000000..d2c23bd86e --- /dev/null +++ b/test/testdata/completion/completions.cabal @@ -0,0 +1,10 @@ +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 diff --git a/test/testdata/context/ExampleContext.hs b/test/testdata/context/ExampleContext.hs new file mode 100644 index 0000000000..324d055282 --- /dev/null +++ b/test/testdata/context/ExampleContext.hs @@ -0,0 +1,20 @@ +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 + diff --git a/test/testdata/context/Foo/Bar.hs b/test/testdata/context/Foo/Bar.hs new file mode 100644 index 0000000000..0d6044ee85 --- /dev/null +++ b/test/testdata/context/Foo/Bar.hs @@ -0,0 +1,3 @@ +module Foo.Bar where + + diff --git a/test/testdata/definition/Bar.hs b/test/testdata/definition/Bar.hs new file mode 100644 index 0000000000..02a244cd4d --- /dev/null +++ b/test/testdata/definition/Bar.hs @@ -0,0 +1,3 @@ +module Bar where + +a = 42 diff --git a/test/testdata/definition/Foo.hs b/test/testdata/definition/Foo.hs new file mode 100644 index 0000000000..6dfb3ba2e6 --- /dev/null +++ b/test/testdata/definition/Foo.hs @@ -0,0 +1,3 @@ +module Foo (module Bar) where + +import Bar diff --git a/test/testdata/definition/definitions.cabal b/test/testdata/definition/definitions.cabal new file mode 100644 index 0000000000..3ddc941472 --- /dev/null +++ b/test/testdata/definition/definitions.cabal @@ -0,0 +1,10 @@ +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 diff --git a/test/testdata/gototest/Setup.hs b/test/testdata/gototest/Setup.hs new file mode 100644 index 0000000000..9a994af677 --- /dev/null +++ b/test/testdata/gototest/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/test/testdata/gototest/app/Main.hs b/test/testdata/gototest/app/Main.hs new file mode 100644 index 0000000000..2c951ca59d --- /dev/null +++ b/test/testdata/gototest/app/Main.hs @@ -0,0 +1,7 @@ +module Main where + +import Lib +import Lib2 + +main :: IO () +main = someFunc >> g diff --git a/test/testdata/gototest/cabal.project b/test/testdata/gototest/cabal.project new file mode 100644 index 0000000000..258ca2fe22 --- /dev/null +++ b/test/testdata/gototest/cabal.project @@ -0,0 +1,3 @@ +packages: . + +write-ghc-environment-files: never diff --git a/test/testdata/gototest/gototest.cabal b/test/testdata/gototest/gototest.cabal new file mode 100644 index 0000000000..5cac1ffefd --- /dev/null +++ b/test/testdata/gototest/gototest.cabal @@ -0,0 +1,24 @@ +name: gototest +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 + +executable gototest-exec + hs-source-dirs: app + main-is: Main.hs + other-modules: + build-depends: base >= 4.7 && < 5, gototest + default-language: Haskell2010 + +library + hs-source-dirs: src + exposed-modules: Lib, Lib2 + build-depends: base >= 4.7 && < 5 + default-language: Haskell2010 diff --git a/test/testdata/gototest/src/Lib.hs b/test/testdata/gototest/src/Lib.hs new file mode 100644 index 0000000000..2603a7474c --- /dev/null +++ b/test/testdata/gototest/src/Lib.hs @@ -0,0 +1,40 @@ +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 \ No newline at end of file diff --git a/test/testdata/gototest/src/Lib2.hs b/test/testdata/gototest/src/Lib2.hs new file mode 100644 index 0000000000..c0ef7d46b0 --- /dev/null +++ b/test/testdata/gototest/src/Lib2.hs @@ -0,0 +1,13 @@ +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 \ No newline at end of file diff --git a/test/testdata/hieBiosError/Foo.hs b/test/testdata/hieBiosError/Foo.hs new file mode 100644 index 0000000000..e495355ec9 --- /dev/null +++ b/test/testdata/hieBiosError/Foo.hs @@ -0,0 +1 @@ +main = putStrLn "hey" diff --git a/test/testdata/hieBiosMainIs/Main.hs b/test/testdata/hieBiosMainIs/Main.hs new file mode 100644 index 0000000000..65ae4a05d5 --- /dev/null +++ b/test/testdata/hieBiosMainIs/Main.hs @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = putStrLn "Hello, Haskell!" diff --git a/test/testdata/hieBiosMainIs/Setup.hs b/test/testdata/hieBiosMainIs/Setup.hs new file mode 100644 index 0000000000..9a994af677 --- /dev/null +++ b/test/testdata/hieBiosMainIs/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/test/testdata/hieBiosMainIs/hieBiosMainIs.cabal b/test/testdata/hieBiosMainIs/hieBiosMainIs.cabal new file mode 100644 index 0000000000..d7efa971e0 --- /dev/null +++ b/test/testdata/hieBiosMainIs/hieBiosMainIs.cabal @@ -0,0 +1,8 @@ +cabal-version: >=1.10 +name: hieBiosMainIs +version: 0.1.0.0 +build-type: Simple +executable hieBiosMainIs + main-is: Main.hs + build-depends: base >=4.12 && <4.13 + default-language: Haskell2010 diff --git a/test/testdata/liquid/Evens.hs b/test/testdata/liquid/Evens.hs new file mode 100644 index 0000000000..38ac14b2be --- /dev/null +++ b/test/testdata/liquid/Evens.hs @@ -0,0 +1,41 @@ +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" diff --git a/test/testdata/redundantImportTest/src/CodeActionRedundant.hs b/test/testdata/redundantImportTest/src/CodeActionRedundant.hs new file mode 100644 index 0000000000..870fc5b16a --- /dev/null +++ b/test/testdata/redundantImportTest/src/CodeActionRedundant.hs @@ -0,0 +1,4 @@ +module CodeActionRedundant where +import Data.List +main :: IO () +main = putStrLn "hello" \ No newline at end of file diff --git a/test/testdata/redundantImportTest/src/MultipleImports.hs b/test/testdata/redundantImportTest/src/MultipleImports.hs new file mode 100644 index 0000000000..4bc5508b61 --- /dev/null +++ b/test/testdata/redundantImportTest/src/MultipleImports.hs @@ -0,0 +1,5 @@ +module MultipleImports where +import Data.Foldable +import Data.Maybe +foo :: Int +foo = fromJust (Just 3) diff --git a/test/testdata/redundantImportTest/test.cabal b/test/testdata/redundantImportTest/test.cabal new file mode 100644 index 0000000000..d185920d5b --- /dev/null +++ b/test/testdata/redundantImportTest/test.cabal @@ -0,0 +1,18 @@ +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 \ No newline at end of file diff --git a/test/testdata/testdata.cabal b/test/testdata/testdata.cabal index 04dc2a7073..c191bbd1f1 100644 --- a/test/testdata/testdata.cabal +++ b/test/testdata/testdata.cabal @@ -3,88 +3,80 @@ version: 0.1.0.0 cabal-version: >=2.0 build-type: Simple -library +executable applyrefact build-depends: base + main-is: ApplyRefact.hs + default-language: Haskell2010 + +executable applyrefact2 + build-depends: base + main-is: ApplyRefact2.hs + default-language: Haskell2010 + +executable codeactionrename + build-depends: base + main-is: CodeActionRename.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 applyrefact2 + build-depends: base + main-is: ApplyRefact2.hs + default-language: Haskell2010 + +executable hlintpragma + build-depends: base + main-is: HlintPragma.hs + default-language: Haskell2010 + +executable harecase + build-depends: base + main-is: HaReCase.hs + default-language: Haskell2010 + +executable haredemote + build-depends: base + main-is: HaReDemote.hs + default-language: Haskell2010 + +executable haremovedef + build-depends: base + main-is: HaReMoveDef.hs + default-language: Haskell2010 + +executable harerename + build-depends: base + main-is: HaReRename.hs + default-language: Haskell2010 + +executable haregenapplicative + build-depends: base + , parsec + main-is: HaReGA1.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 + +executable filewithwarning + build-depends: base + main-is: FileWithWarning.hs default-language: Haskell2010 - exposed-modules: - BrittanyCRLF - BrittanyLF - Format - --- executable applyrefact --- build-depends: base --- main-is: ApplyRefact.hs --- default-language: Haskell2010 - --- executable applyrefact2 --- build-depends: base --- main-is: ApplyRefact2.hs --- default-language: Haskell2010 - --- executable codeactionrename --- build-depends: base --- main-is: CodeActionRename.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 applyrefact2 --- build-depends: base --- main-is: ApplyRefact2.hs --- default-language: Haskell2010 - --- executable hlintpragma --- build-depends: base --- main-is: HlintPragma.hs --- default-language: Haskell2010 - --- executable harecase --- build-depends: base --- main-is: HaReCase.hs --- default-language: Haskell2010 - --- executable haredemote --- build-depends: base --- main-is: HaReDemote.hs --- default-language: Haskell2010 - --- executable haremovedef --- build-depends: base --- main-is: HaReMoveDef.hs --- default-language: Haskell2010 - --- executable harerename --- build-depends: base --- main-is: HaReRename.hs --- default-language: Haskell2010 - --- executable haregenapplicative --- build-depends: base --- , parsec --- main-is: HaReGA1.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 - --- executable filewithwarning --- build-depends: base --- main-is: FileWithWarning.hs --- default-language: Haskell2010 diff --git a/test/testdata/typedHoleDiag.txt b/test/testdata/typedHoleDiag.txt new file mode 100644 index 0000000000..3ca81f900c --- /dev/null +++ b/test/testdata/typedHoleDiag.txt @@ -0,0 +1,26 @@ +• Found hole: _ :: Maybe T.Text +• In the expression: _ + In an equation for ‘extractHoles’: + extractHoles diag + | "Found hole:" `T.isInfixOf` diag = _ + | otherwise = Nothing +• Relevant bindings include + diag :: T.Text + (bound at /private/var/folders/zh/fqwj2cq95b7gbzs49fsq5drw0000gn/T/ghc-mod48138/GhcMod48135-416.hs:482:14) + extractHoles :: T.Text -> Maybe T.Text + (bound at /private/var/folders/zh/fqwj2cq95b7gbzs49fsq5drw0000gn/T/ghc-mod48138/GhcMod48135-416.hs:482:1) + Valid substitutions include + Nothing :: forall a. Maybe a + (imported from ‘Data.Maybe’ at /private/var/folders/zh/fqwj2cq95b7gbzs49fsq5drw0000gn/T/ghc-mod48138/GhcMod48135-416.hs:24:1-27 + (and originally defined in ‘GHC.Base’)) + mempty :: forall a. Monoid a => a + (imported from ‘Prelude’ at /private/var/folders/zh/fqwj2cq95b7gbzs49fsq5drw0000gn/T/ghc-mod48138/GhcMod48135-416.hs:8:8-39 + (and originally defined in ‘GHC.Base’)) + undefined :: forall (a :: TYPE r). + GHC.Stack.Types.HasCallStack => + a + (imported from ‘Prelude’ at /private/var/folders/zh/fqwj2cq95b7gbzs49fsq5drw0000gn/T/ghc-mod48138/GhcMod48135-416.hs:8:8-39 + (and originally defined in ‘GHC.Err’)) + GM.mzero :: forall (m :: * -> *). GM.MonadPlus m => forall a. m a + (imported qualified from ‘GhcMod.Error’ at /private/var/folders/zh/fqwj2cq95b7gbzs49fsq5drw0000gn/T/ghc-mod48138/GhcMod48135-416.hs:37:1-56 + (and originally defined in ‘GHC.Base’)) \ No newline at end of file diff --git a/test/testdata/typedHoleDiag2.txt b/test/testdata/typedHoleDiag2.txt new file mode 100644 index 0000000000..032d18bacc --- /dev/null +++ b/test/testdata/typedHoleDiag2.txt @@ -0,0 +1,17 @@ +• Found hole: _ :: A +• In the expression: _ + In an equation for ‘foo2’: + foo2 x + = _ + where + stuff (A a) = A (a + 1) +• Relevant bindings include + stuff :: A -> A (bound at test/testdata/TypedHoles2.hs:6:5) + x :: [A] (bound at test/testdata/TypedHoles2.hs:4:6) + foo2 :: [A] -> A (bound at test/testdata/TypedHoles2.hs:4:1) + Valid substitutions include + undefined :: forall (a :: TYPE r). + GHC.Stack.Types.HasCallStack => + a + (imported from ‘Prelude’ at test/testdata/TypedHoles2.hs:1:8-18 + (and originally defined in ‘GHC.Err’)) diff --git a/test/testdata/typedHoleDiag3.txt b/test/testdata/typedHoleDiag3.txt new file mode 100644 index 0000000000..ffe520ffaa --- /dev/null +++ b/test/testdata/typedHoleDiag3.txt @@ -0,0 +1,37 @@ +• Found hole: _ :: t -> FilePath + Where: ‘t’ is a rigid type variable bound by + the inferred type of + lintDockerfile :: [IgnoreRule] + -> t + -> IO (Either Language.Docker.Parser.Error [Rules.RuleCheck]) + at app/Main.hs:(229,5)-(235,47) +• In the expression: _ + In the first argument of ‘Docker.parseFile’, namely + ‘(_ dockerFile)’ + In a stmt of a 'do' block: ast <- Docker.parseFile (_ dockerFile) +• Relevant bindings include + processedFile :: Either Language.Docker.Parser.Error Dockerfile + -> Either Language.Docker.Parser.Error [Rules.RuleCheck] + (bound at app/Main.hs:233:9) + processRules :: Dockerfile -> [Rules.RuleCheck] + (bound at app/Main.hs:234:9) + ignoredRules :: Rules.RuleCheck -> Bool + (bound at app/Main.hs:235:9) + dockerFile :: t (bound at app/Main.hs:229:32) + ignoreRules :: [IgnoreRule] (bound at app/Main.hs:229:20) + lintDockerfile :: [IgnoreRule] + -> t -> IO (Either Language.Docker.Parser.Error [Rules.RuleCheck]) + (bound at app/Main.hs:229:5) + (Some bindings suppressed; use -fmax-relevant-binds=N or -fno-max-relevant-binds) + Valid substitutions include + mempty :: forall a. Monoid a => a + (imported from ‘Prelude’ at app/Main.hs:5:8-11 + (and originally defined in ‘GHC.Base’)) + undefined :: forall (a :: TYPE r). + GHC.Stack.Types.HasCallStack => + a + (imported from ‘Prelude’ at app/Main.hs:5:8-11 + (and originally defined in ‘GHC.Err’)) + idm :: forall m. Monoid m => m + (imported from ‘Options.Applicative’ at app/Main.hs:21:1-46 + (and originally defined in ‘Options.Applicative.Builder’)) diff --git a/test/testdata/wErrorTest/src/WError.hs b/test/testdata/wErrorTest/src/WError.hs new file mode 100644 index 0000000000..86e0ad2a3d --- /dev/null +++ b/test/testdata/wErrorTest/src/WError.hs @@ -0,0 +1,2 @@ +module WError where +main = undefined diff --git a/test/testdata/wErrorTest/test.cabal b/test/testdata/wErrorTest/test.cabal new file mode 100644 index 0000000000..4ce7fc3b9a --- /dev/null +++ b/test/testdata/wErrorTest/test.cabal @@ -0,0 +1,18 @@ +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 diff --git a/test/testdata/wrapper/8.8.1/Setup.hs b/test/testdata/wrapper/8.8.1/Setup.hs new file mode 100644 index 0000000000..9a994af677 --- /dev/null +++ b/test/testdata/wrapper/8.8.1/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/test/testdata/wrapper/8.8.1/cabal1.cabal b/test/testdata/wrapper/8.8.1/cabal1.cabal new file mode 100644 index 0000000000..f599b3df0c --- /dev/null +++ b/test/testdata/wrapper/8.8.1/cabal1.cabal @@ -0,0 +1,25 @@ +-- Initial cabal1.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: cabal1 +version: 0.1.0.0 +-- synopsis: +-- description: +license: PublicDomain +-- license-file: LICENSE +author: Alan Zimmerman +maintainer: alan.zimm@gmail.com +-- copyright: +-- category: +build-type: Simple +-- extra-source-files: +-- cabal-helper for cabal 2.2/GHC 8.4 needs a cabal version >= 2 +cabal-version: >=2.0 + +executable cabal1 + main-is: main.hs + -- other-modules: + -- other-extensions: + build-depends: base >=4.6 && <5 + hs-source-dirs: src + default-language: Haskell2010 \ No newline at end of file diff --git a/test/testdata/wrapper/8.8.1/src/Foo/Bar.hs b/test/testdata/wrapper/8.8.1/src/Foo/Bar.hs new file mode 100644 index 0000000000..ceb08691b1 --- /dev/null +++ b/test/testdata/wrapper/8.8.1/src/Foo/Bar.hs @@ -0,0 +1,3 @@ +module Foo.Bar where + +baz = 6 diff --git a/test/testdata/wrapper/8.8.1/src/main.hs b/test/testdata/wrapper/8.8.1/src/main.hs new file mode 100644 index 0000000000..839d104293 --- /dev/null +++ b/test/testdata/wrapper/8.8.1/src/main.hs @@ -0,0 +1,7 @@ +-- | Testing that HaRe can find source files from a cabal file + +import qualified Foo.Bar as B + +main = putStrLn "foo" + +baz = 3 + B.baz diff --git a/test/testdata/wrapper/ghc/dummy b/test/testdata/wrapper/ghc/dummy new file mode 100644 index 0000000000..9c7ffe8ee9 --- /dev/null +++ b/test/testdata/wrapper/ghc/dummy @@ -0,0 +1 @@ +Needed or else git won't track the directory \ No newline at end of file diff --git a/test/testdata/wrapper/lts-14.18/Setup.hs b/test/testdata/wrapper/lts-14.18/Setup.hs new file mode 100644 index 0000000000..9a994af677 --- /dev/null +++ b/test/testdata/wrapper/lts-14.18/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/test/testdata/wrapper/lts-14.18/cabal1.cabal b/test/testdata/wrapper/lts-14.18/cabal1.cabal new file mode 100644 index 0000000000..f599b3df0c --- /dev/null +++ b/test/testdata/wrapper/lts-14.18/cabal1.cabal @@ -0,0 +1,25 @@ +-- Initial cabal1.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: cabal1 +version: 0.1.0.0 +-- synopsis: +-- description: +license: PublicDomain +-- license-file: LICENSE +author: Alan Zimmerman +maintainer: alan.zimm@gmail.com +-- copyright: +-- category: +build-type: Simple +-- extra-source-files: +-- cabal-helper for cabal 2.2/GHC 8.4 needs a cabal version >= 2 +cabal-version: >=2.0 + +executable cabal1 + main-is: main.hs + -- other-modules: + -- other-extensions: + build-depends: base >=4.6 && <5 + hs-source-dirs: src + default-language: Haskell2010 \ No newline at end of file diff --git a/test/testdata/wrapper/lts-14.18/src/Foo/Bar.hs b/test/testdata/wrapper/lts-14.18/src/Foo/Bar.hs new file mode 100644 index 0000000000..ceb08691b1 --- /dev/null +++ b/test/testdata/wrapper/lts-14.18/src/Foo/Bar.hs @@ -0,0 +1,3 @@ +module Foo.Bar where + +baz = 6 diff --git a/test/testdata/wrapper/lts-14.18/src/main.hs b/test/testdata/wrapper/lts-14.18/src/main.hs new file mode 100644 index 0000000000..839d104293 --- /dev/null +++ b/test/testdata/wrapper/lts-14.18/src/main.hs @@ -0,0 +1,7 @@ +-- | Testing that HaRe can find source files from a cabal file + +import qualified Foo.Bar as B + +main = putStrLn "foo" + +baz = 3 + B.baz From 86017da8f53429703e25d70c2a876e30bb80a4a7 Mon Sep 17 00:00:00 2001 From: Jeff Windsor Date: Sat, 9 May 2020 16:09:23 -0700 Subject: [PATCH 06/26] add Completion Tests (all are timing out as of now) --- haskell-language-server.cabal | 3 +- test/functional/Commands.hs | 2 +- test/functional/Completions.hs | 391 +++++++++++++++++++++++++++++++++ test/functional/Main.hs | 2 + test/utils/TastyUtils.hs | 18 +- 5 files changed, 405 insertions(+), 11 deletions(-) create mode 100644 test/functional/Completions.hs diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 9c57c2796f..79332a6bfe 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -228,7 +228,8 @@ test-suite func-test hs-source-dirs: test/functional main-is: Main.hs other-modules: - Commands + Commands + , Completions ghc-options: -Wall -Wno-name-shadowing diff --git a/test/functional/Commands.hs b/test/functional/Commands.hs index 5f9df3e836..0c90711369 100644 --- a/test/functional/Commands.hs +++ b/test/functional/Commands.hs @@ -14,7 +14,7 @@ import TestUtils import TastyUtils tests :: TestTree -tests = testGroup "Commands" [ +tests = testGroup "commands" [ testCase "are prefixed" $ runSession hieCommand fullCaps "test/testdata/" $ do ResponseMessage _ _ (Just res) Nothing <- initializeResponse diff --git a/test/functional/Completions.hs b/test/functional/Completions.hs new file mode 100644 index 0000000000..cf43eafd8d --- /dev/null +++ b/test/functional/Completions.hs @@ -0,0 +1,391 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Completions(tests) where + +import Control.Applicative.Combinators +import Control.Monad.IO.Class +import Control.Lens hiding ((.=)) +-- import Data.Aeson +import Language.Haskell.LSP.Test +import Language.Haskell.LSP.Types +import Language.Haskell.LSP.Types.Lens hiding (applyEdit) +import Test.Tasty +import Test.Tasty.HUnit +import TestUtils +import TastyUtils + +tests :: TestTree +tests = testGroup "completions" [ + testCase "works" $ runSession hieCommand fullCaps "test/testdata/completion" $ do + doc <- openDoc "Completion.hs" "haskell" + _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + + let te = TextEdit (Range (Position 5 7) (Position 5 24)) "put" + _ <- applyEdit doc te + + compls <- getCompletions doc (Position 5 9) + let item = head $ filter ((== "putStrLn") . (^. label)) compls + liftIO $ do + item ^. label `shouldBe` "putStrLn" + item ^. kind `shouldBe` Just CiFunction + item ^. detail `shouldBe` Just "Prelude" + resolvedRes <- request CompletionItemResolve item + let Just (resolved :: CompletionItem) = resolvedRes ^. result + liftIO $ do + resolved ^. label `shouldBe` "putStrLn" + resolved ^. kind `shouldBe` Just CiFunction + resolved ^. detail `shouldBe` Just "String -> IO ()\nPrelude" + resolved ^. insertTextFormat `shouldBe` Just Snippet + resolved ^. insertText `shouldBe` Just "putStrLn ${1:String}" + + , testCase "completes imports" $ runSession hieCommand fullCaps "test/testdata/completion" $ do + doc <- openDoc "Completion.hs" "haskell" + _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + + let te = TextEdit (Range (Position 1 17) (Position 1 26)) "Data.M" + _ <- applyEdit doc te + + compls <- getCompletions doc (Position 1 22) + let item = head $ filter ((== "Maybe") . (^. label)) compls + liftIO $ do + item ^. label `shouldBe` "Maybe" + item ^. detail `shouldBe` Just "Data.Maybe" + item ^. kind `shouldBe` Just CiModule + + , testCase "completes qualified imports" $ runSession hieCommand fullCaps "test/testdata/completion" $ do + doc <- openDoc "Completion.hs" "haskell" + _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + + let te = TextEdit (Range (Position 2 17) (Position 1 25)) "Dat" + _ <- applyEdit doc te + + compls <- getCompletions doc (Position 1 19) + let item = head $ filter ((== "Data.List") . (^. label)) compls + liftIO $ do + item ^. label `shouldBe` "Data.List" + item ^. detail `shouldBe` Just "Data.List" + item ^. kind `shouldBe` Just CiModule + + , testCase "completes language extensions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do + doc <- openDoc "Completion.hs" "haskell" + _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + + let te = TextEdit (Range (Position 0 24) (Position 0 31)) "" + _ <- applyEdit doc te + + compls <- getCompletions doc (Position 0 24) + let item = head $ filter ((== "OverloadedStrings") . (^. label)) compls + liftIO $ do + item ^. label `shouldBe` "OverloadedStrings" + item ^. kind `shouldBe` Just CiKeyword + + , testCase "completes pragmas" $ runSession hieCommand fullCaps "test/testdata/completion" $ do + doc <- openDoc "Completion.hs" "haskell" + _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + + let te = TextEdit (Range (Position 0 4) (Position 0 34)) "" + _ <- applyEdit doc te + + compls <- getCompletions doc (Position 0 4) + let item = head $ filter ((== "LANGUAGE") . (^. label)) compls + liftIO $ do + item ^. label `shouldBe` "LANGUAGE" + item ^. kind `shouldBe` Just CiKeyword + item ^. insertTextFormat `shouldBe` Just Snippet + item ^. insertText `shouldBe` Just "LANGUAGE ${1:extension} #-}" + + , testCase "completes pragmas no close" $ runSession hieCommand fullCaps "test/testdata/completion" $ do + doc <- openDoc "Completion.hs" "haskell" + _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + + let te = TextEdit (Range (Position 0 4) (Position 0 24)) "" + _ <- applyEdit doc te + + compls <- getCompletions doc (Position 0 4) + let item = head $ filter ((== "LANGUAGE") . (^. label)) compls + liftIO $ do + item ^. label `shouldBe` "LANGUAGE" + item ^. kind `shouldBe` Just CiKeyword + item ^. insertTextFormat `shouldBe` Just Snippet + item ^. insertText `shouldBe` Just "LANGUAGE ${1:extension}" + + , testCase "completes options pragma" $ runSession hieCommand fullCaps "test/testdata/completion" $ do + doc <- openDoc "Completion.hs" "haskell" + _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + + let te = TextEdit (Range (Position 0 4) (Position 0 34)) "OPTIONS" + _ <- applyEdit doc te + + compls <- getCompletions doc (Position 0 4) + let item = head $ filter ((== "OPTIONS_GHC") . (^. label)) compls + liftIO $ do + item ^. label `shouldBe` "OPTIONS_GHC" + item ^. kind `shouldBe` Just CiKeyword + item ^. insertTextFormat `shouldBe` Just Snippet + item ^. insertText `shouldBe` Just "OPTIONS_GHC -${1:option} #-}" + + -- ----------------------------------- + + , testCase "completes ghc options pragma values" $ runSession hieCommand fullCaps "test/testdata/completion" $ do + doc <- openDoc "Completion.hs" "haskell" + + _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + + let te = TextEdit (Range (Position 0 0) (Position 0 0)) "{-# OPTIONS_GHC -Wno-red #-}\n" + _ <- applyEdit doc te + + compls <- getCompletions doc (Position 0 24) + let item = head $ filter ((== "Wno-redundant-constraints") . (^. label)) compls + liftIO $ do + item ^. label `shouldBe` "Wno-redundant-constraints" + item ^. kind `shouldBe` Just CiKeyword + item ^. insertTextFormat `shouldBe` Nothing + item ^. insertText `shouldBe` Nothing + + -- ----------------------------------- + + , testCase "completes with no prefix" $ runSession hieCommand fullCaps "test/testdata/completion" $ do + doc <- openDoc "Completion.hs" "haskell" + _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + compls <- getCompletions doc (Position 5 7) + liftIO $ filter ((== "!!") . (^. label)) compls `shouldNotSatisfy` null + + -- See https://github.com/haskell/haskell-ide-engine/issues/903 + , testCase "strips compiler generated stuff from completions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do + doc <- openDoc "DupRecFields.hs" "haskell" + _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + + let te = TextEdit (Range (Position 5 0) (Position 5 2)) "acc" + _ <- applyEdit doc te + + compls <- getCompletions doc (Position 5 4) + let item = head $ filter (\c -> c^.label == "accessor") compls + liftIO $ do + item ^. label `shouldBe` "accessor" + item ^. kind `shouldBe` Just CiFunction + item ^. detail `shouldBe` Just "Two -> Int\nDupRecFields" + item ^. insertText `shouldBe` Just "accessor ${1:Two}" + + , testCase "have implicit foralls on basic polymorphic types" $ runSession hieCommand fullCaps "test/testdata/completion" $ do + doc <- openDoc "Completion.hs" "haskell" + _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + let te = TextEdit (Range (Position 5 7) (Position 5 9)) "id" + _ <- applyEdit doc te + compls <- getCompletions doc (Position 5 9) + let item = head $ filter ((== "id") . (^. label)) compls + resolvedRes <- request CompletionItemResolve item + let Just (resolved :: CompletionItem) = resolvedRes ^. result + liftIO $ + resolved ^. detail `shouldBe` Just "a -> a\nPrelude" + + , testCase "have implicit foralls with multiple type variables" $ runSession hieCommand fullCaps "test/testdata/completion" $ do + doc <- openDoc "Completion.hs" "haskell" + _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + let te = TextEdit (Range (Position 5 7) (Position 5 24)) "flip" + _ <- applyEdit doc te + compls <- getCompletions doc (Position 5 11) + let item = head $ filter ((== "flip") . (^. label)) compls + resolvedRes <- request CompletionItemResolve item + let Just (resolved :: CompletionItem) = resolvedRes ^. result + liftIO $ + resolved ^. detail `shouldBe` Just "(a -> b -> c) -> b -> a -> c\nPrelude" + + , contextTests + , snippetTests + ] + +snippetTests :: TestTree +snippetTests = testGroup "snippets" [ + testCase "work for argumentless constructors" $ runSession hieCommand fullCaps "test/testdata/completion" $ do + doc <- openDoc "Completion.hs" "haskell" + _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + + let te = TextEdit (Range (Position 5 7) (Position 5 24)) "Nothing" + _ <- applyEdit doc te + + compls <- getCompletions doc (Position 5 14) + let item = head $ filter ((== "Nothing") . (^. label)) compls + liftIO $ do + item ^. insertTextFormat `shouldBe` Just Snippet + item ^. insertText `shouldBe` Just "Nothing" + + , testCase "work for polymorphic types" $ runSession hieCommand fullCaps "test/testdata/completion" $ do + doc <- openDoc "Completion.hs" "haskell" + _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + + let te = TextEdit (Range (Position 5 7) (Position 5 24)) "fold" + _ <- applyEdit doc te + + compls <- getCompletions doc (Position 5 11) + let item = head $ filter ((== "foldl") . (^. label)) compls + resolvedRes <- request CompletionItemResolve item + let Just (resolved :: CompletionItem) = resolvedRes ^. result + liftIO $ do + resolved ^. label `shouldBe` "foldl" + resolved ^. kind `shouldBe` Just CiFunction + resolved ^. insertTextFormat `shouldBe` Just Snippet + resolved ^. insertText `shouldBe` Just "foldl ${1:b -> a -> b} ${2:b} ${3:t a}" + + , testCase "work for complex types" $ runSession hieCommand fullCaps "test/testdata/completion" $ do + doc <- openDoc "Completion.hs" "haskell" + _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + + let te = TextEdit (Range (Position 5 7) (Position 5 24)) "mapM" + _ <- applyEdit doc te + + compls <- getCompletions doc (Position 5 11) + let item = head $ filter ((== "mapM") . (^. label)) compls + resolvedRes <- request CompletionItemResolve item + let Just (resolved :: CompletionItem) = resolvedRes ^. result + liftIO $ do + resolved ^. label `shouldBe` "mapM" + resolved ^. kind `shouldBe` Just CiFunction + resolved ^. insertTextFormat `shouldBe` Just Snippet + resolved ^. insertText `shouldBe` Just "mapM ${1:a -> m b} ${2:t a}" + + , testCase "work for infix functions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do + doc <- openDoc "Completion.hs" "haskell" + _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + + let te = TextEdit (Range (Position 5 7) (Position 5 24)) "even `filte" + _ <- applyEdit doc te + + compls <- getCompletions doc (Position 5 18) + let item = head $ filter ((== "filter") . (^. label)) compls + liftIO $ do + item ^. label `shouldBe` "filter" + item ^. kind `shouldBe` Just CiFunction + item ^. insertTextFormat `shouldBe` Just Snippet + item ^. insertText `shouldBe` Just "filter`" + + , testCase "work for infix functions in backticks" $ runSession hieCommand fullCaps "test/testdata/completion" $ do + doc <- openDoc "Completion.hs" "haskell" + _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + + let te = TextEdit (Range (Position 5 7) (Position 5 24)) "even `filte`" + _ <- applyEdit doc te + + compls <- getCompletions doc (Position 5 18) + let item = head $ filter ((== "filter") . (^. label)) compls + liftIO $ do + item ^. label `shouldBe` "filter" + item ^. kind `shouldBe` Just CiFunction + item ^. insertTextFormat `shouldBe` Just Snippet + item ^. insertText `shouldBe` Just "filter" + + , testCase "work for qualified infix functions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do + doc <- openDoc "Completion.hs" "haskell" + _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + + let te = TextEdit (Range (Position 5 7) (Position 5 24)) "\"\" `Data.List.interspe" + _ <- applyEdit doc te + + compls <- getCompletions doc (Position 5 29) + let item = head $ filter ((== "intersperse") . (^. label)) compls + liftIO $ do + item ^. label `shouldBe` "intersperse" + item ^. kind `shouldBe` Just CiFunction + item ^. insertTextFormat `shouldBe` Just Snippet + item ^. insertText `shouldBe` Just "intersperse`" + + , testCase "work for qualified infix functions in backticks" $ runSession hieCommand fullCaps "test/testdata/completion" $ do + doc <- openDoc "Completion.hs" "haskell" + _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + + let te = TextEdit (Range (Position 5 7) (Position 5 24)) "\"\" `Data.List.interspe`" + _ <- applyEdit doc te + + compls <- getCompletions doc (Position 5 29) + let item = head $ filter ((== "intersperse") . (^. label)) compls + liftIO $ do + item ^. label `shouldBe` "intersperse" + item ^. kind `shouldBe` Just CiFunction + item ^. insertTextFormat `shouldBe` Just Snippet + item ^. insertText `shouldBe` Just "intersperse" + + -- -- TODO : Fix compile issue in the test "Variable not in scope: object" + -- , testCase "respects lsp configuration" $ runSession hieCommand fullCaps "test/testdata/completion" $ do + -- doc <- openDoc "Completion.hs" "haskell" + -- _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + + -- let config = object [ "languageServerHaskell" .= (object ["completionSnippetsOn" .= False])] + + -- sendNotification WorkspaceDidChangeConfiguration + -- (DidChangeConfigurationParams config) + + -- checkNoSnippets doc + + , testCase "respects client capabilities" $ runSession hieCommand noSnippetsCaps "test/testdata/completion" $ do + doc <- openDoc "Completion.hs" "haskell" + _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + + checkNoSnippets doc + ] + where + checkNoSnippets doc = do + let te = TextEdit (Range (Position 5 7) (Position 5 24)) "fold" + _ <- applyEdit doc te + + compls <- getCompletions doc (Position 5 11) + let item = head $ filter ((== "foldl") . (^. label)) compls + liftIO $ do + item ^. label `shouldBe` "foldl" + item ^. kind `shouldBe` Just CiFunction + item ^. insertTextFormat `shouldBe` Just PlainText + item ^. insertText `shouldBe` Nothing + + resolvedRes <- request CompletionItemResolve item + let Just (resolved :: CompletionItem) = resolvedRes ^. result + liftIO $ do + resolved ^. label `shouldBe` "foldl" + resolved ^. kind `shouldBe` Just CiFunction + resolved ^. insertTextFormat `shouldBe` Just PlainText + resolved ^. insertText `shouldBe` Nothing + + noSnippetsCaps = + ( textDocument + . _Just + . completion + . _Just + . completionItem + . _Just + . snippetSupport + ?~ False + ) + fullCaps + +contextTests :: TestTree +contextTests = testGroup "contexts" [ + testCase "only provides type suggestions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do + doc <- openDoc "Context.hs" "haskell" + _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + compls <- getCompletions doc (Position 2 17) + liftIO $ do + compls `shouldContainCompl` "Integer" + compls `shouldNotContainCompl` "interact" + + , testCase "only provides type suggestions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do + doc <- openDoc "Context.hs" "haskell" + _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + compls <- getCompletions doc (Position 3 9) + liftIO $ do + compls `shouldContainCompl` "abs" + compls `shouldNotContainCompl` "Applicative" + + -- This currently fails if , testCase takes too long to typecheck the module + -- , testCase "completes qualified type suggestions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do + -- doc <- openDoc "Context.hs" "haskell" + -- _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + -- let te = TextEdit (Range (Position 2 17) (Position 2 17)) " -> Conc." + -- _ <- applyEdit doc te + -- compls <- getCompletions doc (Position 2 26) + -- liftIO $ do + -- compls `shouldNotContainCompl` "forkOn" + -- compls `shouldContainCompl` "MVar" + -- compls `shouldContainCompl` "Chan" + ] + where + compls `shouldContainCompl` x = + filter ((== x) . (^. label)) compls `shouldNotSatisfy` null + compls `shouldNotContainCompl` x = + filter ((== x) . (^. label)) compls `shouldSatisfy` null \ No newline at end of file diff --git a/test/functional/Main.hs b/test/functional/Main.hs index 16b0d4f897..44b9ce135d 100644 --- a/test/functional/Main.hs +++ b/test/functional/Main.hs @@ -5,6 +5,7 @@ import Language.Haskell.LSP.Test import Test.Tasty import TestUtils import Commands +import Completions main :: IO () main = do @@ -16,4 +17,5 @@ main = do defaultMain $ testGroup "HIE" [ Commands.tests + , Completions.tests ] \ No newline at end of file diff --git a/test/utils/TastyUtils.hs b/test/utils/TastyUtils.hs index 3733f23537..fd587d9477 100644 --- a/test/utils/TastyUtils.hs +++ b/test/utils/TastyUtils.hs @@ -1,19 +1,19 @@ module TastyUtils ( - shouldSatisfy - ,shouldNotSatisfy + (===) + , shouldBe + , shouldSatisfy + , shouldNotSatisfy ) where import Test.Tasty.HUnit --- (===) :: (Eq a, Show a) => a -> a -> Assertion --- (===) = (@?=) --- infixl 1 === +infix 1 ===, `shouldBe`, `shouldSatisfy`, `shouldNotSatisfy` --- assertTrue :: Assertion --- assertTrue = assertBool "Success" True +(===) :: (Eq a, Show a) => a -> a -> Assertion +(===) = (@?=) --- assertFalse :: String -> Assertion --- assertFalse msg = assertBool msg False +shouldBe :: (HasCallStack, Show a, Eq a) => a -> a -> Assertion +actual `shouldBe` expected = actual @?= expected shouldSatisfy :: (HasCallStack, Show a) => a -> (a -> Bool) -> Assertion v `shouldSatisfy` p = assertBool ("predicate failed on: " ++ show v) (p v) From 7ba6cc9b9cee4c9496b006b8990325f99bbc1f6f Mon Sep 17 00:00:00 2001 From: Jeff Windsor Date: Sat, 9 May 2020 16:50:19 -0700 Subject: [PATCH 07/26] add Deferred Tests (2 out 4 failing) --- haskell-language-server.cabal | 55 +++--- test/functional/{Commands.hs => Command.hs} | 2 +- .../{Completions.hs => Completion.hs} | 2 +- test/functional/Deferred.hs | 174 ++++++++++++++++++ test/functional/Main.hs | 10 +- test/utils/TastyUtils.hs | 6 +- 6 files changed, 214 insertions(+), 35 deletions(-) rename test/functional/{Commands.hs => Command.hs} (97%) rename test/functional/{Completions.hs => Completion.hs} (99%) create mode 100644 test/functional/Deferred.hs diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 79332a6bfe..c9b6de1224 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -206,34 +206,33 @@ executable haskell-language-server-wrapper default-language: Haskell2010 test-suite func-test - import: agpl - type: exitcode-stdio-1.0 - default-language: Haskell2010 - build-tool-depends: - haskell-language-server:haskell-language-server - , cabal-helper:cabal-helper-main - , ghcide:ghcide-test-preprocessor - build-depends: - base >=4.7 && <5 - , aeson - , data-default - , haskell-lsp-types - , hls-test-utils - , lens - , lsp-test >= 0.10.0.0 - , tasty - , tasty-hunit - , text - , unordered-containers - hs-source-dirs: test/functional - main-is: Main.hs - other-modules: - Commands - , Completions - ghc-options: - -Wall - -Wno-name-shadowing - -threaded -rtsopts -with-rtsopts=-N + import: agpl + type: exitcode-stdio-1.0 + default-language: Haskell2010 + build-tool-depends: haskell-language-server:haskell-language-server + , cabal-helper:cabal-helper-main + , ghcide:ghcide-test-preprocessor + build-depends: base >=4.7 && <5 + , aeson + , data-default + , directory + , filepath + , haskell-lsp-types + , hls-test-utils + , lens + , lsp-test >= 0.10.0.0 + , tasty + , tasty-hunit + , text + , unordered-containers + hs-source-dirs: test/functional + main-is: Main.hs + other-modules: Command + , Completion + , Deferred + ghc-options: -Wall + -Wno-name-shadowing + -threaded -rtsopts -with-rtsopts=-N if flag(pedantic) ghc-options: -Werror -Wredundant-constraints diff --git a/test/functional/Commands.hs b/test/functional/Command.hs similarity index 97% rename from test/functional/Commands.hs rename to test/functional/Command.hs index 0c90711369..4d9614f91f 100644 --- a/test/functional/Commands.hs +++ b/test/functional/Command.hs @@ -1,5 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} -module Commands (tests) where +module Command (tests) where import Control.Lens hiding (List) import Control.Monad.IO.Class diff --git a/test/functional/Completions.hs b/test/functional/Completion.hs similarity index 99% rename from test/functional/Completions.hs rename to test/functional/Completion.hs index cf43eafd8d..b2bdd7f8de 100644 --- a/test/functional/Completions.hs +++ b/test/functional/Completion.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -module Completions(tests) where +module Completion(tests) where import Control.Applicative.Combinators import Control.Monad.IO.Class diff --git a/test/functional/Deferred.hs b/test/functional/Deferred.hs new file mode 100644 index 0000000000..f0e1d50a7d --- /dev/null +++ b/test/functional/Deferred.hs @@ -0,0 +1,174 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedStrings #-} +module Deferred(tests) where + +import Control.Applicative.Combinators +import Control.Monad.IO.Class +import Control.Lens hiding (List) +import Control.Monad +import Data.Maybe +import Language.Haskell.LSP.Test +import Language.Haskell.LSP.Types +import Language.Haskell.LSP.Types.Lens hiding (id, message) +import qualified Language.Haskell.LSP.Types.Lens as LSP +-- import System.Directory +-- import System.FilePath +import Test.Tasty +import Test.Tasty.HUnit +import TestUtils +import TastyUtils + +tests :: TestTree +tests = testGroup "deferred responses" [ + testCase "do not affect hover requests" $ runSession hieCommand 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 `shouldBe` Nothing + liftIO $ hoverRsp ^. LSP.id `shouldBe` responseId id1 + + id2 <- sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams doc Nothing) + symbolsRsp <- skipManyTill anyNotification message :: Session DocumentSymbolsResponse + liftIO $ symbolsRsp ^. LSP.id `shouldBe` responseId id2 + + id3 <- sendRequest TextDocumentHover (TextDocumentPositionParams doc (Position 4 2) Nothing) + hoverRsp2 <- skipManyTill anyNotification message :: Session HoverResponse + liftIO $ hoverRsp2 ^. LSP.id `shouldBe` 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 `shouldBe` [ 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 hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "FuncTestFail.hs" "haskell" + defs <- getDefinitions doc (Position 1 11) + liftIO $ defs `shouldBe` [] + + -- TODO: the benefits of caching parsed modules is doubted. + -- TODO: add issue link + -- , testCase "respond to untypecheckable modules with parsed module cache" $ + -- runSession hieCommand fullCaps "test/testdata" $ do + -- doc <- openDoc "FuncTestFail.hs" "haskell" + -- (Left (sym:_)) <- getDocumentSymbols doc + -- liftIO $ sym ^. name `shouldBe` "main" + + -- TODO does not compile + -- , testCase "returns hints as diagnostics" $ runSession hieCommand fullCaps "test/testdata" $ do + -- _ <- openDoc "FuncTest.hs" "haskell" + + -- cwd <- liftIO getCurrentDirectory + -- let testUri = filePathToUri $ cwd "test/testdata/FuncTest.hs" + + -- diags <- skipManyTill loggingNotification publishDiagnosticsNotification + -- liftIO $ diags ^? params `shouldBe` (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 `shouldBe` 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 `shouldBe` WorkspaceEdit + -- Nothing + -- (Just expectedTextDocEdits) + , multiServerTests + , multiMainTests + ] + +multiServerTests :: TestTree +multiServerTests = testGroup "multi-server setup" [ + testCase "doesn't have clashing commands on two servers" $ do + let getCommands = runSession hieCommand 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" [ + testCase "Can load one file at a time, when more than one Main module exists" + -- $ runSession hieCommand fullCaps "test/testdata" $ do + $ runSession hieCommand fullCaps "test/testdata" $ do + _doc <- openDoc "ApplyRefact2.hs" "haskell" + _diagsRspHlint <- skipManyTill anyNotification message :: Session PublishDiagnosticsNotification + diagsRspGhc <- skipManyTill anyNotification message :: Session PublishDiagnosticsNotification + let (List diags) = diagsRspGhc ^. params . diagnostics + + liftIO $ length diags `shouldBe` 2 + + _doc2 <- openDoc "HaReRename.hs" "haskell" + _diagsRspHlint2 <- skipManyTill anyNotification message :: Session PublishDiagnosticsNotification + -- errMsg <- skipManyTill anyNotification notification :: Session ShowMessageNotification + diagsRsp2 <- skipManyTill anyNotification message :: Session PublishDiagnosticsNotification + let (List diags2) = diagsRsp2 ^. params . diagnostics + + liftIO $ show diags2 `shouldBe` "[]" + ] \ No newline at end of file diff --git a/test/functional/Main.hs b/test/functional/Main.hs index 44b9ce135d..b910263849 100644 --- a/test/functional/Main.hs +++ b/test/functional/Main.hs @@ -4,8 +4,9 @@ import Control.Monad.IO.Class import Language.Haskell.LSP.Test import Test.Tasty import TestUtils -import Commands -import Completions +import Command +-- import Completion +import Deferred main :: IO () main = do @@ -16,6 +17,7 @@ main = do liftIO $ putStrLn "HIE cache is warmed up" defaultMain $ testGroup "HIE" [ - Commands.tests - , Completions.tests + Command.tests + -- , Completion.tests + , Deferred.tests ] \ No newline at end of file diff --git a/test/utils/TastyUtils.hs b/test/utils/TastyUtils.hs index fd587d9477..f26772102e 100644 --- a/test/utils/TastyUtils.hs +++ b/test/utils/TastyUtils.hs @@ -1,13 +1,14 @@ module TastyUtils ( (===) , shouldBe + , shouldNotBe , shouldSatisfy , shouldNotSatisfy ) where import Test.Tasty.HUnit -infix 1 ===, `shouldBe`, `shouldSatisfy`, `shouldNotSatisfy` +infix 1 ===, `shouldBe`, `shouldNotBe`, `shouldSatisfy`, `shouldNotSatisfy` (===) :: (Eq a, Show a) => a -> a -> Assertion (===) = (@?=) @@ -15,6 +16,9 @@ infix 1 ===, `shouldBe`, `shouldSatisfy`, `shouldNotSatisfy` shouldBe :: (HasCallStack, Show a, Eq a) => a -> a -> Assertion actual `shouldBe` expected = actual @?= expected +shouldNotBe :: (HasCallStack, Show a, Eq a) => a -> a -> Assertion +actual `shouldNotBe` notExpected = assertBool ("not expected: " ++ show actual) (actual /= notExpected) + shouldSatisfy :: (HasCallStack, Show a) => a -> (a -> Bool) -> Assertion v `shouldSatisfy` p = assertBool ("predicate failed on: " ++ show v) (p v) From f3c5b87824d9cd40e7016bf6b3da826b7dd63de7 Mon Sep 17 00:00:00 2001 From: Jeff Windsor Date: Sat, 9 May 2020 17:52:49 -0700 Subject: [PATCH 08/26] Refactor Test Util and remove spec files --- haskell-language-server.cabal | 4 +- test/functional/Command.hs | 4 +- test/functional/Completion.hs | 5 +- test/functional/Deferred.hs | 7 +- test/functional/FormatSpec.hs | 273 ---------------- test/functional/FunctionalSpec.hs | 1 - test/functional/Main.hs | 16 +- test/functional/PluginSpec.hs | 117 ------- test/functional/Utils.hs | 21 -- test/utils/Test/HIE.hs | 31 ++ .../Tasty/Expectations.hs} | 12 +- test/utils/TestUtils.hs | 295 ------------------ 12 files changed, 47 insertions(+), 739 deletions(-) delete mode 100644 test/functional/FormatSpec.hs delete mode 100644 test/functional/FunctionalSpec.hs delete mode 100644 test/functional/PluginSpec.hs delete mode 100644 test/functional/Utils.hs create mode 100644 test/utils/Test/HIE.hs rename test/utils/{TastyUtils.hs => Test/Tasty/Expectations.hs} (76%) delete mode 100644 test/utils/TestUtils.hs diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index c9b6de1224..ff69923ecf 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -239,8 +239,8 @@ test-suite func-test library hls-test-utils import: agpl hs-source-dirs: test/utils - exposed-modules: TestUtils - , TastyUtils + exposed-modules: Test.HIE + , Test.Tasty.Expectations build-depends: base , haskell-language-server , haskell-lsp diff --git a/test/functional/Command.hs b/test/functional/Command.hs index 4d9614f91f..62d6ec2260 100644 --- a/test/functional/Command.hs +++ b/test/functional/Command.hs @@ -8,10 +8,10 @@ import Data.Char import Language.Haskell.LSP.Test import Language.Haskell.LSP.Types as LSP import Language.Haskell.LSP.Types.Lens as LSP +import Test.HIE import Test.Tasty import Test.Tasty.HUnit -import TestUtils -import TastyUtils +import Test.Tasty.Expectations tests :: TestTree tests = testGroup "commands" [ diff --git a/test/functional/Completion.hs b/test/functional/Completion.hs index b2bdd7f8de..c03bbd0fb5 100644 --- a/test/functional/Completion.hs +++ b/test/functional/Completion.hs @@ -9,10 +9,11 @@ import Control.Lens hiding ((.=)) import Language.Haskell.LSP.Test import Language.Haskell.LSP.Types import Language.Haskell.LSP.Types.Lens hiding (applyEdit) +import Test.HIE import Test.Tasty import Test.Tasty.HUnit -import TestUtils -import TastyUtils +import Test.Tasty.Expectations + tests :: TestTree tests = testGroup "completions" [ diff --git a/test/functional/Deferred.hs b/test/functional/Deferred.hs index f0e1d50a7d..dedd36b157 100644 --- a/test/functional/Deferred.hs +++ b/test/functional/Deferred.hs @@ -12,12 +12,11 @@ import Language.Haskell.LSP.Test import Language.Haskell.LSP.Types import Language.Haskell.LSP.Types.Lens hiding (id, message) import qualified Language.Haskell.LSP.Types.Lens as LSP --- import System.Directory --- import System.FilePath +import Test.HIE import Test.Tasty import Test.Tasty.HUnit -import TestUtils -import TastyUtils +import Test.Tasty.Expectations + tests :: TestTree tests = testGroup "deferred responses" [ diff --git a/test/functional/FormatSpec.hs b/test/functional/FormatSpec.hs deleted file mode 100644 index e99627f208..0000000000 --- a/test/functional/FormatSpec.hs +++ /dev/null @@ -1,273 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -module FormatSpec where - -import Control.Monad.IO.Class -import Data.Aeson -import qualified Data.Text as T -import Language.Haskell.LSP.Test -import Language.Haskell.LSP.Types -import Test.Hspec -import TestUtils - -spec :: Spec -spec = do - let formatLspConfig provider = - object [ "languageServerHaskell" .= object ["formattingProvider" .= (provider :: Value)] ] - formatConfig provider = defaultConfig { lspConfig = Just (formatLspConfig provider) } - describe "format document" $ do - it "works" $ runSession hieCommand fullCaps "test/testdata" $ do - doc <- openDoc "Format.hs" "haskell" - formatDoc doc (FormattingOptions 2 True) - documentContents doc >>= liftIO . (`shouldBe` formattedDocOrmolu) - it "works with custom tab size" $ do - pendingWith "ormolu does not accept parameters" - -- $ runSession hieCommand fullCaps "test/testdata" $ do - -- doc <- openDoc "Format.hs" "haskell" - -- formatDoc doc (FormattingOptions 5 True) - -- documentContents doc >>= liftIO . (`shouldBe` formattedDocTabSize5) - - describe "format range" $ do - it "works" $ runSession hieCommand fullCaps "test/testdata" $ do - doc <- openDoc "Format.hs" "haskell" - formatRange doc (FormattingOptions 2 True) (Range (Position 2 0) (Position 4 10)) - documentContents doc >>= liftIO . (`shouldBe` formattedRangeTabSize2) - it "works with custom tab size" $ do - pendingWith "ormolu does not accept parameters" - -- $ runSession hieCommand fullCaps "test/testdata" $ do - -- doc <- openDoc "Format.hs" "haskell" - -- formatRange doc (FormattingOptions 5 True) (Range (Position 4 0) (Position 7 19)) - -- documentContents doc >>= liftIO . (`shouldBe` formattedRangeTabSize5) - - describe "formatting provider" $ do - it "respects none" $ runSessionWithConfig (formatConfig "none") hieCommand fullCaps "test/testdata" $ do - doc <- openDoc "Format.hs" "haskell" - orig <- documentContents doc - - formatDoc doc (FormattingOptions 2 True) - documentContents doc >>= liftIO . (`shouldBe` orig) - - formatRange doc (FormattingOptions 2 True) (Range (Position 2 0) (Position 4 10)) - documentContents doc >>= liftIO . (`shouldBe` orig) - - -- --------------------------------- - - it "formatting is idempotent" $ runSession hieCommand fullCaps "test/testdata" $ do - doc <- openDoc "Format.hs" "haskell" - - sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "ormolu")) - formatDoc doc (FormattingOptions 2 True) - documentContents doc >>= liftIO . (`shouldBe` formattedDocOrmolu) - - formatDoc doc (FormattingOptions 2 True) - liftIO $ pendingWith "documentContents returns junk" - documentContents doc >>= liftIO . (`shouldBe` formattedDocOrmolu) - - -- --------------------------------- - - it "can change on the fly" $ runSession hieCommand fullCaps "test/testdata" $ do - doc <- openDoc "Format.hs" "haskell" - - sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "ormolu")) - formatDoc doc (FormattingOptions 2 True) - documentContents doc >>= liftIO . (`shouldBe` formattedDocOrmolu) - -- sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "brittany")) - -- formatDoc doc (FormattingOptions 2 True) - -- documentContents doc >>= liftIO . (`shouldBe` formattedDocTabSize2) - - sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "floskell")) - formatDoc doc (FormattingOptions 2 True) - liftIO $ pendingWith "documentContents returns junk" - documentContents doc >>= liftIO . (`shouldBe` formattedFloskellPostBrittany) - - -- sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "brittany")) - -- formatDoc doc (FormattingOptions 2 True) - -- documentContents doc >>= liftIO . (`shouldBe` formattedBrittanyPostFloskell) - - describe "brittany" $ do - let formatLspConfig provider = - object [ "languageServerHaskell" .= object ["formattingProvider" .= (provider :: Value)] ] - it "formats a document with LF endings" $ runSession hieCommand fullCaps "test/testdata" $ do - doc <- openDoc "BrittanyLF.hs" "haskell" - sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "brittany")) - let opts = DocumentFormattingParams doc (FormattingOptions 4 True) Nothing - ResponseMessage _ _ (Just edits) _ <- request TextDocumentFormatting opts - liftIO $ edits `shouldBe` [TextEdit (Range (Position 0 0) (Position 5 0)) - "module BrittanyLF where\n\nfoo :: Int -> String -> IO ()\nfoo x y = do\n print x\n return ()\n"] - - it "formats a document with CRLF endings" $ runSession hieCommand fullCaps "test/testdata" $ do - doc <- openDoc "BrittanyCRLF.hs" "haskell" - sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "brittany")) - let opts = DocumentFormattingParams doc (FormattingOptions 4 True) Nothing - ResponseMessage _ _ (Just edits) _ <- request TextDocumentFormatting opts - liftIO $ edits `shouldBe` [TextEdit (Range (Position 0 0) (Position 5 0)) - "module BrittanyCRLF where\n\nfoo :: Int -> String -> IO ()\nfoo x y = do\n print x\n return ()\n"] - - it "formats a range with LF endings" $ runSession hieCommand fullCaps "test/testdata" $ do - doc <- openDoc "BrittanyLF.hs" "haskell" - sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "brittany")) - let range = Range (Position 3 0) (Position 5 22) - opts = DocumentRangeFormattingParams doc range (FormattingOptions 4 True) Nothing - ResponseMessage _ _ (Just edits) _ <- request TextDocumentRangeFormatting opts - liftIO $ edits `shouldBe` [TextEdit (Range (Position 3 0) (Position 6 0)) - "foo x y = do\n print x\n return ()\n"] - - it "formats a range with CRLF endings" $ runSession hieCommand fullCaps "test/testdata" $ do - doc <- openDoc "BrittanyCRLF.hs" "haskell" - sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "brittany")) - let range = Range (Position 3 0) (Position 5 22) - opts = DocumentRangeFormattingParams doc range (FormattingOptions 4 True) Nothing - ResponseMessage _ _ (Just edits) _ <- request TextDocumentRangeFormatting opts - liftIO $ edits `shouldBe` [TextEdit (Range (Position 3 0) (Position 6 0)) - "foo x y = do\n print x\n return ()\n"] - - -- --------------------------------- - - describe "ormolu" $ do - let formatLspConfig provider = - object [ "languageServerHaskell" .= object ["formattingProvider" .= (provider :: Value)] ] - - it "formats correctly" $ runSession hieCommand fullCaps "test/testdata" $ do - sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "ormolu")) - doc <- openDoc "Format.hs" "haskell" - formatDoc doc (FormattingOptions 2 True) - docContent <- documentContents doc - let formatted = liftIO $ docContent `shouldBe` formattedOrmolu - case ghcVersion of - GHC88 -> formatted - GHC86 -> formatted - _ -> liftIO $ docContent `shouldBe` unchangedOrmolu - --- --------------------------------------------------------------------- - -formattedDocOrmolu :: T.Text -formattedDocOrmolu = - "{-# LANGUAGE NoImplicitPrelude #-}\n\n\ - \module Format where\n\n\ - \foo :: Int -> Int\n\ - \foo 3 = 2\n\ - \foo x = x\n\n\ - \bar :: String -> IO String\n\ - \bar s = do\n\ - \ x <- return \"hello\"\n\ - \ return \"asdf\"\n" - -formattedDocTabSize2 :: T.Text -formattedDocTabSize2 = - "module Format where\n\ - \foo :: Int -> Int\n\ - \foo 3 = 2\n\ - \foo x = x\n\ - \bar :: String -> IO String\n\ - \bar s = do\n\ - \ x <- return \"hello\"\n\ - \ return \"asdf\"\n\n" - -formattedDocTabSize5 :: T.Text -formattedDocTabSize5 = - "module Format where\n\ - \foo :: Int -> Int\n\ - \foo 3 = 2\n\ - \foo x = x\n\ - \bar :: String -> IO String\n\ - \bar s = do\n\ - \ x <- return \"hello\"\n\ - \ return \"asdf\"\n\n" - -formattedRangeTabSize2 :: T.Text -formattedRangeTabSize2 = - "{-# LANGUAGE NoImplicitPrelude #-}\n\ - \module Format where\n\n\ - \foo :: Int -> Int\n\ - \foo 3 = 2\n\ - \foo x = x\n\ - \bar :: String -> IO String\n\ - \bar s = do\n\ - \ x <- return \"hello\"\n\ - \ return \"asdf\"\n\ - \" - -formattedRangeTabSize5 :: T.Text -formattedRangeTabSize5 = - "{-# LANGUAGE NoImplicitPrelude #-}\n\n\ - \module Format where\n\ - \foo :: Int -> Int\n\ - \foo 3 = 2\n\ - \foo x = x\n\ - \bar :: String -> IO String\n\ - \bar s = do\n\ - \ x <- return \"hello\"\n\ - \ return \"asdf\"\n\ - \ \n" - -formattedFloskell :: T.Text -formattedFloskell = - "{-# LANGUAGE NoImplicitPrelude #-}\n\n\ - \module Format where\n\ - \\n\ - \foo :: Int -> Int\n\ - \foo 3 = 2\n\ - \foo x = x\n\ - \\n\ - \bar :: String -> IO String\n\ - \bar s = do\n\ - \ x <- return \"hello\"\n\ - \ return \"asdf\"\n\n\ - \" - --- TODO: the format is wrong, but we are currently testing switching formatters only. --- (duplicated last line) -formattedFloskellPostBrittany :: T.Text -formattedFloskellPostBrittany = - "{-# LANGUAGE NoImplicitPrelude #-}\n\n\ - \module Format where\n\ - \\n\ - \foo :: Int -> Int\n\ - \foo 3 = 2\n\ - \foo x = x\n\ - \\n\ - \bar :: String -> IO String\n\ - \bar s = do\n\ - \ x <- return \"hello\"\n\ - \ return \"asdf\"\n\ - \" - -formattedBrittanyPostFloskell :: T.Text -formattedBrittanyPostFloskell = - "{-# LANGUAGE NoImplicitPrelude #-}\n\n\ - \module Format where\n\ - \\n\ - \foo :: Int -> Int\n\ - \foo 3 = 2\n\ - \foo x = x\n\ - \\n\ - \bar :: String -> IO String\n\ - \bar s = do\n\ - \ x <- return \"hello\"\n\ - \ return \"asdf\"\n\n" - -formattedOrmolu :: T.Text -formattedOrmolu = - "{-# LANGUAGE NoImplicitPrelude #-}\n\n\ - \module Format where\n\ - \\n\ - \foo :: Int -> Int\n\ - \foo 3 = 2\n\ - \foo x = x\n\ - \\n\ - \bar :: String -> IO String\n\ - \bar s = do\n\ - \ x <- return \"hello\"\n\ - \ return \"asdf\"\n" - -unchangedOrmolu :: T.Text -unchangedOrmolu = - "{-# LANGUAGE NoImplicitPrelude #-}\n\n\ - \module Format where\n\ - \foo :: Int -> Int\n\ - \foo 3 = 2\n\ - \foo x = x\n\ - \bar :: String -> IO String\n\ - \bar s = do\n\ - \ x <- return \"hello\"\n\ - \ return \"asdf\"\n\ - \ \n" diff --git a/test/functional/FunctionalSpec.hs b/test/functional/FunctionalSpec.hs deleted file mode 100644 index 6a7e8ad4ef..0000000000 --- a/test/functional/FunctionalSpec.hs +++ /dev/null @@ -1 +0,0 @@ -{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=FunctionalSpec #-} diff --git a/test/functional/Main.hs b/test/functional/Main.hs index b910263849..b55525d328 100644 --- a/test/functional/Main.hs +++ b/test/functional/Main.hs @@ -1,23 +1,13 @@ module Main where -import Control.Monad.IO.Class -import Language.Haskell.LSP.Test import Test.Tasty -import TestUtils import Command --- import Completion +import Completion import Deferred main :: IO () -main = do - setupBuildToolFiles - -- run a test session to warm up the cache to prevent timeouts in other tests - putStrLn "Warming up HIE cache..." - runSessionWithConfig (defaultConfig { messageTimeout = 120 }) hieCommand fullCaps "test/testdata" $ - liftIO $ putStrLn "HIE cache is warmed up" - - defaultMain $ testGroup "HIE" [ +main = defaultMain $ testGroup "HIE" [ Command.tests - -- , Completion.tests + , Completion.tests , Deferred.tests ] \ No newline at end of file diff --git a/test/functional/PluginSpec.hs b/test/functional/PluginSpec.hs deleted file mode 100644 index e51f8741c5..0000000000 --- a/test/functional/PluginSpec.hs +++ /dev/null @@ -1,117 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeApplications #-} -module PluginSpec where - -import Control.Applicative.Combinators -import Control.Lens hiding (List) --- import Control.Monad -import Control.Monad.IO.Class --- import Data.Aeson --- import Data.Default --- import qualified Data.HashMap.Strict as HM --- import Data.Maybe -import qualified Data.Text as T --- import Language.Haskell.LSP.Test -import Language.Haskell.LSP.Test as Test -import Language.Haskell.LSP.Types --- import qualified Language.Haskell.LSP.Types.Capabilities as C -import qualified Language.Haskell.LSP.Types.Lens as L -import Test.Hspec -import TestUtils - -#if __GLASGOW_HASKELL__ < 808 --- import Data.Monoid ((<>)) -#endif - --- --------------------------------------------------------------------- - --- | Put a text marker on stdout in the client and the server log -mark :: String -> Session () -mark str = do - sendNotification (CustomClientMethod "$/testid") (T.pack str) - liftIO $ putStrLn str - --- --------------------------------------------------------------------- - -spec :: Spec -spec = do - describe "composes code actions" $ - it "provides 3.8 code actions" $ runSession hieCommandExamplePlugin fullCaps "test/testdata" $ do - - mark "provides 3.8 code actions" - - doc <- openDoc "Format.hs" "haskell" - diags@(diag1:_) <- waitForDiagnosticsSource "typecheck" - - -- liftIO $ putStrLn $ "diags = " ++ show diags -- AZ - liftIO $ do - length diags `shouldBe` 5 - diag1 ^. L.range `shouldBe` Range (Position 2 9) (Position 2 12) - diag1 ^. L.severity `shouldBe` Just DsError - diag1 ^. L.code `shouldBe` Nothing - -- diag1 ^. L.source `shouldBe` Just "example2" - - diag1 ^. L.source `shouldBe` Just "typecheck" - -- diag2 ^. L.source `shouldBe` Just "example" - - _cas@(CACodeAction ca:_) <- getAllCodeActions doc - -- liftIO $ length cas `shouldBe` 2 - - -- liftIO $ putStrLn $ "cas = " ++ show cas -- AZ - - liftIO $ [ca ^. L.title] `shouldContain` ["Add TODO Item 1"] - - -- mark "A" -- AZ - executeCodeAction ca - -- mark "B" -- AZ - - -- _ <- skipMany (message @RegisterCapabilityRequest) - -- liftIO $ putStrLn $ "B2" -- AZ - - -- _diags2 <- waitForDiagnosticsSource "typecheck" - -- liftIO $ putStrLn $ "diags2 = " ++ show _diags2 -- AZ - - -- contents <- getDocumentEdit doc - -- mark "C" -- AZ - -- liftIO $ contents `shouldBe` "main = undefined\nfoo x = x\n" - - -- noDiagnostics - return () - - describe "symbol providers" $ - it "combines symbol providers" $ runSession hieCommandExamplePlugin fullCaps "test/testdata" $ do - - doc <- openDoc "Format.hs" "haskell" - - _ <- waitForDiagnostics - - id2 <- sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams doc Nothing) - symbolsRsp <- skipManyTill anyNotification message :: Session DocumentSymbolsResponse - liftIO $ symbolsRsp ^. L.id `shouldBe` responseId id2 - - - let Just (DSDocumentSymbols (List ds)) = symbolsRsp ^. L.result - liftIO $ length ds `shouldBe` 3 - liftIO $ (take 2 ds) `shouldBe` - [DocumentSymbol - "Example_symbol_name" - Nothing - SkVariable - Nothing - (Range {_start = Position {_line = 2, _character = 0} - , _end = Position {_line = 2, _character = 5}}) - (Range {_start = Position {_line = 2, _character = 0} - , _end = Position {_line = 2, _character = 5}}) - Nothing - ,DocumentSymbol "Example2_symbol_name" - Nothing - SkVariable - Nothing - (Range {_start = Position {_line = 4, _character = 1} - , _end = Position {_line = 4, _character = 7}}) - (Range {_start = Position {_line = 4, _character = 1} - , _end = Position {_line = 4, _character = 7}}) - Nothing] - - return () diff --git a/test/functional/Utils.hs b/test/functional/Utils.hs deleted file mode 100644 index 88ba0cf781..0000000000 --- a/test/functional/Utils.hs +++ /dev/null @@ -1,21 +0,0 @@ -module Utils where - -import Data.Default -import qualified Language.Haskell.LSP.Test as Test -import Language.Haskell.LSP.Test hiding (message) -import qualified Language.Haskell.LSP.Types.Capabilities as C - --- --------------------------------------------------------------------- - -noLogConfig :: SessionConfig -noLogConfig = Test.defaultConfig { logMessages = False } - -logConfig :: SessionConfig -logConfig = Test.defaultConfig { logMessages = True } - -codeActionSupportCaps :: C.ClientCapabilities -codeActionSupportCaps = def { C._textDocument = Just textDocumentCaps } - where - textDocumentCaps = def { C._codeAction = Just codeActionCaps } - codeActionCaps = C.CodeActionClientCapabilities (Just True) (Just literalSupport) - literalSupport = C.CodeActionLiteralSupport def diff --git a/test/utils/Test/HIE.hs b/test/utils/Test/HIE.hs new file mode 100644 index 0000000000..5e3821a74f --- /dev/null +++ b/test/utils/Test/HIE.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE CPP, OverloadedStrings #-} +module Test.HIE (hieCommand) where + +data GhcVersion + = GHC88 + | GHC86 + | GHC84 + deriving (Eq,Show) + +ghcVersion :: GhcVersion +#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,8,0,0))) +ghcVersion = GHC88 +#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,6,0,0))) +ghcVersion = GHC86 +#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,4,0,0))) +ghcVersion = GHC84 +#endif + +logFilePath :: String +logFilePath = "hie-" ++ show ghcVersion ++ ".log" + +-- | The command to execute the version of hie for the current compiler. +-- +-- Both @stack test@ and @cabal new-test@ setup the environment so @hie@ is +-- on PATH. Cabal seems to respond to @build-tool-depends@ specifically while +-- stack just puts all project executables on PATH. +hieCommand :: String +-- hieCommand = "hie --lsp --bios-verbose -d -l test-logs/" ++ logFilePath +-- hieCommand = "haskell-language-server --lsp" +-- hieCommand = "haskell-language-server --lsp --test --shake-profiling=test-logs/" ++ logFilePath +hieCommand = "haskell-language-server --lsp -d -l test-logs/" ++ logFilePath \ No newline at end of file diff --git a/test/utils/TastyUtils.hs b/test/utils/Test/Tasty/Expectations.hs similarity index 76% rename from test/utils/TastyUtils.hs rename to test/utils/Test/Tasty/Expectations.hs index f26772102e..db5f88d09a 100644 --- a/test/utils/TastyUtils.hs +++ b/test/utils/Test/Tasty/Expectations.hs @@ -1,14 +1,8 @@ -module TastyUtils ( - (===) - , shouldBe - , shouldNotBe - , shouldSatisfy - , shouldNotSatisfy -) where +module Test.Tasty.Expectations where import Test.Tasty.HUnit -infix 1 ===, `shouldBe`, `shouldNotBe`, `shouldSatisfy`, `shouldNotSatisfy` +infix 1 ===, `shouldBe`, `shouldSatisfy`, `shouldNotBe`, `shouldNotSatisfy` (===) :: (Eq a, Show a) => a -> a -> Assertion (===) = (@?=) @@ -23,4 +17,4 @@ shouldSatisfy :: (HasCallStack, Show a) => a -> (a -> Bool) -> Assertion v `shouldSatisfy` p = assertBool ("predicate failed on: " ++ show v) (p v) shouldNotSatisfy :: (HasCallStack, Show a) => a -> (a -> Bool) -> Assertion -v `shouldNotSatisfy` p = assertBool ("predicate succeeded on: " ++ show v) ((not . p) v) \ No newline at end of file +v `shouldNotSatisfy` p = assertBool ("predicate succeeded on: " ++ show v) ((not . p) v) diff --git a/test/utils/TestUtils.hs b/test/utils/TestUtils.hs deleted file mode 100644 index 8260d92b8b..0000000000 --- a/test/utils/TestUtils.hs +++ /dev/null @@ -1,295 +0,0 @@ -{-# LANGUAGE CPP, OverloadedStrings, NamedFieldPuns #-} -module TestUtils - ( - withFileLogging - , setupBuildToolFiles - -- , testCommand - -- , runSingle - -- , runSingle' - -- , runSingleReq - -- , makeRequest - -- , runIGM - -- , runIGM' - , ghcVersion, GhcVersion(..) - , logFilePath - , hieCommand - , hieCommandVomit - , hieCommandExamplePlugin - , getHspecFormattedConfig - -- , testOptions - , flushStackEnvironment - , dummyLspFuncs - ) -where - --- import Control.Concurrent.STM -import Control.Monad -import Data.Default -import Data.List (intercalate) --- import Data.Typeable --- import qualified Data.Map as Map -import Data.Maybe -import Language.Haskell.LSP.Core -import Language.Haskell.LSP.Types --- import Haskell.Ide.Engine.MonadTypes hiding (withProgress, withIndefiniteProgress) --- import qualified Ide.Cradle as Bios --- import qualified Ide.Engine.Config as Config -import System.Directory -import System.Environment -import System.FilePath -import qualified System.Log.Logger as L --- import Test.Hspec -import Test.Hspec.Runner -import Test.Hspec.Core.Formatters -import Text.Blaze.Renderer.String (renderMarkup) -import Text.Blaze.Internal --- import qualified Haskell.Ide.Engine.PluginApi as HIE (BiosOptions, defaultOptions) - --- import HIE.Bios.Types - --- testOptions :: HIE.BiosOptions --- testOptions = HIE.defaultOptions { cradleOptsVerbosity = Verbose } - --- --------------------------------------------------------------------- - - --- testCommand :: (ToJSON a, Typeable b, ToJSON b, Show b, Eq b) --- => IdePlugins -> FilePath -> IdeGhcM (IdeResult b) -> PluginId -> CommandId -> a -> IdeResult b -> IO () --- testCommand testPlugins fp act plugin cmd arg res = do --- flushStackEnvironment --- (newApiRes, oldApiRes) <- runIGM testPlugins fp $ do --- new <- act --- old <- makeRequest plugin cmd arg --- return (new, old) --- newApiRes `shouldBe` res --- fmap fromDynJSON oldApiRes `shouldBe` fmap Just res - --- runSingle :: IdePlugins -> FilePath -> IdeGhcM (IdeResult b) -> IO (IdeResult b) --- runSingle = runSingle' id - --- runSingle' :: (Config.Config -> Config.Config) -> IdePlugins -> FilePath -> IdeGhcM (IdeResult b) -> IO (IdeResult b) --- runSingle' modifyConfig testPlugins fp act = runIGM' modifyConfig testPlugins fp act - --- runSingleReq :: ToJSON a --- => IdePlugins -> FilePath -> PluginId -> CommandId -> a -> IO (IdeResult DynamicJSON) --- runSingleReq testPlugins fp plugin com arg = runIGM testPlugins fp (makeRequest plugin com arg) - --- makeRequest :: ToJSON a => PluginId -> CommandId -> a -> IdeGhcM (IdeResult DynamicJSON) --- makeRequest plugin com arg = runPluginCommand plugin com (toJSON arg) - --- runIGM :: IdePlugins -> FilePath -> IdeGhcM a -> IO a --- runIGM = runIGM' id - --- runIGM' :: (Config.Config -> Config.Config) -> IdePlugins -> FilePath -> IdeGhcM a -> IO a --- runIGM' modifyConfig testPlugins fp f = do --- stateVar <- newTVarIO $ IdeState emptyModuleCache Map.empty Map.empty Nothing --- crdl <- Bios.findLocalCradle fp --- mlibdir <- Bios.getProjectGhcLibDir crdl --- let tmpFuncs :: LspFuncs Config.Config --- tmpFuncs = dummyLspFuncs --- lspFuncs :: LspFuncs Config.Config --- lspFuncs = tmpFuncs { config = (fmap . fmap) modifyConfig (config tmpFuncs)} --- runIdeGhcM mlibdir testPlugins lspFuncs stateVar f - -withFileLogging :: FilePath -> IO a -> IO a -withFileLogging logFile f = do - let logDir = "./test-logs" - logPath = logDir logFile - - dirExists <- doesDirectoryExist logDir - unless dirExists $ createDirectory logDir - - exists <- doesFileExist logPath - when exists $ removeFile logPath - - setupLogger (Just logPath) ["hie"] L.DEBUG - - f - --- --------------------------------------------------------------------- - -setupBuildToolFiles :: IO () -setupBuildToolFiles = do - forM_ files setupDirectFilesIn - -setupDirectFilesIn :: FilePath -> IO () -setupDirectFilesIn f = - writeFile (f ++ "hie.yaml") hieYamlCradleDirectContents - - --- --------------------------------------------------------------------- - -files :: [FilePath] -files = - [ "./test/testdata/" - -- , "./test/testdata/addPackageTest/cabal-exe/" - -- , "./test/testdata/addPackageTest/hpack-exe/" - -- , "./test/testdata/addPackageTest/cabal-lib/" - -- , "./test/testdata/addPackageTest/hpack-lib/" - -- , "./test/testdata/addPragmas/" - -- , "./test/testdata/badProjects/cabal/" - -- , "./test/testdata/completion/" - -- , "./test/testdata/definition/" - -- , "./test/testdata/gototest/" - -- , "./test/testdata/redundantImportTest/" - -- , "./test/testdata/wErrorTest/" - ] - -data GhcVersion - = GHC88 - | GHC86 - | GHC84 - deriving (Eq,Show) - -ghcVersion :: GhcVersion -#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,8,0,0))) -ghcVersion = GHC88 -#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,6,0,0))) -ghcVersion = GHC86 -#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,4,0,0))) -ghcVersion = GHC84 -#endif - -logFilePath :: String -logFilePath = "hie-" ++ show ghcVersion ++ ".log" - --- | The command to execute the version of hie for the current compiler. --- --- Both @stack test@ and @cabal new-test@ setup the environment so @hie@ is --- on PATH. Cabal seems to respond to @build-tool-depends@ specifically while --- stack just puts all project executables on PATH. -hieCommand :: String --- hieCommand = "hie --lsp --bios-verbose -d -l test-logs/" ++ logFilePath --- hieCommand = "haskell-language-server --lsp" --- hieCommand = "haskell-language-server --lsp --test --shake-profiling=test-logs/" ++ logFilePath -hieCommand = "haskell-language-server --lsp -d -l test-logs/" ++ logFilePath - -hieCommandVomit :: String -hieCommandVomit = hieCommand ++ " --vomit" - -hieCommandExamplePlugin :: String -hieCommandExamplePlugin = hieCommand ++ " --example" - --- --------------------------------------------------------------------- - -hieYamlCradleDirectContents :: String -hieYamlCradleDirectContents = unlines - [ "# WARNING: THIS FILE IS AUTOGENERATED IN test/utils/TestUtils.hs. IT WILL BE OVERWRITTEN ON EVERY TEST RUN" - , "cradle:" - , " direct:" - , " arguments:" - , " - -i." - ] - - --- --------------------------------------------------------------------- - -getHspecFormattedConfig :: String -> IO Config -getHspecFormattedConfig name = do - -- https://circleci.com/docs/2.0/env-vars/#built-in-environment-variables - isCI <- isJust <$> lookupEnv "CI" - - -- Only use the xml formatter on CI since it hides console output - if isCI - then do - let subdir = "test-results" name - createDirectoryIfMissing True subdir - - return $ defaultConfig { configFormatter = Just xmlFormatter - , configOutputFile = Right $ subdir "results.xml" - } - else return defaultConfig - --- | A Hspec formatter for CircleCI. --- Originally from https://github.com/LeastAuthority/hspec-jenkins -xmlFormatter :: Formatter -xmlFormatter = silent { - headerFormatter = do - writeLine "" - writeLine "" - , exampleSucceeded - , exampleFailed - , examplePending - , footerFormatter = writeLine "" - } - where - -#if MIN_VERSION_hspec(2,5,0) - exampleSucceeded path _ = -#else - exampleSucceeded path = -#endif - writeLine $ renderMarkup $ testcase path "" - -#if MIN_VERSION_hspec(2,5,0) - exampleFailed path _ err = -#else - exampleFailed path (Left err) = - writeLine $ renderMarkup $ testcase path $ - failure ! message (show err) $ "" - exampleFailed path (Right err) = -#endif - writeLine $ renderMarkup $ testcase path $ - failure ! message (reasonAsString err) $ "" - -#if MIN_VERSION_hspec(2,5,0) - examplePending path _ reason = -#else - examplePending path reason = -#endif - writeLine $ renderMarkup $ testcase path $ - case reason of - Just desc -> skipped ! message desc $ "" - Nothing -> skipped "" - - failure, skipped :: Markup -> Markup - failure = customParent "failure" - skipped = customParent "skipped" - - name, className, message :: String -> Attribute - name = customAttribute "name" . stringValue - className = customAttribute "classname" . stringValue - message = customAttribute "message" . stringValue - - testcase :: Path -> Markup -> Markup - testcase (xs,x) = customParent "testcase" ! name x ! className (intercalate "." xs) - - reasonAsString :: FailureReason -> String - reasonAsString NoReason = "no reason given" - reasonAsString (Reason x) = x - reasonAsString (ExpectedButGot Nothing expected got) = "Expected " ++ expected ++ " but got " ++ got - reasonAsString (ExpectedButGot (Just src) expected got) = src ++ " expected " ++ expected ++ " but got " ++ got -#if MIN_VERSION_hspec(2,5,0) - reasonAsString (Error Nothing err ) = show err - reasonAsString (Error (Just s) err) = s ++ show err -#endif - --- --------------------------------------------------------------------- - -flushStackEnvironment :: IO () -flushStackEnvironment = do - -- We need to clear these environment variables to prevent - -- collisions with stack usages - -- See https://github.com/commercialhaskell/stack/issues/4875 - unsetEnv "GHC_PACKAGE_PATH" - unsetEnv "GHC_ENVIRONMENT" - unsetEnv "HASKELL_PACKAGE_SANDBOX" - unsetEnv "HASKELL_PACKAGE_SANDBOXES" - --- --------------------------------------------------------------------- - -dummyLspFuncs :: Default a => LspFuncs a -dummyLspFuncs = LspFuncs { clientCapabilities = def - , config = return (Just def) - , sendFunc = const (return ()) - , getVirtualFileFunc = const (return Nothing) - , persistVirtualFileFunc = \uri -> return (uriToFilePath (fromNormalizedUri uri)) - , reverseFileMapFunc = return id - , publishDiagnosticsFunc = mempty - , flushDiagnosticsBySourceFunc = mempty - , getNextReqId = pure (IdInt 0) - , rootPath = Nothing - , getWorkspaceFolders = return Nothing - , withProgress = \_ _ f -> f (const (return ())) - , withIndefiniteProgress = \_ _ f -> f - } From c0d7dd1f46d724c4b43d4a224afc9a9772d24fc3 Mon Sep 17 00:00:00 2001 From: Jeff Windsor Date: Sat, 9 May 2020 18:03:10 -0700 Subject: [PATCH 09/26] add definition tests --- haskell-language-server.cabal | 1 + test/functional/Definition.hs | 63 +++++++++++++++++++++++++++++++++++ test/functional/Main.hs | 8 +++-- 3 files changed, 69 insertions(+), 3 deletions(-) create mode 100644 test/functional/Definition.hs diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index ff69923ecf..1c2c9385a8 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -230,6 +230,7 @@ test-suite func-test other-modules: Command , Completion , Deferred + , Definition ghc-options: -Wall -Wno-name-shadowing -threaded -rtsopts -with-rtsopts=-N diff --git a/test/functional/Definition.hs b/test/functional/Definition.hs new file mode 100644 index 0000000000..9904795ae5 --- /dev/null +++ b/test/functional/Definition.hs @@ -0,0 +1,63 @@ +module Definition (tests) where + +import Control.Lens +import Control.Monad.IO.Class +import Language.Haskell.LSP.Test +import Language.Haskell.LSP.Types +import Language.Haskell.LSP.Types.Lens +import System.Directory +import Test.HIE +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.Expectations + +tests :: TestTree +tests = testGroup "definitions" [ + testCase "goto's symbols" $ runSession hieCommand 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 `shouldBe` [Location (doc ^. uri) expRange] + + -- ----------------------------------- + + , testCase "goto's imported modules" $ runSession hieCommand 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 `shouldBe` [Location (filePathToUri fp) zeroRange] + + , testCase "goto's exported modules" $ runSession hieCommand 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 `shouldBe` [Location (filePathToUri fp) zeroRange] + + , testCase "goto's imported modules that are loaded" $ runSession hieCommand 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 `shouldBe` [Location (filePathToUri fp) zeroRange] + + , testCase "goto's imported modules that are loaded, and then closed" $ + runSession hieCommand 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 `shouldBe` [Location (filePathToUri fp) zeroRange] + liftIO $ putStrLn "E" -- AZ + + noDiagnostics + ] + +zeroRange :: Range +zeroRange = Range (Position 0 0) (Position 0 0) diff --git a/test/functional/Main.hs b/test/functional/Main.hs index b55525d328..8a516d7a59 100644 --- a/test/functional/Main.hs +++ b/test/functional/Main.hs @@ -1,13 +1,15 @@ module Main where -import Test.Tasty import Command -import Completion +-- import Completion import Deferred +import Definition +import Test.Tasty main :: IO () main = defaultMain $ testGroup "HIE" [ Command.tests - , Completion.tests + -- , Completion.tests , Deferred.tests + , Definition.tests ] \ No newline at end of file From 29497543a35050eb7bbacf72e8a700f412c91f3e Mon Sep 17 00:00:00 2001 From: Jeff Windsor Date: Sat, 9 May 2020 18:51:05 -0700 Subject: [PATCH 10/26] add diagnostic tests --- haskell-language-server.cabal | 3 + test/functional/Diagnostic.hs | 102 +++++++++++++ test/functional/Main.hs | 6 +- test/utils/Test/HIE.hs | 277 +++++++++++++++++++++++++++++++++- 4 files changed, 384 insertions(+), 4 deletions(-) create mode 100644 test/functional/Diagnostic.hs diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 1c2c9385a8..41df1ad2af 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -217,6 +217,7 @@ test-suite func-test , data-default , directory , filepath + , haskell-language-server , haskell-lsp-types , hls-test-utils , lens @@ -231,6 +232,7 @@ test-suite func-test , Completion , Deferred , Definition + , Diagnostic ghc-options: -Wall -Wno-name-shadowing -threaded -rtsopts -with-rtsopts=-N @@ -255,6 +257,7 @@ library hls-test-utils , hslogger , hspec , hspec-core + , lsp-test , stm , tasty-hunit , text diff --git a/test/functional/Diagnostic.hs b/test/functional/Diagnostic.hs new file mode 100644 index 0000000000..56b24cd96d --- /dev/null +++ b/test/functional/Diagnostic.hs @@ -0,0 +1,102 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Diagnostic (tests) where + +import Control.Applicative.Combinators +import Control.Lens hiding (List) +import Control.Monad.IO.Class +import Data.Aeson (toJSON) +import qualified Data.Text as T +import qualified Data.Default +import Ide.Logger +import Ide.Plugin.Config +import Language.Haskell.LSP.Test hiding (message) +import Language.Haskell.LSP.Types +import qualified Language.Haskell.LSP.Types.Lens as LSP +import Test.HIE +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.Expectations + +-- --------------------------------------------------------------------- + +tests :: TestTree +tests = testGroup "diagnostics providers" [ + saveTests + , triggerTests + , errorTests + , warningTests + ] + + +triggerTests :: TestTree +triggerTests = testGroup "diagnostics triggers" [ + testCase "runs diagnostics on save" $ + runSession hieCommandExamplePlugin codeActionSupportCaps "test/testdata" $ do + logm "starting DiagnosticSpec.runs diagnostic on save" + doc <- openDoc "ApplyRefact2.hs" "haskell" + + diags@(reduceDiag:_) <- waitForDiagnostics + + liftIO $ do + length diags `shouldBe` 2 + reduceDiag ^. LSP.range `shouldBe` Range (Position 1 0) (Position 1 12) + reduceDiag ^. LSP.severity `shouldBe` Just DsInfo + reduceDiag ^. LSP.code `shouldBe` Just (StringValue "Eta reduce") + reduceDiag ^. LSP.source `shouldBe` Just "hlint" + + diags2a <- waitForDiagnostics + + liftIO $ length diags2a `shouldBe` 2 + + sendNotification TextDocumentDidSave (DidSaveTextDocumentParams doc) + + diags3@(d:_) <- waitForDiagnosticsSource "eg2" + + liftIO $ do + length diags3 `shouldBe` 1 + d ^. LSP.range `shouldBe` Range (Position 0 0) (Position 1 0) + d ^. LSP.severity `shouldBe` Nothing + d ^. LSP.code `shouldBe` Nothing + d ^. LSP.message `shouldBe` T.pack "Example plugin diagnostic, triggered byDiagnosticOnSave" + ] + +errorTests :: TestTree +errorTests = testGroup "typed hole errors" [ + testCase "is deferred" $ + runSession hieCommand fullCaps "test/testdata" $ do + _ <- openDoc "TypedHoles.hs" "haskell" + [diag] <- waitForDiagnosticsSource "bios" + liftIO $ diag ^. LSP.severity `shouldBe` Just DsWarning + ] + +warningTests :: TestTree +warningTests = testGroup "Warnings are warnings" [ + testCase "Overrides -Werror" $ + runSession hieCommand fullCaps "test/testdata/wErrorTest" $ do + _ <- openDoc "src/WError.hs" "haskell" + [diag] <- waitForDiagnosticsSource "bios" + liftIO $ diag ^. LSP.severity `shouldBe` Just DsWarning + ] + +saveTests :: TestTree +saveTests = testGroup "only diagnostics on save" [ + testCase "Respects diagnosticsOnChange setting" $ + runSession hieCommandExamplePlugin codeActionSupportCaps "test/testdata" $ do + let config = Data.Default.def { diagnosticsOnChange = False } :: Config + sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) + doc <- openDoc "Hover.hs" "haskell" + diags <- waitForDiagnostics + + liftIO $ do + length diags `shouldBe` 0 + + let te = TextEdit (Range (Position 0 0) (Position 0 13)) "" + _ <- applyEdit doc te + skipManyTill loggingNotification noDiagnostics + + sendNotification TextDocumentDidSave (DidSaveTextDocumentParams doc) + diags2 <- waitForDiagnostics + liftIO $ + length diags2 `shouldBe` 1 + ] diff --git a/test/functional/Main.hs b/test/functional/Main.hs index 8a516d7a59..0337d61e8d 100644 --- a/test/functional/Main.hs +++ b/test/functional/Main.hs @@ -1,15 +1,17 @@ module Main where import Command --- import Completion +import Completion import Deferred import Definition +import Diagnostic import Test.Tasty main :: IO () main = defaultMain $ testGroup "HIE" [ Command.tests - -- , Completion.tests + , Completion.tests , Deferred.tests , Definition.tests + , Diagnostic.tests ] \ No newline at end of file diff --git a/test/utils/Test/HIE.hs b/test/utils/Test/HIE.hs index 5e3821a74f..b3e7ead8f5 100644 --- a/test/utils/Test/HIE.hs +++ b/test/utils/Test/HIE.hs @@ -1,5 +1,16 @@ {-# LANGUAGE CPP, OverloadedStrings #-} -module Test.HIE (hieCommand) where +module Test.HIE ( + codeActionSupportCaps + , hieCommand + , hieCommandExamplePlugin + , logConfig + , noLogConfig + ) where + +import Data.Default +import qualified Language.Haskell.LSP.Test as Test +import Language.Haskell.LSP.Test hiding (message) +import qualified Language.Haskell.LSP.Types.Capabilities as C data GhcVersion = GHC88 @@ -28,4 +39,266 @@ hieCommand :: String -- hieCommand = "hie --lsp --bios-verbose -d -l test-logs/" ++ logFilePath -- hieCommand = "haskell-language-server --lsp" -- hieCommand = "haskell-language-server --lsp --test --shake-profiling=test-logs/" ++ logFilePath -hieCommand = "haskell-language-server --lsp -d -l test-logs/" ++ logFilePath \ No newline at end of file +hieCommand = "haskell-language-server --lsp -d -l test-logs/" ++ logFilePath + +-- hieCommandVomit :: String +-- hieCommandVomit = hieCommand ++ " --vomit" + +hieCommandExamplePlugin :: String +hieCommandExamplePlugin = hieCommand ++ " --example" + +-- --------------------------------------------------------------------- + +noLogConfig :: SessionConfig +noLogConfig = Test.defaultConfig { logMessages = False } + +logConfig :: SessionConfig +logConfig = Test.defaultConfig { logMessages = True } + +codeActionSupportCaps :: C.ClientCapabilities +codeActionSupportCaps = def { C._textDocument = Just textDocumentCaps } + where + textDocumentCaps = def { C._codeAction = Just codeActionCaps } + codeActionCaps = C.CodeActionClientCapabilities (Just True) (Just literalSupport) + literalSupport = C.CodeActionLiteralSupport def + + +-- --------------------------------------------------------------------- +-- --------------------------------------------------------------------- + +-- import Control.Concurrent.STM +-- import Control.Monad +-- import Data.Default +-- import Data.List (intercalate) +-- -- import Data.Typeable +-- -- import qualified Data.Map as Map +-- import Data.Maybe +-- import Language.Haskell.LSP.Core +-- import Language.Haskell.LSP.Types +-- -- import Haskell.Ide.Engine.MonadTypes hiding (withProgress, withIndefiniteProgress) +-- -- import qualified Ide.Cradle as Bios +-- -- import qualified Ide.Engine.Config as Config +-- import System.Directory +-- import System.Environment +-- import System.FilePath +-- import qualified System.Log.Logger as L +-- -- import Test.Hspec +-- import Test.Hspec.Runner +-- import Test.Hspec.Core.Formatters +-- import Text.Blaze.Renderer.String (renderMarkup) +-- import Text.Blaze.Internal +-- -- import qualified Haskell.Ide.Engine.PluginApi as HIE (BiosOptions, defaultOptions) + +-- import HIE.Bios.Types + +-- testOptions :: HIE.BiosOptions +-- testOptions = HIE.defaultOptions { cradleOptsVerbosity = Verbose } + +-- --------------------------------------------------------------------- + + +-- testCommand :: (ToJSON a, Typeable b, ToJSON b, Show b, Eq b) +-- => IdePlugins -> FilePath -> IdeGhcM (IdeResult b) -> PluginId -> CommandId -> a -> IdeResult b -> IO () +-- testCommand testPlugins fp act plugin cmd arg res = do +-- flushStackEnvironment +-- (newApiRes, oldApiRes) <- runIGM testPlugins fp $ do +-- new <- act +-- old <- makeRequest plugin cmd arg +-- return (new, old) +-- newApiRes `shouldBe` res +-- fmap fromDynJSON oldApiRes `shouldBe` fmap Just res + +-- runSingle :: IdePlugins -> FilePath -> IdeGhcM (IdeResult b) -> IO (IdeResult b) +-- runSingle = runSingle' id + +-- runSingle' :: (Config.Config -> Config.Config) -> IdePlugins -> FilePath -> IdeGhcM (IdeResult b) -> IO (IdeResult b) +-- runSingle' modifyConfig testPlugins fp act = runIGM' modifyConfig testPlugins fp act + +-- runSingleReq :: ToJSON a +-- => IdePlugins -> FilePath -> PluginId -> CommandId -> a -> IO (IdeResult DynamicJSON) +-- runSingleReq testPlugins fp plugin com arg = runIGM testPlugins fp (makeRequest plugin com arg) + +-- makeRequest :: ToJSON a => PluginId -> CommandId -> a -> IdeGhcM (IdeResult DynamicJSON) +-- makeRequest plugin com arg = runPluginCommand plugin com (toJSON arg) + +-- runIGM :: IdePlugins -> FilePath -> IdeGhcM a -> IO a +-- runIGM = runIGM' id + +-- runIGM' :: (Config.Config -> Config.Config) -> IdePlugins -> FilePath -> IdeGhcM a -> IO a +-- runIGM' modifyConfig testPlugins fp f = do +-- stateVar <- newTVarIO $ IdeState emptyModuleCache Map.empty Map.empty Nothing +-- crdl <- Bios.findLocalCradle fp +-- mlibdir <- Bios.getProjectGhcLibDir crdl +-- let tmpFuncs :: LspFuncs Config.Config +-- tmpFuncs = dummyLspFuncs +-- lspFuncs :: LspFuncs Config.Config +-- lspFuncs = tmpFuncs { config = (fmap . fmap) modifyConfig (config tmpFuncs)} +-- runIdeGhcM mlibdir testPlugins lspFuncs stateVar f + +-- withFileLogging :: FilePath -> IO a -> IO a +-- withFileLogging logFile f = do +-- let logDir = "./test-logs" +-- logPath = logDir logFile + +-- dirExists <- doesDirectoryExist logDir +-- unless dirExists $ createDirectory logDir + +-- exists <- doesFileExist logPath +-- when exists $ removeFile logPath + +-- setupLogger (Just logPath) ["hie"] L.DEBUG + +-- f + +-- -- --------------------------------------------------------------------- + +-- setupBuildToolFiles :: IO () +-- setupBuildToolFiles = do +-- forM_ files setupDirectFilesIn + +-- setupDirectFilesIn :: FilePath -> IO () +-- setupDirectFilesIn f = +-- writeFile (f ++ "hie.yaml") hieYamlCradleDirectContents + + +-- -- --------------------------------------------------------------------- + +-- files :: [FilePath] +-- files = +-- [ "./test/testdata/" +-- -- , "./test/testdata/addPackageTest/cabal-exe/" +-- -- , "./test/testdata/addPackageTest/hpack-exe/" +-- -- , "./test/testdata/addPackageTest/cabal-lib/" +-- -- , "./test/testdata/addPackageTest/hpack-lib/" +-- -- , "./test/testdata/addPragmas/" +-- -- , "./test/testdata/badProjects/cabal/" +-- -- , "./test/testdata/completion/" +-- -- , "./test/testdata/definition/" +-- -- , "./test/testdata/gototest/" +-- -- , "./test/testdata/redundantImportTest/" +-- -- , "./test/testdata/wErrorTest/" +-- ] + +-- --------------------------------------------------------------------- + +-- hieYamlCradleDirectContents :: String +-- hieYamlCradleDirectContents = unlines +-- [ "# WARNING: THIS FILE IS AUTOGENERATED IN test/utils/TestUtils.hs. IT WILL BE OVERWRITTEN ON EVERY TEST RUN" +-- , "cradle:" +-- , " direct:" +-- , " arguments:" +-- , " - -i." +-- ] + + +-- -- --------------------------------------------------------------------- + +-- getHspecFormattedConfig :: String -> IO Config +-- getHspecFormattedConfig name = do +-- -- https://circleci.com/docs/2.0/env-vars/#built-in-environment-variables +-- isCI <- isJust <$> lookupEnv "CI" + +-- -- Only use the xml formatter on CI since it hides console output +-- if isCI +-- then do +-- let subdir = "test-results" name +-- createDirectoryIfMissing True subdir + +-- return $ defaultConfig { configFormatter = Just xmlFormatter +-- , configOutputFile = Right $ subdir "results.xml" +-- } +-- else return defaultConfig + +-- -- | A Hspec formatter for CircleCI. +-- -- Originally from https://github.com/LeastAuthority/hspec-jenkins +-- xmlFormatter :: Formatter +-- xmlFormatter = silent { +-- headerFormatter = do +-- writeLine "" +-- writeLine "" +-- , exampleSucceeded +-- , exampleFailed +-- , examplePending +-- , footerFormatter = writeLine "" +-- } +-- where + +-- #if MIN_VERSION_hspec(2,5,0) +-- exampleSucceeded path _ = +-- #else +-- exampleSucceeded path = +-- #endif +-- writeLine $ renderMarkup $ testcase path "" + +-- #if MIN_VERSION_hspec(2,5,0) +-- exampleFailed path _ err = +-- #else +-- exampleFailed path (Left err) = +-- writeLine $ renderMarkup $ testcase path $ +-- failure ! message (show err) $ "" +-- exampleFailed path (Right err) = +-- #endif +-- writeLine $ renderMarkup $ testcase path $ +-- failure ! message (reasonAsString err) $ "" + +-- #if MIN_VERSION_hspec(2,5,0) +-- examplePending path _ reason = +-- #else +-- examplePending path reason = +-- #endif +-- writeLine $ renderMarkup $ testcase path $ +-- case reason of +-- Just desc -> skipped ! message desc $ "" +-- Nothing -> skipped "" + +-- failure, skipped :: Markup -> Markup +-- failure = customParent "failure" +-- skipped = customParent "skipped" + +-- name, className, message :: String -> Attribute +-- name = customAttribute "name" . stringValue +-- className = customAttribute "classname" . stringValue +-- message = customAttribute "message" . stringValue + +-- testcase :: Path -> Markup -> Markup +-- testcase (xs,x) = customParent "testcase" ! name x ! className (intercalate "." xs) + +-- reasonAsString :: FailureReason -> String +-- reasonAsString NoReason = "no reason given" +-- reasonAsString (Reason x) = x +-- reasonAsString (ExpectedButGot Nothing expected got) = "Expected " ++ expected ++ " but got " ++ got +-- reasonAsString (ExpectedButGot (Just src) expected got) = src ++ " expected " ++ expected ++ " but got " ++ got +-- #if MIN_VERSION_hspec(2,5,0) +-- reasonAsString (Error Nothing err ) = show err +-- reasonAsString (Error (Just s) err) = s ++ show err +-- #endif + +-- --------------------------------------------------------------------- + +-- flushStackEnvironment :: IO () +-- flushStackEnvironment = do +-- -- We need to clear these environment variables to prevent +-- -- collisions with stack usages +-- -- See https://github.com/commercialhaskell/stack/issues/4875 +-- unsetEnv "GHC_PACKAGE_PATH" +-- unsetEnv "GHC_ENVIRONMENT" +-- unsetEnv "HASKELL_PACKAGE_SANDBOX" +-- unsetEnv "HASKELL_PACKAGE_SANDBOXES" + +-- --------------------------------------------------------------------- + +-- dummyLspFuncs :: Default a => LspFuncs a +-- dummyLspFuncs = LspFuncs { clientCapabilities = def +-- , config = return (Just def) +-- , sendFunc = const (return ()) +-- , getVirtualFileFunc = const (return Nothing) +-- , persistVirtualFileFunc = \uri -> return (uriToFilePath (fromNormalizedUri uri)) +-- , reverseFileMapFunc = return id +-- , publishDiagnosticsFunc = mempty +-- , flushDiagnosticsBySourceFunc = mempty +-- , getNextReqId = pure (IdInt 0) +-- , rootPath = Nothing +-- , getWorkspaceFolders = return Nothing +-- , withProgress = \_ _ f -> f (const (return ())) +-- , withIndefiniteProgress = \_ _ f -> f +-- } \ No newline at end of file From 7b6c550bb83e467f2b2ba6d3177e370f443267ab Mon Sep 17 00:00:00 2001 From: Jeff Windsor Date: Sat, 9 May 2020 19:12:59 -0700 Subject: [PATCH 11/26] add format tests --- haskell-language-server.cabal | 1 + test/functional/Format.hs | 230 ++++++++++++++++++++++++++++++++++ test/functional/Main.hs | 3 + test/utils/Test/HIE.hs | 1 + 4 files changed, 235 insertions(+) create mode 100644 test/functional/Format.hs diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 41df1ad2af..d75a9f5679 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -233,6 +233,7 @@ test-suite func-test , Deferred , Definition , Diagnostic + , Format ghc-options: -Wall -Wno-name-shadowing -threaded -rtsopts -with-rtsopts=-N diff --git a/test/functional/Format.hs b/test/functional/Format.hs new file mode 100644 index 0000000000..2835e0ca14 --- /dev/null +++ b/test/functional/Format.hs @@ -0,0 +1,230 @@ +{-# LANGUAGE OverloadedStrings #-} +module Format (tests) where + +import Control.Monad.IO.Class +import Data.Aeson +import qualified Data.Text as T +import Language.Haskell.LSP.Test +import Language.Haskell.LSP.Types +import Test.HIE +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.Expectations + +tests :: TestTree +tests = testGroup "format document" [ + testCase "works" $ runSession hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "Format.hs" "haskell" + formatDoc doc (FormattingOptions 2 True) + documentContents doc >>= liftIO . (`shouldBe` formattedDocTabSize2) + , testCase "works with custom tab size" $ runSession hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "Format.hs" "haskell" + formatDoc doc (FormattingOptions 5 True) + documentContents doc >>= liftIO . (`shouldBe` formattedDocTabSize5) + , rangeTests + , providerTests + , brittanyTests + , ormoluTests + ] + +rangeTests :: TestTree +rangeTests = testGroup "format range" [ + testCase "works" $ runSession hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "Format.hs" "haskell" + formatRange doc (FormattingOptions 2 True) (Range (Position 1 0) (Position 3 10)) + documentContents doc >>= liftIO . (`shouldBe` formattedRangeTabSize2) + , testCase "works with custom tab size" $ runSession hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "Format.hs" "haskell" + formatRange doc (FormattingOptions 5 True) (Range (Position 4 0) (Position 7 19)) + documentContents doc >>= liftIO . (`shouldBe` formattedRangeTabSize5) + ] + +providerTests :: TestTree +providerTests = testGroup "formatting provider" [ + testCase "respects none" $ runSessionWithConfig (formatConfig "none") hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "Format.hs" "haskell" + orig <- documentContents doc + + formatDoc doc (FormattingOptions 2 True) + documentContents doc >>= liftIO . (`shouldBe` orig) + + formatRange doc (FormattingOptions 2 True) (Range (Position 1 0) (Position 3 10)) + documentContents doc >>= liftIO . (`shouldBe` orig) + + , testCase "can change on the fly" $ runSession hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "Format.hs" "haskell" + + sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "brittany")) + formatDoc doc (FormattingOptions 2 True) + documentContents doc >>= liftIO . (`shouldBe` formattedDocTabSize2) + + sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "floskell")) + formatDoc doc (FormattingOptions 2 True) + documentContents doc >>= liftIO . (`shouldBe` formattedFloskell) + + sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "brittany")) + formatDoc doc (FormattingOptions 2 True) + documentContents doc >>= liftIO . (`shouldBe` formattedBrittanyPostFloskell) + ] + +brittanyTests :: TestTree +brittanyTests = testGroup "brittany" [ + testCase "formats a document with LF endings" $ runSession hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "BrittanyLF.hs" "haskell" + let opts = DocumentFormattingParams doc (FormattingOptions 4 True) Nothing + ResponseMessage _ _ (Just edits) _ <- request TextDocumentFormatting opts + liftIO $ edits `shouldBe` [TextEdit (Range (Position 0 0) (Position 3 0)) + "foo :: Int -> String -> IO ()\nfoo x y = do\n print x\n return 42\n"] + + , testCase "formats a document with CRLF endings" $ runSession hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "BrittanyCRLF.hs" "haskell" + let opts = DocumentFormattingParams doc (FormattingOptions 4 True) Nothing + ResponseMessage _ _ (Just edits) _ <- request TextDocumentFormatting opts + liftIO $ edits `shouldBe` [TextEdit (Range (Position 0 0) (Position 3 0)) + "foo :: Int -> String -> IO ()\nfoo x y = do\n print x\n return 42\n"] + + , testCase "formats a range with LF endings" $ runSession hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "BrittanyLF.hs" "haskell" + let range = Range (Position 1 0) (Position 2 22) + opts = DocumentRangeFormattingParams doc range (FormattingOptions 4 True) Nothing + ResponseMessage _ _ (Just edits) _ <- request TextDocumentRangeFormatting opts + liftIO $ edits `shouldBe` [TextEdit (Range (Position 1 0) (Position 3 0)) + "foo x y = do\n print x\n return 42\n"] + + , testCase "formats a range with CRLF endings" $ runSession hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "BrittanyCRLF.hs" "haskell" + let range = Range (Position 1 0) (Position 2 22) + opts = DocumentRangeFormattingParams doc range (FormattingOptions 4 True) Nothing + ResponseMessage _ _ (Just edits) _ <- request TextDocumentRangeFormatting opts + liftIO $ edits `shouldBe` [TextEdit (Range (Position 1 0) (Position 3 0)) + "foo x y = do\n print x\n return 42\n"] + ] + +ormoluTests :: TestTree +ormoluTests = testGroup "ormolu" [ + testCase "formats correctly" $ runSession hieCommand fullCaps "test/testdata" $ do + let formatLspConfig provider = + object [ "languageServerHaskell" .= object ["formattingProvider" .= (provider :: Value)] ] + sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "ormolu")) + doc <- openDoc "Format.hs" "haskell" + formatDoc doc (FormattingOptions 2 True) + docContent <- documentContents doc + let formatted = liftIO $ docContent `shouldBe` formattedOrmolu + case ghcVersion of + GHC88 -> formatted + GHC86 -> formatted + _ -> liftIO $ docContent `shouldBe` unchangedOrmolu + ] + + +formatLspConfig :: Value -> Value +formatLspConfig provider = object [ "languageServerHaskell" .= object ["formattingProvider" .= (provider :: Value)] ] + +formatConfig :: Value -> SessionConfig +formatConfig provider = defaultConfig { lspConfig = Just (formatLspConfig provider) } + + +formattedDocTabSize2 :: T.Text +formattedDocTabSize2 = + "module Format where\n\ + \foo :: Int -> Int\n\ + \foo 3 = 2\n\ + \foo x = x\n\ + \bar :: String -> IO String\n\ + \bar s = do\n\ + \ x <- return \"hello\"\n\ + \ return \"asdf\"\n\n\ + \data Baz = Baz { a :: Int, b :: String }\n\n" + +formattedDocTabSize5 :: T.Text +formattedDocTabSize5 = + "module Format where\n\ + \foo :: Int -> Int\n\ + \foo 3 = 2\n\ + \foo x = x\n\ + \bar :: String -> IO String\n\ + \bar s = do\n\ + \ x <- return \"hello\"\n\ + \ return \"asdf\"\n\n\ + \data Baz = Baz { a :: Int, b :: String }\n\n" + +formattedRangeTabSize2 :: T.Text +formattedRangeTabSize2 = + "module Format where\n\ + \foo :: Int -> Int\n\ + \foo 3 = 2\n\ + \foo x = x\n\ + \bar :: String -> IO String\n\ + \bar s = do\n\ + \ x <- return \"hello\"\n\ + \ return \"asdf\"\n\ + \\n\ + \data Baz = Baz { a :: Int, b :: String }\n\n" + +formattedRangeTabSize5 :: T.Text +formattedRangeTabSize5 = + "module Format where\n\ + \foo :: Int -> Int\n\ + \foo 3 = 2\n\ + \foo x = x\n\ + \bar :: String -> IO String\n\ + \bar s = do\n\ + \ x <- return \"hello\"\n\ + \ return \"asdf\"\n\ + \\n\ + \data Baz = Baz { a :: Int, b :: String }\n\n" + +formattedFloskell :: T.Text +formattedFloskell = + "module Format where\n\ + \\n\ + \foo :: Int -> Int\n\ + \foo 3 = 2\n\ + \foo x = x\n\ + \\n\ + \bar :: String -> IO String\n\ + \bar s = do\n\ + \ x <- return \"hello\"\n\ + \ return \"asdf\"\n\n\ + \data Baz = Baz { a :: Int, b :: String }\n\n" + +formattedBrittanyPostFloskell :: T.Text +formattedBrittanyPostFloskell = + "module Format where\n\ + \\n\ + \foo :: Int -> Int\n\ + \foo 3 = 2\n\ + \foo x = x\n\ + \\n\ + \bar :: String -> IO String\n\ + \bar s = do\n\ + \ x <- return \"hello\"\n\ + \ return \"asdf\"\n\n\ + \data Baz = Baz { a :: Int, b :: String }\n\n" + +formattedOrmolu :: T.Text +formattedOrmolu = + "module Format where\n\ + \\n\ + \foo :: Int -> Int\n\ + \foo 3 = 2\n\ + \foo x = x\n\ + \\n\ + \bar :: String -> IO String\n\ + \bar s = do\n\ + \ x <- return \"hello\"\n\ + \ return \"asdf\"\n\n\ + \data Baz = Baz {a :: Int, b :: String}\n" + +unchangedOrmolu :: T.Text +unchangedOrmolu = + "module Format where\n\ + \foo :: Int -> Int\n\ + \foo 3 = 2\n\ + \foo x = x\n\ + \bar :: String -> IO String\n\ + \bar s = do\n\ + \ x <- return \"hello\"\n\ + \ return \"asdf\"\n\ + \\n\ + \data Baz = Baz { a :: Int, b :: String }\n\n" diff --git a/test/functional/Main.hs b/test/functional/Main.hs index 0337d61e8d..a34a9f8884 100644 --- a/test/functional/Main.hs +++ b/test/functional/Main.hs @@ -5,6 +5,8 @@ import Completion import Deferred import Definition import Diagnostic +import Format + import Test.Tasty main :: IO () @@ -14,4 +16,5 @@ main = defaultMain $ testGroup "HIE" [ , Deferred.tests , Definition.tests , Diagnostic.tests + , Format.tests ] \ No newline at end of file diff --git a/test/utils/Test/HIE.hs b/test/utils/Test/HIE.hs index b3e7ead8f5..d401d91aed 100644 --- a/test/utils/Test/HIE.hs +++ b/test/utils/Test/HIE.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP, OverloadedStrings #-} module Test.HIE ( codeActionSupportCaps + , ghcVersion, GhcVersion(..) , hieCommand , hieCommandExamplePlugin , logConfig From ece0d31a7177eb03868c8dc52a8ab0b99c591626 Mon Sep 17 00:00:00 2001 From: Jeff Windsor Date: Sat, 9 May 2020 20:19:30 -0700 Subject: [PATCH 12/26] add FunctionalCodeAction tests --- haskell-language-server.cabal | 1 + test/functional/FunctionalCodeAction.hs | 492 ++++++++++++++++++++++++ test/functional/Main.hs | 22 +- test/utils/Test/HIE.hs | 24 +- test/utils/Test/Tasty/Expectations.hs | 37 ++ 5 files changed, 555 insertions(+), 21 deletions(-) create mode 100644 test/functional/FunctionalCodeAction.hs diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index d75a9f5679..80e30ae805 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -234,6 +234,7 @@ test-suite func-test , Definition , Diagnostic , Format + , FunctionalCodeAction ghc-options: -Wall -Wno-name-shadowing -threaded -rtsopts -with-rtsopts=-N diff --git a/test/functional/FunctionalCodeAction.hs b/test/functional/FunctionalCodeAction.hs new file mode 100644 index 0000000000..c0e0e4a0a4 --- /dev/null +++ b/test/functional/FunctionalCodeAction.hs @@ -0,0 +1,492 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} + +module FunctionalCodeAction (tests) where + +import Control.Applicative.Combinators +import Control.Lens hiding (List) +import Control.Monad +import Control.Monad.IO.Class +import Data.Aeson +import Data.Default +import qualified Data.HashMap.Strict as HM +import Data.Maybe +#if __GLASGOW_HASKELL__ < 808 +import Data.Monoid ((<>)) +#endif +import qualified Data.Text as T +import Ide.Plugin.Config +import Language.Haskell.LSP.Test as Test +import Language.Haskell.LSP.Types +import qualified Language.Haskell.LSP.Types.Lens as L +import qualified Language.Haskell.LSP.Types.Capabilities as C +import Test.HIE +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.Expectations + +{-# ANN module ("HLint: ignore Reduce duplication"::String) #-} + +tests :: TestTree +tests = testGroup "code actions" [ + hlintTests + , importTests + , missingPragmaTests + , packageTests + , redundantImportTests + , renameTests + , signatureTests + , typedHoleTests + , unusedTermTests + ] + + +hlintTests :: TestTree +hlintTests = testGroup "hlint suggestions" [ + testCase "provides 3.8 code actions" $ runSession hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "ApplyRefact2.hs" "haskell" + diags@(reduceDiag:_) <- waitForDiagnostics + + liftIO $ do + length diags `shouldBe` 2 + reduceDiag ^. L.range `shouldBe` Range (Position 1 0) (Position 1 12) + reduceDiag ^. L.severity `shouldBe` Just DsInfo + reduceDiag ^. L.code `shouldBe` Just (StringValue "Eta reduce") + reduceDiag ^. L.source `shouldBe` Just "hlint" + + (CACodeAction ca:_) <- getAllCodeActions doc + + -- Evaluate became redundant id in later hlint versions + liftIO $ ["Apply hint:Redundant id", "Apply hint:Evaluate"] `shouldContain` [ca ^. L.title] + + executeCodeAction ca + + contents <- getDocumentEdit doc + liftIO $ contents `shouldBe` "main = undefined\nfoo x = x\n" + + noDiagnostics + + , testCase "falls back to pre 3.8 code actions" $ runSession hieCommand noLiteralCaps "test/testdata" $ do + doc <- openDoc "ApplyRefact2.hs" "haskell" + + _ <- waitForDiagnostics + + (CACommand cmd:_) <- getAllCodeActions doc + + -- Evaluate became redundant id in later hlint versions + liftIO $ ["Apply hint:Redundant id", "Apply hint:Evaluate"] `shouldContain` [cmd ^. L.title ] + + executeCommand cmd + + contents <- skipManyTill publishDiagnosticsNotification $ getDocumentEdit doc + liftIO $ contents `shouldBe` "main = undefined\nfoo x = x\n" + + noDiagnostics + + , testCase "runs diagnostics on save" $ runSession hieCommand fullCaps "test/testdata" $ do + let config = def { diagnosticsOnChange = False } + sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) + + doc <- openDoc "ApplyRefact2.hs" "haskell" + diags@(reduceDiag:_) <- waitForDiagnostics + + liftIO $ do + length diags `shouldBe` 2 + reduceDiag ^. L.range `shouldBe` Range (Position 1 0) (Position 1 12) + reduceDiag ^. L.severity `shouldBe` Just DsInfo + reduceDiag ^. L.code `shouldBe` Just (StringValue "Eta reduce") + reduceDiag ^. L.source `shouldBe` Just "hlint" + + (CACodeAction ca:_) <- getAllCodeActions doc + + -- Evaluate became redundant id in later hlint versions + liftIO $ ["Apply hint:Redundant id", "Apply hint:Evaluate"] `shouldContain` [ca ^. L.title] + + executeCodeAction ca + + contents <- getDocumentEdit doc + liftIO $ contents `shouldBe` "main = undefined\nfoo x = x\n" + sendNotification TextDocumentDidSave (DidSaveTextDocumentParams doc) + + noDiagnostics + ] + +renameTests :: TestTree +renameTests = testGroup "rename suggestions" [ + testCase "works" $ runSession hieCommand noLiteralCaps "test/testdata" $ do + doc <- openDoc "CodeActionRename.hs" "haskell" + + _ <- waitForDiagnosticsSource "bios" + + CACommand cmd:_ <- getAllCodeActions doc + executeCommand cmd + + x:_ <- T.lines <$> documentContents doc + liftIO $ x `shouldBe` "main = putStrLn \"hello\"" + + , testCase "doesn't give both documentChanges and changes" + $ runSession hieCommand noLiteralCaps "test/testdata" $ do + doc <- openDoc "CodeActionRename.hs" "haskell" + + _ <- waitForDiagnosticsSource "bios" + + CACommand cmd <- (!! 2) <$> getAllCodeActions doc + let Just (List [Object args]) = cmd ^. L.arguments + Object editParams = args HM.! "fallbackWorkspaceEdit" + liftIO $ do + editParams `shouldSatisfy` HM.member "changes" + editParams `shouldNotSatisfy` HM.member "documentChanges" + + executeCommand cmd + + _:x:_ <- T.lines <$> documentContents doc + liftIO $ x `shouldBe` "foo = putStrLn \"world\"" + ] + +importTests :: TestTree +importTests = testGroup "import suggestions" [ + testCase "works with 3.8 code action kinds" $ runSession hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "CodeActionImport.hs" "haskell" + -- No Formatting: + let config = def { formattingProvider = "none" } + sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) + + -- ignore the first empty hlint diagnostic publish + [_,diag:_] <- count 2 waitForDiagnostics + liftIO $ diag ^. L.message `shouldBe` "Variable not in scope: when :: Bool -> IO () -> IO ()" + + actionsOrCommands <- getAllCodeActions doc + let actns = map fromAction actionsOrCommands + + liftIO $ do + head actns ^. L.title `shouldBe` "Import module Control.Monad" + head (tail actns) ^. L.title `shouldBe` "Import module Control.Monad (when)" + forM_ actns $ \a -> do + a ^. L.kind `shouldBe` Just CodeActionQuickFix + a ^. L.command `shouldSatisfy` isJust + a ^. L.edit `shouldBe` Nothing + let hasOneDiag (Just (List [_])) = True + hasOneDiag _ = False + a ^. L.diagnostics `shouldSatisfy` hasOneDiag + length actns `shouldBe` 10 + + executeCodeAction (head actns) + + contents <- getDocumentEdit doc + liftIO $ contents `shouldBe` "import Control.Monad\nmain :: IO ()\nmain = when True $ putStrLn \"hello\"" + ] + +packageTests :: TestTree +packageTests = testGroup "add package suggestions" [ + testCase "adds to .cabal files" $ do + flushStackEnvironment + runSession hieCommand fullCaps "test/testdata/addPackageTest/cabal-exe" $ do + doc <- openDoc "AddPackage.hs" "haskell" + + -- ignore the first empty hlint diagnostic publish + [_,diag:_] <- count 2 waitForDiagnostics + + 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 $ diag ^. L.message `shouldSatisfy` \m -> any (`T.isPrefixOf` m) prefixes + + acts <- getAllCodeActions doc + let (CACodeAction action:_) = acts + + liftIO $ do + action ^. L.title `shouldBe` "Add text as a dependency" + action ^. L.kind `shouldBe` Just CodeActionQuickFix + action ^. L.command . _Just . L.command `shouldSatisfy` T.isSuffixOf "package:add" + + executeCodeAction action + + contents <- getDocumentEdit . TextDocumentIdentifier =<< getDocUri "add-package-test.cabal" + liftIO $ + T.lines contents `shouldSatisfy` \x -> + any (\l -> "text -any" `T.isSuffixOf` l || "text : {} -any" `T.isSuffixOf` l) x + + , testCase "adds to hpack package.yaml files" $ + runSession hieCommand fullCaps "test/testdata/addPackageTest/hpack-exe" $ do + doc <- openDoc "app/Asdf.hs" "haskell" + + -- ignore the first empty hlint diagnostic publish + [_,_:diag:_] <- count 2 waitForDiagnostics + + 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 $ diag ^. L.message `shouldSatisfy` \m -> any (`T.isPrefixOf` m) prefixes + + mActions <- getAllCodeActions doc + let allActions = map fromAction mActions + action = head allActions + + liftIO $ do + action ^. L.title `shouldBe` "Add zlib as a dependency" + forM_ allActions $ \a -> a ^. L.kind `shouldBe` Just CodeActionQuickFix + forM_ allActions $ \a -> a ^. L.command . _Just . L.command `shouldSatisfy` T.isSuffixOf "package:add" + + executeCodeAction action + + contents <- getDocumentEdit . TextDocumentIdentifier =<< getDocUri "package.yaml" + liftIO $ do + T.lines contents !! 3 `shouldSatisfy` T.isSuffixOf "zlib" + T.lines contents !! 21 `shouldNotSatisfy` T.isSuffixOf "zlib" + ] + +redundantImportTests :: TestTree +redundantImportTests = testGroup "redundant import code actions" [ + testCase "remove solitary redundant imports" $ + runSession hieCommand fullCaps "test/testdata/redundantImportTest/" $ do + doc <- openDoc "src/CodeActionRedundant.hs" "haskell" + + -- ignore the first empty hlint diagnostic publish + [_,diag:_] <- count 2 waitForDiagnostics + + let prefixes = [ "The import of `Data.List' is redundant" -- Windows + , "The import of ‘Data.List’ is redundant" + ] + in liftIO $ diag ^. L.message `shouldSatisfy` \m -> any (`T.isPrefixOf` m) prefixes + + mActions <- getAllCodeActions doc + + let allActions@[removeAction, changeAction] = map fromAction mActions + + liftIO $ do + removeAction ^. L.title `shouldBe` "Remove redundant import" + changeAction ^. L.title `shouldBe` "Import instances" + forM_ allActions $ \a -> a ^. L.kind `shouldBe` Just CodeActionQuickFix + forM_ allActions $ \a -> a ^. L.command `shouldBe` Nothing + forM_ allActions $ \a -> a ^. L.edit `shouldSatisfy` isJust + + executeCodeAction removeAction + + -- No command/applyworkspaceedit should be here, since action + -- provides workspace edit property which skips round trip to + -- the server + contents <- documentContents doc + liftIO $ contents `shouldBe` "module CodeActionRedundant where\nmain :: IO ()\nmain = putStrLn \"hello\"" + + , testCase "doesn't touch other imports" $ runSession hieCommand noLiteralCaps "test/testdata/redundantImportTest/" $ do + doc <- openDoc "src/MultipleImports.hs" "haskell" + _ <- count 2 waitForDiagnostics + [CACommand cmd, _] <- getAllCodeActions doc + executeCommand cmd + contents <- documentContents doc + liftIO $ (T.lines contents) `shouldBe` + [ "module MultipleImports where" + , "import Data.Maybe" + , "foo :: Int" + , "foo = fromJust (Just 3)" + ] + ] + +typedHoleTests :: TestTree +typedHoleTests = testGroup "typed hole code actions" [ + testCase "works" $ + runSession hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "TypedHoles.hs" "haskell" + _ <- waitForDiagnosticsSource "bios" + cas <- map (\(CACodeAction x)-> x) <$> getAllCodeActions doc + + suggestion <- + case ghcVersion of + GHC88 -> do + liftIO $ map (^. L.title) cas `shouldMatchList` + [ "Substitute hole (Int) with x ([Int])" + , "Substitute hole (Int) with foo ([Int] -> Int Valid hole fits include)" + , "Substitute hole (Int) with maxBound (forall a. Bounded a => a with maxBound @Int)" + , "Substitute hole (Int) with minBound (forall a. Bounded a => a with minBound @Int)" + ] + return "x" + GHC86 -> do + liftIO $ map (^. L.title) cas `shouldMatchList` + [ "Substitute hole (Int) with x ([Int])" + , "Substitute hole (Int) with foo ([Int] -> Int Valid hole fits include)" + , "Substitute hole (Int) with maxBound (forall a. Bounded a => a with maxBound @Int)" + , "Substitute hole (Int) with minBound (forall a. Bounded a => a with minBound @Int)" + ] + return "x" + GHC84 -> do + liftIO $ map (^. L.title) cas `shouldMatchList` + [ "Substitute hole (Int) with maxBound (forall a. Bounded a => a)" + , "Substitute hole (Int) with minBound (forall a. Bounded a => a)" + , "Substitute hole (Int) with undefined (forall (a :: TYPE r). GHC.Stack.Types.HasCallStack => a)" + ] + return "maxBound" + + executeCodeAction $ head cas + + contents <- documentContents doc + + liftIO $ contents `shouldBe` T.concat + [ "module TypedHoles where\n" + , "foo :: [Int] -> Int\n" + , "foo x = " <> suggestion + ] + + , testCase "shows more suggestions" $ + runSession hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "TypedHoles2.hs" "haskell" + _ <- waitForDiagnosticsSource "bios" + cas <- map fromAction <$> getAllCodeActions doc + + suggestion <- + case ghcVersion of + GHC88 -> do + liftIO $ map (^. L.title) cas `shouldMatchList` + [ "Substitute hole (A) with stuff (A -> A)" + , "Substitute hole (A) with x ([A])" + , "Substitute hole (A) with foo2 ([A] -> A)" + ] + return "stuff" + GHC86 -> do + liftIO $ map (^. L.title) cas `shouldMatchList` + [ "Substitute hole (A) with stuff (A -> A)" + , "Substitute hole (A) with x ([A])" + , "Substitute hole (A) with foo2 ([A] -> A)" + ] + return "stuff" + GHC84 -> do + liftIO $ map (^. L.title) cas `shouldMatchList` + [ "Substitute hole (A) with undefined (forall (a :: TYPE r). GHC.Stack.Types.HasCallStack => a)" + , "Substitute hole (A) with stuff (A -> A)" + , "Substitute hole (A) with x ([A])" + , "Substitute hole (A) with foo2 ([A] -> A)" + ] + return "undefined" + + executeCodeAction $ head cas + + contents <- documentContents doc + + liftIO $ (T.lines contents) `shouldBe` + [ "module TypedHoles2 (foo2) where" + , "newtype A = A Int" + , "foo2 :: [A] -> A" + , "foo2 x = " <> suggestion <> "" + , " where" + , " stuff (A a) = A (a + 1)" + ] + ] + +signatureTests :: TestTree +signatureTests = testGroup "missing top level signature code actions" [ + testCase "Adds top level signature" $ + runSession hieCommand fullCaps "test/testdata/" $ do + doc <- openDoc "TopLevelSignature.hs" "haskell" + + _ <- waitForDiagnosticsSource "bios" + cas <- map fromAction <$> getAllCodeActions doc + + liftIO $ map (^. L.title) cas `shouldContain` [ "Add signature: main :: IO ()"] + + executeCodeAction $ head cas + + contents <- documentContents doc + + let expected = [ "{-# OPTIONS_GHC -Wall #-}" + , "module TopLevelSignature where" + , "main :: IO ()" + , "main = do" + , " putStrLn \"Hello\"" + , " return ()" + ] + + liftIO $ (T.lines contents) `shouldBe` expected + ] + +missingPragmaTests :: TestTree +missingPragmaTests = testGroup "missing pragma warning code actions" [ + testCase "Adds TypeSynonymInstances pragma" $ + runSession hieCommand fullCaps "test/testdata/addPragmas" $ do + doc <- openDoc "NeedsPragmas.hs" "haskell" + + _ <- waitForDiagnosticsSource "bios" + cas <- map fromAction <$> getAllCodeActions doc + + liftIO $ map (^. L.title) cas `shouldContain` [ "Add \"TypeSynonymInstances\""] + liftIO $ map (^. L.title) cas `shouldContain` [ "Add \"FlexibleInstances\""] + + executeCodeAction $ head cas + + contents <- getDocumentEdit doc + + let expected = [ "{-# LANGUAGE TypeSynonymInstances #-}" + , "" + , "import GHC.Generics" + , "" + , "main = putStrLn \"hello\"" + , "" + , "type Foo = Int" + , "" + , "instance Show Foo where" + , " show x = undefined" + , "" + , "instance Show (Int,String) where" + , " show = undefined" + , "" + , "data FFF a = FFF Int String a" + , " deriving (Generic,Functor,Traversable)" + ] + + liftIO $ (T.lines contents) `shouldBe` expected + ] + +unusedTermTests :: TestTree +unusedTermTests = testGroup "unused term code actions" [ + -- testCase "Prefixes with '_'" $ pendingWith "removed because of HaRe" + -- runSession hieCommand fullCaps "test/testdata/" $ do + -- doc <- openDoc "UnusedTerm.hs" "haskell" + -- + -- _ <- waitForDiagnosticsSource "bios" + -- cas <- map fromAction <$> getAllCodeActions doc + -- + -- liftIO $ map (^. L.title) cas `shouldContain` [ "Prefix imUnused with _"] + -- + -- executeCodeAction $ head cas + -- + -- edit <- getDocumentEdit doc + -- + -- let expected = [ "{-# OPTIONS_GHC -Wall #-}" + -- , "module UnusedTerm () where" + -- , "_imUnused :: Int -> Int" + -- , "_imUnused 1 = 1" + -- , "_imUnused 2 = 2" + -- , "_imUnused _ = 3" + -- ] + -- + -- liftIO $ edit `shouldBe` T.unlines expected + + -- See https://microsoft.github.io/language-server-protocol/specifications/specification-3-15/#textDocument_codeAction + -- `CodeActionContext` + testCase "respect 'only' parameter" $ runSession hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "CodeActionOnly.hs" "haskell" + _ <- count 2 waitForDiagnostics -- need to wait for both hlint and ghcmod + diags <- getCurrentDiagnostics doc + let params = CodeActionParams doc (Range (Position 2 10) (Position 4 0)) caContext Nothing + caContext = CodeActionContext (List diags) (Just (List [CodeActionRefactorInline])) + ResponseMessage _ _ (Just (List res)) _ <- request TextDocumentCodeAction params + let cas = map fromAction res + kinds = map (^. L.kind) cas + liftIO $ do + -- TODO: When HaRe is back this should be uncommented + -- kinds `shouldNotSatisfy` null + kinds `shouldNotSatisfy` any (Just CodeActionRefactorInline /=) + kinds `shouldSatisfy` all (Just CodeActionRefactorInline ==) + ] + +fromAction :: CAResult -> CodeAction +fromAction (CACodeAction action) = action +fromAction _ = error "Not a code action" + +noLiteralCaps :: C.ClientCapabilities +noLiteralCaps = def { C._textDocument = Just textDocumentCaps } + where + textDocumentCaps = def { C._codeAction = Just codeActionCaps } + codeActionCaps = C.CodeActionClientCapabilities (Just True) Nothing diff --git a/test/functional/Main.hs b/test/functional/Main.hs index a34a9f8884..73f6e7e3d2 100644 --- a/test/functional/Main.hs +++ b/test/functional/Main.hs @@ -1,20 +1,22 @@ module Main where import Command -import Completion -import Deferred -import Definition -import Diagnostic -import Format +-- import Completion +-- import Deferred +-- import Definition +-- import Diagnostic +-- import Format +import FunctionalCodeAction import Test.Tasty main :: IO () main = defaultMain $ testGroup "HIE" [ Command.tests - , Completion.tests - , Deferred.tests - , Definition.tests - , Diagnostic.tests - , Format.tests + -- , Completion.tests + -- , Deferred.tests + -- , Definition.tests + -- , Diagnostic.tests + -- , Format.tests + , FunctionalCodeAction.tests ] \ No newline at end of file diff --git a/test/utils/Test/HIE.hs b/test/utils/Test/HIE.hs index d401d91aed..d739fadca9 100644 --- a/test/utils/Test/HIE.hs +++ b/test/utils/Test/HIE.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP, OverloadedStrings #-} module Test.HIE ( codeActionSupportCaps + , flushStackEnvironment , ghcVersion, GhcVersion(..) , hieCommand , hieCommandExamplePlugin @@ -12,6 +13,8 @@ import Data.Default import qualified Language.Haskell.LSP.Test as Test import Language.Haskell.LSP.Test hiding (message) import qualified Language.Haskell.LSP.Types.Capabilities as C +import System.Environment + data GhcVersion = GHC88 @@ -63,6 +66,16 @@ codeActionSupportCaps = def { C._textDocument = Just textDocumentCaps } codeActionCaps = C.CodeActionClientCapabilities (Just True) (Just literalSupport) literalSupport = C.CodeActionLiteralSupport def +flushStackEnvironment :: IO () +flushStackEnvironment = do + -- We need to clear these environment variables to prevent + -- collisions with stack usages + -- See https://github.com/commercialhaskell/stack/issues/4875 + unsetEnv "GHC_PACKAGE_PATH" + unsetEnv "GHC_ENVIRONMENT" + unsetEnv "HASKELL_PACKAGE_SANDBOX" + unsetEnv "HASKELL_PACKAGE_SANDBOXES" + -- --------------------------------------------------------------------- -- --------------------------------------------------------------------- @@ -275,17 +288,6 @@ codeActionSupportCaps = def { C._textDocument = Just textDocumentCaps } -- #endif -- --------------------------------------------------------------------- - --- flushStackEnvironment :: IO () --- flushStackEnvironment = do --- -- We need to clear these environment variables to prevent --- -- collisions with stack usages --- -- See https://github.com/commercialhaskell/stack/issues/4875 --- unsetEnv "GHC_PACKAGE_PATH" --- unsetEnv "GHC_ENVIRONMENT" --- unsetEnv "HASKELL_PACKAGE_SANDBOX" --- unsetEnv "HASKELL_PACKAGE_SANDBOXES" - -- --------------------------------------------------------------------- -- dummyLspFuncs :: Default a => LspFuncs a diff --git a/test/utils/Test/Tasty/Expectations.hs b/test/utils/Test/Tasty/Expectations.hs index db5f88d09a..9e327c6dab 100644 --- a/test/utils/Test/Tasty/Expectations.hs +++ b/test/utils/Test/Tasty/Expectations.hs @@ -1,12 +1,17 @@ module Test.Tasty.Expectations where +import Data.List import Test.Tasty.HUnit infix 1 ===, `shouldBe`, `shouldSatisfy`, `shouldNotBe`, `shouldNotSatisfy` +infix 1 `shouldContain`, `shouldMatchList` (===) :: (Eq a, Show a) => a -> a -> Assertion (===) = (@?=) +--was not ready to add a library until it was discussed, so +--converted these helper functions from https://github.com/hspec/hspec-expectations + shouldBe :: (HasCallStack, Show a, Eq a) => a -> a -> Assertion actual `shouldBe` expected = actual @?= expected @@ -18,3 +23,35 @@ v `shouldSatisfy` p = assertBool ("predicate failed on: " ++ show v) (p v) shouldNotSatisfy :: (HasCallStack, Show a) => a -> (a -> Bool) -> Assertion v `shouldNotSatisfy` p = assertBool ("predicate succeeded on: " ++ show v) ((not . p) v) + +shouldContain :: (HasCallStack, Show a, Eq a) => [a] -> [a] -> Assertion +shouldContain = compareWith isInfixOf "does not contain" + +shouldMatchList :: (HasCallStack, Show a, Eq a) => [a] -> [a] -> Assertion +xs `shouldMatchList` ys = maybe (return ()) assertFailure (matchList xs ys) + +-- ----------------------------------------------------------------------- + +compareWith :: (HasCallStack, Show a) => (a -> a -> Bool) -> String -> a -> a -> Assertion +compareWith comparator errorDesc result expected = assertBool errorMsg (comparator expected result) + where + errorMsg = show result ++ " " ++ errorDesc ++ " " ++ show expected + +matchList :: (Show a, Eq a) => [a] -> [a] -> Maybe String +xs `matchList` ys + | null extra && null missing = Nothing + | otherwise = Just (err "") + where + extra = xs \\ ys + missing = ys \\ xs + + msgAndList msg zs = showString msg . showList zs . showString "\n" + optMsgList msg zs = if null zs then id else msgAndList msg zs + + err :: ShowS + err = + showString "Actual list is not a permutation of expected list!\n" + . msgAndList " expected list contains: " ys + . msgAndList " actual list contains: " xs + . optMsgList " the missing elements are: " missing + . optMsgList " the extra elements are: " extra \ No newline at end of file From f08db9bbc538793d29b77096786db0657c64e4a1 Mon Sep 17 00:00:00 2001 From: Jeff Windsor Date: Sun, 10 May 2020 10:32:08 -0700 Subject: [PATCH 13/26] add FunctionalLiquid HieBois Highlist tests --- haskell-language-server.cabal | 4 ++ test/functional/FunctionalLiquid.hs | 100 ++++++++++++++++++++++++++++ test/functional/HieBios.hs | 35 ++++++++++ test/functional/Highlight.hs | 28 ++++++++ test/functional/Main.hs | 26 +++++--- test/utils/Test/HIE.hs | 4 +- 6 files changed, 185 insertions(+), 12 deletions(-) create mode 100644 test/functional/FunctionalLiquid.hs create mode 100644 test/functional/HieBios.hs create mode 100644 test/functional/Highlight.hs diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 80e30ae805..54e4a29108 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -218,6 +218,7 @@ test-suite func-test , directory , filepath , haskell-language-server + , haskell-lsp , haskell-lsp-types , hls-test-utils , lens @@ -235,6 +236,9 @@ test-suite func-test , Diagnostic , Format , FunctionalCodeAction + , FunctionalLiquid + , HieBios + , Highlight ghc-options: -Wall -Wno-name-shadowing -threaded -rtsopts -with-rtsopts=-N diff --git a/test/functional/FunctionalLiquid.hs b/test/functional/FunctionalLiquid.hs new file mode 100644 index 0000000000..6aa6df3c40 --- /dev/null +++ b/test/functional/FunctionalLiquid.hs @@ -0,0 +1,100 @@ +{-# LANGUAGE OverloadedStrings #-} + +module FunctionalLiquid (tests) where + +import Control.Lens hiding (List) +import Control.Monad.IO.Class +import Data.Aeson +import Data.Default +import qualified Data.Text as T +import Language.Haskell.LSP.Test hiding (message) +import Language.Haskell.LSP.Types as LSP +import Language.Haskell.LSP.Types.Lens as LSP hiding (contents, error ) +import Ide.Plugin.Config +import Test.HIE +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.Expectations + +-- --------------------------------------------------------------------- + +tests :: TestTree +tests = testGroup "liquid haskell diagnostics" [ + testCase "runs diagnostics on save, no liquid" $ + runSession hieCommandExamplePlugin codeActionSupportCaps "test/testdata" $ do + doc <- openDoc "liquid/Evens.hs" "haskell" + + diags@(reduceDiag:_) <- waitForDiagnostics + + liftIO $ do + length diags `shouldBe` 2 + reduceDiag ^. range `shouldBe` Range (Position 5 18) (Position 5 22) + reduceDiag ^. severity `shouldBe` Just DsHint + reduceDiag ^. code `shouldBe` Just (StringValue "Use negate") + reduceDiag ^. source `shouldBe` Just "hlint" + + diags2hlint <- waitForDiagnostics + + liftIO $ length diags2hlint `shouldBe` 2 + + sendNotification TextDocumentDidSave (DidSaveTextDocumentParams doc) + + diags3@(d:_) <- waitForDiagnosticsSource "eg2" + + liftIO $ do + length diags3 `shouldBe` 1 + d ^. LSP.range `shouldBe` Range (Position 0 0) (Position 1 0) + d ^. LSP.severity `shouldBe` Nothing + d ^. LSP.code `shouldBe` Nothing + d ^. LSP.message `shouldBe` T.pack "Example plugin diagnostic, triggered byDiagnosticOnSave" + + -- --------------------------------- + + , testCase "runs diagnostics on save, with liquid haskell" $ + runSession hieCommand codeActionSupportCaps "test/testdata" $ do + -- runSessionWithConfig logConfig hieCommand codeActionSupportCaps "test/testdata" $ do + doc <- openDoc "liquid/Evens.hs" "haskell" + + diags@(reduceDiag:_) <- waitForDiagnostics + + -- liftIO $ show diags `shouldBe` "" + + liftIO $ do + length diags `shouldBe` 2 + reduceDiag ^. range `shouldBe` Range (Position 5 18) (Position 5 22) + reduceDiag ^. severity `shouldBe` Just DsHint + reduceDiag ^. code `shouldBe` Just (StringValue "Use negate") + reduceDiag ^. source `shouldBe` Just "hlint" + + -- Enable liquid haskell plugin and disable hlint + let config = def { liquidOn = True, hlintOn = False } + sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) + + -- docItem <- getDocItem file languageId + sendNotification TextDocumentDidSave (DidSaveTextDocumentParams doc) + -- TODO: what does that test? + -- TODO: whether hlint is really disbabled? + -- TODO: @fendor, document or remove + -- diags2hlint <- waitForDiagnostics + -- -- liftIO $ show diags2hlint `shouldBe` "" + + -- -- We turned hlint diagnostics off + -- liftIO $ length diags2hlint `shouldBe` 0 + -- diags2liquid <- waitForDiagnostics + -- liftIO $ length diags2liquid `shouldBe` 0 + -- liftIO $ show diags2liquid `shouldBe` "" + diags3@(d:_) <- waitForDiagnosticsSource "liquid" + -- liftIO $ show diags3 `shouldBe` "" + liftIO $ do + length diags3 `shouldBe` 1 + d ^. range `shouldBe` Range (Position 8 0) (Position 8 11) + d ^. severity `shouldBe` Just DsError + d ^. code `shouldBe` Nothing + d ^. source `shouldBe` Just "liquid" + d ^. message `shouldSatisfy` T.isPrefixOf ("Error: Liquid Type Mismatch\n" <> + " Inferred type\n" <> + " VV : {v : GHC.Types.Int | v == 7}\n" <> + " \n" <> + " not a subtype of Required type\n" <> + " VV : {VV : GHC.Types.Int | VV mod 2 == 0}\n ") + ] \ No newline at end of file diff --git a/test/functional/HieBios.hs b/test/functional/HieBios.hs new file mode 100644 index 0000000000..d6484bef34 --- /dev/null +++ b/test/functional/HieBios.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE OverloadedStrings #-} +module HieBios (tests) where + +import Control.Applicative.Combinators +import qualified Data.Text as T +import Language.Haskell.LSP.Test +import Language.Haskell.LSP.Types +import Language.Haskell.LSP.Messages +import System.FilePath (()) +import Test.HIE +import Test.Tasty +import Test.Tasty.HUnit + +tests :: TestTree +tests = testGroup "hie-bios" [ + testCase "loads modules inside main-is" $ do + writeFile (hieBiosErrorPath "hie.yaml") "" + runSession hieCommand fullCaps "test/testdata/hieBiosMainIs" $ do + _ <- openDoc "Main.hs" "haskell" + _ <- count 2 waitForDiagnostics + return () + + , testCase "reports errors in hie.yaml" $ do + writeFile (hieBiosErrorPath "hie.yaml") "" + runSession hieCommand fullCaps hieBiosErrorPath $ do + _ <- openDoc "Foo.hs" "haskell" + _ <- skipManyTill loggingNotification (satisfy isMessage) + return () + ] + where + hieBiosErrorPath = "test/testdata/hieBiosError" + + isMessage (NotShowMessage (NotificationMessage _ _ (ShowMessageParams MtError s))) = + "Couldn't parse hie.yaml" `T.isInfixOf` s + isMessage _ = False diff --git a/test/functional/Highlight.hs b/test/functional/Highlight.hs new file mode 100644 index 0000000000..068006761c --- /dev/null +++ b/test/functional/Highlight.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE OverloadedStrings #-} +module Highlight (tests) where + +import Control.Applicative.Combinators +import Control.Monad.IO.Class +import Language.Haskell.LSP.Test +import Language.Haskell.LSP.Types +import Test.HIE +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.Expectations + +tests :: TestTree +tests = testGroup "highlight" [ + testCase "works" $ runSession hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "Highlight.hs" "haskell" + _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + highlights <- getHighlights doc (Position 2 2) + liftIO $ do + let hls = + [ DocumentHighlight (mkRange 2 0 2 3) (Just HkWrite) + , DocumentHighlight (mkRange 4 22 4 25) (Just HkRead) + , DocumentHighlight (mkRange 3 6 3 9) (Just HkRead) + , DocumentHighlight (mkRange 1 0 1 3) (Just HkRead)] + mapM_ (\x -> highlights `shouldContain` [x]) hls + ] + where + mkRange sl sc el ec = Range (Position sl sc) (Position el ec) diff --git a/test/functional/Main.hs b/test/functional/Main.hs index 73f6e7e3d2..87f578860f 100644 --- a/test/functional/Main.hs +++ b/test/functional/Main.hs @@ -1,22 +1,28 @@ module Main where import Command --- import Completion --- import Deferred --- import Definition --- import Diagnostic --- import Format +import Completion +import Deferred +import Definition +import Diagnostic +import Format import FunctionalCodeAction +import FunctionalLiquid +import HieBios +import Highlight import Test.Tasty main :: IO () main = defaultMain $ testGroup "HIE" [ Command.tests - -- , Completion.tests - -- , Deferred.tests - -- , Definition.tests - -- , Diagnostic.tests - -- , Format.tests + , Completion.tests + , Deferred.tests + , Definition.tests + , Diagnostic.tests + , Format.tests , FunctionalCodeAction.tests + , FunctionalLiquid.tests + , HieBios.tests + , Highlight.tests ] \ No newline at end of file diff --git a/test/utils/Test/HIE.hs b/test/utils/Test/HIE.hs index d739fadca9..9b9135b612 100644 --- a/test/utils/Test/HIE.hs +++ b/test/utils/Test/HIE.hs @@ -89,7 +89,7 @@ flushStackEnvironment = do -- import Data.Maybe -- import Language.Haskell.LSP.Core -- import Language.Haskell.LSP.Types --- -- import Haskell.Ide.Engine.MonadTypes hiding (withProgress, withIndefiniteProgress) +-- -- import Ide.Plugin.MonadTypes hiding (withProgress, withIndefiniteProgress) -- -- import qualified Ide.Cradle as Bios -- -- import qualified Ide.Engine.Config as Config -- import System.Directory @@ -101,7 +101,7 @@ flushStackEnvironment = do -- import Test.Hspec.Core.Formatters -- import Text.Blaze.Renderer.String (renderMarkup) -- import Text.Blaze.Internal --- -- import qualified Haskell.Ide.Engine.PluginApi as HIE (BiosOptions, defaultOptions) +-- -- import qualified Ide.Plugin.PluginApi as HIE (BiosOptions, defaultOptions) -- import HIE.Bios.Types From f9173b06e4668a7214eb4c6c0564611d9c41ea01 Mon Sep 17 00:00:00 2001 From: Jeff Windsor Date: Sun, 10 May 2020 11:57:34 -0700 Subject: [PATCH 14/26] add other tests --- haskell-language-server.cabal | 6 ++ test/functional/FunctionalBadProject.hs | 42 +++++++++ test/functional/Main.hs | 31 +++++-- test/functional/Progress.hs | 118 ++++++++++++++++++++++++ test/functional/Reference.hs | 34 +++++++ test/functional/Rename.hs | 28 ++++++ test/functional/Symbol.hs | 113 +++++++++++++++++++++++ test/functional/TypeDefinition.hs | 107 +++++++++++++++++++++ 8 files changed, 469 insertions(+), 10 deletions(-) create mode 100644 test/functional/FunctionalBadProject.hs create mode 100644 test/functional/Progress.hs create mode 100644 test/functional/Reference.hs create mode 100644 test/functional/Rename.hs create mode 100644 test/functional/Symbol.hs create mode 100644 test/functional/TypeDefinition.hs diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 54e4a29108..c9cea10995 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -235,10 +235,16 @@ test-suite func-test , Definition , Diagnostic , Format + , FunctionalBadProject , FunctionalCodeAction , FunctionalLiquid , HieBios , Highlight + , Progress + , Reference + , Rename + , Symbol + , TypeDefinition ghc-options: -Wall -Wno-name-shadowing -threaded -rtsopts -with-rtsopts=-N diff --git a/test/functional/FunctionalBadProject.hs b/test/functional/FunctionalBadProject.hs new file mode 100644 index 0000000000..92ac11713c --- /dev/null +++ b/test/functional/FunctionalBadProject.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE OverloadedStrings #-} + +module FunctionalBadProject (tests) where + +-- import Control.Lens hiding (List) +-- import Control.Monad.IO.Class +-- import qualified Data.Text as T +-- import Language.Haskell.LSP.Test hiding (message) +-- import Language.Haskell.LSP.Types as LSP +-- import Language.Haskell.LSP.Types.Lens as LSP hiding (contents, error ) +-- import Test.HIE +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.Expectations + +-- --------------------------------------------------------------------- +-- TODO: Currently this can not succeed, since such an error is thrown in "runActionWithContext" which +-- can produce diagnostics at the moment. Needs more investigation +-- TODO: @fendor: Add issue link here +-- +tests :: TestTree +tests = testGroup "behaviour on malformed projects" [ + testCase "no test executed" $ True `shouldBe` True + ] + + -- testCase "deals with cabal file with unsatisfiable dependency" $ + -- runSession hieCommandExamplePlugin codeActionSupportCaps "test/testdata/badProjects/cabal" $ do + -- -- runSessionWithConfig logConfig hieCommandExamplePlugin codeActionSupportCaps "test/testdata" $ do + -- _doc <- openDoc "Foo.hs" "haskell" + + -- diags@(d:_) <- waitForDiagnosticsSource "bios" + -- -- liftIO $ show diags `shouldBe` "" + -- -- liftIO $ putStrLn $ show diags + -- -- liftIO $ putStrLn "a" + -- liftIO $ do + -- length diags `shouldBe` 1 + -- d ^. range `shouldBe` Range (Position 0 0) (Position 1 0) + -- d ^. severity `shouldBe` (Just DsError) + -- d ^. code `shouldBe` Nothing + -- d ^. source `shouldBe` Just "bios" + -- d ^. message `shouldBe` + -- (T.pack "readCreateProcess: stack \"build\" \"--only-configure\" \".\" (exit 1): failed\n") diff --git a/test/functional/Main.hs b/test/functional/Main.hs index 87f578860f..1626429b60 100644 --- a/test/functional/Main.hs +++ b/test/functional/Main.hs @@ -1,16 +1,21 @@ module Main where import Command -import Completion -import Deferred -import Definition -import Diagnostic -import Format -import FunctionalCodeAction -import FunctionalLiquid -import HieBios -import Highlight - +-- import Completion +-- import Deferred +-- import Definition +-- import Diagnostic +-- import Format +import FunctionalBadProject +-- import FunctionalCodeAction +-- import FunctionalLiquid +-- import HieBios +-- import Highlight +import Progress +import Reference +import Rename +import Symbol +import TypeDefinition import Test.Tasty main :: IO () @@ -21,8 +26,14 @@ main = defaultMain $ testGroup "HIE" [ , Definition.tests , Diagnostic.tests , Format.tests + , FunctionalBadProject.tests , FunctionalCodeAction.tests , FunctionalLiquid.tests , HieBios.tests , Highlight.tests + , Progress.tests + , Reference.tests + , Rename.tests + , Symbol.tests + , TypeDefinition.tests ] \ No newline at end of file diff --git a/test/functional/Progress.hs b/test/functional/Progress.hs new file mode 100644 index 0000000000..218e97e39c --- /dev/null +++ b/test/functional/Progress.hs @@ -0,0 +1,118 @@ +{-# LANGUAGE OverloadedStrings #-} +module Progress (tests) where + +import Control.Applicative.Combinators +import Control.Lens +import Control.Monad.IO.Class +import Data.Aeson +import Data.Default +import Ide.Plugin.Config +import Language.Haskell.LSP.Test +import Language.Haskell.LSP.Messages -- TODO: Move this into haskell-lsp-types +import Language.Haskell.LSP.Types +import qualified Language.Haskell.LSP.Types.Lens as L +import Language.Haskell.LSP.Types.Capabilities +import Test.HIE +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.Expectations + +tests :: TestTree +tests = testGroup "window/workDoneProgress" [ + testCase "sends indefinite progress notifications" $ + -- Testing that ghc-mod sends progress notifications + runSession hieCommand progressCaps "test/testdata" $ do + doc <- openDoc "ApplyRefact2.hs" "haskell" + + skipMany loggingNotification + + createRequest <- message :: Session WorkDoneProgressCreateRequest + liftIO $ do + createRequest ^. L.params `shouldBe` WorkDoneProgressCreateParams (ProgressNumericToken 0) + + startNotification <- message :: Session WorkDoneProgressBeginNotification + liftIO $ do + -- Expect a stack cradle, since the given `hie.yaml` is expected + -- to contain a multi-stack cradle. + startNotification ^. L.params . L.value . L.title `shouldBe` "Initializing Stack project" + startNotification ^. L.params . L.token `shouldBe` (ProgressNumericToken 0) + + reportNotification <- message :: Session WorkDoneProgressReportNotification + liftIO $ do + reportNotification ^. L.params . L.value . L.message `shouldBe` Just "Main" + reportNotification ^. L.params . L.token `shouldBe` (ProgressNumericToken 0) + + -- may produce diagnostics + skipMany publishDiagnosticsNotification + + doneNotification <- message :: Session WorkDoneProgressEndNotification + liftIO $ doneNotification ^. L.params . L.token `shouldBe` (ProgressNumericToken 0) + + -- Initial hlint notifications + _ <- publishDiagnosticsNotification + + -- Test incrementing ids + sendNotification TextDocumentDidSave (DidSaveTextDocumentParams doc) + + createRequest' <- skipManyTill loggingNotification (message :: Session WorkDoneProgressCreateRequest) + liftIO $ do + createRequest' ^. L.params `shouldBe` WorkDoneProgressCreateParams (ProgressNumericToken 1) + + startNotification' <- message :: Session WorkDoneProgressBeginNotification + liftIO $ do + startNotification' ^. L.params . L.value . L.title `shouldBe` "loading" + startNotification' ^. L.params . L.token `shouldBe` (ProgressNumericToken 1) + + reportNotification' <- message :: Session WorkDoneProgressReportNotification + liftIO $ do + reportNotification' ^. L.params . L.value . L.message `shouldBe` Just "Main" + reportNotification' ^. L.params . L.token `shouldBe` (ProgressNumericToken 1) + + doneNotification' <- message :: Session WorkDoneProgressEndNotification + liftIO $ doneNotification' ^. L.params . L.token `shouldBe` (ProgressNumericToken 1) + + -- Initial hlint notifications + _ <- publishDiagnosticsNotification + return () + + , testCase "sends indefinite progress notifications with liquid" $ + -- Testing that Liquid Haskell sends progress notifications + runSession hieCommand progressCaps "test/testdata" $ do + doc <- openDoc "liquid/Evens.hs" "haskell" + + skipMany loggingNotification + + _ <- message :: Session WorkDoneProgressCreateRequest + _ <- message :: Session WorkDoneProgressBeginNotification + _ <- message :: Session WorkDoneProgressReportNotification + _ <- message :: Session WorkDoneProgressEndNotification + + -- the hie-bios diagnostics + _ <- skipManyTill loggingNotification publishDiagnosticsNotification + + -- Enable liquid haskell plugin + let config = def { liquidOn = True, hlintOn = False } + sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) + + -- Test liquid + sendNotification TextDocumentDidSave (DidSaveTextDocumentParams doc) + + -- hlint notifications + -- TODO: potential race between typechecking, e.g. context intialisation + -- TODO: and disabling hlint notifications + -- _ <- skipManyTill loggingNotification publishDiagnosticsNotification + + let startPred (NotWorkDoneProgressBegin m) = + m ^. L.params . L.value . L.title == "Running Liquid Haskell on Evens.hs" + startPred _ = False + + let donePred (NotWorkDoneProgressEnd _) = True + donePred _ = False + + _ <- skipManyTill anyMessage $ between (satisfy startPred) (satisfy donePred) $ + many (satisfy (\x -> not (startPred x || donePred x))) + return () + ] + +progressCaps :: ClientCapabilities +progressCaps = fullCaps { _window = Just (WindowClientCapabilities (Just True)) } diff --git a/test/functional/Reference.hs b/test/functional/Reference.hs new file mode 100644 index 0000000000..92f112b5a9 --- /dev/null +++ b/test/functional/Reference.hs @@ -0,0 +1,34 @@ +module Reference (tests) where + +import Control.Lens +import Control.Monad.IO.Class +import Language.Haskell.LSP.Test +import Language.Haskell.LSP.Types +import Language.Haskell.LSP.Types.Lens +import Test.HIE +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.Expectations + +tests :: TestTree +tests = testGroup "references" [ + testCase "works with definitions" $ runSession hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "References.hs" "haskell" + let pos = Position 2 7 -- foo = bar <-- + refs <- getReferences doc pos True + liftIO $ refs `shouldContain` 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 + ] + -- TODO: Respect withDeclaration parameter + -- testCase "works without definitions" $ runSession hieCommand 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) diff --git a/test/functional/Rename.hs b/test/functional/Rename.hs new file mode 100644 index 0000000000..69936782b6 --- /dev/null +++ b/test/functional/Rename.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE OverloadedStrings #-} +module Rename (tests) where + +-- import Control.Monad.IO.Class +-- import Language.Haskell.LSP.Test +-- import Language.Haskell.LSP.Types +-- import Test.HIE +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.Expectations + +tests :: TestTree +tests = testGroup "rename" [ + testCase "works" $ True `shouldBe` True + -- pendingWith "removed because of HaRe" + -- runSession hieCommand fullCaps "test/testdata" $ do + -- doc <- openDoc "Rename.hs" "haskell" + -- rename doc (Position 3 1) "baz" -- foo :: Int -> Int + -- documentContents doc >>= liftIO . flip shouldBe expected + -- where + -- expected = + -- "main = do\n\ + -- \ x <- return $ baz 42\n\ + -- \ return (baz x)\n\ + -- \baz :: Int -> Int\n\ + -- \baz x = x + 1\n\ + -- \bar = (+ 1) . baz\n" + ] \ No newline at end of file diff --git a/test/functional/Symbol.hs b/test/functional/Symbol.hs new file mode 100644 index 0000000000..e263d25ebd --- /dev/null +++ b/test/functional/Symbol.hs @@ -0,0 +1,113 @@ +{-# LANGUAGE OverloadedStrings #-} +module Symbol (tests) where + +import Control.Monad.IO.Class +import Language.Haskell.LSP.Test as Test +import Language.Haskell.LSP.Types +import Language.Haskell.LSP.Types.Capabilities +import Test.HIE +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.Expectations + +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 hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "Symbols.hs" "haskell" + Left symbs <- getDocumentSymbols doc + + let myData = DocumentSymbol "MyData" (Just "") SkClass Nothing myDataR myDataSR (Just (List [a, b])) + a = DocumentSymbol "A" (Just "") SkConstructor Nothing aR aSR (Just mempty) + b = DocumentSymbol "B" (Just "") SkConstructor Nothing bR bSR (Just mempty) + + liftIO $ symbs `shouldContain` [myData] + + ,testCase "provides nested where functions" $ runSession hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "Symbols.hs" "haskell" + Left symbs <- getDocumentSymbols doc + + let foo = DocumentSymbol "foo" (Just "") SkFunction Nothing fooR fooSR (Just (List [bar])) + bar = DocumentSymbol "bar" (Just "") SkFunction Nothing barR barSR (Just (List [dog, cat])) + dog = DocumentSymbol "dog" (Just "") SkVariable Nothing dogR dogSR (Just mempty) + cat = DocumentSymbol "cat" (Just "") SkVariable Nothing catR catSR (Just mempty) + + liftIO $ symbs `shouldContain` [foo] + + , testCase "provides pattern synonyms" $ runSession hieCommand fullCaps "test/testdata" $ do + doc <- openDoc "Symbols.hs" "haskell" + Left symbs <- getDocumentSymbols doc + + let testPattern = DocumentSymbol "TestPattern" + (Just "") SkFunction Nothing testPatternR testPatternSR (Just mempty) + + liftIO $ symbs `shouldContain` [testPattern] + ] + +-- TODO: Test module, imports + +pre310Tests :: TestTree +pre310Tests = testGroup "pre 3.10 symbol information" [ + testCase "provides nested data types and constructors" $ runSession hieCommand oldCaps "test/testdata" $ do + doc@(TextDocumentIdentifier testUri) <- openDoc "Symbols.hs" "haskell" + Right symbs <- getDocumentSymbols doc + + let myData = SymbolInformation "MyData" SkClass Nothing (Location testUri myDataR) Nothing + a = SymbolInformation "A" SkConstructor Nothing (Location testUri aR) (Just "MyData") + b = SymbolInformation "B" SkConstructor Nothing (Location testUri bR) (Just "MyData") + + liftIO $ symbs `shouldContain` [myData, a, b] + + ,testCase "provides nested where functions" $ runSession hieCommand oldCaps "test/testdata" $ do + doc@(TextDocumentIdentifier testUri) <- openDoc "Symbols.hs" "haskell" + Right symbs <- getDocumentSymbols doc + + let foo = SymbolInformation "foo" SkFunction Nothing (Location testUri fooR) Nothing + bar = SymbolInformation "bar" SkFunction Nothing (Location testUri barR) (Just "foo") + dog = SymbolInformation "dog" SkVariable Nothing (Location testUri dogR) (Just "bar") + cat = SymbolInformation "cat" SkVariable Nothing (Location testUri catR) (Just "bar") + + -- Order is important! + liftIO $ symbs `shouldContain` [foo, bar, dog, cat] + ] + +oldCaps :: ClientCapabilities +oldCaps = capsForVersion (LSPVersion 3 9) +-- Some common ranges and selection ranges in Symbols.hs +fooSR :: Range +fooSR = Range (Position 5 0) (Position 5 3) +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 5) (Position 9 11) +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) \ No newline at end of file diff --git a/test/functional/TypeDefinition.hs b/test/functional/TypeDefinition.hs new file mode 100644 index 0000000000..1534c72251 --- /dev/null +++ b/test/functional/TypeDefinition.hs @@ -0,0 +1,107 @@ +module TypeDefinition (tests) where + +import Control.Monad.IO.Class +import Language.Haskell.LSP.Test +import Language.Haskell.LSP.Types +import System.Directory +import Test.HIE +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.Expectations + +tests :: TestTree +tests = testGroup "type definitions" [ + testCase "finds local definition of record variable" + $ runSession hieCommand fullCaps "test/testdata/gototest" + $ do + doc <- openDoc "src/Lib.hs" "haskell" + defs <- getTypeDefinitions doc (toPos (11, 23)) + liftIO $ do + fp <- canonicalizePath "test/testdata/gototest/src/Lib.hs" + defs + `shouldBe` [ Location (filePathToUri fp) + (Range (toPos (8, 1)) (toPos (8, 29))) + ] + , testCase "finds local definition of newtype variable" + $ runSession hieCommand fullCaps "test/testdata/gototest" + $ do + doc <- openDoc "src/Lib.hs" "haskell" + defs <- getTypeDefinitions doc (toPos (16, 21)) + liftIO $ do + fp <- canonicalizePath "test/testdata/gototest/src/Lib.hs" + defs + `shouldBe` [ Location (filePathToUri fp) + (Range (toPos (13, 1)) (toPos (13, 30))) + ] + , testCase "finds local definition of sum type variable" + $ runSession hieCommand fullCaps "test/testdata/gototest" + $ do + doc <- openDoc "src/Lib.hs" "haskell" + defs <- getTypeDefinitions doc (toPos (21, 13)) + liftIO $ do + fp <- canonicalizePath "test/testdata/gototest/src/Lib.hs" + defs + `shouldBe` [ Location (filePathToUri fp) + (Range (toPos (18, 1)) (toPos (18, 26))) + ] + , testCase "finds local definition of sum type contructor" + $ runSession hieCommand fullCaps "test/testdata/gototest" + $ do + doc <- openDoc "src/Lib.hs" "haskell" + defs <- getTypeDefinitions doc (toPos (24, 7)) + liftIO $ do + fp <- canonicalizePath "test/testdata/gototest/src/Lib.hs" + defs + `shouldBe` [ Location (filePathToUri fp) + (Range (toPos (18, 1)) (toPos (18, 26))) + ] + , testCase "can not find non-local definition of type def" + $ runSession hieCommand fullCaps "test/testdata/gototest" + $ do + doc <- openDoc "src/Lib.hs" "haskell" + defs <- getTypeDefinitions doc (toPos (30, 17)) + liftIO $ defs `shouldBe` [] + + , testCase "find local definition of type def" + $ runSession hieCommand fullCaps "test/testdata/gototest" + $ do + doc <- openDoc "src/Lib.hs" "haskell" + defs <- getTypeDefinitions doc (toPos (35, 16)) + liftIO $ do + fp <- canonicalizePath "test/testdata/gototest/src/Lib.hs" + defs + `shouldBe` [ Location (filePathToUri fp) + (Range (toPos (18, 1)) (toPos (18, 26))) + ] + + -- TODO Implement + -- , testCase "find type-definition of type def in component" + -- $ pendingWith "Finding symbols cross module is currently not supported" + -- $ runSession hieCommand fullCaps "test/testdata/gototest" + -- $ do + -- doc <- openDoc "src/Lib2.hs" "haskell" + -- otherDoc <- openDoc "src/Lib.hs" "haskell" + -- closeDoc otherDoc + -- defs <- getTypeDefinitions doc (toPos (13, 20)) + -- liftIO $ do + -- fp <- canonicalizePath "test/testdata/gototest/src/Lib.hs" + -- defs + -- `shouldBe` [ Location (filePathToUri fp) + -- (Range (toPos (8, 1)) (toPos (8, 29))) + -- ] + , testCase "find definition of parameterized data type" + $ runSession hieCommand fullCaps "test/testdata/gototest" + $ do + doc <- openDoc "src/Lib.hs" "haskell" + defs <- getTypeDefinitions doc (toPos (40, 19)) + liftIO $ do + fp <- canonicalizePath "test/testdata/gototest/src/Lib.hs" + defs + `shouldBe` [ Location (filePathToUri fp) + (Range (toPos (37, 1)) (toPos (37, 31))) + ] + ] + +--NOTE: copied from Haskell.Ide.Engine.ArtifactMap +toPos :: (Int,Int) -> Position +toPos (l,c) = Position (l-1) (c-1) \ No newline at end of file From 8cccd93f4807f20c0f149ef817c036b7000d6576 Mon Sep 17 00:00:00 2001 From: Jeff Windsor Date: Sun, 10 May 2020 11:59:33 -0700 Subject: [PATCH 15/26] turn on all tests --- test/functional/Main.hs | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/test/functional/Main.hs b/test/functional/Main.hs index 1626429b60..40aaf44bcf 100644 --- a/test/functional/Main.hs +++ b/test/functional/Main.hs @@ -1,16 +1,16 @@ module Main where import Command --- import Completion --- import Deferred --- import Definition --- import Diagnostic --- import Format +import Completion +import Deferred +import Definition +import Diagnostic +import Format import FunctionalBadProject --- import FunctionalCodeAction --- import FunctionalLiquid --- import HieBios --- import Highlight +import FunctionalCodeAction +import FunctionalLiquid +import HieBios +import Highlight import Progress import Reference import Rename From d0c0e6150dc86b2bf8b4f528e0c66ef731693ac8 Mon Sep 17 00:00:00 2001 From: Jeff Windsor Date: Sun, 10 May 2020 12:25:05 -0700 Subject: [PATCH 16/26] move and restore full test util module --- haskell-language-server.cabal | 4 +- test/functional/Command.hs | 4 +- test/functional/Completion.hs | 4 +- test/functional/Deferred.hs | 4 +- test/functional/Definition.hs | 4 +- test/functional/Diagnostic.hs | 4 +- test/functional/Format.hs | 4 +- test/functional/FunctionalBadProject.hs | 4 +- test/functional/FunctionalCodeAction.hs | 4 +- test/functional/FunctionalLiquid.hs | 4 +- test/functional/HieBios.hs | 2 +- test/functional/Highlight.hs | 4 +- test/functional/Progress.hs | 4 +- test/functional/Reference.hs | 4 +- test/functional/Rename.hs | 4 +- test/functional/Symbol.hs | 4 +- test/functional/TypeDefinition.hs | 4 +- test/utils/Test/HIE.hs | 307 ----------------- test/utils/Test/HIE/Util.hs | 312 ++++++++++++++++++ .../Tasty/{Expectations.hs => Expectation.hs} | 2 +- 20 files changed, 346 insertions(+), 341 deletions(-) delete mode 100644 test/utils/Test/HIE.hs create mode 100644 test/utils/Test/HIE/Util.hs rename test/utils/Test/Tasty/{Expectations.hs => Expectation.hs} (98%) diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index c9cea10995..5e1902cea3 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -254,8 +254,8 @@ test-suite func-test library hls-test-utils import: agpl hs-source-dirs: test/utils - exposed-modules: Test.HIE - , Test.Tasty.Expectations + exposed-modules: Test.HIE.Util + , Test.Tasty.Expectation build-depends: base , haskell-language-server , haskell-lsp diff --git a/test/functional/Command.hs b/test/functional/Command.hs index 62d6ec2260..2010518f43 100644 --- a/test/functional/Command.hs +++ b/test/functional/Command.hs @@ -8,10 +8,10 @@ import Data.Char import Language.Haskell.LSP.Test import Language.Haskell.LSP.Types as LSP import Language.Haskell.LSP.Types.Lens as LSP -import Test.HIE +import Test.HIE.Util import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.Expectations +import Test.Tasty.Expectation tests :: TestTree tests = testGroup "commands" [ diff --git a/test/functional/Completion.hs b/test/functional/Completion.hs index c03bbd0fb5..a0d77bf676 100644 --- a/test/functional/Completion.hs +++ b/test/functional/Completion.hs @@ -9,10 +9,10 @@ import Control.Lens hiding ((.=)) import Language.Haskell.LSP.Test import Language.Haskell.LSP.Types import Language.Haskell.LSP.Types.Lens hiding (applyEdit) -import Test.HIE +import Test.HIE.Util import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.Expectations +import Test.Tasty.Expectation tests :: TestTree diff --git a/test/functional/Deferred.hs b/test/functional/Deferred.hs index dedd36b157..882039904c 100644 --- a/test/functional/Deferred.hs +++ b/test/functional/Deferred.hs @@ -12,10 +12,10 @@ import Language.Haskell.LSP.Test import Language.Haskell.LSP.Types import Language.Haskell.LSP.Types.Lens hiding (id, message) import qualified Language.Haskell.LSP.Types.Lens as LSP -import Test.HIE +import Test.HIE.Util import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.Expectations +import Test.Tasty.Expectation tests :: TestTree diff --git a/test/functional/Definition.hs b/test/functional/Definition.hs index 9904795ae5..bb972a4a55 100644 --- a/test/functional/Definition.hs +++ b/test/functional/Definition.hs @@ -6,10 +6,10 @@ import Language.Haskell.LSP.Test import Language.Haskell.LSP.Types import Language.Haskell.LSP.Types.Lens import System.Directory -import Test.HIE +import Test.HIE.Util import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.Expectations +import Test.Tasty.Expectation tests :: TestTree tests = testGroup "definitions" [ diff --git a/test/functional/Diagnostic.hs b/test/functional/Diagnostic.hs index 56b24cd96d..32eca1ab85 100644 --- a/test/functional/Diagnostic.hs +++ b/test/functional/Diagnostic.hs @@ -13,10 +13,10 @@ import Ide.Plugin.Config import Language.Haskell.LSP.Test hiding (message) import Language.Haskell.LSP.Types import qualified Language.Haskell.LSP.Types.Lens as LSP -import Test.HIE +import Test.HIE.Util import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.Expectations +import Test.Tasty.Expectation -- --------------------------------------------------------------------- diff --git a/test/functional/Format.hs b/test/functional/Format.hs index 2835e0ca14..1250d596df 100644 --- a/test/functional/Format.hs +++ b/test/functional/Format.hs @@ -6,10 +6,10 @@ import Data.Aeson import qualified Data.Text as T import Language.Haskell.LSP.Test import Language.Haskell.LSP.Types -import Test.HIE +import Test.HIE.Util import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.Expectations +import Test.Tasty.Expectation tests :: TestTree tests = testGroup "format document" [ diff --git a/test/functional/FunctionalBadProject.hs b/test/functional/FunctionalBadProject.hs index 92ac11713c..469978d5c6 100644 --- a/test/functional/FunctionalBadProject.hs +++ b/test/functional/FunctionalBadProject.hs @@ -8,10 +8,10 @@ module FunctionalBadProject (tests) where -- import Language.Haskell.LSP.Test hiding (message) -- import Language.Haskell.LSP.Types as LSP -- import Language.Haskell.LSP.Types.Lens as LSP hiding (contents, error ) --- import Test.HIE +-- import Test.HIE.Util import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.Expectations +import Test.Tasty.Expectation -- --------------------------------------------------------------------- -- TODO: Currently this can not succeed, since such an error is thrown in "runActionWithContext" which diff --git a/test/functional/FunctionalCodeAction.hs b/test/functional/FunctionalCodeAction.hs index c0e0e4a0a4..5d82383ad2 100644 --- a/test/functional/FunctionalCodeAction.hs +++ b/test/functional/FunctionalCodeAction.hs @@ -20,10 +20,10 @@ import Language.Haskell.LSP.Test as Test import Language.Haskell.LSP.Types import qualified Language.Haskell.LSP.Types.Lens as L import qualified Language.Haskell.LSP.Types.Capabilities as C -import Test.HIE +import Test.HIE.Util import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.Expectations +import Test.Tasty.Expectation {-# ANN module ("HLint: ignore Reduce duplication"::String) #-} diff --git a/test/functional/FunctionalLiquid.hs b/test/functional/FunctionalLiquid.hs index 6aa6df3c40..bf3e7dcfb0 100644 --- a/test/functional/FunctionalLiquid.hs +++ b/test/functional/FunctionalLiquid.hs @@ -11,10 +11,10 @@ import Language.Haskell.LSP.Test hiding (message) import Language.Haskell.LSP.Types as LSP import Language.Haskell.LSP.Types.Lens as LSP hiding (contents, error ) import Ide.Plugin.Config -import Test.HIE +import Test.HIE.Util import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.Expectations +import Test.Tasty.Expectation -- --------------------------------------------------------------------- diff --git a/test/functional/HieBios.hs b/test/functional/HieBios.hs index d6484bef34..e6113bdbde 100644 --- a/test/functional/HieBios.hs +++ b/test/functional/HieBios.hs @@ -7,7 +7,7 @@ import Language.Haskell.LSP.Test import Language.Haskell.LSP.Types import Language.Haskell.LSP.Messages import System.FilePath (()) -import Test.HIE +import Test.HIE.Util import Test.Tasty import Test.Tasty.HUnit diff --git a/test/functional/Highlight.hs b/test/functional/Highlight.hs index 068006761c..9421117c69 100644 --- a/test/functional/Highlight.hs +++ b/test/functional/Highlight.hs @@ -5,10 +5,10 @@ import Control.Applicative.Combinators import Control.Monad.IO.Class import Language.Haskell.LSP.Test import Language.Haskell.LSP.Types -import Test.HIE +import Test.HIE.Util import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.Expectations +import Test.Tasty.Expectation tests :: TestTree tests = testGroup "highlight" [ diff --git a/test/functional/Progress.hs b/test/functional/Progress.hs index 218e97e39c..800d37c501 100644 --- a/test/functional/Progress.hs +++ b/test/functional/Progress.hs @@ -12,10 +12,10 @@ import Language.Haskell.LSP.Messages -- TODO: Move this into haskell-lsp-types import Language.Haskell.LSP.Types import qualified Language.Haskell.LSP.Types.Lens as L import Language.Haskell.LSP.Types.Capabilities -import Test.HIE +import Test.HIE.Util import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.Expectations +import Test.Tasty.Expectation tests :: TestTree tests = testGroup "window/workDoneProgress" [ diff --git a/test/functional/Reference.hs b/test/functional/Reference.hs index 92f112b5a9..e1bcb6d71f 100644 --- a/test/functional/Reference.hs +++ b/test/functional/Reference.hs @@ -5,10 +5,10 @@ import Control.Monad.IO.Class import Language.Haskell.LSP.Test import Language.Haskell.LSP.Types import Language.Haskell.LSP.Types.Lens -import Test.HIE +import Test.HIE.Util import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.Expectations +import Test.Tasty.Expectation tests :: TestTree tests = testGroup "references" [ diff --git a/test/functional/Rename.hs b/test/functional/Rename.hs index 69936782b6..3664c338e4 100644 --- a/test/functional/Rename.hs +++ b/test/functional/Rename.hs @@ -4,10 +4,10 @@ module Rename (tests) where -- import Control.Monad.IO.Class -- import Language.Haskell.LSP.Test -- import Language.Haskell.LSP.Types --- import Test.HIE +-- import Test.HIE.Util import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.Expectations +import Test.Tasty.Expectation tests :: TestTree tests = testGroup "rename" [ diff --git a/test/functional/Symbol.hs b/test/functional/Symbol.hs index e263d25ebd..9ff7d93b3c 100644 --- a/test/functional/Symbol.hs +++ b/test/functional/Symbol.hs @@ -5,10 +5,10 @@ import Control.Monad.IO.Class import Language.Haskell.LSP.Test as Test import Language.Haskell.LSP.Types import Language.Haskell.LSP.Types.Capabilities -import Test.HIE +import Test.HIE.Util import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.Expectations +import Test.Tasty.Expectation tests :: TestTree tests = testGroup "document symbols" [ diff --git a/test/functional/TypeDefinition.hs b/test/functional/TypeDefinition.hs index 1534c72251..0393890adb 100644 --- a/test/functional/TypeDefinition.hs +++ b/test/functional/TypeDefinition.hs @@ -4,10 +4,10 @@ import Control.Monad.IO.Class import Language.Haskell.LSP.Test import Language.Haskell.LSP.Types import System.Directory -import Test.HIE +import Test.HIE.Util import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.Expectations +import Test.Tasty.Expectation tests :: TestTree tests = testGroup "type definitions" [ diff --git a/test/utils/Test/HIE.hs b/test/utils/Test/HIE.hs deleted file mode 100644 index 9b9135b612..0000000000 --- a/test/utils/Test/HIE.hs +++ /dev/null @@ -1,307 +0,0 @@ -{-# LANGUAGE CPP, OverloadedStrings #-} -module Test.HIE ( - codeActionSupportCaps - , flushStackEnvironment - , ghcVersion, GhcVersion(..) - , hieCommand - , hieCommandExamplePlugin - , logConfig - , noLogConfig - ) where - -import Data.Default -import qualified Language.Haskell.LSP.Test as Test -import Language.Haskell.LSP.Test hiding (message) -import qualified Language.Haskell.LSP.Types.Capabilities as C -import System.Environment - - -data GhcVersion - = GHC88 - | GHC86 - | GHC84 - deriving (Eq,Show) - -ghcVersion :: GhcVersion -#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,8,0,0))) -ghcVersion = GHC88 -#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,6,0,0))) -ghcVersion = GHC86 -#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,4,0,0))) -ghcVersion = GHC84 -#endif - -logFilePath :: String -logFilePath = "hie-" ++ show ghcVersion ++ ".log" - --- | The command to execute the version of hie for the current compiler. --- --- Both @stack test@ and @cabal new-test@ setup the environment so @hie@ is --- on PATH. Cabal seems to respond to @build-tool-depends@ specifically while --- stack just puts all project executables on PATH. -hieCommand :: String --- hieCommand = "hie --lsp --bios-verbose -d -l test-logs/" ++ logFilePath --- hieCommand = "haskell-language-server --lsp" --- hieCommand = "haskell-language-server --lsp --test --shake-profiling=test-logs/" ++ logFilePath -hieCommand = "haskell-language-server --lsp -d -l test-logs/" ++ logFilePath - --- hieCommandVomit :: String --- hieCommandVomit = hieCommand ++ " --vomit" - -hieCommandExamplePlugin :: String -hieCommandExamplePlugin = hieCommand ++ " --example" - --- --------------------------------------------------------------------- - -noLogConfig :: SessionConfig -noLogConfig = Test.defaultConfig { logMessages = False } - -logConfig :: SessionConfig -logConfig = Test.defaultConfig { logMessages = True } - -codeActionSupportCaps :: C.ClientCapabilities -codeActionSupportCaps = def { C._textDocument = Just textDocumentCaps } - where - textDocumentCaps = def { C._codeAction = Just codeActionCaps } - codeActionCaps = C.CodeActionClientCapabilities (Just True) (Just literalSupport) - literalSupport = C.CodeActionLiteralSupport def - -flushStackEnvironment :: IO () -flushStackEnvironment = do - -- We need to clear these environment variables to prevent - -- collisions with stack usages - -- See https://github.com/commercialhaskell/stack/issues/4875 - unsetEnv "GHC_PACKAGE_PATH" - unsetEnv "GHC_ENVIRONMENT" - unsetEnv "HASKELL_PACKAGE_SANDBOX" - unsetEnv "HASKELL_PACKAGE_SANDBOXES" - - --- --------------------------------------------------------------------- --- --------------------------------------------------------------------- - --- import Control.Concurrent.STM --- import Control.Monad --- import Data.Default --- import Data.List (intercalate) --- -- import Data.Typeable --- -- import qualified Data.Map as Map --- import Data.Maybe --- import Language.Haskell.LSP.Core --- import Language.Haskell.LSP.Types --- -- import Ide.Plugin.MonadTypes hiding (withProgress, withIndefiniteProgress) --- -- import qualified Ide.Cradle as Bios --- -- import qualified Ide.Engine.Config as Config --- import System.Directory --- import System.Environment --- import System.FilePath --- import qualified System.Log.Logger as L --- -- import Test.Hspec --- import Test.Hspec.Runner --- import Test.Hspec.Core.Formatters --- import Text.Blaze.Renderer.String (renderMarkup) --- import Text.Blaze.Internal --- -- import qualified Ide.Plugin.PluginApi as HIE (BiosOptions, defaultOptions) - --- import HIE.Bios.Types - --- testOptions :: HIE.BiosOptions --- testOptions = HIE.defaultOptions { cradleOptsVerbosity = Verbose } - --- --------------------------------------------------------------------- - - --- testCommand :: (ToJSON a, Typeable b, ToJSON b, Show b, Eq b) --- => IdePlugins -> FilePath -> IdeGhcM (IdeResult b) -> PluginId -> CommandId -> a -> IdeResult b -> IO () --- testCommand testPlugins fp act plugin cmd arg res = do --- flushStackEnvironment --- (newApiRes, oldApiRes) <- runIGM testPlugins fp $ do --- new <- act --- old <- makeRequest plugin cmd arg --- return (new, old) --- newApiRes `shouldBe` res --- fmap fromDynJSON oldApiRes `shouldBe` fmap Just res - --- runSingle :: IdePlugins -> FilePath -> IdeGhcM (IdeResult b) -> IO (IdeResult b) --- runSingle = runSingle' id - --- runSingle' :: (Config.Config -> Config.Config) -> IdePlugins -> FilePath -> IdeGhcM (IdeResult b) -> IO (IdeResult b) --- runSingle' modifyConfig testPlugins fp act = runIGM' modifyConfig testPlugins fp act - --- runSingleReq :: ToJSON a --- => IdePlugins -> FilePath -> PluginId -> CommandId -> a -> IO (IdeResult DynamicJSON) --- runSingleReq testPlugins fp plugin com arg = runIGM testPlugins fp (makeRequest plugin com arg) - --- makeRequest :: ToJSON a => PluginId -> CommandId -> a -> IdeGhcM (IdeResult DynamicJSON) --- makeRequest plugin com arg = runPluginCommand plugin com (toJSON arg) - --- runIGM :: IdePlugins -> FilePath -> IdeGhcM a -> IO a --- runIGM = runIGM' id - --- runIGM' :: (Config.Config -> Config.Config) -> IdePlugins -> FilePath -> IdeGhcM a -> IO a --- runIGM' modifyConfig testPlugins fp f = do --- stateVar <- newTVarIO $ IdeState emptyModuleCache Map.empty Map.empty Nothing --- crdl <- Bios.findLocalCradle fp --- mlibdir <- Bios.getProjectGhcLibDir crdl --- let tmpFuncs :: LspFuncs Config.Config --- tmpFuncs = dummyLspFuncs --- lspFuncs :: LspFuncs Config.Config --- lspFuncs = tmpFuncs { config = (fmap . fmap) modifyConfig (config tmpFuncs)} --- runIdeGhcM mlibdir testPlugins lspFuncs stateVar f - --- withFileLogging :: FilePath -> IO a -> IO a --- withFileLogging logFile f = do --- let logDir = "./test-logs" --- logPath = logDir logFile - --- dirExists <- doesDirectoryExist logDir --- unless dirExists $ createDirectory logDir - --- exists <- doesFileExist logPath --- when exists $ removeFile logPath - --- setupLogger (Just logPath) ["hie"] L.DEBUG - --- f - --- -- --------------------------------------------------------------------- - --- setupBuildToolFiles :: IO () --- setupBuildToolFiles = do --- forM_ files setupDirectFilesIn - --- setupDirectFilesIn :: FilePath -> IO () --- setupDirectFilesIn f = --- writeFile (f ++ "hie.yaml") hieYamlCradleDirectContents - - --- -- --------------------------------------------------------------------- - --- files :: [FilePath] --- files = --- [ "./test/testdata/" --- -- , "./test/testdata/addPackageTest/cabal-exe/" --- -- , "./test/testdata/addPackageTest/hpack-exe/" --- -- , "./test/testdata/addPackageTest/cabal-lib/" --- -- , "./test/testdata/addPackageTest/hpack-lib/" --- -- , "./test/testdata/addPragmas/" --- -- , "./test/testdata/badProjects/cabal/" --- -- , "./test/testdata/completion/" --- -- , "./test/testdata/definition/" --- -- , "./test/testdata/gototest/" --- -- , "./test/testdata/redundantImportTest/" --- -- , "./test/testdata/wErrorTest/" --- ] - --- --------------------------------------------------------------------- - --- hieYamlCradleDirectContents :: String --- hieYamlCradleDirectContents = unlines --- [ "# WARNING: THIS FILE IS AUTOGENERATED IN test/utils/TestUtils.hs. IT WILL BE OVERWRITTEN ON EVERY TEST RUN" --- , "cradle:" --- , " direct:" --- , " arguments:" --- , " - -i." --- ] - - --- -- --------------------------------------------------------------------- - --- getHspecFormattedConfig :: String -> IO Config --- getHspecFormattedConfig name = do --- -- https://circleci.com/docs/2.0/env-vars/#built-in-environment-variables --- isCI <- isJust <$> lookupEnv "CI" - --- -- Only use the xml formatter on CI since it hides console output --- if isCI --- then do --- let subdir = "test-results" name --- createDirectoryIfMissing True subdir - --- return $ defaultConfig { configFormatter = Just xmlFormatter --- , configOutputFile = Right $ subdir "results.xml" --- } --- else return defaultConfig - --- -- | A Hspec formatter for CircleCI. --- -- Originally from https://github.com/LeastAuthority/hspec-jenkins --- xmlFormatter :: Formatter --- xmlFormatter = silent { --- headerFormatter = do --- writeLine "" --- writeLine "" --- , exampleSucceeded --- , exampleFailed --- , examplePending --- , footerFormatter = writeLine "" --- } --- where - --- #if MIN_VERSION_hspec(2,5,0) --- exampleSucceeded path _ = --- #else --- exampleSucceeded path = --- #endif --- writeLine $ renderMarkup $ testcase path "" - --- #if MIN_VERSION_hspec(2,5,0) --- exampleFailed path _ err = --- #else --- exampleFailed path (Left err) = --- writeLine $ renderMarkup $ testcase path $ --- failure ! message (show err) $ "" --- exampleFailed path (Right err) = --- #endif --- writeLine $ renderMarkup $ testcase path $ --- failure ! message (reasonAsString err) $ "" - --- #if MIN_VERSION_hspec(2,5,0) --- examplePending path _ reason = --- #else --- examplePending path reason = --- #endif --- writeLine $ renderMarkup $ testcase path $ --- case reason of --- Just desc -> skipped ! message desc $ "" --- Nothing -> skipped "" - --- failure, skipped :: Markup -> Markup --- failure = customParent "failure" --- skipped = customParent "skipped" - --- name, className, message :: String -> Attribute --- name = customAttribute "name" . stringValue --- className = customAttribute "classname" . stringValue --- message = customAttribute "message" . stringValue - --- testcase :: Path -> Markup -> Markup --- testcase (xs,x) = customParent "testcase" ! name x ! className (intercalate "." xs) - --- reasonAsString :: FailureReason -> String --- reasonAsString NoReason = "no reason given" --- reasonAsString (Reason x) = x --- reasonAsString (ExpectedButGot Nothing expected got) = "Expected " ++ expected ++ " but got " ++ got --- reasonAsString (ExpectedButGot (Just src) expected got) = src ++ " expected " ++ expected ++ " but got " ++ got --- #if MIN_VERSION_hspec(2,5,0) --- reasonAsString (Error Nothing err ) = show err --- reasonAsString (Error (Just s) err) = s ++ show err --- #endif - --- --------------------------------------------------------------------- --- --------------------------------------------------------------------- - --- dummyLspFuncs :: Default a => LspFuncs a --- dummyLspFuncs = LspFuncs { clientCapabilities = def --- , config = return (Just def) --- , sendFunc = const (return ()) --- , getVirtualFileFunc = const (return Nothing) --- , persistVirtualFileFunc = \uri -> return (uriToFilePath (fromNormalizedUri uri)) --- , reverseFileMapFunc = return id --- , publishDiagnosticsFunc = mempty --- , flushDiagnosticsBySourceFunc = mempty --- , getNextReqId = pure (IdInt 0) --- , rootPath = Nothing --- , getWorkspaceFolders = return Nothing --- , withProgress = \_ _ f -> f (const (return ())) --- , withIndefiniteProgress = \_ _ f -> f --- } \ No newline at end of file diff --git a/test/utils/Test/HIE/Util.hs b/test/utils/Test/HIE/Util.hs new file mode 100644 index 0000000000..ca76998cf3 --- /dev/null +++ b/test/utils/Test/HIE/Util.hs @@ -0,0 +1,312 @@ +{-# LANGUAGE CPP, OverloadedStrings, NamedFieldPuns #-} +module Test.HIE.Util + ( + codeActionSupportCaps + , dummyLspFuncs + , flushStackEnvironment + , getHspecFormattedConfig + , ghcVersion, GhcVersion(..) + , hieCommand + , hieCommandExamplePlugin + , hieCommandVomit + , logConfig + , logFilePath + , noLogConfig + , setupBuildToolFiles + , withFileLogging + -- , makeRequest + -- , runIGM + -- , runIGM' + -- , runSingle + -- , runSingle' + -- , runSingleReq + -- , testCommand + -- , testOptions + ) +where + +-- import Control.Concurrent.STM +import Control.Monad +import Data.Default +import Data.List (intercalate) +-- import Data.Typeable +-- import qualified Data.Map as Map +import Data.Maybe +import Language.Haskell.LSP.Core +import Language.Haskell.LSP.Types +import qualified Language.Haskell.LSP.Test as T +import qualified Language.Haskell.LSP.Types.Capabilities as C +-- import Haskell.Ide.Engine.MonadTypes hiding (withProgress, withIndefiniteProgress) +-- import qualified Ide.Cradle as Bios +-- import qualified Ide.Engine.Config as Config +import System.Directory +import System.Environment +import System.FilePath +import qualified System.Log.Logger as L +-- import Test.Hspec +import Test.Hspec.Runner +import Test.Hspec.Core.Formatters +import Text.Blaze.Renderer.String (renderMarkup) +import Text.Blaze.Internal +-- import qualified Haskell.Ide.Engine.PluginApi as HIE (BiosOptions, defaultOptions) +-- import HIE.Bios.Types + +-- testOptions :: HIE.BiosOptions +-- testOptions = HIE.defaultOptions { cradleOptsVerbosity = Verbose } + +-- --------------------------------------------------------------------- + + +-- testCommand :: (ToJSON a, Typeable b, ToJSON b, Show b, Eq b) +-- => IdePlugins -> FilePath -> IdeGhcM (IdeResult b) -> PluginId -> CommandId -> a -> IdeResult b -> IO () +-- testCommand testPlugins fp act plugin cmd arg res = do +-- flushStackEnvironment +-- (newApiRes, oldApiRes) <- runIGM testPlugins fp $ do +-- new <- act +-- old <- makeRequest plugin cmd arg +-- return (new, old) +-- newApiRes `shouldBe` res +-- fmap fromDynJSON oldApiRes `shouldBe` fmap Just res + +-- runSingle :: IdePlugins -> FilePath -> IdeGhcM (IdeResult b) -> IO (IdeResult b) +-- runSingle = runSingle' id + +-- runSingle' :: (Config.Config -> Config.Config) -> IdePlugins -> FilePath -> IdeGhcM (IdeResult b) -> IO (IdeResult b) +-- runSingle' modifyConfig testPlugins fp act = runIGM' modifyConfig testPlugins fp act + +-- runSingleReq :: ToJSON a +-- => IdePlugins -> FilePath -> PluginId -> CommandId -> a -> IO (IdeResult DynamicJSON) +-- runSingleReq testPlugins fp plugin com arg = runIGM testPlugins fp (makeRequest plugin com arg) + +-- makeRequest :: ToJSON a => PluginId -> CommandId -> a -> IdeGhcM (IdeResult DynamicJSON) +-- makeRequest plugin com arg = runPluginCommand plugin com (toJSON arg) + +-- runIGM :: IdePlugins -> FilePath -> IdeGhcM a -> IO a +-- runIGM = runIGM' id + +-- runIGM' :: (Config.Config -> Config.Config) -> IdePlugins -> FilePath -> IdeGhcM a -> IO a +-- runIGM' modifyConfig testPlugins fp f = do +-- stateVar <- newTVarIO $ IdeState emptyModuleCache Map.empty Map.empty Nothing +-- crdl <- Bios.findLocalCradle fp +-- mlibdir <- Bios.getProjectGhcLibDir crdl +-- let tmpFuncs :: LspFuncs Config.Config +-- tmpFuncs = dummyLspFuncs +-- lspFuncs :: LspFuncs Config.Config +-- lspFuncs = tmpFuncs { config = (fmap . fmap) modifyConfig (config tmpFuncs)} +-- runIdeGhcM mlibdir testPlugins lspFuncs stateVar f + +noLogConfig :: T.SessionConfig +noLogConfig = T.defaultConfig { T.logMessages = False } + +logConfig :: T.SessionConfig +logConfig = T.defaultConfig { T.logMessages = True } + +codeActionSupportCaps :: C.ClientCapabilities +codeActionSupportCaps = def { C._textDocument = Just textDocumentCaps } + where + textDocumentCaps = def { C._codeAction = Just codeActionCaps } + codeActionCaps = C.CodeActionClientCapabilities (Just True) (Just literalSupport) + literalSupport = C.CodeActionLiteralSupport def + +withFileLogging :: FilePath -> IO a -> IO a +withFileLogging logFile f = do + let logDir = "./test-logs" + logPath = logDir logFile + + dirExists <- doesDirectoryExist logDir + unless dirExists $ createDirectory logDir + + exists <- doesFileExist logPath + when exists $ removeFile logPath + + setupLogger (Just logPath) ["hie"] L.DEBUG + + f + +-- --------------------------------------------------------------------- + +setupBuildToolFiles :: IO () +setupBuildToolFiles = do + forM_ files setupDirectFilesIn + +setupDirectFilesIn :: FilePath -> IO () +setupDirectFilesIn f = + writeFile (f ++ "hie.yaml") hieYamlCradleDirectContents + + +-- --------------------------------------------------------------------- + +files :: [FilePath] +files = + [ "./test/testdata/" + -- , "./test/testdata/addPackageTest/cabal-exe/" + -- , "./test/testdata/addPackageTest/hpack-exe/" + -- , "./test/testdata/addPackageTest/cabal-lib/" + -- , "./test/testdata/addPackageTest/hpack-lib/" + -- , "./test/testdata/addPragmas/" + -- , "./test/testdata/badProjects/cabal/" + -- , "./test/testdata/completion/" + -- , "./test/testdata/definition/" + -- , "./test/testdata/gototest/" + -- , "./test/testdata/redundantImportTest/" + -- , "./test/testdata/wErrorTest/" + ] + +data GhcVersion + = GHC88 + | GHC86 + | GHC84 + deriving (Eq,Show) + +ghcVersion :: GhcVersion +#if (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,8,0,0))) +ghcVersion = GHC88 +#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,6,0,0))) +ghcVersion = GHC86 +#elif (defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,4,0,0))) +ghcVersion = GHC84 +#endif + +logFilePath :: String +logFilePath = "hie-" ++ show ghcVersion ++ ".log" + +-- | The command to execute the version of hie for the current compiler. +-- +-- Both @stack test@ and @cabal new-test@ setup the environment so @hie@ is +-- on PATH. Cabal seems to respond to @build-tool-depends@ specifically while +-- stack just puts all project executables on PATH. +hieCommand :: String +-- hieCommand = "hie --lsp --bios-verbose -d -l test-logs/" ++ logFilePath +-- hieCommand = "haskell-language-server --lsp" +-- hieCommand = "haskell-language-server --lsp --test --shake-profiling=test-logs/" ++ logFilePath +hieCommand = "haskell-language-server --lsp -d -l test-logs/" ++ logFilePath + +hieCommandVomit :: String +hieCommandVomit = hieCommand ++ " --vomit" + +hieCommandExamplePlugin :: String +hieCommandExamplePlugin = hieCommand ++ " --example" + +-- --------------------------------------------------------------------- + +hieYamlCradleDirectContents :: String +hieYamlCradleDirectContents = unlines + [ "# WARNING: THIS FILE IS AUTOGENERATED IN test/utils/TestUtils.hs. IT WILL BE OVERWRITTEN ON EVERY TEST RUN" + , "cradle:" + , " direct:" + , " arguments:" + , " - -i." + ] + + +-- --------------------------------------------------------------------- + +getHspecFormattedConfig :: String -> IO Config +getHspecFormattedConfig name = do + -- https://circleci.com/docs/2.0/env-vars/#built-in-environment-variables + isCI <- isJust <$> lookupEnv "CI" + + -- Only use the xml formatter on CI since it hides console output + if isCI + then do + let subdir = "test-results" name + createDirectoryIfMissing True subdir + + return $ defaultConfig { configFormatter = Just xmlFormatter + , configOutputFile = Right $ subdir "results.xml" + } + else return defaultConfig + +-- | A Hspec formatter for CircleCI. +-- Originally from https://github.com/LeastAuthority/hspec-jenkins +xmlFormatter :: Formatter +xmlFormatter = silent { + headerFormatter = do + writeLine "" + writeLine "" + , exampleSucceeded + , exampleFailed + , examplePending + , footerFormatter = writeLine "" + } + where + +#if MIN_VERSION_hspec(2,5,0) + exampleSucceeded path _ = +#else + exampleSucceeded path = +#endif + writeLine $ renderMarkup $ testcase path "" + +#if MIN_VERSION_hspec(2,5,0) + exampleFailed path _ err = +#else + exampleFailed path (Left err) = + writeLine $ renderMarkup $ testcase path $ + failure ! message (show err) $ "" + exampleFailed path (Right err) = +#endif + writeLine $ renderMarkup $ testcase path $ + failure ! message (reasonAsString err) $ "" + +#if MIN_VERSION_hspec(2,5,0) + examplePending path _ reason = +#else + examplePending path reason = +#endif + writeLine $ renderMarkup $ testcase path $ + case reason of + Just desc -> skipped ! message desc $ "" + Nothing -> skipped "" + + failure, skipped :: Markup -> Markup + failure = customParent "failure" + skipped = customParent "skipped" + + name, className, message :: String -> Attribute + name = customAttribute "name" . stringValue + className = customAttribute "classname" . stringValue + message = customAttribute "message" . stringValue + + testcase :: Path -> Markup -> Markup + testcase (xs,x) = customParent "testcase" ! name x ! className (intercalate "." xs) + + reasonAsString :: FailureReason -> String + reasonAsString NoReason = "no reason given" + reasonAsString (Reason x) = x + reasonAsString (ExpectedButGot Nothing expected got) = "Expected " ++ expected ++ " but got " ++ got + reasonAsString (ExpectedButGot (Just src) expected got) = src ++ " expected " ++ expected ++ " but got " ++ got +#if MIN_VERSION_hspec(2,5,0) + reasonAsString (Error Nothing err ) = show err + reasonAsString (Error (Just s) err) = s ++ show err +#endif + +-- --------------------------------------------------------------------- + +flushStackEnvironment :: IO () +flushStackEnvironment = do + -- We need to clear these environment variables to prevent + -- collisions with stack usages + -- See https://github.com/commercialhaskell/stack/issues/4875 + unsetEnv "GHC_PACKAGE_PATH" + unsetEnv "GHC_ENVIRONMENT" + unsetEnv "HASKELL_PACKAGE_SANDBOX" + unsetEnv "HASKELL_PACKAGE_SANDBOXES" + +-- --------------------------------------------------------------------- + +dummyLspFuncs :: Default a => LspFuncs a +dummyLspFuncs = LspFuncs { clientCapabilities = def + , config = return (Just def) + , sendFunc = const (return ()) + , getVirtualFileFunc = const (return Nothing) + , persistVirtualFileFunc = \uri -> return (uriToFilePath (fromNormalizedUri uri)) + , reverseFileMapFunc = return id + , publishDiagnosticsFunc = mempty + , flushDiagnosticsBySourceFunc = mempty + , getNextReqId = pure (IdInt 0) + , rootPath = Nothing + , getWorkspaceFolders = return Nothing + , withProgress = \_ _ f -> f (const (return ())) + , withIndefiniteProgress = \_ _ f -> f + } \ No newline at end of file diff --git a/test/utils/Test/Tasty/Expectations.hs b/test/utils/Test/Tasty/Expectation.hs similarity index 98% rename from test/utils/Test/Tasty/Expectations.hs rename to test/utils/Test/Tasty/Expectation.hs index 9e327c6dab..027e696727 100644 --- a/test/utils/Test/Tasty/Expectations.hs +++ b/test/utils/Test/Tasty/Expectation.hs @@ -1,4 +1,4 @@ -module Test.Tasty.Expectations where +module Test.Tasty.Expectation where import Data.List import Test.Tasty.HUnit From 218ac493e5aff5dab014b764a7ed18bc0b495424 Mon Sep 17 00:00:00 2001 From: Jeff Windsor Date: Sun, 10 May 2020 12:49:28 -0700 Subject: [PATCH 17/26] add warmup, missing runner --- test/functional/Main.hs | 21 ++++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) diff --git a/test/functional/Main.hs b/test/functional/Main.hs index 40aaf44bcf..09d9db1e43 100644 --- a/test/functional/Main.hs +++ b/test/functional/Main.hs @@ -1,5 +1,10 @@ module Main where +import Control.Monad.IO.Class +import Language.Haskell.LSP.Test +import Test.HIE.Util +import Test.Tasty + import Command import Completion import Deferred @@ -16,10 +21,20 @@ import Reference import Rename import Symbol import TypeDefinition -import Test.Tasty main :: IO () -main = defaultMain $ testGroup "HIE" [ +main = do + setupBuildToolFiles + + -- run a test session to warm up the cache to prevent timeouts in other tests + putStrLn "Warming up HIE cache..." + runSessionWithConfig (defaultConfig { messageTimeout = 120 }) hieCommand fullCaps "test/testdata" $ + liftIO $ putStrLn "HIE cache is warmed up" + + --TODO Test runner with config like HSpec?? + + -- test tree + defaultMain $ testGroup "HIE" [ Command.tests , Completion.tests , Deferred.tests @@ -36,4 +51,4 @@ main = defaultMain $ testGroup "HIE" [ , Rename.tests , Symbol.tests , TypeDefinition.tests - ] \ No newline at end of file + ] \ No newline at end of file From 7c3d784497b5aac11ca1e4bbf0e7b354626d6460 Mon Sep 17 00:00:00 2001 From: Jeff Windsor Date: Sun, 10 May 2020 18:03:42 -0700 Subject: [PATCH 18/26] use hspec-expectations for shoulds --- haskell-language-server.cabal | 1 + test/functional/Command.hs | 2 +- test/functional/Completion.hs | 2 +- test/functional/Deferred.hs | 2 +- test/functional/Definition.hs | 2 +- test/functional/Diagnostic.hs | 2 +- test/functional/Format.hs | 2 +- test/functional/FunctionalBadProject.hs | 2 +- test/functional/FunctionalCodeAction.hs | 2 +- test/functional/FunctionalLiquid.hs | 2 +- test/functional/Highlight.hs | 2 +- test/functional/Progress.hs | 2 +- test/functional/Reference.hs | 2 +- test/functional/Rename.hs | 2 +- test/functional/Symbol.hs | 2 +- test/functional/TypeDefinition.hs | 2 +- test/utils/Test/Tasty/Expectation.hs | 57 ------------------------- 17 files changed, 16 insertions(+), 72 deletions(-) delete mode 100644 test/utils/Test/Tasty/Expectation.hs diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index f16ffab3b7..110dcf4f8f 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -221,6 +221,7 @@ test-suite func-test , haskell-lsp , haskell-lsp-types , hls-test-utils + , hspec-expectations , lens , lsp-test >= 0.10.0.0 , tasty diff --git a/test/functional/Command.hs b/test/functional/Command.hs index 2010518f43..60cbc859fb 100644 --- a/test/functional/Command.hs +++ b/test/functional/Command.hs @@ -11,7 +11,7 @@ import Language.Haskell.LSP.Types.Lens as LSP import Test.HIE.Util import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.Expectation +import Test.Hspec.Expectations tests :: TestTree tests = testGroup "commands" [ diff --git a/test/functional/Completion.hs b/test/functional/Completion.hs index a0d77bf676..6d16f659ae 100644 --- a/test/functional/Completion.hs +++ b/test/functional/Completion.hs @@ -12,7 +12,7 @@ import Language.Haskell.LSP.Types.Lens hiding (applyEdit) import Test.HIE.Util import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.Expectation +import Test.Hspec.Expectations tests :: TestTree diff --git a/test/functional/Deferred.hs b/test/functional/Deferred.hs index 882039904c..fda48b7c5c 100644 --- a/test/functional/Deferred.hs +++ b/test/functional/Deferred.hs @@ -15,7 +15,7 @@ import qualified Language.Haskell.LSP.Types.Lens as LSP import Test.HIE.Util import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.Expectation +import Test.Hspec.Expectations tests :: TestTree diff --git a/test/functional/Definition.hs b/test/functional/Definition.hs index bb972a4a55..c2df797484 100644 --- a/test/functional/Definition.hs +++ b/test/functional/Definition.hs @@ -9,7 +9,7 @@ import System.Directory import Test.HIE.Util import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.Expectation +import Test.Hspec.Expectations tests :: TestTree tests = testGroup "definitions" [ diff --git a/test/functional/Diagnostic.hs b/test/functional/Diagnostic.hs index 32eca1ab85..bff282fe24 100644 --- a/test/functional/Diagnostic.hs +++ b/test/functional/Diagnostic.hs @@ -16,7 +16,7 @@ import qualified Language.Haskell.LSP.Types.Lens as LSP import Test.HIE.Util import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.Expectation +import Test.Hspec.Expectations -- --------------------------------------------------------------------- diff --git a/test/functional/Format.hs b/test/functional/Format.hs index 1250d596df..79cb45019f 100644 --- a/test/functional/Format.hs +++ b/test/functional/Format.hs @@ -9,7 +9,7 @@ import Language.Haskell.LSP.Types import Test.HIE.Util import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.Expectation +import Test.Hspec.Expectations tests :: TestTree tests = testGroup "format document" [ diff --git a/test/functional/FunctionalBadProject.hs b/test/functional/FunctionalBadProject.hs index 469978d5c6..b02d723df7 100644 --- a/test/functional/FunctionalBadProject.hs +++ b/test/functional/FunctionalBadProject.hs @@ -11,7 +11,7 @@ module FunctionalBadProject (tests) where -- import Test.HIE.Util import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.Expectation +import Test.Hspec.Expectations -- --------------------------------------------------------------------- -- TODO: Currently this can not succeed, since such an error is thrown in "runActionWithContext" which diff --git a/test/functional/FunctionalCodeAction.hs b/test/functional/FunctionalCodeAction.hs index 5d82383ad2..09283081e5 100644 --- a/test/functional/FunctionalCodeAction.hs +++ b/test/functional/FunctionalCodeAction.hs @@ -23,7 +23,7 @@ import qualified Language.Haskell.LSP.Types.Capabilities as C import Test.HIE.Util import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.Expectation +import Test.Hspec.Expectations {-# ANN module ("HLint: ignore Reduce duplication"::String) #-} diff --git a/test/functional/FunctionalLiquid.hs b/test/functional/FunctionalLiquid.hs index bf3e7dcfb0..6f26347036 100644 --- a/test/functional/FunctionalLiquid.hs +++ b/test/functional/FunctionalLiquid.hs @@ -14,7 +14,7 @@ import Ide.Plugin.Config import Test.HIE.Util import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.Expectation +import Test.Hspec.Expectations -- --------------------------------------------------------------------- diff --git a/test/functional/Highlight.hs b/test/functional/Highlight.hs index 9421117c69..c0b727f5e4 100644 --- a/test/functional/Highlight.hs +++ b/test/functional/Highlight.hs @@ -8,7 +8,7 @@ import Language.Haskell.LSP.Types import Test.HIE.Util import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.Expectation +import Test.Hspec.Expectations tests :: TestTree tests = testGroup "highlight" [ diff --git a/test/functional/Progress.hs b/test/functional/Progress.hs index 800d37c501..add204ef17 100644 --- a/test/functional/Progress.hs +++ b/test/functional/Progress.hs @@ -15,7 +15,7 @@ import Language.Haskell.LSP.Types.Capabilities import Test.HIE.Util import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.Expectation +import Test.Hspec.Expectations tests :: TestTree tests = testGroup "window/workDoneProgress" [ diff --git a/test/functional/Reference.hs b/test/functional/Reference.hs index e1bcb6d71f..0f28cad85e 100644 --- a/test/functional/Reference.hs +++ b/test/functional/Reference.hs @@ -8,7 +8,7 @@ import Language.Haskell.LSP.Types.Lens import Test.HIE.Util import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.Expectation +import Test.Hspec.Expectations tests :: TestTree tests = testGroup "references" [ diff --git a/test/functional/Rename.hs b/test/functional/Rename.hs index 3664c338e4..fc10a1c147 100644 --- a/test/functional/Rename.hs +++ b/test/functional/Rename.hs @@ -7,7 +7,7 @@ module Rename (tests) where -- import Test.HIE.Util import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.Expectation +import Test.Hspec.Expectations tests :: TestTree tests = testGroup "rename" [ diff --git a/test/functional/Symbol.hs b/test/functional/Symbol.hs index 9ff7d93b3c..c30d432c18 100644 --- a/test/functional/Symbol.hs +++ b/test/functional/Symbol.hs @@ -8,7 +8,7 @@ import Language.Haskell.LSP.Types.Capabilities import Test.HIE.Util import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.Expectation +import Test.Hspec.Expectations tests :: TestTree tests = testGroup "document symbols" [ diff --git a/test/functional/TypeDefinition.hs b/test/functional/TypeDefinition.hs index 0393890adb..e8730fdd04 100644 --- a/test/functional/TypeDefinition.hs +++ b/test/functional/TypeDefinition.hs @@ -7,7 +7,7 @@ import System.Directory import Test.HIE.Util import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.Expectation +import Test.Hspec.Expectations tests :: TestTree tests = testGroup "type definitions" [ diff --git a/test/utils/Test/Tasty/Expectation.hs b/test/utils/Test/Tasty/Expectation.hs deleted file mode 100644 index 027e696727..0000000000 --- a/test/utils/Test/Tasty/Expectation.hs +++ /dev/null @@ -1,57 +0,0 @@ -module Test.Tasty.Expectation where - -import Data.List -import Test.Tasty.HUnit - -infix 1 ===, `shouldBe`, `shouldSatisfy`, `shouldNotBe`, `shouldNotSatisfy` -infix 1 `shouldContain`, `shouldMatchList` - -(===) :: (Eq a, Show a) => a -> a -> Assertion -(===) = (@?=) - ---was not ready to add a library until it was discussed, so ---converted these helper functions from https://github.com/hspec/hspec-expectations - -shouldBe :: (HasCallStack, Show a, Eq a) => a -> a -> Assertion -actual `shouldBe` expected = actual @?= expected - -shouldNotBe :: (HasCallStack, Show a, Eq a) => a -> a -> Assertion -actual `shouldNotBe` notExpected = assertBool ("not expected: " ++ show actual) (actual /= notExpected) - -shouldSatisfy :: (HasCallStack, Show a) => a -> (a -> Bool) -> Assertion -v `shouldSatisfy` p = assertBool ("predicate failed on: " ++ show v) (p v) - -shouldNotSatisfy :: (HasCallStack, Show a) => a -> (a -> Bool) -> Assertion -v `shouldNotSatisfy` p = assertBool ("predicate succeeded on: " ++ show v) ((not . p) v) - -shouldContain :: (HasCallStack, Show a, Eq a) => [a] -> [a] -> Assertion -shouldContain = compareWith isInfixOf "does not contain" - -shouldMatchList :: (HasCallStack, Show a, Eq a) => [a] -> [a] -> Assertion -xs `shouldMatchList` ys = maybe (return ()) assertFailure (matchList xs ys) - --- ----------------------------------------------------------------------- - -compareWith :: (HasCallStack, Show a) => (a -> a -> Bool) -> String -> a -> a -> Assertion -compareWith comparator errorDesc result expected = assertBool errorMsg (comparator expected result) - where - errorMsg = show result ++ " " ++ errorDesc ++ " " ++ show expected - -matchList :: (Show a, Eq a) => [a] -> [a] -> Maybe String -xs `matchList` ys - | null extra && null missing = Nothing - | otherwise = Just (err "") - where - extra = xs \\ ys - missing = ys \\ xs - - msgAndList msg zs = showString msg . showList zs . showString "\n" - optMsgList msg zs = if null zs then id else msgAndList msg zs - - err :: ShowS - err = - showString "Actual list is not a permutation of expected list!\n" - . msgAndList " expected list contains: " ys - . msgAndList " actual list contains: " xs - . optMsgList " the missing elements are: " missing - . optMsgList " the extra elements are: " extra \ No newline at end of file From fc140e5f7a129e7c0bf1e7dff631816b24adad17 Mon Sep 17 00:00:00 2001 From: Jeff Windsor Date: Sun, 10 May 2020 18:45:50 -0700 Subject: [PATCH 19/26] add tasty-rerun --- haskell-language-server.cabal | 1 + test/functional/Main.hs | 3 ++- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 110dcf4f8f..d6b64d7a39 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -226,6 +226,7 @@ test-suite func-test , lsp-test >= 0.10.0.0 , tasty , tasty-hunit + , tasty-rerun , text , unordered-containers hs-source-dirs: test/functional diff --git a/test/functional/Main.hs b/test/functional/Main.hs index 09d9db1e43..772953f916 100644 --- a/test/functional/Main.hs +++ b/test/functional/Main.hs @@ -4,6 +4,7 @@ import Control.Monad.IO.Class import Language.Haskell.LSP.Test import Test.HIE.Util import Test.Tasty +import Test.Tasty.Ingredients.Rerun import Command import Completion @@ -34,7 +35,7 @@ main = do --TODO Test runner with config like HSpec?? -- test tree - defaultMain $ testGroup "HIE" [ + defaultMainWithRerun $ testGroup "HIE" [ Command.tests , Completion.tests , Deferred.tests From f23d9e4919c264d13066d6e037b4acd69a78c79e Mon Sep 17 00:00:00 2001 From: Jeff Windsor Date: Sat, 16 May 2020 16:51:30 -0700 Subject: [PATCH 20/26] remove old tasty util reference --- haskell-language-server.cabal | 1 - 1 file changed, 1 deletion(-) diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index fbaa367ad7..98fd9e2c13 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -257,7 +257,6 @@ library hls-test-utils import: agpl hs-source-dirs: test/utils exposed-modules: Test.HIE.Util - , Test.Tasty.Expectation build-depends: base , haskell-language-server , haskell-lsp From ade13db938317e3ae53ec797ce4e820556b04778 Mon Sep 17 00:00:00 2001 From: Jeff Windsor Date: Sat, 16 May 2020 16:54:54 -0700 Subject: [PATCH 21/26] rename Test.HIE.Util to Test.Hls.Util --- haskell-language-server.cabal | 2 +- test/functional/Command.hs | 2 +- test/functional/Completion.hs | 2 +- test/functional/Deferred.hs | 2 +- test/functional/Definition.hs | 2 +- test/functional/Diagnostic.hs | 2 +- test/functional/Format.hs | 2 +- test/functional/FunctionalBadProject.hs | 2 +- test/functional/FunctionalCodeAction.hs | 2 +- test/functional/FunctionalLiquid.hs | 2 +- test/functional/HieBios.hs | 2 +- test/functional/Highlight.hs | 2 +- test/functional/Main.hs | 2 +- test/functional/Progress.hs | 2 +- test/functional/Reference.hs | 2 +- test/functional/Rename.hs | 2 +- test/functional/Symbol.hs | 2 +- test/functional/TypeDefinition.hs | 2 +- test/utils/Test/{HIE => Hls}/Util.hs | 2 +- 19 files changed, 19 insertions(+), 19 deletions(-) rename test/utils/Test/{HIE => Hls}/Util.hs (99%) diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 98fd9e2c13..ff110e7395 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -256,7 +256,7 @@ test-suite func-test library hls-test-utils import: agpl hs-source-dirs: test/utils - exposed-modules: Test.HIE.Util + exposed-modules: Test.Hls.Util build-depends: base , haskell-language-server , haskell-lsp diff --git a/test/functional/Command.hs b/test/functional/Command.hs index 60cbc859fb..3d86e88f85 100644 --- a/test/functional/Command.hs +++ b/test/functional/Command.hs @@ -8,7 +8,7 @@ import Data.Char import Language.Haskell.LSP.Test import Language.Haskell.LSP.Types as LSP import Language.Haskell.LSP.Types.Lens as LSP -import Test.HIE.Util +import Test.Hls.Util import Test.Tasty import Test.Tasty.HUnit import Test.Hspec.Expectations diff --git a/test/functional/Completion.hs b/test/functional/Completion.hs index 6d16f659ae..edb2049553 100644 --- a/test/functional/Completion.hs +++ b/test/functional/Completion.hs @@ -9,7 +9,7 @@ import Control.Lens hiding ((.=)) import Language.Haskell.LSP.Test import Language.Haskell.LSP.Types import Language.Haskell.LSP.Types.Lens hiding (applyEdit) -import Test.HIE.Util +import Test.Hls.Util import Test.Tasty import Test.Tasty.HUnit import Test.Hspec.Expectations diff --git a/test/functional/Deferred.hs b/test/functional/Deferred.hs index fda48b7c5c..e517eae138 100644 --- a/test/functional/Deferred.hs +++ b/test/functional/Deferred.hs @@ -12,7 +12,7 @@ import Language.Haskell.LSP.Test import Language.Haskell.LSP.Types import Language.Haskell.LSP.Types.Lens hiding (id, message) import qualified Language.Haskell.LSP.Types.Lens as LSP -import Test.HIE.Util +import Test.Hls.Util import Test.Tasty import Test.Tasty.HUnit import Test.Hspec.Expectations diff --git a/test/functional/Definition.hs b/test/functional/Definition.hs index c2df797484..100e28f8d2 100644 --- a/test/functional/Definition.hs +++ b/test/functional/Definition.hs @@ -6,7 +6,7 @@ import Language.Haskell.LSP.Test import Language.Haskell.LSP.Types import Language.Haskell.LSP.Types.Lens import System.Directory -import Test.HIE.Util +import Test.Hls.Util import Test.Tasty import Test.Tasty.HUnit import Test.Hspec.Expectations diff --git a/test/functional/Diagnostic.hs b/test/functional/Diagnostic.hs index bff282fe24..4f6d184a14 100644 --- a/test/functional/Diagnostic.hs +++ b/test/functional/Diagnostic.hs @@ -13,7 +13,7 @@ import Ide.Plugin.Config import Language.Haskell.LSP.Test hiding (message) import Language.Haskell.LSP.Types import qualified Language.Haskell.LSP.Types.Lens as LSP -import Test.HIE.Util +import Test.Hls.Util import Test.Tasty import Test.Tasty.HUnit import Test.Hspec.Expectations diff --git a/test/functional/Format.hs b/test/functional/Format.hs index 79cb45019f..dcde1dcac1 100644 --- a/test/functional/Format.hs +++ b/test/functional/Format.hs @@ -6,7 +6,7 @@ import Data.Aeson import qualified Data.Text as T import Language.Haskell.LSP.Test import Language.Haskell.LSP.Types -import Test.HIE.Util +import Test.Hls.Util import Test.Tasty import Test.Tasty.HUnit import Test.Hspec.Expectations diff --git a/test/functional/FunctionalBadProject.hs b/test/functional/FunctionalBadProject.hs index b02d723df7..e51ee00cf0 100644 --- a/test/functional/FunctionalBadProject.hs +++ b/test/functional/FunctionalBadProject.hs @@ -8,7 +8,7 @@ module FunctionalBadProject (tests) where -- import Language.Haskell.LSP.Test hiding (message) -- import Language.Haskell.LSP.Types as LSP -- import Language.Haskell.LSP.Types.Lens as LSP hiding (contents, error ) --- import Test.HIE.Util +-- import Test.Hls.Util import Test.Tasty import Test.Tasty.HUnit import Test.Hspec.Expectations diff --git a/test/functional/FunctionalCodeAction.hs b/test/functional/FunctionalCodeAction.hs index 09283081e5..94f1508e0e 100644 --- a/test/functional/FunctionalCodeAction.hs +++ b/test/functional/FunctionalCodeAction.hs @@ -20,7 +20,7 @@ import Language.Haskell.LSP.Test as Test import Language.Haskell.LSP.Types import qualified Language.Haskell.LSP.Types.Lens as L import qualified Language.Haskell.LSP.Types.Capabilities as C -import Test.HIE.Util +import Test.Hls.Util import Test.Tasty import Test.Tasty.HUnit import Test.Hspec.Expectations diff --git a/test/functional/FunctionalLiquid.hs b/test/functional/FunctionalLiquid.hs index 6f26347036..8c64b099b4 100644 --- a/test/functional/FunctionalLiquid.hs +++ b/test/functional/FunctionalLiquid.hs @@ -11,7 +11,7 @@ import Language.Haskell.LSP.Test hiding (message) import Language.Haskell.LSP.Types as LSP import Language.Haskell.LSP.Types.Lens as LSP hiding (contents, error ) import Ide.Plugin.Config -import Test.HIE.Util +import Test.Hls.Util import Test.Tasty import Test.Tasty.HUnit import Test.Hspec.Expectations diff --git a/test/functional/HieBios.hs b/test/functional/HieBios.hs index e6113bdbde..ab1d191bd3 100644 --- a/test/functional/HieBios.hs +++ b/test/functional/HieBios.hs @@ -7,7 +7,7 @@ import Language.Haskell.LSP.Test import Language.Haskell.LSP.Types import Language.Haskell.LSP.Messages import System.FilePath (()) -import Test.HIE.Util +import Test.Hls.Util import Test.Tasty import Test.Tasty.HUnit diff --git a/test/functional/Highlight.hs b/test/functional/Highlight.hs index c0b727f5e4..bb7e1b1938 100644 --- a/test/functional/Highlight.hs +++ b/test/functional/Highlight.hs @@ -5,7 +5,7 @@ import Control.Applicative.Combinators import Control.Monad.IO.Class import Language.Haskell.LSP.Test import Language.Haskell.LSP.Types -import Test.HIE.Util +import Test.Hls.Util import Test.Tasty import Test.Tasty.HUnit import Test.Hspec.Expectations diff --git a/test/functional/Main.hs b/test/functional/Main.hs index 772953f916..b11dcfd97e 100644 --- a/test/functional/Main.hs +++ b/test/functional/Main.hs @@ -2,7 +2,7 @@ module Main where import Control.Monad.IO.Class import Language.Haskell.LSP.Test -import Test.HIE.Util +import Test.Hls.Util import Test.Tasty import Test.Tasty.Ingredients.Rerun diff --git a/test/functional/Progress.hs b/test/functional/Progress.hs index add204ef17..f61a00252b 100644 --- a/test/functional/Progress.hs +++ b/test/functional/Progress.hs @@ -12,7 +12,7 @@ import Language.Haskell.LSP.Messages -- TODO: Move this into haskell-lsp-types import Language.Haskell.LSP.Types import qualified Language.Haskell.LSP.Types.Lens as L import Language.Haskell.LSP.Types.Capabilities -import Test.HIE.Util +import Test.Hls.Util import Test.Tasty import Test.Tasty.HUnit import Test.Hspec.Expectations diff --git a/test/functional/Reference.hs b/test/functional/Reference.hs index 0f28cad85e..e7f0809561 100644 --- a/test/functional/Reference.hs +++ b/test/functional/Reference.hs @@ -5,7 +5,7 @@ import Control.Monad.IO.Class import Language.Haskell.LSP.Test import Language.Haskell.LSP.Types import Language.Haskell.LSP.Types.Lens -import Test.HIE.Util +import Test.Hls.Util import Test.Tasty import Test.Tasty.HUnit import Test.Hspec.Expectations diff --git a/test/functional/Rename.hs b/test/functional/Rename.hs index fc10a1c147..0cecd1c73d 100644 --- a/test/functional/Rename.hs +++ b/test/functional/Rename.hs @@ -4,7 +4,7 @@ module Rename (tests) where -- import Control.Monad.IO.Class -- import Language.Haskell.LSP.Test -- import Language.Haskell.LSP.Types --- import Test.HIE.Util +-- import Test.Hls.Util import Test.Tasty import Test.Tasty.HUnit import Test.Hspec.Expectations diff --git a/test/functional/Symbol.hs b/test/functional/Symbol.hs index c30d432c18..0bc41d83bd 100644 --- a/test/functional/Symbol.hs +++ b/test/functional/Symbol.hs @@ -5,7 +5,7 @@ import Control.Monad.IO.Class import Language.Haskell.LSP.Test as Test import Language.Haskell.LSP.Types import Language.Haskell.LSP.Types.Capabilities -import Test.HIE.Util +import Test.Hls.Util import Test.Tasty import Test.Tasty.HUnit import Test.Hspec.Expectations diff --git a/test/functional/TypeDefinition.hs b/test/functional/TypeDefinition.hs index e8730fdd04..4458f9faa1 100644 --- a/test/functional/TypeDefinition.hs +++ b/test/functional/TypeDefinition.hs @@ -4,7 +4,7 @@ import Control.Monad.IO.Class import Language.Haskell.LSP.Test import Language.Haskell.LSP.Types import System.Directory -import Test.HIE.Util +import Test.Hls.Util import Test.Tasty import Test.Tasty.HUnit import Test.Hspec.Expectations diff --git a/test/utils/Test/HIE/Util.hs b/test/utils/Test/Hls/Util.hs similarity index 99% rename from test/utils/Test/HIE/Util.hs rename to test/utils/Test/Hls/Util.hs index ca76998cf3..65b024167e 100644 --- a/test/utils/Test/HIE/Util.hs +++ b/test/utils/Test/Hls/Util.hs @@ -1,5 +1,5 @@ {-# LANGUAGE CPP, OverloadedStrings, NamedFieldPuns #-} -module Test.HIE.Util +module Test.Hls.Util ( codeActionSupportCaps , dummyLspFuncs From b16623e9e6510d1063bf1bd18e59c02f17cb7dc4 Mon Sep 17 00:00:00 2001 From: Jeff Windsor Date: Sat, 16 May 2020 17:25:10 -0700 Subject: [PATCH 22/26] fix ResponseMessage change --- test/functional/Command.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/test/functional/Command.hs b/test/functional/Command.hs index 3d86e88f85..b3d95337e9 100644 --- a/test/functional/Command.hs +++ b/test/functional/Command.hs @@ -13,11 +13,13 @@ import Test.Tasty import Test.Tasty.HUnit import Test.Hspec.Expectations + +--TODO : Response Message no longer has 4 inputs tests :: TestTree tests = testGroup "commands" [ testCase "are prefixed" $ runSession hieCommand fullCaps "test/testdata/" $ do - ResponseMessage _ _ (Just res) Nothing <- initializeResponse + ResponseMessage _ _ (Right res) <- initializeResponse let List cmds = res ^. LSP.capabilities . executeCommandProvider . _Just . commands f x = (T.length (T.takeWhile isNumber x) >= 1) && (T.count ":" x >= 2) liftIO $ do @@ -25,7 +27,7 @@ tests = testGroup "commands" [ cmds `shouldNotSatisfy` null , testCase "get de-prefixed" $ runSession hieCommand fullCaps "test/testdata/" $ do - ResponseMessage _ _ _ (Just err) <- request + ResponseMessage _ _ (Left err) <- request WorkspaceExecuteCommand (ExecuteCommandParams "1234:package:add" (Just (List [])) Nothing) :: Session ExecuteCommandResponse let ResponseError _ msg _ = err From 2f555230c001d0423cfba52b00c4eb27b3b2302d Mon Sep 17 00:00:00 2001 From: Jeff Windsor Date: Sat, 16 May 2020 17:33:14 -0700 Subject: [PATCH 23/26] fix tests do not compile after update --- test/functional/Completion.hs | 643 ++++++++++++------------ test/functional/Deferred.hs | 173 +++---- test/functional/Format.hs | 8 +- test/functional/FunctionalCodeAction.hs | 2 +- test/functional/FunctionalLiquid.hs | 2 +- 5 files changed, 416 insertions(+), 412 deletions(-) diff --git a/test/functional/Completion.hs b/test/functional/Completion.hs index edb2049553..245a3831c5 100644 --- a/test/functional/Completion.hs +++ b/test/functional/Completion.hs @@ -14,295 +14,296 @@ import Test.Tasty import Test.Tasty.HUnit import Test.Hspec.Expectations +--TODO: Fix tests, some structural changed hav been made tests :: TestTree tests = testGroup "completions" [ - testCase "works" $ runSession hieCommand fullCaps "test/testdata/completion" $ do - doc <- openDoc "Completion.hs" "haskell" - _ <- count 2 $ skipManyTill loggingNotification noDiagnostics - - let te = TextEdit (Range (Position 5 7) (Position 5 24)) "put" - _ <- applyEdit doc te - - compls <- getCompletions doc (Position 5 9) - let item = head $ filter ((== "putStrLn") . (^. label)) compls - liftIO $ do - item ^. label `shouldBe` "putStrLn" - item ^. kind `shouldBe` Just CiFunction - item ^. detail `shouldBe` Just "Prelude" - resolvedRes <- request CompletionItemResolve item - let Just (resolved :: CompletionItem) = resolvedRes ^. result - liftIO $ do - resolved ^. label `shouldBe` "putStrLn" - resolved ^. kind `shouldBe` Just CiFunction - resolved ^. detail `shouldBe` Just "String -> IO ()\nPrelude" - resolved ^. insertTextFormat `shouldBe` Just Snippet - resolved ^. insertText `shouldBe` Just "putStrLn ${1:String}" - - , testCase "completes imports" $ runSession hieCommand fullCaps "test/testdata/completion" $ do - doc <- openDoc "Completion.hs" "haskell" - _ <- count 2 $ skipManyTill loggingNotification noDiagnostics - - let te = TextEdit (Range (Position 1 17) (Position 1 26)) "Data.M" - _ <- applyEdit doc te - - compls <- getCompletions doc (Position 1 22) - let item = head $ filter ((== "Maybe") . (^. label)) compls - liftIO $ do - item ^. label `shouldBe` "Maybe" - item ^. detail `shouldBe` Just "Data.Maybe" - item ^. kind `shouldBe` Just CiModule - - , testCase "completes qualified imports" $ runSession hieCommand fullCaps "test/testdata/completion" $ do - doc <- openDoc "Completion.hs" "haskell" - _ <- count 2 $ skipManyTill loggingNotification noDiagnostics - - let te = TextEdit (Range (Position 2 17) (Position 1 25)) "Dat" - _ <- applyEdit doc te - - compls <- getCompletions doc (Position 1 19) - let item = head $ filter ((== "Data.List") . (^. label)) compls - liftIO $ do - item ^. label `shouldBe` "Data.List" - item ^. detail `shouldBe` Just "Data.List" - item ^. kind `shouldBe` Just CiModule - - , testCase "completes language extensions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do - doc <- openDoc "Completion.hs" "haskell" - _ <- count 2 $ skipManyTill loggingNotification noDiagnostics - - let te = TextEdit (Range (Position 0 24) (Position 0 31)) "" - _ <- applyEdit doc te - - compls <- getCompletions doc (Position 0 24) - let item = head $ filter ((== "OverloadedStrings") . (^. label)) compls - liftIO $ do - item ^. label `shouldBe` "OverloadedStrings" - item ^. kind `shouldBe` Just CiKeyword - - , testCase "completes pragmas" $ runSession hieCommand fullCaps "test/testdata/completion" $ do - doc <- openDoc "Completion.hs" "haskell" - _ <- count 2 $ skipManyTill loggingNotification noDiagnostics - - let te = TextEdit (Range (Position 0 4) (Position 0 34)) "" - _ <- applyEdit doc te - - compls <- getCompletions doc (Position 0 4) - let item = head $ filter ((== "LANGUAGE") . (^. label)) compls - liftIO $ do - item ^. label `shouldBe` "LANGUAGE" - item ^. kind `shouldBe` Just CiKeyword - item ^. insertTextFormat `shouldBe` Just Snippet - item ^. insertText `shouldBe` Just "LANGUAGE ${1:extension} #-}" - - , testCase "completes pragmas no close" $ runSession hieCommand fullCaps "test/testdata/completion" $ do - doc <- openDoc "Completion.hs" "haskell" - _ <- count 2 $ skipManyTill loggingNotification noDiagnostics - - let te = TextEdit (Range (Position 0 4) (Position 0 24)) "" - _ <- applyEdit doc te - - compls <- getCompletions doc (Position 0 4) - let item = head $ filter ((== "LANGUAGE") . (^. label)) compls - liftIO $ do - item ^. label `shouldBe` "LANGUAGE" - item ^. kind `shouldBe` Just CiKeyword - item ^. insertTextFormat `shouldBe` Just Snippet - item ^. insertText `shouldBe` Just "LANGUAGE ${1:extension}" - - , testCase "completes options pragma" $ runSession hieCommand fullCaps "test/testdata/completion" $ do - doc <- openDoc "Completion.hs" "haskell" - _ <- count 2 $ skipManyTill loggingNotification noDiagnostics - - let te = TextEdit (Range (Position 0 4) (Position 0 34)) "OPTIONS" - _ <- applyEdit doc te - - compls <- getCompletions doc (Position 0 4) - let item = head $ filter ((== "OPTIONS_GHC") . (^. label)) compls - liftIO $ do - item ^. label `shouldBe` "OPTIONS_GHC" - item ^. kind `shouldBe` Just CiKeyword - item ^. insertTextFormat `shouldBe` Just Snippet - item ^. insertText `shouldBe` Just "OPTIONS_GHC -${1:option} #-}" - - -- ----------------------------------- - - , testCase "completes ghc options pragma values" $ runSession hieCommand fullCaps "test/testdata/completion" $ do - doc <- openDoc "Completion.hs" "haskell" - - _ <- count 2 $ skipManyTill loggingNotification noDiagnostics - - let te = TextEdit (Range (Position 0 0) (Position 0 0)) "{-# OPTIONS_GHC -Wno-red #-}\n" - _ <- applyEdit doc te - - compls <- getCompletions doc (Position 0 24) - let item = head $ filter ((== "Wno-redundant-constraints") . (^. label)) compls - liftIO $ do - item ^. label `shouldBe` "Wno-redundant-constraints" - item ^. kind `shouldBe` Just CiKeyword - item ^. insertTextFormat `shouldBe` Nothing - item ^. insertText `shouldBe` Nothing - - -- ----------------------------------- - - , testCase "completes with no prefix" $ runSession hieCommand fullCaps "test/testdata/completion" $ do - doc <- openDoc "Completion.hs" "haskell" - _ <- count 2 $ skipManyTill loggingNotification noDiagnostics - compls <- getCompletions doc (Position 5 7) - liftIO $ filter ((== "!!") . (^. label)) compls `shouldNotSatisfy` null - - -- See https://github.com/haskell/haskell-ide-engine/issues/903 - , testCase "strips compiler generated stuff from completions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do - doc <- openDoc "DupRecFields.hs" "haskell" - _ <- count 2 $ skipManyTill loggingNotification noDiagnostics - - let te = TextEdit (Range (Position 5 0) (Position 5 2)) "acc" - _ <- applyEdit doc te - - compls <- getCompletions doc (Position 5 4) - let item = head $ filter (\c -> c^.label == "accessor") compls - liftIO $ do - item ^. label `shouldBe` "accessor" - item ^. kind `shouldBe` Just CiFunction - item ^. detail `shouldBe` Just "Two -> Int\nDupRecFields" - item ^. insertText `shouldBe` Just "accessor ${1:Two}" - - , testCase "have implicit foralls on basic polymorphic types" $ runSession hieCommand fullCaps "test/testdata/completion" $ do - doc <- openDoc "Completion.hs" "haskell" - _ <- count 2 $ skipManyTill loggingNotification noDiagnostics - let te = TextEdit (Range (Position 5 7) (Position 5 9)) "id" - _ <- applyEdit doc te - compls <- getCompletions doc (Position 5 9) - let item = head $ filter ((== "id") . (^. label)) compls - resolvedRes <- request CompletionItemResolve item - let Just (resolved :: CompletionItem) = resolvedRes ^. result - liftIO $ - resolved ^. detail `shouldBe` Just "a -> a\nPrelude" - - , testCase "have implicit foralls with multiple type variables" $ runSession hieCommand fullCaps "test/testdata/completion" $ do - doc <- openDoc "Completion.hs" "haskell" - _ <- count 2 $ skipManyTill loggingNotification noDiagnostics - let te = TextEdit (Range (Position 5 7) (Position 5 24)) "flip" - _ <- applyEdit doc te - compls <- getCompletions doc (Position 5 11) - let item = head $ filter ((== "flip") . (^. label)) compls - resolvedRes <- request CompletionItemResolve item - let Just (resolved :: CompletionItem) = resolvedRes ^. result - liftIO $ - resolved ^. detail `shouldBe` Just "(a -> b -> c) -> b -> a -> c\nPrelude" - - , contextTests - , snippetTests +-- testCase "works" $ runSession hieCommand fullCaps "test/testdata/completion" $ do +-- doc <- openDoc "Completion.hs" "haskell" +-- _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + +-- let te = TextEdit (Range (Position 5 7) (Position 5 24)) "put" +-- _ <- applyEdit doc te + +-- compls <- getCompletions doc (Position 5 9) +-- let item = head $ filter ((== "putStrLn") . (^. label)) compls +-- liftIO $ do +-- item ^. label `shouldBe` "putStrLn" +-- item ^. kind `shouldBe` Just CiFunction +-- item ^. detail `shouldBe` Just "Prelude" +-- resolvedRes <- request CompletionItemResolve item +-- let Just (resolved :: CompletionItem) = resolvedRes ^. result +-- liftIO $ do +-- resolved ^. label `shouldBe` "putStrLn" +-- resolved ^. kind `shouldBe` Just CiFunction +-- resolved ^. detail `shouldBe` Just "String -> IO ()\nPrelude" +-- resolved ^. insertTextFormat `shouldBe` Just Snippet +-- resolved ^. insertText `shouldBe` Just "putStrLn ${1:String}" + +-- , testCase "completes imports" $ runSession hieCommand fullCaps "test/testdata/completion" $ do +-- doc <- openDoc "Completion.hs" "haskell" +-- _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + +-- let te = TextEdit (Range (Position 1 17) (Position 1 26)) "Data.M" +-- _ <- applyEdit doc te + +-- compls <- getCompletions doc (Position 1 22) +-- let item = head $ filter ((== "Maybe") . (^. label)) compls +-- liftIO $ do +-- item ^. label `shouldBe` "Maybe" +-- item ^. detail `shouldBe` Just "Data.Maybe" +-- item ^. kind `shouldBe` Just CiModule + +-- , testCase "completes qualified imports" $ runSession hieCommand fullCaps "test/testdata/completion" $ do +-- doc <- openDoc "Completion.hs" "haskell" +-- _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + +-- let te = TextEdit (Range (Position 2 17) (Position 1 25)) "Dat" +-- _ <- applyEdit doc te + +-- compls <- getCompletions doc (Position 1 19) +-- let item = head $ filter ((== "Data.List") . (^. label)) compls +-- liftIO $ do +-- item ^. label `shouldBe` "Data.List" +-- item ^. detail `shouldBe` Just "Data.List" +-- item ^. kind `shouldBe` Just CiModule + +-- , testCase "completes language extensions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do +-- doc <- openDoc "Completion.hs" "haskell" +-- _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + +-- let te = TextEdit (Range (Position 0 24) (Position 0 31)) "" +-- _ <- applyEdit doc te + +-- compls <- getCompletions doc (Position 0 24) +-- let item = head $ filter ((== "OverloadedStrings") . (^. label)) compls +-- liftIO $ do +-- item ^. label `shouldBe` "OverloadedStrings" +-- item ^. kind `shouldBe` Just CiKeyword + +-- , testCase "completes pragmas" $ runSession hieCommand fullCaps "test/testdata/completion" $ do +-- doc <- openDoc "Completion.hs" "haskell" +-- _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + +-- let te = TextEdit (Range (Position 0 4) (Position 0 34)) "" +-- _ <- applyEdit doc te + +-- compls <- getCompletions doc (Position 0 4) +-- let item = head $ filter ((== "LANGUAGE") . (^. label)) compls +-- liftIO $ do +-- item ^. label `shouldBe` "LANGUAGE" +-- item ^. kind `shouldBe` Just CiKeyword +-- item ^. insertTextFormat `shouldBe` Just Snippet +-- item ^. insertText `shouldBe` Just "LANGUAGE ${1:extension} #-}" + +-- , testCase "completes pragmas no close" $ runSession hieCommand fullCaps "test/testdata/completion" $ do +-- doc <- openDoc "Completion.hs" "haskell" +-- _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + +-- let te = TextEdit (Range (Position 0 4) (Position 0 24)) "" +-- _ <- applyEdit doc te + +-- compls <- getCompletions doc (Position 0 4) +-- let item = head $ filter ((== "LANGUAGE") . (^. label)) compls +-- liftIO $ do +-- item ^. label `shouldBe` "LANGUAGE" +-- item ^. kind `shouldBe` Just CiKeyword +-- item ^. insertTextFormat `shouldBe` Just Snippet +-- item ^. insertText `shouldBe` Just "LANGUAGE ${1:extension}" + +-- , testCase "completes options pragma" $ runSession hieCommand fullCaps "test/testdata/completion" $ do +-- doc <- openDoc "Completion.hs" "haskell" +-- _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + +-- let te = TextEdit (Range (Position 0 4) (Position 0 34)) "OPTIONS" +-- _ <- applyEdit doc te + +-- compls <- getCompletions doc (Position 0 4) +-- let item = head $ filter ((== "OPTIONS_GHC") . (^. label)) compls +-- liftIO $ do +-- item ^. label `shouldBe` "OPTIONS_GHC" +-- item ^. kind `shouldBe` Just CiKeyword +-- item ^. insertTextFormat `shouldBe` Just Snippet +-- item ^. insertText `shouldBe` Just "OPTIONS_GHC -${1:option} #-}" + +-- -- ----------------------------------- + +-- , testCase "completes ghc options pragma values" $ runSession hieCommand fullCaps "test/testdata/completion" $ do +-- doc <- openDoc "Completion.hs" "haskell" + +-- _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + +-- let te = TextEdit (Range (Position 0 0) (Position 0 0)) "{-# OPTIONS_GHC -Wno-red #-}\n" +-- _ <- applyEdit doc te + +-- compls <- getCompletions doc (Position 0 24) +-- let item = head $ filter ((== "Wno-redundant-constraints") . (^. label)) compls +-- liftIO $ do +-- item ^. label `shouldBe` "Wno-redundant-constraints" +-- item ^. kind `shouldBe` Just CiKeyword +-- item ^. insertTextFormat `shouldBe` Nothing +-- item ^. insertText `shouldBe` Nothing + +-- -- ----------------------------------- + +-- , testCase "completes with no prefix" $ runSession hieCommand fullCaps "test/testdata/completion" $ do +-- doc <- openDoc "Completion.hs" "haskell" +-- _ <- count 2 $ skipManyTill loggingNotification noDiagnostics +-- compls <- getCompletions doc (Position 5 7) +-- liftIO $ filter ((== "!!") . (^. label)) compls `shouldNotSatisfy` null + +-- -- See https://github.com/haskell/haskell-ide-engine/issues/903 +-- , testCase "strips compiler generated stuff from completions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do +-- doc <- openDoc "DupRecFields.hs" "haskell" +-- _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + +-- let te = TextEdit (Range (Position 5 0) (Position 5 2)) "acc" +-- _ <- applyEdit doc te + +-- compls <- getCompletions doc (Position 5 4) +-- let item = head $ filter (\c -> c^.label == "accessor") compls +-- liftIO $ do +-- item ^. label `shouldBe` "accessor" +-- item ^. kind `shouldBe` Just CiFunction +-- item ^. detail `shouldBe` Just "Two -> Int\nDupRecFields" +-- item ^. insertText `shouldBe` Just "accessor ${1:Two}" + +-- , testCase "have implicit foralls on basic polymorphic types" $ runSession hieCommand fullCaps "test/testdata/completion" $ do +-- doc <- openDoc "Completion.hs" "haskell" +-- _ <- count 2 $ skipManyTill loggingNotification noDiagnostics +-- let te = TextEdit (Range (Position 5 7) (Position 5 9)) "id" +-- _ <- applyEdit doc te +-- compls <- getCompletions doc (Position 5 9) +-- let item = head $ filter ((== "id") . (^. label)) compls +-- resolvedRes <- request CompletionItemResolve item +-- let Just (resolved :: CompletionItem) = resolvedRes ^. result +-- liftIO $ +-- resolved ^. detail `shouldBe` Just "a -> a\nPrelude" + +-- , testCase "have implicit foralls with multiple type variables" $ runSession hieCommand fullCaps "test/testdata/completion" $ do +-- doc <- openDoc "Completion.hs" "haskell" +-- _ <- count 2 $ skipManyTill loggingNotification noDiagnostics +-- let te = TextEdit (Range (Position 5 7) (Position 5 24)) "flip" +-- _ <- applyEdit doc te +-- compls <- getCompletions doc (Position 5 11) +-- let item = head $ filter ((== "flip") . (^. label)) compls +-- resolvedRes <- request CompletionItemResolve item +-- let Just (resolved :: CompletionItem) = resolvedRes ^. result +-- liftIO $ +-- resolved ^. detail `shouldBe` Just "(a -> b -> c) -> b -> a -> c\nPrelude" + + contextTests +-- , snippetTests ] -snippetTests :: TestTree -snippetTests = testGroup "snippets" [ - testCase "work for argumentless constructors" $ runSession hieCommand fullCaps "test/testdata/completion" $ do - doc <- openDoc "Completion.hs" "haskell" - _ <- count 2 $ skipManyTill loggingNotification noDiagnostics - - let te = TextEdit (Range (Position 5 7) (Position 5 24)) "Nothing" - _ <- applyEdit doc te - - compls <- getCompletions doc (Position 5 14) - let item = head $ filter ((== "Nothing") . (^. label)) compls - liftIO $ do - item ^. insertTextFormat `shouldBe` Just Snippet - item ^. insertText `shouldBe` Just "Nothing" - - , testCase "work for polymorphic types" $ runSession hieCommand fullCaps "test/testdata/completion" $ do - doc <- openDoc "Completion.hs" "haskell" - _ <- count 2 $ skipManyTill loggingNotification noDiagnostics - - let te = TextEdit (Range (Position 5 7) (Position 5 24)) "fold" - _ <- applyEdit doc te - - compls <- getCompletions doc (Position 5 11) - let item = head $ filter ((== "foldl") . (^. label)) compls - resolvedRes <- request CompletionItemResolve item - let Just (resolved :: CompletionItem) = resolvedRes ^. result - liftIO $ do - resolved ^. label `shouldBe` "foldl" - resolved ^. kind `shouldBe` Just CiFunction - resolved ^. insertTextFormat `shouldBe` Just Snippet - resolved ^. insertText `shouldBe` Just "foldl ${1:b -> a -> b} ${2:b} ${3:t a}" - - , testCase "work for complex types" $ runSession hieCommand fullCaps "test/testdata/completion" $ do - doc <- openDoc "Completion.hs" "haskell" - _ <- count 2 $ skipManyTill loggingNotification noDiagnostics - - let te = TextEdit (Range (Position 5 7) (Position 5 24)) "mapM" - _ <- applyEdit doc te - - compls <- getCompletions doc (Position 5 11) - let item = head $ filter ((== "mapM") . (^. label)) compls - resolvedRes <- request CompletionItemResolve item - let Just (resolved :: CompletionItem) = resolvedRes ^. result - liftIO $ do - resolved ^. label `shouldBe` "mapM" - resolved ^. kind `shouldBe` Just CiFunction - resolved ^. insertTextFormat `shouldBe` Just Snippet - resolved ^. insertText `shouldBe` Just "mapM ${1:a -> m b} ${2:t a}" - - , testCase "work for infix functions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do - doc <- openDoc "Completion.hs" "haskell" - _ <- count 2 $ skipManyTill loggingNotification noDiagnostics - - let te = TextEdit (Range (Position 5 7) (Position 5 24)) "even `filte" - _ <- applyEdit doc te - - compls <- getCompletions doc (Position 5 18) - let item = head $ filter ((== "filter") . (^. label)) compls - liftIO $ do - item ^. label `shouldBe` "filter" - item ^. kind `shouldBe` Just CiFunction - item ^. insertTextFormat `shouldBe` Just Snippet - item ^. insertText `shouldBe` Just "filter`" - - , testCase "work for infix functions in backticks" $ runSession hieCommand fullCaps "test/testdata/completion" $ do - doc <- openDoc "Completion.hs" "haskell" - _ <- count 2 $ skipManyTill loggingNotification noDiagnostics - - let te = TextEdit (Range (Position 5 7) (Position 5 24)) "even `filte`" - _ <- applyEdit doc te - - compls <- getCompletions doc (Position 5 18) - let item = head $ filter ((== "filter") . (^. label)) compls - liftIO $ do - item ^. label `shouldBe` "filter" - item ^. kind `shouldBe` Just CiFunction - item ^. insertTextFormat `shouldBe` Just Snippet - item ^. insertText `shouldBe` Just "filter" - - , testCase "work for qualified infix functions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do - doc <- openDoc "Completion.hs" "haskell" - _ <- count 2 $ skipManyTill loggingNotification noDiagnostics - - let te = TextEdit (Range (Position 5 7) (Position 5 24)) "\"\" `Data.List.interspe" - _ <- applyEdit doc te - - compls <- getCompletions doc (Position 5 29) - let item = head $ filter ((== "intersperse") . (^. label)) compls - liftIO $ do - item ^. label `shouldBe` "intersperse" - item ^. kind `shouldBe` Just CiFunction - item ^. insertTextFormat `shouldBe` Just Snippet - item ^. insertText `shouldBe` Just "intersperse`" - - , testCase "work for qualified infix functions in backticks" $ runSession hieCommand fullCaps "test/testdata/completion" $ do - doc <- openDoc "Completion.hs" "haskell" - _ <- count 2 $ skipManyTill loggingNotification noDiagnostics - - let te = TextEdit (Range (Position 5 7) (Position 5 24)) "\"\" `Data.List.interspe`" - _ <- applyEdit doc te - - compls <- getCompletions doc (Position 5 29) - let item = head $ filter ((== "intersperse") . (^. label)) compls - liftIO $ do - item ^. label `shouldBe` "intersperse" - item ^. kind `shouldBe` Just CiFunction - item ^. insertTextFormat `shouldBe` Just Snippet - item ^. insertText `shouldBe` Just "intersperse" +-- snippetTests :: TestTree +-- snippetTests = testGroup "snippets" [ +-- testCase "work for argumentless constructors" $ runSession hieCommand fullCaps "test/testdata/completion" $ do +-- doc <- openDoc "Completion.hs" "haskell" +-- _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + +-- let te = TextEdit (Range (Position 5 7) (Position 5 24)) "Nothing" +-- _ <- applyEdit doc te + +-- compls <- getCompletions doc (Position 5 14) +-- let item = head $ filter ((== "Nothing") . (^. label)) compls +-- liftIO $ do +-- item ^. insertTextFormat `shouldBe` Just Snippet +-- item ^. insertText `shouldBe` Just "Nothing" + +-- , testCase "work for polymorphic types" $ runSession hieCommand fullCaps "test/testdata/completion" $ do +-- doc <- openDoc "Completion.hs" "haskell" +-- _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + +-- let te = TextEdit (Range (Position 5 7) (Position 5 24)) "fold" +-- _ <- applyEdit doc te + +-- compls <- getCompletions doc (Position 5 11) +-- let item = head $ filter ((== "foldl") . (^. label)) compls +-- resolvedRes <- request CompletionItemResolve item +-- let Just (resolved :: CompletionItem) = resolvedRes ^. result +-- liftIO $ do +-- resolved ^. label `shouldBe` "foldl" +-- resolved ^. kind `shouldBe` Just CiFunction +-- resolved ^. insertTextFormat `shouldBe` Just Snippet +-- resolved ^. insertText `shouldBe` Just "foldl ${1:b -> a -> b} ${2:b} ${3:t a}" + +-- , testCase "work for complex types" $ runSession hieCommand fullCaps "test/testdata/completion" $ do +-- doc <- openDoc "Completion.hs" "haskell" +-- _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + +-- let te = TextEdit (Range (Position 5 7) (Position 5 24)) "mapM" +-- _ <- applyEdit doc te + +-- compls <- getCompletions doc (Position 5 11) +-- let item = head $ filter ((== "mapM") . (^. label)) compls +-- resolvedRes <- request CompletionItemResolve item +-- let Just (resolved :: CompletionItem) = resolvedRes ^. result +-- liftIO $ do +-- resolved ^. label `shouldBe` "mapM" +-- resolved ^. kind `shouldBe` Just CiFunction +-- resolved ^. insertTextFormat `shouldBe` Just Snippet +-- resolved ^. insertText `shouldBe` Just "mapM ${1:a -> m b} ${2:t a}" + +-- , testCase "work for infix functions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do +-- doc <- openDoc "Completion.hs" "haskell" +-- _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + +-- let te = TextEdit (Range (Position 5 7) (Position 5 24)) "even `filte" +-- _ <- applyEdit doc te + +-- compls <- getCompletions doc (Position 5 18) +-- let item = head $ filter ((== "filter") . (^. label)) compls +-- liftIO $ do +-- item ^. label `shouldBe` "filter" +-- item ^. kind `shouldBe` Just CiFunction +-- item ^. insertTextFormat `shouldBe` Just Snippet +-- item ^. insertText `shouldBe` Just "filter`" + +-- , testCase "work for infix functions in backticks" $ runSession hieCommand fullCaps "test/testdata/completion" $ do +-- doc <- openDoc "Completion.hs" "haskell" +-- _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + +-- let te = TextEdit (Range (Position 5 7) (Position 5 24)) "even `filte`" +-- _ <- applyEdit doc te + +-- compls <- getCompletions doc (Position 5 18) +-- let item = head $ filter ((== "filter") . (^. label)) compls +-- liftIO $ do +-- item ^. label `shouldBe` "filter" +-- item ^. kind `shouldBe` Just CiFunction +-- item ^. insertTextFormat `shouldBe` Just Snippet +-- item ^. insertText `shouldBe` Just "filter" + +-- , testCase "work for qualified infix functions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do +-- doc <- openDoc "Completion.hs" "haskell" +-- _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + +-- let te = TextEdit (Range (Position 5 7) (Position 5 24)) "\"\" `Data.List.interspe" +-- _ <- applyEdit doc te + +-- compls <- getCompletions doc (Position 5 29) +-- let item = head $ filter ((== "intersperse") . (^. label)) compls +-- liftIO $ do +-- item ^. label `shouldBe` "intersperse" +-- item ^. kind `shouldBe` Just CiFunction +-- item ^. insertTextFormat `shouldBe` Just Snippet +-- item ^. insertText `shouldBe` Just "intersperse`" + +-- , testCase "work for qualified infix functions in backticks" $ runSession hieCommand fullCaps "test/testdata/completion" $ do +-- doc <- openDoc "Completion.hs" "haskell" +-- _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + +-- let te = TextEdit (Range (Position 5 7) (Position 5 24)) "\"\" `Data.List.interspe`" +-- _ <- applyEdit doc te + +-- compls <- getCompletions doc (Position 5 29) +-- let item = head $ filter ((== "intersperse") . (^. label)) compls +-- liftIO $ do +-- item ^. label `shouldBe` "intersperse" +-- item ^. kind `shouldBe` Just CiFunction +-- item ^. insertTextFormat `shouldBe` Just Snippet +-- item ^. insertText `shouldBe` Just "intersperse" -- -- TODO : Fix compile issue in the test "Variable not in scope: object" -- , testCase "respects lsp configuration" $ runSession hieCommand fullCaps "test/testdata/completion" $ do @@ -316,44 +317,44 @@ snippetTests = testGroup "snippets" [ -- checkNoSnippets doc - , testCase "respects client capabilities" $ runSession hieCommand noSnippetsCaps "test/testdata/completion" $ do - doc <- openDoc "Completion.hs" "haskell" - _ <- count 2 $ skipManyTill loggingNotification noDiagnostics + -- , testCase "respects client capabilities" $ runSession hieCommand noSnippetsCaps "test/testdata/completion" $ do + -- doc <- openDoc "Completion.hs" "haskell" + -- _ <- count 2 $ skipManyTill loggingNotification noDiagnostics - checkNoSnippets doc - ] - where - checkNoSnippets doc = do - let te = TextEdit (Range (Position 5 7) (Position 5 24)) "fold" - _ <- applyEdit doc te - - compls <- getCompletions doc (Position 5 11) - let item = head $ filter ((== "foldl") . (^. label)) compls - liftIO $ do - item ^. label `shouldBe` "foldl" - item ^. kind `shouldBe` Just CiFunction - item ^. insertTextFormat `shouldBe` Just PlainText - item ^. insertText `shouldBe` Nothing - - resolvedRes <- request CompletionItemResolve item - let Just (resolved :: CompletionItem) = resolvedRes ^. result - liftIO $ do - resolved ^. label `shouldBe` "foldl" - resolved ^. kind `shouldBe` Just CiFunction - resolved ^. insertTextFormat `shouldBe` Just PlainText - resolved ^. insertText `shouldBe` Nothing - - noSnippetsCaps = - ( textDocument - . _Just - . completion - . _Just - . completionItem - . _Just - . snippetSupport - ?~ False - ) - fullCaps + -- checkNoSnippets doc + -- ] + -- where + -- checkNoSnippets doc = do + -- let te = TextEdit (Range (Position 5 7) (Position 5 24)) "fold" + -- _ <- applyEdit doc te + + -- compls <- getCompletions doc (Position 5 11) + -- let item = head $ filter ((== "foldl") . (^. label)) compls + -- liftIO $ do + -- item ^. label `shouldBe` "foldl" + -- item ^. kind `shouldBe` Just CiFunction + -- item ^. insertTextFormat `shouldBe` Just PlainText + -- item ^. insertText `shouldBe` Nothing + + -- resolvedRes <- request CompletionItemResolve item + -- let Just (resolved :: CompletionItem) = resolvedRes ^. result + -- liftIO $ do + -- resolved ^. label `shouldBe` "foldl" + -- resolved ^. kind `shouldBe` Just CiFunction + -- resolved ^. insertTextFormat `shouldBe` Just PlainText + -- resolved ^. insertText `shouldBe` Nothing + + -- noSnippetsCaps = + -- ( textDocument + -- . _Just + -- . completion + -- . _Just + -- . completionItem + -- . _Just + -- . snippetSupport + -- ?~ False + -- ) + -- fullCaps contextTests :: TestTree contextTests = testGroup "contexts" [ diff --git a/test/functional/Deferred.hs b/test/functional/Deferred.hs index e517eae138..e77d49ff2e 100644 --- a/test/functional/Deferred.hs +++ b/test/functional/Deferred.hs @@ -6,12 +6,12 @@ module Deferred(tests) where import Control.Applicative.Combinators import Control.Monad.IO.Class import Control.Lens hiding (List) -import Control.Monad -import Data.Maybe +-- import Control.Monad +-- import Data.Maybe import Language.Haskell.LSP.Test import Language.Haskell.LSP.Types import Language.Haskell.LSP.Types.Lens hiding (id, message) -import qualified Language.Haskell.LSP.Types.Lens as LSP +-- import qualified Language.Haskell.LSP.Types.Lens as LSP import Test.Hls.Util import Test.Tasty import Test.Tasty.HUnit @@ -20,76 +20,78 @@ import Test.Hspec.Expectations tests :: TestTree tests = testGroup "deferred responses" [ - testCase "do not affect hover requests" $ runSession hieCommand 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 `shouldBe` Nothing - liftIO $ hoverRsp ^. LSP.id `shouldBe` responseId id1 - - id2 <- sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams doc Nothing) - symbolsRsp <- skipManyTill anyNotification message :: Session DocumentSymbolsResponse - liftIO $ symbolsRsp ^. LSP.id `shouldBe` responseId id2 - - id3 <- sendRequest TextDocumentHover (TextDocumentPositionParams doc (Position 4 2) Nothing) - hoverRsp2 <- skipManyTill anyNotification message :: Session HoverResponse - liftIO $ hoverRsp2 ^. LSP.id `shouldBe` 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 `shouldBe` [ 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 hieCommand fullCaps "test/testdata" $ do + + --TODO: DOes not compile + -- testCase "do not affect hover requests" $ runSession hieCommand 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 `shouldBe` Nothing + -- liftIO $ hoverRsp ^. LSP.id `shouldBe` responseId id1 + + -- id2 <- sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams doc Nothing) + -- symbolsRsp <- skipManyTill anyNotification message :: Session DocumentSymbolsResponse + -- liftIO $ symbolsRsp ^. LSP.id `shouldBe` responseId id2 + + -- id3 <- sendRequest TextDocumentHover (TextDocumentPositionParams doc (Position 4 2) Nothing) + -- hoverRsp2 <- skipManyTill anyNotification message :: Session HoverResponse + -- liftIO $ hoverRsp2 ^. LSP.id `shouldBe` 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 `shouldBe` [ 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 hieCommand fullCaps "test/testdata" $ do doc <- openDoc "FuncTestFail.hs" "haskell" defs <- getDefinitions doc (Position 1 11) liftIO $ defs `shouldBe` [] @@ -135,21 +137,22 @@ tests = testGroup "deferred responses" [ -- liftIO $ editReq ^. params . edit `shouldBe` WorkspaceEdit -- Nothing -- (Just expectedTextDocEdits) - , multiServerTests + -- , multiServerTests , multiMainTests ] -multiServerTests :: TestTree -multiServerTests = testGroup "multi-server setup" [ - testCase "doesn't have clashing commands on two servers" $ do - let getCommands = runSession hieCommand 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) - ] +--TODO: Does not compile +-- multiServerTests :: TestTree +-- multiServerTests = testGroup "multi-server setup" [ +-- testCase "doesn't have clashing commands on two servers" $ do +-- let getCommands = runSession hieCommand 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" [ diff --git a/test/functional/Format.hs b/test/functional/Format.hs index dcde1dcac1..9d45dc7160 100644 --- a/test/functional/Format.hs +++ b/test/functional/Format.hs @@ -72,14 +72,14 @@ brittanyTests = testGroup "brittany" [ testCase "formats a document with LF endings" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "BrittanyLF.hs" "haskell" let opts = DocumentFormattingParams doc (FormattingOptions 4 True) Nothing - ResponseMessage _ _ (Just edits) _ <- request TextDocumentFormatting opts + ResponseMessage _ _ (Right edits) <- request TextDocumentFormatting opts liftIO $ edits `shouldBe` [TextEdit (Range (Position 0 0) (Position 3 0)) "foo :: Int -> String -> IO ()\nfoo x y = do\n print x\n return 42\n"] , testCase "formats a document with CRLF endings" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "BrittanyCRLF.hs" "haskell" let opts = DocumentFormattingParams doc (FormattingOptions 4 True) Nothing - ResponseMessage _ _ (Just edits) _ <- request TextDocumentFormatting opts + ResponseMessage _ _ (Right edits) <- request TextDocumentFormatting opts liftIO $ edits `shouldBe` [TextEdit (Range (Position 0 0) (Position 3 0)) "foo :: Int -> String -> IO ()\nfoo x y = do\n print x\n return 42\n"] @@ -87,7 +87,7 @@ brittanyTests = testGroup "brittany" [ doc <- openDoc "BrittanyLF.hs" "haskell" let range = Range (Position 1 0) (Position 2 22) opts = DocumentRangeFormattingParams doc range (FormattingOptions 4 True) Nothing - ResponseMessage _ _ (Just edits) _ <- request TextDocumentRangeFormatting opts + ResponseMessage _ _ (Right edits) <- request TextDocumentRangeFormatting opts liftIO $ edits `shouldBe` [TextEdit (Range (Position 1 0) (Position 3 0)) "foo x y = do\n print x\n return 42\n"] @@ -95,7 +95,7 @@ brittanyTests = testGroup "brittany" [ doc <- openDoc "BrittanyCRLF.hs" "haskell" let range = Range (Position 1 0) (Position 2 22) opts = DocumentRangeFormattingParams doc range (FormattingOptions 4 True) Nothing - ResponseMessage _ _ (Just edits) _ <- request TextDocumentRangeFormatting opts + ResponseMessage _ _ (Right edits) <- request TextDocumentRangeFormatting opts liftIO $ edits `shouldBe` [TextEdit (Range (Position 1 0) (Position 3 0)) "foo x y = do\n print x\n return 42\n"] ] diff --git a/test/functional/FunctionalCodeAction.hs b/test/functional/FunctionalCodeAction.hs index 94f1508e0e..b5f0ef1fa8 100644 --- a/test/functional/FunctionalCodeAction.hs +++ b/test/functional/FunctionalCodeAction.hs @@ -471,7 +471,7 @@ unusedTermTests = testGroup "unused term code actions" [ diags <- getCurrentDiagnostics doc let params = CodeActionParams doc (Range (Position 2 10) (Position 4 0)) caContext Nothing caContext = CodeActionContext (List diags) (Just (List [CodeActionRefactorInline])) - ResponseMessage _ _ (Just (List res)) _ <- request TextDocumentCodeAction params + ResponseMessage _ _ (Right (List res)) <- request TextDocumentCodeAction params let cas = map fromAction res kinds = map (^. L.kind) cas liftIO $ do diff --git a/test/functional/FunctionalLiquid.hs b/test/functional/FunctionalLiquid.hs index 8c64b099b4..be9f4a63a7 100644 --- a/test/functional/FunctionalLiquid.hs +++ b/test/functional/FunctionalLiquid.hs @@ -9,7 +9,7 @@ import Data.Default import qualified Data.Text as T import Language.Haskell.LSP.Test hiding (message) import Language.Haskell.LSP.Types as LSP -import Language.Haskell.LSP.Types.Lens as LSP hiding (contents, error ) +import Language.Haskell.LSP.Types.Lens as LSP hiding (contents) import Ide.Plugin.Config import Test.Hls.Util import Test.Tasty From 182b5391ad81b7853b91c46aee626383c72cfeb4 Mon Sep 17 00:00:00 2001 From: Jeff Windsor Date: Sat, 16 May 2020 18:10:00 -0700 Subject: [PATCH 24/26] remove cabal-helper depends --- haskell-language-server.cabal | 1 - 1 file changed, 1 deletion(-) diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index ff110e7395..dff9c517d7 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -210,7 +210,6 @@ test-suite func-test type: exitcode-stdio-1.0 default-language: Haskell2010 build-tool-depends: haskell-language-server:haskell-language-server - , cabal-helper:cabal-helper-main , ghcide:ghcide-test-preprocessor build-depends: base >=4.7 && <5 , aeson From 092db6ef9620aaff1343752d6a66fcc145af03fe Mon Sep 17 00:00:00 2001 From: Jeff Windsor Date: Sat, 16 May 2020 19:19:49 -0700 Subject: [PATCH 25/26] ignore broken tests --- haskell-language-server.cabal | 1 + test/functional/Command.hs | 4 ++- test/functional/Completion.hs | 5 +++- test/functional/Deferred.hs | 2 ++ test/functional/Definition.hs | 17 +++++++++---- test/functional/Diagnostic.hs | 10 +++++--- test/functional/Format.hs | 21 ++++++++-------- test/functional/FunctionalCodeAction.hs | 33 +++++++++++++------------ test/functional/FunctionalLiquid.hs | 5 ++-- test/functional/HieBios.hs | 5 ++-- test/functional/Highlight.hs | 3 ++- test/functional/Main.hs | 6 ++--- test/functional/Progress.hs | 5 ++-- test/functional/Reference.hs | 5 ++-- test/functional/Symbol.hs | 11 +++++---- test/functional/TypeDefinition.hs | 17 +++++++------ 16 files changed, 88 insertions(+), 62 deletions(-) diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index dff9c517d7..f54f41941d 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -224,6 +224,7 @@ test-suite func-test , lens , lsp-test >= 0.10.0.0 , tasty + , tasty-expected-failure , tasty-hunit , tasty-rerun , text diff --git a/test/functional/Command.hs b/test/functional/Command.hs index b3d95337e9..aaf91175ff 100644 --- a/test/functional/Command.hs +++ b/test/functional/Command.hs @@ -11,6 +11,7 @@ import Language.Haskell.LSP.Types.Lens as LSP import Test.Hls.Util import Test.Tasty import Test.Tasty.HUnit +import Test.Tasty.ExpectedFailure (ignoreTestBecause) import Test.Hspec.Expectations @@ -25,7 +26,8 @@ tests = testGroup "commands" [ liftIO $ do cmds `shouldSatisfy` all f cmds `shouldNotSatisfy` null - , testCase "get de-prefixed" $ + , ignoreTestBecause "Broken: Plugin package doesn't exist" $ + testCase "get de-prefixed" $ runSession hieCommand fullCaps "test/testdata/" $ do ResponseMessage _ _ (Left err) <- request WorkspaceExecuteCommand diff --git a/test/functional/Completion.hs b/test/functional/Completion.hs index 245a3831c5..ca1a2d801f 100644 --- a/test/functional/Completion.hs +++ b/test/functional/Completion.hs @@ -11,6 +11,7 @@ import Language.Haskell.LSP.Types import Language.Haskell.LSP.Types.Lens hiding (applyEdit) import Test.Hls.Util import Test.Tasty +import Test.Tasty.ExpectedFailure (ignoreTestBecause) import Test.Tasty.HUnit import Test.Hspec.Expectations @@ -358,6 +359,7 @@ tests = testGroup "completions" [ contextTests :: TestTree contextTests = testGroup "contexts" [ + ignoreTestBecause "Broken: Timed out waiting to receive a message from the server" $ testCase "only provides type suggestions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do doc <- openDoc "Context.hs" "haskell" _ <- count 2 $ skipManyTill loggingNotification noDiagnostics @@ -366,7 +368,8 @@ contextTests = testGroup "contexts" [ compls `shouldContainCompl` "Integer" compls `shouldNotContainCompl` "interact" - , testCase "only provides type suggestions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do + , ignoreTestBecause "Broken: Timed out waiting to receive a message from the server" $ + testCase "only provides type suggestions" $ runSession hieCommand fullCaps "test/testdata/completion" $ do doc <- openDoc "Context.hs" "haskell" _ <- count 2 $ skipManyTill loggingNotification noDiagnostics compls <- getCompletions doc (Position 3 9) diff --git a/test/functional/Deferred.hs b/test/functional/Deferred.hs index e77d49ff2e..4bcebda277 100644 --- a/test/functional/Deferred.hs +++ b/test/functional/Deferred.hs @@ -14,6 +14,7 @@ import Language.Haskell.LSP.Types.Lens hiding (id, message) -- import qualified Language.Haskell.LSP.Types.Lens as LSP import Test.Hls.Util import Test.Tasty +import Test.Tasty.ExpectedFailure (ignoreTestBecause) import Test.Tasty.HUnit import Test.Hspec.Expectations @@ -156,6 +157,7 @@ tests = testGroup "deferred responses" [ 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 hieCommand fullCaps "test/testdata" $ do $ runSession hieCommand fullCaps "test/testdata" $ do diff --git a/test/functional/Definition.hs b/test/functional/Definition.hs index 100e28f8d2..1bfdb1da1b 100644 --- a/test/functional/Definition.hs +++ b/test/functional/Definition.hs @@ -8,12 +8,15 @@ import Language.Haskell.LSP.Types.Lens import System.Directory import Test.Hls.Util import Test.Tasty +import Test.Tasty.ExpectedFailure (ignoreTestBecause) import Test.Tasty.HUnit import Test.Hspec.Expectations tests :: TestTree tests = testGroup "definitions" [ - testCase "goto's symbols" $ runSession hieCommand fullCaps "test/testdata" $ do + + ignoreTestBecause "Broken: file:///Users/jwindsor/src/haskell-language-server/test/testdata/References.hs" $ + testCase "goto's symbols" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "References.hs" "haskell" defs <- getDefinitions doc (Position 7 8) let expRange = Range (Position 4 0) (Position 4 3) @@ -21,21 +24,24 @@ tests = testGroup "definitions" [ -- ----------------------------------- - , testCase "goto's imported modules" $ runSession hieCommand fullCaps "test/testdata/definition" $ do + , ignoreTestBecause "Broken: file:///Users/jwindsor/src/haskell-language-server/test/testdata/Bar.hs" $ + testCase "goto's imported modules" $ runSession hieCommand 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 `shouldBe` [Location (filePathToUri fp) zeroRange] - , testCase "goto's exported modules" $ runSession hieCommand fullCaps "test/testdata/definition" $ do + , ignoreTestBecause "Broken: file:///Users/jwindsor/src/haskell-language-server/test/testdata/Bar.hs" $ + testCase "goto's exported modules" $ runSession hieCommand 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 `shouldBe` [Location (filePathToUri fp) zeroRange] - , testCase "goto's imported modules that are loaded" $ runSession hieCommand fullCaps "test/testdata/definition" $ do + , ignoreTestBecause "Broken: file:///Users/jwindsor/src/haskell-language-server/test/testdata/Bar.hs" $ + testCase "goto's imported modules that are loaded" $ runSession hieCommand fullCaps "test/testdata/definition" $ do doc <- openDoc "Foo.hs" "haskell" _ <- openDoc "Bar.hs" "haskell" defs <- getDefinitions doc (Position 2 8) @@ -43,7 +49,8 @@ tests = testGroup "definitions" [ fp <- canonicalizePath "test/testdata/definition/Bar.hs" defs `shouldBe` [Location (filePathToUri fp) zeroRange] - , testCase "goto's imported modules that are loaded, and then closed" $ + , 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 hieCommand fullCaps "test/testdata/definition" $ do doc <- openDoc "Foo.hs" "haskell" otherDoc <- openDoc "Bar.hs" "haskell" diff --git a/test/functional/Diagnostic.hs b/test/functional/Diagnostic.hs index 4f6d184a14..fc67bf324d 100644 --- a/test/functional/Diagnostic.hs +++ b/test/functional/Diagnostic.hs @@ -15,6 +15,7 @@ import Language.Haskell.LSP.Types import qualified Language.Haskell.LSP.Types.Lens as LSP import Test.Hls.Util import Test.Tasty +import Test.Tasty.ExpectedFailure (ignoreTestBecause) import Test.Tasty.HUnit import Test.Hspec.Expectations @@ -31,7 +32,8 @@ tests = testGroup "diagnostics providers" [ triggerTests :: TestTree triggerTests = testGroup "diagnostics triggers" [ - testCase "runs diagnostics on save" $ + ignoreTestBecause "Broken" $ + ignoreTestBecause "Broken" $ testCase "runs diagnostics on save" $ runSession hieCommandExamplePlugin codeActionSupportCaps "test/testdata" $ do logm "starting DiagnosticSpec.runs diagnostic on save" doc <- openDoc "ApplyRefact2.hs" "haskell" @@ -63,7 +65,7 @@ triggerTests = testGroup "diagnostics triggers" [ errorTests :: TestTree errorTests = testGroup "typed hole errors" [ - testCase "is deferred" $ + ignoreTestBecause "Broken" $ testCase "is deferred" $ runSession hieCommand fullCaps "test/testdata" $ do _ <- openDoc "TypedHoles.hs" "haskell" [diag] <- waitForDiagnosticsSource "bios" @@ -72,7 +74,7 @@ errorTests = testGroup "typed hole errors" [ warningTests :: TestTree warningTests = testGroup "Warnings are warnings" [ - testCase "Overrides -Werror" $ + ignoreTestBecause "Broken" $ testCase "Overrides -Werror" $ runSession hieCommand fullCaps "test/testdata/wErrorTest" $ do _ <- openDoc "src/WError.hs" "haskell" [diag] <- waitForDiagnosticsSource "bios" @@ -81,7 +83,7 @@ warningTests = testGroup "Warnings are warnings" [ saveTests :: TestTree saveTests = testGroup "only diagnostics on save" [ - testCase "Respects diagnosticsOnChange setting" $ + ignoreTestBecause "Broken" $ testCase "Respects diagnosticsOnChange setting" $ runSession hieCommandExamplePlugin codeActionSupportCaps "test/testdata" $ do let config = Data.Default.def { diagnosticsOnChange = False } :: Config sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) diff --git a/test/functional/Format.hs b/test/functional/Format.hs index 9d45dc7160..733614ed2b 100644 --- a/test/functional/Format.hs +++ b/test/functional/Format.hs @@ -8,16 +8,17 @@ import Language.Haskell.LSP.Test import Language.Haskell.LSP.Types import Test.Hls.Util import Test.Tasty +import Test.Tasty.ExpectedFailure (ignoreTestBecause) import Test.Tasty.HUnit import Test.Hspec.Expectations tests :: TestTree tests = testGroup "format document" [ - testCase "works" $ runSession hieCommand fullCaps "test/testdata" $ do + ignoreTestBecause "Broken" $ testCase "works" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "Format.hs" "haskell" formatDoc doc (FormattingOptions 2 True) documentContents doc >>= liftIO . (`shouldBe` formattedDocTabSize2) - , testCase "works with custom tab size" $ runSession hieCommand fullCaps "test/testdata" $ do + , ignoreTestBecause "Broken" $ testCase "works with custom tab size" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "Format.hs" "haskell" formatDoc doc (FormattingOptions 5 True) documentContents doc >>= liftIO . (`shouldBe` formattedDocTabSize5) @@ -29,11 +30,11 @@ tests = testGroup "format document" [ rangeTests :: TestTree rangeTests = testGroup "format range" [ - testCase "works" $ runSession hieCommand fullCaps "test/testdata" $ do + ignoreTestBecause "Broken" $ testCase "works" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "Format.hs" "haskell" formatRange doc (FormattingOptions 2 True) (Range (Position 1 0) (Position 3 10)) documentContents doc >>= liftIO . (`shouldBe` formattedRangeTabSize2) - , testCase "works with custom tab size" $ runSession hieCommand fullCaps "test/testdata" $ do + , ignoreTestBecause "Broken" $ testCase "works with custom tab size" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "Format.hs" "haskell" formatRange doc (FormattingOptions 5 True) (Range (Position 4 0) (Position 7 19)) documentContents doc >>= liftIO . (`shouldBe` formattedRangeTabSize5) @@ -51,7 +52,7 @@ providerTests = testGroup "formatting provider" [ formatRange doc (FormattingOptions 2 True) (Range (Position 1 0) (Position 3 10)) documentContents doc >>= liftIO . (`shouldBe` orig) - , testCase "can change on the fly" $ runSession hieCommand fullCaps "test/testdata" $ do + , ignoreTestBecause "Broken" $ testCase "can change on the fly" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "Format.hs" "haskell" sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "brittany")) @@ -69,21 +70,21 @@ providerTests = testGroup "formatting provider" [ brittanyTests :: TestTree brittanyTests = testGroup "brittany" [ - testCase "formats a document with LF endings" $ runSession hieCommand fullCaps "test/testdata" $ do + ignoreTestBecause "Broken" $ testCase "formats a document with LF endings" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "BrittanyLF.hs" "haskell" let opts = DocumentFormattingParams doc (FormattingOptions 4 True) Nothing ResponseMessage _ _ (Right edits) <- request TextDocumentFormatting opts liftIO $ edits `shouldBe` [TextEdit (Range (Position 0 0) (Position 3 0)) "foo :: Int -> String -> IO ()\nfoo x y = do\n print x\n return 42\n"] - , testCase "formats a document with CRLF endings" $ runSession hieCommand fullCaps "test/testdata" $ do + , ignoreTestBecause "Broken" $ testCase "formats a document with CRLF endings" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "BrittanyCRLF.hs" "haskell" let opts = DocumentFormattingParams doc (FormattingOptions 4 True) Nothing ResponseMessage _ _ (Right edits) <- request TextDocumentFormatting opts liftIO $ edits `shouldBe` [TextEdit (Range (Position 0 0) (Position 3 0)) "foo :: Int -> String -> IO ()\nfoo x y = do\n print x\n return 42\n"] - , testCase "formats a range with LF endings" $ runSession hieCommand fullCaps "test/testdata" $ do + , ignoreTestBecause "Broken" $ testCase "formats a range with LF endings" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "BrittanyLF.hs" "haskell" let range = Range (Position 1 0) (Position 2 22) opts = DocumentRangeFormattingParams doc range (FormattingOptions 4 True) Nothing @@ -91,7 +92,7 @@ brittanyTests = testGroup "brittany" [ liftIO $ edits `shouldBe` [TextEdit (Range (Position 1 0) (Position 3 0)) "foo x y = do\n print x\n return 42\n"] - , testCase "formats a range with CRLF endings" $ runSession hieCommand fullCaps "test/testdata" $ do + , ignoreTestBecause "Broken" $ testCase "formats a range with CRLF endings" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "BrittanyCRLF.hs" "haskell" let range = Range (Position 1 0) (Position 2 22) opts = DocumentRangeFormattingParams doc range (FormattingOptions 4 True) Nothing @@ -102,7 +103,7 @@ brittanyTests = testGroup "brittany" [ ormoluTests :: TestTree ormoluTests = testGroup "ormolu" [ - testCase "formats correctly" $ runSession hieCommand fullCaps "test/testdata" $ do + ignoreTestBecause "Broken" $ testCase "formats correctly" $ runSession hieCommand fullCaps "test/testdata" $ do let formatLspConfig provider = object [ "languageServerHaskell" .= object ["formattingProvider" .= (provider :: Value)] ] sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "ormolu")) diff --git a/test/functional/FunctionalCodeAction.hs b/test/functional/FunctionalCodeAction.hs index b5f0ef1fa8..1acf37216f 100644 --- a/test/functional/FunctionalCodeAction.hs +++ b/test/functional/FunctionalCodeAction.hs @@ -22,6 +22,7 @@ import qualified Language.Haskell.LSP.Types.Lens as L import qualified Language.Haskell.LSP.Types.Capabilities as C import Test.Hls.Util import Test.Tasty +import Test.Tasty.ExpectedFailure (ignoreTestBecause) import Test.Tasty.HUnit import Test.Hspec.Expectations @@ -43,7 +44,7 @@ tests = testGroup "code actions" [ hlintTests :: TestTree hlintTests = testGroup "hlint suggestions" [ - testCase "provides 3.8 code actions" $ runSession hieCommand fullCaps "test/testdata" $ do + ignoreTestBecause "Broken" $ testCase "provides 3.8 code actions" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "ApplyRefact2.hs" "haskell" diags@(reduceDiag:_) <- waitForDiagnostics @@ -66,7 +67,7 @@ hlintTests = testGroup "hlint suggestions" [ noDiagnostics - , testCase "falls back to pre 3.8 code actions" $ runSession hieCommand noLiteralCaps "test/testdata" $ do + , ignoreTestBecause "Broken" $ testCase "falls back to pre 3.8 code actions" $ runSession hieCommand noLiteralCaps "test/testdata" $ do doc <- openDoc "ApplyRefact2.hs" "haskell" _ <- waitForDiagnostics @@ -83,7 +84,7 @@ hlintTests = testGroup "hlint suggestions" [ noDiagnostics - , testCase "runs diagnostics on save" $ runSession hieCommand fullCaps "test/testdata" $ do + , ignoreTestBecause "Broken" $ testCase "runs diagnostics on save" $ runSession hieCommand fullCaps "test/testdata" $ do let config = def { diagnosticsOnChange = False } sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config)) @@ -113,7 +114,7 @@ hlintTests = testGroup "hlint suggestions" [ renameTests :: TestTree renameTests = testGroup "rename suggestions" [ - testCase "works" $ runSession hieCommand noLiteralCaps "test/testdata" $ do + ignoreTestBecause "Broken" $ testCase "works" $ runSession hieCommand noLiteralCaps "test/testdata" $ do doc <- openDoc "CodeActionRename.hs" "haskell" _ <- waitForDiagnosticsSource "bios" @@ -124,7 +125,7 @@ renameTests = testGroup "rename suggestions" [ x:_ <- T.lines <$> documentContents doc liftIO $ x `shouldBe` "main = putStrLn \"hello\"" - , testCase "doesn't give both documentChanges and changes" + , ignoreTestBecause "Broken" $ testCase "doesn't give both documentChanges and changes" $ runSession hieCommand noLiteralCaps "test/testdata" $ do doc <- openDoc "CodeActionRename.hs" "haskell" @@ -145,7 +146,7 @@ renameTests = testGroup "rename suggestions" [ importTests :: TestTree importTests = testGroup "import suggestions" [ - testCase "works with 3.8 code action kinds" $ runSession hieCommand fullCaps "test/testdata" $ do + ignoreTestBecause "Broken" $ testCase "works with 3.8 code action kinds" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "CodeActionImport.hs" "haskell" -- No Formatting: let config = def { formattingProvider = "none" } @@ -178,7 +179,7 @@ importTests = testGroup "import suggestions" [ packageTests :: TestTree packageTests = testGroup "add package suggestions" [ - testCase "adds to .cabal files" $ do + ignoreTestBecause "Broken" $ testCase "adds to .cabal files" $ do flushStackEnvironment runSession hieCommand fullCaps "test/testdata/addPackageTest/cabal-exe" $ do doc <- openDoc "AddPackage.hs" "haskell" @@ -208,7 +209,7 @@ packageTests = testGroup "add package suggestions" [ T.lines contents `shouldSatisfy` \x -> any (\l -> "text -any" `T.isSuffixOf` l || "text : {} -any" `T.isSuffixOf` l) x - , testCase "adds to hpack package.yaml files" $ + , ignoreTestBecause "Broken" $ testCase "adds to hpack package.yaml files" $ runSession hieCommand fullCaps "test/testdata/addPackageTest/hpack-exe" $ do doc <- openDoc "app/Asdf.hs" "haskell" @@ -241,7 +242,7 @@ packageTests = testGroup "add package suggestions" [ redundantImportTests :: TestTree redundantImportTests = testGroup "redundant import code actions" [ - testCase "remove solitary redundant imports" $ + ignoreTestBecause "Broken" $ testCase "remove solitary redundant imports" $ runSession hieCommand fullCaps "test/testdata/redundantImportTest/" $ do doc <- openDoc "src/CodeActionRedundant.hs" "haskell" @@ -272,7 +273,7 @@ redundantImportTests = testGroup "redundant import code actions" [ contents <- documentContents doc liftIO $ contents `shouldBe` "module CodeActionRedundant where\nmain :: IO ()\nmain = putStrLn \"hello\"" - , testCase "doesn't touch other imports" $ runSession hieCommand noLiteralCaps "test/testdata/redundantImportTest/" $ do + , ignoreTestBecause "Broken" $ testCase "doesn't touch other imports" $ runSession hieCommand noLiteralCaps "test/testdata/redundantImportTest/" $ do doc <- openDoc "src/MultipleImports.hs" "haskell" _ <- count 2 waitForDiagnostics [CACommand cmd, _] <- getAllCodeActions doc @@ -288,7 +289,7 @@ redundantImportTests = testGroup "redundant import code actions" [ typedHoleTests :: TestTree typedHoleTests = testGroup "typed hole code actions" [ - testCase "works" $ + ignoreTestBecause "Broken" $ testCase "works" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "TypedHoles.hs" "haskell" _ <- waitForDiagnosticsSource "bios" @@ -330,7 +331,7 @@ typedHoleTests = testGroup "typed hole code actions" [ , "foo x = " <> suggestion ] - , testCase "shows more suggestions" $ + , ignoreTestBecause "Broken" $ testCase "shows more suggestions" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "TypedHoles2.hs" "haskell" _ <- waitForDiagnosticsSource "bios" @@ -377,7 +378,7 @@ typedHoleTests = testGroup "typed hole code actions" [ signatureTests :: TestTree signatureTests = testGroup "missing top level signature code actions" [ - testCase "Adds top level signature" $ + ignoreTestBecause "Broken" $ testCase "Adds top level signature" $ runSession hieCommand fullCaps "test/testdata/" $ do doc <- openDoc "TopLevelSignature.hs" "haskell" @@ -403,7 +404,7 @@ signatureTests = testGroup "missing top level signature code actions" [ missingPragmaTests :: TestTree missingPragmaTests = testGroup "missing pragma warning code actions" [ - testCase "Adds TypeSynonymInstances pragma" $ + ignoreTestBecause "Broken" $ testCase "Adds TypeSynonymInstances pragma" $ runSession hieCommand fullCaps "test/testdata/addPragmas" $ do doc <- openDoc "NeedsPragmas.hs" "haskell" @@ -440,7 +441,7 @@ missingPragmaTests = testGroup "missing pragma warning code actions" [ unusedTermTests :: TestTree unusedTermTests = testGroup "unused term code actions" [ - -- testCase "Prefixes with '_'" $ pendingWith "removed because of HaRe" + -- ignoreTestBecause "Broken" $ testCase "Prefixes with '_'" $ pendingWith "removed because of HaRe" -- runSession hieCommand fullCaps "test/testdata/" $ do -- doc <- openDoc "UnusedTerm.hs" "haskell" -- @@ -465,7 +466,7 @@ unusedTermTests = testGroup "unused term code actions" [ -- See https://microsoft.github.io/language-server-protocol/specifications/specification-3-15/#textDocument_codeAction -- `CodeActionContext` - testCase "respect 'only' parameter" $ runSession hieCommand fullCaps "test/testdata" $ do + ignoreTestBecause "Broken" $ testCase "respect 'only' parameter" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "CodeActionOnly.hs" "haskell" _ <- count 2 waitForDiagnostics -- need to wait for both hlint and ghcmod diags <- getCurrentDiagnostics doc diff --git a/test/functional/FunctionalLiquid.hs b/test/functional/FunctionalLiquid.hs index be9f4a63a7..7cd8bb6557 100644 --- a/test/functional/FunctionalLiquid.hs +++ b/test/functional/FunctionalLiquid.hs @@ -13,6 +13,7 @@ import Language.Haskell.LSP.Types.Lens as LSP hiding (contents) import Ide.Plugin.Config import Test.Hls.Util import Test.Tasty +import Test.Tasty.ExpectedFailure (ignoreTestBecause) import Test.Tasty.HUnit import Test.Hspec.Expectations @@ -20,7 +21,7 @@ import Test.Hspec.Expectations tests :: TestTree tests = testGroup "liquid haskell diagnostics" [ - testCase "runs diagnostics on save, no liquid" $ + ignoreTestBecause "Broken" $ testCase "runs diagnostics on save, no liquid" $ runSession hieCommandExamplePlugin codeActionSupportCaps "test/testdata" $ do doc <- openDoc "liquid/Evens.hs" "haskell" @@ -50,7 +51,7 @@ tests = testGroup "liquid haskell diagnostics" [ -- --------------------------------- - , testCase "runs diagnostics on save, with liquid haskell" $ + , ignoreTestBecause "Broken" $ testCase "runs diagnostics on save, with liquid haskell" $ runSession hieCommand codeActionSupportCaps "test/testdata" $ do -- runSessionWithConfig logConfig hieCommand codeActionSupportCaps "test/testdata" $ do doc <- openDoc "liquid/Evens.hs" "haskell" diff --git a/test/functional/HieBios.hs b/test/functional/HieBios.hs index ab1d191bd3..f1c58f1928 100644 --- a/test/functional/HieBios.hs +++ b/test/functional/HieBios.hs @@ -9,18 +9,19 @@ import Language.Haskell.LSP.Messages import System.FilePath (()) import Test.Hls.Util import Test.Tasty +import Test.Tasty.ExpectedFailure (ignoreTestBecause) import Test.Tasty.HUnit tests :: TestTree tests = testGroup "hie-bios" [ - testCase "loads modules inside main-is" $ do + ignoreTestBecause "Broken" $ testCase "loads modules inside main-is" $ do writeFile (hieBiosErrorPath "hie.yaml") "" runSession hieCommand fullCaps "test/testdata/hieBiosMainIs" $ do _ <- openDoc "Main.hs" "haskell" _ <- count 2 waitForDiagnostics return () - , testCase "reports errors in hie.yaml" $ do + , ignoreTestBecause "Broken" $ testCase "reports errors in hie.yaml" $ do writeFile (hieBiosErrorPath "hie.yaml") "" runSession hieCommand fullCaps hieBiosErrorPath $ do _ <- openDoc "Foo.hs" "haskell" diff --git a/test/functional/Highlight.hs b/test/functional/Highlight.hs index bb7e1b1938..07031785c9 100644 --- a/test/functional/Highlight.hs +++ b/test/functional/Highlight.hs @@ -7,12 +7,13 @@ import Language.Haskell.LSP.Test import Language.Haskell.LSP.Types import Test.Hls.Util import Test.Tasty +import Test.Tasty.ExpectedFailure (ignoreTestBecause) import Test.Tasty.HUnit import Test.Hspec.Expectations tests :: TestTree tests = testGroup "highlight" [ - testCase "works" $ runSession hieCommand fullCaps "test/testdata" $ do + ignoreTestBecause "Broken" $ testCase "works" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "Highlight.hs" "haskell" _ <- count 2 $ skipManyTill loggingNotification noDiagnostics highlights <- getHighlights doc (Position 2 2) diff --git a/test/functional/Main.hs b/test/functional/Main.hs index b11dcfd97e..de556e135c 100644 --- a/test/functional/Main.hs +++ b/test/functional/Main.hs @@ -28,14 +28,14 @@ main = do setupBuildToolFiles -- run a test session to warm up the cache to prevent timeouts in other tests - putStrLn "Warming up HIE cache..." + putStrLn "Warming up haskell-language-server cache..." runSessionWithConfig (defaultConfig { messageTimeout = 120 }) hieCommand fullCaps "test/testdata" $ - liftIO $ putStrLn "HIE cache is warmed up" + liftIO $ putStrLn "haskell-language-server cache is warmed up" --TODO Test runner with config like HSpec?? -- test tree - defaultMainWithRerun $ testGroup "HIE" [ + defaultMainWithRerun $ testGroup "haskell-language-server" [ Command.tests , Completion.tests , Deferred.tests diff --git a/test/functional/Progress.hs b/test/functional/Progress.hs index f61a00252b..82daa4e429 100644 --- a/test/functional/Progress.hs +++ b/test/functional/Progress.hs @@ -14,12 +14,13 @@ import qualified Language.Haskell.LSP.Types.Lens as L import Language.Haskell.LSP.Types.Capabilities import Test.Hls.Util import Test.Tasty +import Test.Tasty.ExpectedFailure (ignoreTestBecause) import Test.Tasty.HUnit import Test.Hspec.Expectations tests :: TestTree tests = testGroup "window/workDoneProgress" [ - testCase "sends indefinite progress notifications" $ + ignoreTestBecause "Broken" $ testCase "sends indefinite progress notifications" $ -- Testing that ghc-mod sends progress notifications runSession hieCommand progressCaps "test/testdata" $ do doc <- openDoc "ApplyRefact2.hs" "haskell" @@ -75,7 +76,7 @@ tests = testGroup "window/workDoneProgress" [ _ <- publishDiagnosticsNotification return () - , testCase "sends indefinite progress notifications with liquid" $ + , ignoreTestBecause "Broken" $ testCase "sends indefinite progress notifications with liquid" $ -- Testing that Liquid Haskell sends progress notifications runSession hieCommand progressCaps "test/testdata" $ do doc <- openDoc "liquid/Evens.hs" "haskell" diff --git a/test/functional/Reference.hs b/test/functional/Reference.hs index e7f0809561..173e42515b 100644 --- a/test/functional/Reference.hs +++ b/test/functional/Reference.hs @@ -7,12 +7,13 @@ import Language.Haskell.LSP.Types import Language.Haskell.LSP.Types.Lens import Test.Hls.Util import Test.Tasty +import Test.Tasty.ExpectedFailure (ignoreTestBecause) import Test.Tasty.HUnit import Test.Hspec.Expectations tests :: TestTree tests = testGroup "references" [ - testCase "works with definitions" $ runSession hieCommand fullCaps "test/testdata" $ do + ignoreTestBecause "Broken" $ testCase "works with definitions" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "References.hs" "haskell" let pos = Position 2 7 -- foo = bar <-- refs <- getReferences doc pos True @@ -25,7 +26,7 @@ tests = testGroup "references" [ , mkRange 2 6 2 9 ] -- TODO: Respect withDeclaration parameter - -- testCase "works without definitions" $ runSession hieCommand fullCaps "test/testdata" $ do + -- ignoreTestBecause "Broken" $ testCase "works without definitions" $ runSession hieCommand fullCaps "test/testdata" $ do -- doc <- openDoc "References.hs" "haskell" -- let pos = Position 2 7 -- foo = bar <-- -- refs <- getReferences doc pos False diff --git a/test/functional/Symbol.hs b/test/functional/Symbol.hs index 0bc41d83bd..066b87b71c 100644 --- a/test/functional/Symbol.hs +++ b/test/functional/Symbol.hs @@ -7,6 +7,7 @@ import Language.Haskell.LSP.Types import Language.Haskell.LSP.Types.Capabilities import Test.Hls.Util import Test.Tasty +import Test.Tasty.ExpectedFailure (ignoreTestBecause) import Test.Tasty.HUnit import Test.Hspec.Expectations @@ -18,7 +19,7 @@ tests = testGroup "document symbols" [ v310Tests :: TestTree v310Tests = testGroup "3.10 hierarchical document symbols" [ - testCase "provides nested data types and constructors" $ runSession hieCommand fullCaps "test/testdata" $ do + ignoreTestBecause "Broken" $ testCase "provides nested data types and constructors" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "Symbols.hs" "haskell" Left symbs <- getDocumentSymbols doc @@ -28,7 +29,7 @@ v310Tests = testGroup "3.10 hierarchical document symbols" [ liftIO $ symbs `shouldContain` [myData] - ,testCase "provides nested where functions" $ runSession hieCommand fullCaps "test/testdata" $ do + ,ignoreTestBecause "Broken" $ testCase "provides nested where functions" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "Symbols.hs" "haskell" Left symbs <- getDocumentSymbols doc @@ -39,7 +40,7 @@ v310Tests = testGroup "3.10 hierarchical document symbols" [ liftIO $ symbs `shouldContain` [foo] - , testCase "provides pattern synonyms" $ runSession hieCommand fullCaps "test/testdata" $ do + , ignoreTestBecause "Broken" $ testCase "provides pattern synonyms" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "Symbols.hs" "haskell" Left symbs <- getDocumentSymbols doc @@ -53,7 +54,7 @@ v310Tests = testGroup "3.10 hierarchical document symbols" [ pre310Tests :: TestTree pre310Tests = testGroup "pre 3.10 symbol information" [ - testCase "provides nested data types and constructors" $ runSession hieCommand oldCaps "test/testdata" $ do + ignoreTestBecause "Broken" $ testCase "provides nested data types and constructors" $ runSession hieCommand oldCaps "test/testdata" $ do doc@(TextDocumentIdentifier testUri) <- openDoc "Symbols.hs" "haskell" Right symbs <- getDocumentSymbols doc @@ -63,7 +64,7 @@ pre310Tests = testGroup "pre 3.10 symbol information" [ liftIO $ symbs `shouldContain` [myData, a, b] - ,testCase "provides nested where functions" $ runSession hieCommand oldCaps "test/testdata" $ do + ,ignoreTestBecause "Broken" $ testCase "provides nested where functions" $ runSession hieCommand oldCaps "test/testdata" $ do doc@(TextDocumentIdentifier testUri) <- openDoc "Symbols.hs" "haskell" Right symbs <- getDocumentSymbols doc diff --git a/test/functional/TypeDefinition.hs b/test/functional/TypeDefinition.hs index 4458f9faa1..893448d36d 100644 --- a/test/functional/TypeDefinition.hs +++ b/test/functional/TypeDefinition.hs @@ -6,12 +6,13 @@ import Language.Haskell.LSP.Types import System.Directory import Test.Hls.Util import Test.Tasty +import Test.Tasty.ExpectedFailure (ignoreTestBecause) import Test.Tasty.HUnit import Test.Hspec.Expectations tests :: TestTree tests = testGroup "type definitions" [ - testCase "finds local definition of record variable" + ignoreTestBecause "Broken" $ testCase "finds local definition of record variable" $ runSession hieCommand fullCaps "test/testdata/gototest" $ do doc <- openDoc "src/Lib.hs" "haskell" @@ -22,7 +23,7 @@ tests = testGroup "type definitions" [ `shouldBe` [ Location (filePathToUri fp) (Range (toPos (8, 1)) (toPos (8, 29))) ] - , testCase "finds local definition of newtype variable" + , ignoreTestBecause "Broken" $ testCase "finds local definition of newtype variable" $ runSession hieCommand fullCaps "test/testdata/gototest" $ do doc <- openDoc "src/Lib.hs" "haskell" @@ -33,7 +34,7 @@ tests = testGroup "type definitions" [ `shouldBe` [ Location (filePathToUri fp) (Range (toPos (13, 1)) (toPos (13, 30))) ] - , testCase "finds local definition of sum type variable" + , ignoreTestBecause "Broken" $ testCase "finds local definition of sum type variable" $ runSession hieCommand fullCaps "test/testdata/gototest" $ do doc <- openDoc "src/Lib.hs" "haskell" @@ -44,7 +45,7 @@ tests = testGroup "type definitions" [ `shouldBe` [ Location (filePathToUri fp) (Range (toPos (18, 1)) (toPos (18, 26))) ] - , testCase "finds local definition of sum type contructor" + , ignoreTestBecause "Broken" $ testCase "finds local definition of sum type contructor" $ runSession hieCommand fullCaps "test/testdata/gototest" $ do doc <- openDoc "src/Lib.hs" "haskell" @@ -55,14 +56,14 @@ tests = testGroup "type definitions" [ `shouldBe` [ Location (filePathToUri fp) (Range (toPos (18, 1)) (toPos (18, 26))) ] - , testCase "can not find non-local definition of type def" + , ignoreTestBecause "Broken" $ testCase "can not find non-local definition of type def" $ runSession hieCommand fullCaps "test/testdata/gototest" $ do doc <- openDoc "src/Lib.hs" "haskell" defs <- getTypeDefinitions doc (toPos (30, 17)) liftIO $ defs `shouldBe` [] - , testCase "find local definition of type def" + , ignoreTestBecause "Broken" $ testCase "find local definition of type def" $ runSession hieCommand fullCaps "test/testdata/gototest" $ do doc <- openDoc "src/Lib.hs" "haskell" @@ -75,7 +76,7 @@ tests = testGroup "type definitions" [ ] -- TODO Implement - -- , testCase "find type-definition of type def in component" + -- , ignoreTestBecause "Broken" $ testCase "find type-definition of type def in component" -- $ pendingWith "Finding symbols cross module is currently not supported" -- $ runSession hieCommand fullCaps "test/testdata/gototest" -- $ do @@ -89,7 +90,7 @@ tests = testGroup "type definitions" [ -- `shouldBe` [ Location (filePathToUri fp) -- (Range (toPos (8, 1)) (toPos (8, 29))) -- ] - , testCase "find definition of parameterized data type" + , ignoreTestBecause "Broken" $ testCase "find definition of parameterized data type" $ runSession hieCommand fullCaps "test/testdata/gototest" $ do doc <- openDoc "src/Lib.hs" "haskell" From 0c1708f80f3b336cfc7a8cced40a439bc1c09e48 Mon Sep 17 00:00:00 2001 From: Jeff Windsor Date: Sat, 16 May 2020 19:36:53 -0700 Subject: [PATCH 26/26] add xml output to runner --- haskell-language-server.cabal | 1 + test/functional/Main.hs | 25 ++++++++++--------------- 2 files changed, 11 insertions(+), 15 deletions(-) diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index f54f41941d..c55d900bd7 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -224,6 +224,7 @@ test-suite func-test , lens , lsp-test >= 0.10.0.0 , tasty + , tasty-ant-xml , tasty-expected-failure , tasty-hunit , tasty-rerun diff --git a/test/functional/Main.hs b/test/functional/Main.hs index de556e135c..7bffaf33d3 100644 --- a/test/functional/Main.hs +++ b/test/functional/Main.hs @@ -1,10 +1,9 @@ module Main where -import Control.Monad.IO.Class -import Language.Haskell.LSP.Test -import Test.Hls.Util import Test.Tasty +import Test.Tasty.Runners (listingTests, consoleTestReporter) import Test.Tasty.Ingredients.Rerun +import Test.Tasty.Runners.AntXML import Command import Completion @@ -24,18 +23,14 @@ import Symbol import TypeDefinition main :: IO () -main = do - setupBuildToolFiles - - -- run a test session to warm up the cache to prevent timeouts in other tests - putStrLn "Warming up haskell-language-server cache..." - runSessionWithConfig (defaultConfig { messageTimeout = 120 }) hieCommand fullCaps "test/testdata" $ - liftIO $ putStrLn "haskell-language-server cache is warmed up" - - --TODO Test runner with config like HSpec?? - - -- test tree - defaultMainWithRerun $ testGroup "haskell-language-server" [ +main = + -- ingredient: xml runner writes json file of test results (https://github.com/ocharles/tasty-ant-xml/blob/master/Test/Tasty/Runners/AntXML.hs) + -- rerunningTests allow rerun of failed tests (https://github.com/ocharles/tasty-rerun/blob/master/src/Test/Tasty/Ingredients/Rerun.hs) + defaultMainWithIngredients [ + antXMLRunner + , rerunningTests [ listingTests, consoleTestReporter ] + ] + $ testGroup "haskell-language-server" [ Command.tests , Completion.tests , Deferred.tests