Enable more tests

test/functional/Command.hs

@@ -11,10 +11,7 @@ import Language.Haskell.LSP.Types.Lens as LSP
 import Test.Hls.Util
 import Test.Tasty
 import Test.Tasty.HUnit
-import Test.Tasty.ExpectedFailure (ignoreTestBecause)
 
-
---TODO : Response Message no longer has 4 inputs
 tests :: TestTree
 tests = testGroup "commands" [
     testCase "are prefixed" $
@@ -25,13 +22,13 @@ tests = testGroup "commands" [
             liftIO $ do
                 all f cmds @? "All prefixed"
                 not (null cmds) @? "Commands aren't empty"
-    , ignoreTestBecause "Broken: Plugin package doesn't exist" $
-      testCase "get de-prefixed" $
+    , testCase "get de-prefixed" $
         runSession hlsCommand fullCaps "test/testdata/" $ do
             ResponseMessage _ _ (Left err) <- request
                 WorkspaceExecuteCommand
-                (ExecuteCommandParams "1234:package:add" (Just (List [])) Nothing) :: Session ExecuteCommandResponse
+                (ExecuteCommandParams "34133:eval:evalCommand" (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 `T.isInfixOf` "while parsing args for add in plugin package") @? "Has error message"
+            -- We expect an error message about the dud arguments, but we can
+            -- check that we found the right plugin.
+            liftIO $ "while parsing args for evalCommand in plugin eval" `T.isInfixOf` msg @? "Has error message"
     ]

test/functional/Diagnostic.hs

@@ -6,9 +6,7 @@ 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
@@ -22,72 +20,53 @@ import           Test.Tasty.HUnit
 
 tests :: TestTree
 tests = testGroup "diagnostics providers" [
-        saveTests
-        , triggerTests
-        , errorTests
+        basicTests
+        , saveTests
         , warningTests
     ]
 
-
-triggerTests :: TestTree
-triggerTests = testGroup "diagnostics triggers" [
-    ignoreTestBecause "Broken" $
-    ignoreTestBecause "Broken" $ testCase "runs diagnostics on save" $
-        runSession hlsCommandExamplePlugin codeActionSupportCaps "test/testdata" $ do
-            logm "starting DiagnosticSpec.runs diagnostic on save"
+basicTests :: TestTree
+basicTests = testGroup "Diagnostics work" [
+    testCase "hlint produces diagnostics" $
+        runSession hlsCommand fullCaps "test/testdata/hlint" $ do
             doc <- openDoc "ApplyRefact2.hs" "haskell"
-
-            diags@(reduceDiag:_) <- waitForDiagnostics
-
+            diags <- waitForDiagnosticsFromSource doc "hlint"
+            reduceDiag <- liftIO $ inspectDiagnostic diags ["Eta reduce"]
+            redundantID <- liftIO $ inspectDiagnostic diags ["Redundant id"]
             liftIO $ do
                 length diags @?= 2
                 reduceDiag ^. LSP.range @?= Range (Position 1 0) (Position 1 12)
                 reduceDiag ^. LSP.severity @?= Just DsInfo
-                reduceDiag ^. LSP.code @?= Just (StringValue "Eta reduce")
-                reduceDiag ^. LSP.source @?= Just "hlint"
-
-            diags2a <- waitForDiagnostics
-
-            liftIO $ length diags2a @?= 2
-
-            sendNotification TextDocumentDidSave (DidSaveTextDocumentParams doc)
-
-            diags3@(d:_) <- waitForDiagnosticsSource "eg2"
+                redundantID ^. LSP.severity @?= Just DsInfo
 
+    , testCase "example plugin produces diagnostics" $
+        runSession hlsCommandExamplePlugin fullCaps "test/testdata/hlint" $ do
+            doc <- openDoc "ApplyRefact2.hs" "haskell"
+            diags <- waitForDiagnosticsFromSource doc "example2"
+            reduceDiag <- liftIO $ inspectDiagnostic diags ["example2 diagnostic, hello world"]
             liftIO $ do
-                length diags3 @?= 1
-                d ^. LSP.range @?= Range (Position 0 0) (Position 1 0)
-                d ^. LSP.severity @?= Nothing
-                d ^. LSP.code @?= Nothing
-                d ^. LSP.message @?= T.pack "Example plugin diagnostic, triggered byDiagnosticOnSave"
-    ]
-
-errorTests :: TestTree
-errorTests = testGroup  "typed hole errors" [
-    ignoreTestBecause "Broken" $ testCase "is deferred" $
-        runSession hlsCommand fullCaps "test/testdata" $ do
-            _ <- openDoc "TypedHoles.hs" "haskell"
-            [diag] <- waitForDiagnosticsSource "bios"
-            liftIO $ diag ^. LSP.severity @?= Just DsWarning
+                length diags @?= 1
+                reduceDiag ^. LSP.range @?= Range (Position 0 0) (Position 1 0)
+                reduceDiag ^. LSP.severity @?= Just DsError
     ]
 
 warningTests :: TestTree
 warningTests = testGroup  "Warnings are warnings" [
-    ignoreTestBecause "Broken" $ testCase "Overrides -Werror" $
+    testCase "Overrides -Werror" $
         runSession hlsCommand fullCaps "test/testdata/wErrorTest" $ do
-            _ <- openDoc "src/WError.hs" "haskell"
-            [diag] <- waitForDiagnosticsSource "bios"
+            doc <- openDoc "src/WError.hs" "haskell"
+            [diag] <- waitForDiagnosticsFrom doc
             liftIO $ diag ^. LSP.severity @?= Just DsWarning
     ]
 
 saveTests :: TestTree
 saveTests = testGroup  "only diagnostics on save" [
-    ignoreTestBecause "Broken" $ testCase "Respects diagnosticsOnChange setting" $
+    ignoreTestBecause "diagnosticsOnChange parameter is not supported right now" $ testCase "Respects diagnosticsOnChange setting" $
         runSession hlsCommandExamplePlugin codeActionSupportCaps "test/testdata" $ do
             let config = Data.Default.def { diagnosticsOnChange = False } :: Config
             sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
             doc <- openDoc "Hover.hs" "haskell"
-            diags <- waitForDiagnostics
+            diags <- waitForDiagnosticsFrom doc
 
             liftIO $ do
                 length diags @?= 0
@@ -97,7 +76,7 @@ saveTests = testGroup  "only diagnostics on save" [
             skipManyTill loggingNotification noDiagnostics
 
             sendNotification TextDocumentDidSave (DidSaveTextDocumentParams doc)
-            diags2 <- waitForDiagnostics
+            diags2 <- waitForDiagnosticsFrom doc
             liftIO $
                 length diags2 @?= 1
     ]

test/functional/FunctionalCodeAction.hs

@@ -475,15 +475,24 @@ unusedTermTests = testGroup "unused term code actions" [
         doc   <- openDoc "CodeActionOnly.hs" "haskell"
         _     <- waitForDiagnosticsFrom doc
         diags <- getCurrentDiagnostics doc
-        let params = CodeActionParams doc (Range (Position 2 10) (Position 4 0)) caContext Nothing
+        let params = CodeActionParams doc (Range (Position 1 0) (Position 4 0)) caContext Nothing
             caContext = CodeActionContext (List diags) (Just (List [CodeActionRefactorInline]))
+            caContextAllActions = CodeActionContext (List diags) Nothing
+        -- Verify that we get code actions of at least two different kinds.
+        ResponseMessage _ _ (Right (List allCodeActions))
+          <- request TextDocumentCodeAction (params & L.context .~ caContextAllActions)
+        liftIO $ do
+            redundantId <- inspectCodeAction allCodeActions ["Redundant id"]
+            redundantId ^. L.kind @?= Just CodeActionQuickFix
+            unfoldFoo <- inspectCodeAction allCodeActions ["Unfold foo"]
+            unfoldFoo ^. L.kind @?= Just CodeActionRefactorInline
+        -- Verify that that when we set the only parameter, we only get actions
+        -- of the right kind.
         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
-            not (any (Just CodeActionRefactorInline /=) kinds) @? "None not CodeActionRefactorInline"
+            not (null kinds) @? "We found an action of kind RefactorInline"
             all (Just CodeActionRefactorInline ==) kinds @? "All CodeActionRefactorInline"
     ]
 

test/functional/FunctionalLiquid.hs

@@ -6,7 +6,6 @@ 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)
@@ -20,83 +19,19 @@ import           Test.Tasty.HUnit
 
 tests :: TestTree
 tests = testGroup "liquid haskell diagnostics" [
-    ignoreTestBecause "Broken" $ testCase "runs diagnostics on save, no liquid" $
-        runSession hlsCommandExamplePlugin codeActionSupportCaps "test/testdata" $ do
-            doc <- openDoc "liquid/Evens.hs" "haskell"
-
-            diags@(reduceDiag:_) <- waitForDiagnostics
-
-            liftIO $ do
-                length diags @?= 2
-                reduceDiag ^. range @?= Range (Position 5 18) (Position 5 22)
-                reduceDiag ^. severity @?= Just DsHint
-                reduceDiag ^. code @?= Just (StringValue "Use negate")
-                reduceDiag ^. source @?= Just "hlint"
-
-            diags2hlint <- waitForDiagnostics
-
-            liftIO $ length diags2hlint @?= 2
-
-            sendNotification TextDocumentDidSave (DidSaveTextDocumentParams doc)
-
-            diags3@(d:_) <- waitForDiagnosticsSource "eg2"
-
-            liftIO $ do
-                length diags3 @?= 1
-                d ^. LSP.range @?= Range (Position 0 0) (Position 1 0)
-                d ^. LSP.severity @?= Nothing
-                d ^. LSP.code @?= Nothing
-                d ^. LSP.message @?= T.pack "Example plugin diagnostic, triggered byDiagnosticOnSave"
-
-    -- ---------------------------------
-
-    , ignoreTestBecause "Broken" $ testCase "runs diagnostics on save, with liquid haskell" $
+    ignoreTestBecause "no liquid haskell"
+    $ testCase "liquid haskell generates diagnostics" $
         runSession hlsCommand codeActionSupportCaps "test/testdata" $ do
-        -- runSessionWithConfig logConfig hlsCommand codeActionSupportCaps "test/testdata" $ do
             doc <- openDoc "liquid/Evens.hs" "haskell"
 
-            diags@(reduceDiag:_) <- waitForDiagnostics
-
-            -- liftIO $ show diags @?= ""
-
-            liftIO $ do
-                length diags @?= 2
-                reduceDiag ^. range @?= Range (Position 5 18) (Position 5 22)
-                reduceDiag ^. severity @?= Just DsHint
-                reduceDiag ^. code @?= Just (StringValue "Use negate")
-                reduceDiag ^. source @?= 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 @?= ""
-
-            -- -- We turned hlint diagnostics off
-            -- liftIO $ length diags2hlint @?= 0
-            -- diags2liquid <- waitForDiagnostics
-            -- liftIO $ length diags2liquid @?= 0
-            -- liftIO $ show diags2liquid @?= ""
-            diags3@(d:_) <- waitForDiagnosticsSource "liquid"
-            -- liftIO $ show diags3 @?= ""
+            diags <- waitForDiagnosticsFromSource doc "liquid"
+            d <- liftIO $ inspectDiagnostic diags ["Liquid Type Mismatch"]
             liftIO $ do
-                length diags3 @?= 1
+                length diags @?= 1
                 d ^. range @?= Range (Position 8 0) (Position 8 11)
                 d ^. severity @?= Just DsError
                 d ^. code @?= Nothing
-                d ^. source @?= Just "liquid"
-                (d ^. message) `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 ")
-                    @? "Contains error message"
     ]

test/functional/HieBios.hs

@@ -1,36 +1,35 @@
 {-# LANGUAGE OverloadedStrings #-}
 module HieBios (tests) where
 
-import Control.Applicative.Combinators
+import Control.Lens ((^.))
+import Control.Monad.IO.Class
 import qualified Data.Text as T
 import Language.Haskell.LSP.Test
 import Language.Haskell.LSP.Types
-import Language.Haskell.LSP.Messages
+import qualified Language.Haskell.LSP.Types.Lens as L
 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
+    testCase "loads modules inside main-is" $ do
         writeFile (hieBiosErrorPath </> "hie.yaml") ""
         runSession hlsCommand fullCaps "test/testdata/hieBiosMainIs" $ do
-            _ <- openDoc "Main.hs" "haskell"
-            _ <- count 2 waitForDiagnostics
-            return ()
+            doc <- openDoc "Main.hs" "haskell"
+            Just mainHoverText <- getHover doc (Position 3 1)
+            let (HoverContents (MarkupContent _ x)) = mainHoverText ^. L.contents
+            liftIO $ "main :: IO ()" `T.isInfixOf` x
+                     @? "found hover text for main"
 
-    , ignoreTestBecause "Broken" $ testCase "reports errors in hie.yaml" $ do
+    , testCase "reports errors in hie.yaml" $ do
         writeFile (hieBiosErrorPath </> "hie.yaml") ""
         runSession hlsCommand fullCaps hieBiosErrorPath $ do
             _ <- openDoc "Foo.hs" "haskell"
-            _ <- skipManyTill loggingNotification (satisfy isMessage)
-            return ()
+            (diag:_) <- waitForDiagnostics
+            liftIO $ "Expected a cradle: key containing the preferences" `T.isInfixOf` (diag ^. L.message)
+                     @? "Error reported"
     ]
     where
         hieBiosErrorPath = "test/testdata/hieBiosError"
-
-        isMessage (NotShowMessage (NotificationMessage _ _ (ShowMessageParams MtError s))) =
-            "Couldn't parse hie.yaml" `T.isInfixOf` s
-        isMessage _ = False

test/functional/Rename.hs

@@ -1,27 +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 Control.Monad.IO.Class (liftIO)
+import Language.Haskell.LSP.Test
+import Language.Haskell.LSP.Types
+import Test.Hls.Util
 import Test.Tasty
 import Test.Tasty.HUnit
+import Test.Tasty.ExpectedFailure (ignoreTestBecause)
 
 tests :: TestTree
 tests = testGroup "rename" [
-  testCase "works" $ True @?= True
-  --  pendingWith "removed because of HaRe"
-  -- runSession hlsCommand 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"
+    ignoreTestBecause "no symbol renaming (yet!)" $
+    testCase "works" $
+        runSession hlsCommand fullCaps "test/testdata/rename" $ do
+          doc <- openDoc "Rename.hs" "haskell"
+          rename doc (Position 3 1) "baz" -- foo :: Int -> Int
+          contents <- documentContents doc
+          let 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"
+          liftIO $ contents @?= expected
     ]

test/testdata/testdata.cabal

@@ -8,6 +8,13 @@ executable codeactionrename
   main-is:             CodeActionRename.hs
   default-language:    Haskell2010
 
+executable codeactiononly
+  build-depends:       base
+  main-is:             CodeActionOnly.hs
+  default-language:    Haskell2010
+
+
+
 executable hover
   build-depends:       base
   main-is:             Hover.hs

test/testdata/wErrorTest/cabal.project

@@ -0,0 +1 @@
+packages: test.cabal

test/testdata/wErrorTest/hie.yaml

@@ -0,0 +1,4 @@
+cradle:
+  cabal:
+    - path: "src"
+      component: "lib:test"