diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 16ec322d5e..c55d900bd7 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -205,69 +205,59 @@ executable haskell-language-server-wrapper , process default-language: Haskell2010 - 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 == 0.22.* - , 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 + import: agpl + type: exitcode-stdio-1.0 + default-language: Haskell2010 + build-tool-depends: haskell-language-server:haskell-language-server + , ghcide:ghcide-test-preprocessor + build-depends: base >=4.7 && <5 + , aeson + , data-default + , directory + , filepath + , haskell-language-server + , haskell-lsp + , haskell-lsp-types + , hls-test-utils + , hspec-expectations + , lens + , lsp-test >= 0.10.0.0 + , tasty + , tasty-ant-xml + , tasty-expected-failure + , tasty-hunit + , tasty-rerun + , text + , unordered-containers + hs-source-dirs: test/functional + main-is: Main.hs + other-modules: Command + , Completion + , Deferred + , Definition + , Diagnostic + , Format + , FunctionalBadProject + , FunctionalCodeAction + , FunctionalLiquid + , HieBios + , Highlight + , Progress + , Reference + , Rename + , Symbol + , TypeDefinition + ghc-options: -Wall + -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 + ghc-options: -Werror -Wredundant-constraints library hls-test-utils import: agpl hs-source-dirs: test/utils - exposed-modules: TestUtils + exposed-modules: Test.Hls.Util build-depends: base , haskell-language-server , haskell-lsp @@ -281,7 +271,9 @@ library hls-test-utils , hslogger , hspec , hspec-core + , lsp-test , stm + , tasty-hunit , text , unordered-containers , yaml 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/functional/Command.hs b/test/functional/Command.hs new file mode 100644 index 0000000000..aaf91175ff --- /dev/null +++ b/test/functional/Command.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE OverloadedStrings #-} +module Command (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.Hls.Util +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.ExpectedFailure (ignoreTestBecause) +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 _ _ (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 + cmds `shouldSatisfy` all f + cmds `shouldNotSatisfy` null + , ignoreTestBecause "Broken: Plugin package doesn't exist" $ + testCase "get de-prefixed" $ + runSession hieCommand fullCaps "test/testdata/" $ do + ResponseMessage _ _ (Left 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" + ] diff --git a/test/functional/Completion.hs b/test/functional/Completion.hs new file mode 100644 index 0000000000..ca1a2d801f --- /dev/null +++ b/test/functional/Completion.hs @@ -0,0 +1,396 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Completion(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.Hls.Util +import Test.Tasty +import Test.Tasty.ExpectedFailure (ignoreTestBecause) +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 + ] + +-- 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" [ + 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 2 17) + liftIO $ do + compls `shouldContainCompl` "Integer" + compls `shouldNotContainCompl` "interact" + + , 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) + 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/Deferred.hs b/test/functional/Deferred.hs new file mode 100644 index 0000000000..4bcebda277 --- /dev/null +++ b/test/functional/Deferred.hs @@ -0,0 +1,178 @@ +{-# 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 Test.Hls.Util +import Test.Tasty +import Test.Tasty.ExpectedFailure (ignoreTestBecause) +import Test.Tasty.HUnit +import Test.Hspec.Expectations + + +tests :: TestTree +tests = testGroup "deferred responses" [ + + --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` [] + + -- 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 + ] + +--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" [ + 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 + _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/Definition.hs b/test/functional/Definition.hs new file mode 100644 index 0000000000..1bfdb1da1b --- /dev/null +++ b/test/functional/Definition.hs @@ -0,0 +1,70 @@ +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.Hls.Util +import Test.Tasty +import Test.Tasty.ExpectedFailure (ignoreTestBecause) +import Test.Tasty.HUnit +import Test.Hspec.Expectations + +tests :: TestTree +tests = testGroup "definitions" [ + + 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) + liftIO $ defs `shouldBe` [Location (doc ^. uri) expRange] + + -- ----------------------------------- + + , 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] + + , 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] + + , 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) + liftIO $ do + fp <- canonicalizePath "test/testdata/definition/Bar.hs" + defs `shouldBe` [Location (filePathToUri fp) zeroRange] + + , ignoreTestBecause "Broken: file:///Users/jwindsor/src/haskell-language-server/test/testdata/Bar.hs" $ + testCase "goto's imported modules that are loaded, and then closed" $ + runSession 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/Diagnostic.hs b/test/functional/Diagnostic.hs new file mode 100644 index 0000000000..fc67bf324d --- /dev/null +++ b/test/functional/Diagnostic.hs @@ -0,0 +1,104 @@ +{-# 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.Hls.Util +import Test.Tasty +import Test.Tasty.ExpectedFailure (ignoreTestBecause) +import Test.Tasty.HUnit +import Test.Hspec.Expectations + +-- --------------------------------------------------------------------- + +tests :: TestTree +tests = testGroup "diagnostics providers" [ + saveTests + , triggerTests + , errorTests + , warningTests + ] + + +triggerTests :: TestTree +triggerTests = testGroup "diagnostics triggers" [ + 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" + + 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" [ + ignoreTestBecause "Broken" $ 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" [ + ignoreTestBecause "Broken" $ 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" [ + 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)) + 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/Format.hs b/test/functional/Format.hs new file mode 100644 index 0000000000..733614ed2b --- /dev/null +++ b/test/functional/Format.hs @@ -0,0 +1,231 @@ +{-# 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.Hls.Util +import Test.Tasty +import Test.Tasty.ExpectedFailure (ignoreTestBecause) +import Test.Tasty.HUnit +import Test.Hspec.Expectations + +tests :: TestTree +tests = testGroup "format document" [ + 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) + , 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) + , rangeTests + , providerTests + , brittanyTests + , ormoluTests + ] + +rangeTests :: TestTree +rangeTests = testGroup "format range" [ + 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) + , 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) + ] + +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) + + , ignoreTestBecause "Broken" $ 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" [ + 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"] + + , 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"] + + , 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 + 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"] + + , 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 + 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"] + ] + +ormoluTests :: TestTree +ormoluTests = testGroup "ormolu" [ + 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")) + 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/FormatSpec.hs b/test/functional/FormatSpec.hs deleted file mode 100644 index 1d710112a3..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 _ _ (Right (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 _ _ (Right (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 _ _ (Right (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 _ _ (Right (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/FunctionalBadProject.hs b/test/functional/FunctionalBadProject.hs new file mode 100644 index 0000000000..e51ee00cf0 --- /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.Hls.Util +import Test.Tasty +import Test.Tasty.HUnit +import Test.Hspec.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/FunctionalCodeAction.hs b/test/functional/FunctionalCodeAction.hs new file mode 100644 index 0000000000..1acf37216f --- /dev/null +++ b/test/functional/FunctionalCodeAction.hs @@ -0,0 +1,493 @@ +{-# 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.Hls.Util +import Test.Tasty +import Test.Tasty.ExpectedFailure (ignoreTestBecause) +import Test.Tasty.HUnit +import Test.Hspec.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" [ + ignoreTestBecause "Broken" $ 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 + + , ignoreTestBecause "Broken" $ 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 + + , ignoreTestBecause "Broken" $ 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" [ + ignoreTestBecause "Broken" $ 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\"" + + , ignoreTestBecause "Broken" $ 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" [ + 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" } + 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" [ + ignoreTestBecause "Broken" $ 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 + + , ignoreTestBecause "Broken" $ 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" [ + ignoreTestBecause "Broken" $ 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\"" + + , 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 + 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" [ + ignoreTestBecause "Broken" $ 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 + ] + + , ignoreTestBecause "Broken" $ 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" [ + ignoreTestBecause "Broken" $ 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" [ + ignoreTestBecause "Broken" $ 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" [ + -- ignoreTestBecause "Broken" $ 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` + 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 + let params = CodeActionParams doc (Range (Position 2 10) (Position 4 0)) caContext Nothing + caContext = CodeActionContext (List diags) (Just (List [CodeActionRefactorInline])) + ResponseMessage _ _ (Right (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/FunctionalLiquid.hs b/test/functional/FunctionalLiquid.hs new file mode 100644 index 0000000000..7cd8bb6557 --- /dev/null +++ b/test/functional/FunctionalLiquid.hs @@ -0,0 +1,101 @@ +{-# 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) +import Ide.Plugin.Config +import Test.Hls.Util +import Test.Tasty +import Test.Tasty.ExpectedFailure (ignoreTestBecause) +import Test.Tasty.HUnit +import Test.Hspec.Expectations + +-- --------------------------------------------------------------------- + +tests :: TestTree +tests = testGroup "liquid haskell diagnostics" [ + ignoreTestBecause "Broken" $ 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" + + -- --------------------------------- + + , 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" + + 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/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/HieBios.hs b/test/functional/HieBios.hs new file mode 100644 index 0000000000..f1c58f1928 --- /dev/null +++ b/test/functional/HieBios.hs @@ -0,0 +1,36 @@ +{-# 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.Hls.Util +import Test.Tasty +import Test.Tasty.ExpectedFailure (ignoreTestBecause) +import Test.Tasty.HUnit + +tests :: TestTree +tests = testGroup "hie-bios" [ + 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 () + + , ignoreTestBecause "Broken" $ 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..07031785c9 --- /dev/null +++ b/test/functional/Highlight.hs @@ -0,0 +1,29 @@ +{-# 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.Hls.Util +import Test.Tasty +import Test.Tasty.ExpectedFailure (ignoreTestBecause) +import Test.Tasty.HUnit +import Test.Hspec.Expectations + +tests :: TestTree +tests = testGroup "highlight" [ + 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) + 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 312ab2b880..7bffaf33d3 100644 --- a/test/functional/Main.hs +++ b/test/functional/Main.hs @@ -1,19 +1,50 @@ module Main where -import Control.Monad.IO.Class -import Language.Haskell.LSP.Test -import qualified FunctionalSpec -import Test.Hspec.Runner (hspecWith) -import TestUtils +import Test.Tasty +import Test.Tasty.Runners (listingTests, consoleTestReporter) +import Test.Tasty.Ingredients.Rerun +import Test.Tasty.Runners.AntXML -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" +import Command +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 - config <- getHspecFormattedConfig "functional" - withFileLogging logFilePath $ hspecWith config FunctionalSpec.spec +main :: IO () +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 + , 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/PluginSpec.hs b/test/functional/PluginSpec.hs deleted file mode 100644 index 1fd5d8b99f..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 Right (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/Progress.hs b/test/functional/Progress.hs new file mode 100644 index 0000000000..82daa4e429 --- /dev/null +++ b/test/functional/Progress.hs @@ -0,0 +1,119 @@ +{-# 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.Hls.Util +import Test.Tasty +import Test.Tasty.ExpectedFailure (ignoreTestBecause) +import Test.Tasty.HUnit +import Test.Hspec.Expectations + +tests :: TestTree +tests = testGroup "window/workDoneProgress" [ + 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" + + 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 () + + , 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" + + 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..173e42515b --- /dev/null +++ b/test/functional/Reference.hs @@ -0,0 +1,35 @@ +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.Hls.Util +import Test.Tasty +import Test.Tasty.ExpectedFailure (ignoreTestBecause) +import Test.Tasty.HUnit +import Test.Hspec.Expectations + +tests :: TestTree +tests = testGroup "references" [ + 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 + 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 + -- 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 + -- 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..0cecd1c73d --- /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.Hls.Util +import Test.Tasty +import Test.Tasty.HUnit +import Test.Hspec.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..066b87b71c --- /dev/null +++ b/test/functional/Symbol.hs @@ -0,0 +1,114 @@ +{-# 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.Hls.Util +import Test.Tasty +import Test.Tasty.ExpectedFailure (ignoreTestBecause) +import Test.Tasty.HUnit +import Test.Hspec.Expectations + +tests :: TestTree +tests = testGroup "document symbols" [ + pre310Tests + , v310Tests + ] + +v310Tests :: TestTree +v310Tests = testGroup "3.10 hierarchical document symbols" [ + ignoreTestBecause "Broken" $ 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] + + ,ignoreTestBecause "Broken" $ 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] + + , ignoreTestBecause "Broken" $ 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" [ + 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 + + 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] + + ,ignoreTestBecause "Broken" $ 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..893448d36d --- /dev/null +++ b/test/functional/TypeDefinition.hs @@ -0,0 +1,108 @@ +module TypeDefinition (tests) where + +import Control.Monad.IO.Class +import Language.Haskell.LSP.Test +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" [ + ignoreTestBecause "Broken" $ 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))) + ] + , ignoreTestBecause "Broken" $ 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))) + ] + , ignoreTestBecause "Broken" $ 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))) + ] + , ignoreTestBecause "Broken" $ 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))) + ] + , 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` [] + + , ignoreTestBecause "Broken" $ 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 + -- , 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 + -- 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))) + -- ] + , ignoreTestBecause "Broken" $ 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 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/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 diff --git a/test/utils/TestUtils.hs b/test/utils/Test/Hls/Util.hs similarity index 91% rename from test/utils/TestUtils.hs rename to test/utils/Test/Hls/Util.hs index 8260d92b8b..65b024167e 100644 --- a/test/utils/TestUtils.hs +++ b/test/utils/Test/Hls/Util.hs @@ -1,24 +1,27 @@ {-# LANGUAGE CPP, OverloadedStrings, NamedFieldPuns #-} -module TestUtils +module Test.Hls.Util ( - withFileLogging - , setupBuildToolFiles - -- , testCommand - -- , runSingle - -- , runSingle' - -- , runSingleReq + codeActionSupportCaps + , dummyLspFuncs + , flushStackEnvironment + , getHspecFormattedConfig + , ghcVersion, GhcVersion(..) + , hieCommand + , hieCommandExamplePlugin + , hieCommandVomit + , logConfig + , logFilePath + , noLogConfig + , setupBuildToolFiles + , withFileLogging -- , makeRequest -- , runIGM -- , runIGM' - , ghcVersion, GhcVersion(..) - , logFilePath - , hieCommand - , hieCommandVomit - , hieCommandExamplePlugin - , getHspecFormattedConfig + -- , runSingle + -- , runSingle' + -- , runSingleReq + -- , testCommand -- , testOptions - , flushStackEnvironment - , dummyLspFuncs ) where @@ -31,6 +34,8 @@ import Data.List (intercalate) 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 @@ -44,7 +49,6 @@ 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 @@ -91,6 +95,19 @@ import Text.Blaze.Internal -- 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" @@ -292,4 +309,4 @@ dummyLspFuncs = LspFuncs { clientCapabilities = def , getWorkspaceFolders = return Nothing , withProgress = \_ _ f -> f (const (return ())) , withIndefiniteProgress = \_ _ f -> f - } + } \ No newline at end of file