fix hls tests

ghcide/test/exe/Main.hs

@@ -87,17 +87,17 @@ import Data.Tuple.Extra
 waitForProgressBegin :: Session ()
 waitForProgressBegin = void $ skipManyTill anyMessage $ satisfyMaybe $ \case
   FromServerMess SProgress (NotificationMessage _ _ (ProgressParams _ (Begin _))) -> Just ()
-  _ -> pure ()
+  _ -> Nothing
 
 waitForProgressReport :: Session ()
 waitForProgressReport = void $ skipManyTill anyMessage $ satisfyMaybe $ \case
   FromServerMess SProgress (NotificationMessage _ _ (ProgressParams _ (Report _))) -> Just ()
-  _ -> pure ()
+  _ -> Nothing
 
 waitForProgressDone :: Session ()
 waitForProgressDone = void $ skipManyTill anyMessage $ satisfyMaybe $ \case
   FromServerMess SProgress (NotificationMessage _ _ (ProgressParams _ (End _))) -> Just ()
-  _ -> pure ()
+  _ -> Nothing
 
 main :: IO ()
 main = do

plugins/hls-eval-plugin/test/Eval.hs

@@ -1,36 +1,23 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 
 module Eval (
     tests,
 ) where
 
 import Control.Applicative.Combinators (
-    skipManyTill,
+    skipManyTill
  )
+import Data.Function
 import Control.Monad (when)
 import Control.Monad.IO.Class (MonadIO (liftIO))
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
-import Language.Haskell.LSP.Test (
-    Session,
-    anyMessage,
-    documentContents,
-    executeCommand,
-    fullCaps,
-    getCodeLenses,
-    message,
-    openDoc,
-    runSession,
- )
-import Language.Haskell.LSP.Types (
-    ApplyWorkspaceEditRequest,
-    CodeLens (CodeLens, _command, _range),
-    Command (Command, _title),
-    Position (..),
-    Range (..),
-    TextDocumentIdentifier,
- )
+import Language.LSP.Test
+import Language.LSP.Types
+import Language.LSP.Types.Lens (command, title, range)
+import Control.Lens (view, _Just, preview)
 import System.Directory (doesFileExist)
 import System.FilePath (
     (<.>),
@@ -58,27 +45,27 @@ tests =
             runSession hlsCommand fullCaps evalPath $ do
                 doc <- openDoc "T1.hs" "haskell"
                 lenses <- getEvalCodeLenses doc
-                liftIO $ map (fmap _title . _command) lenses @?= [Just "Evaluate..."]
+                liftIO $ map (preview $ command . _Just . title) lenses @?= [Just "Evaluate..."]
         , testCase "Produces Refresh code lenses" $
             runSession hlsCommand fullCaps evalPath $ do
                 doc <- openDoc "T2.hs" "haskell"
                 lenses <- getEvalCodeLenses doc
-                liftIO $ map (fmap _title . _command) lenses @?= [Just "Refresh..."]
+                liftIO $ map (preview $ command . _Just . title) lenses @?= [Just "Refresh..."]
         , testCase "Code lenses have ranges" $
             runSession hlsCommand fullCaps evalPath $ do
                 doc <- openDoc "T1.hs" "haskell"
                 lenses <- getEvalCodeLenses doc
-                liftIO $ map _range lenses @?= [Range (Position 4 0) (Position 5 0)]
+                liftIO $ map (view range) lenses @?= [Range (Position 4 0) (Position 5 0)]
         , testCase "Multi-line expressions have a multi-line range" $ do
             runSession hlsCommand fullCaps evalPath $ do
                 doc <- openDoc "T3.hs" "haskell"
                 lenses <- getEvalCodeLenses doc
-                liftIO $ map _range lenses @?= [Range (Position 3 0) (Position 5 0)]
+                liftIO $ map (view range) lenses @?= [Range (Position 3 0) (Position 5 0)]
         , testCase "Executed expressions range covers only the expression" $ do
             runSession hlsCommand fullCaps evalPath $ do
                 doc <- openDoc "T2.hs" "haskell"
                 lenses <- getEvalCodeLenses doc
-                liftIO $ map _range lenses @?= [Range (Position 4 0) (Position 5 0)]
+                liftIO $ map (view range) lenses @?= [Range (Position 4 0) (Position 5 0)]
         , testCase "Evaluation of expressions" $ goldenTest "T1.hs"
         , testCase "Reevaluation of expressions" $ goldenTest "T2.hs"
         , testCase "Evaluation of expressions w/ imports" $ goldenTest "T3.hs"
@@ -214,7 +201,7 @@ getCodeLensesBy f doc = filter f <$> getCodeLenses doc
 executeCmd :: Command -> Session ()
 executeCmd cmd = do
     executeCommand cmd
-    _resp :: ApplyWorkspaceEditRequest <- skipManyTill anyMessage message
+    _resp <- skipManyTill anyMessage (message SWorkspaceApplyEdit)
     -- liftIO $ print _resp
     return ()
 

test/functional/Class.hs

@@ -2,6 +2,7 @@
 -- {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE OverloadedStrings   #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeOperators #-}
 module Class
   ( tests
   )
@@ -11,9 +12,9 @@ import           Control.Lens                    hiding ((<.>))
 import           Control.Monad.IO.Class          (MonadIO(liftIO))
 import qualified Data.ByteString.Lazy            as BS
 import qualified Data.Text.Encoding              as T
-import           Language.Haskell.LSP.Test
-import           Language.Haskell.LSP.Types      hiding (_title, _command)
-import qualified Language.Haskell.LSP.Types.Lens as J
+import           Language.LSP.Test
+import           Language.LSP.Types      hiding (_title, _command)
+import qualified Language.LSP.Types.Lens as J
 import           System.FilePath
 import           Test.Hls.Util
 import           Test.Tasty
@@ -54,10 +55,10 @@ tests = testGroup
       executeCodeAction _fAction
   ]
 
-_CACodeAction :: Prism' CAResult CodeAction
-_CACodeAction = prism' CACodeAction $ \case
-  CACodeAction action -> Just action
-  _                   -> Nothing
+_CACodeAction :: Prism' (Command |? CodeAction) CodeAction
+_CACodeAction = prism' InR $ \case
+  InR action -> Just action
+  _          -> Nothing
 
 classPath :: FilePath
 classPath = "test" </> "testdata" </> "class"

test/functional/Command.hs

@@ -5,9 +5,9 @@ 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 Language.LSP.Test
+import Language.LSP.Types as LSP
+import Language.LSP.Types.Lens as LSP
 import Test.Hls.Util
 import Test.Tasty
 import Test.Tasty.HUnit
@@ -25,8 +25,8 @@ tests = testGroup "commands" [
     , testCase "get de-prefixed" $
         runSession hlsCommand fullCaps "test/testdata/" $ do
             ResponseMessage _ _ (Left err) <- request
-                WorkspaceExecuteCommand
-                (ExecuteCommandParams "34133:eval:evalCommand" (Just (List [])) Nothing) :: Session ExecuteCommandResponse
+                SWorkspaceExecuteCommand
+                (ExecuteCommandParams Nothing "34133:eval:evalCommand" (Just (List [])))
             let ResponseError _ msg _ = err
             -- We expect an error message about the dud arguments, but we can
             -- check that we found the right plugin.

test/functional/Completion.hs

@@ -5,9 +5,9 @@ module Completion(tests) where
 import Control.Monad.IO.Class
 import Control.Lens hiding ((.=))
 import Data.Aeson (object, (.=))
-import Language.Haskell.LSP.Test
-import Language.Haskell.LSP.Types
-import Language.Haskell.LSP.Types.Lens hiding (applyEdit)
+import Language.LSP.Test
+import Language.LSP.Types
+import Language.LSP.Types.Lens hiding (applyEdit)
 import Test.Hls.Util
 import Test.Tasty
 import Test.Tasty.ExpectedFailure (ignoreTestBecause)
@@ -42,8 +42,8 @@ tests = testGroup "completions" [
 
          compls <- getCompletions doc (Position 5 9)
          let item = head $ filter ((== "putStrLn") . (^. label)) compls
-         resolvedRes <- request CompletionItemResolve item
-         let Right (resolved :: CompletionItem) = resolvedRes ^. result
+         resolvedRes <- request SCompletionItemResolve item
+         let Right resolved = resolvedRes ^. result
          liftIO $ print resolved
          liftIO $ do
              resolved ^. label @?= "putStrLn"
@@ -336,7 +336,7 @@ snippetTests = testGroup "snippets" [
 
         let config = object [ "haskell" .= object ["completionSnippetsOn" .= False]]
 
-        sendNotification WorkspaceDidChangeConfiguration
+        sendNotification SWorkspaceDidChangeConfiguration
                         (DidChangeConfigurationParams config)
 
         checkNoSnippets doc

test/functional/Config.hs

@@ -11,9 +11,9 @@ import           Data.Default
 import qualified Data.Map as Map
 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           Language.LSP.Test as Test
+import           Language.LSP.Types
+import qualified Language.LSP.Types.Lens as L
 import           System.FilePath ((</>))
 import           Test.Hls.Util
 import           Test.Tasty
@@ -34,27 +34,27 @@ hlintTests = testGroup "hlint plugin enables" [
 
       testCase "changing hlintOn configuration enables or disables hlint diagnostics" $ runHlintSession "" $ do
         let config = def { hlintOn = True }
-        sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
+        sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
 
         doc <- openDoc "ApplyRefact2.hs" "haskell"
         testHlintDiagnostics doc
 
         let config' = def { hlintOn = False }
-        sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config'))
+        sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config'))
 
         diags' <- waitForDiagnosticsFrom doc
 
         liftIO $ noHlintDiagnostics diags'
 
     , testCase "changing hlint plugin configuration enables or disables hlint diagnostics" $ runHlintSession "" $ do
         let config = def { hlintOn = True }
-        sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
+        sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
 
         doc <- openDoc "ApplyRefact2.hs" "haskell"
         testHlintDiagnostics doc
 
         let config' = pluginGlobalOn config "hlint" False
-        sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config'))
+        sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config'))
 
         diags' <- waitForDiagnosticsFrom doc
 
@@ -78,12 +78,12 @@ configTests :: TestTree
 configTests = testGroup "config parsing" [
       testCase "empty object as user configuration should not send error logMessage" $ runConfigSession "" $ do
         let config = object []
-        sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
+        sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
 
         -- Send custom request so server returns a response to prevent blocking
-        void $ Test.sendRequest (CustomClientMethod "non-existent-method") ()
+        void $ Test.sendRequest (SCustomMethod "non-existent-method") Null
 
-        logNot <- skipManyTill Test.anyMessage Test.message :: Session LogMessageNotification
+        logNot <- skipManyTill Test.anyMessage (message SWindowLogMessage)
 
         liftIO $ (logNot ^. L.params . L.xtype) > MtError
                  || "non-existent-method" `T.isInfixOf` (logNot ^. L.params . L.message)

test/functional/Deferred.hs

@@ -8,10 +8,10 @@ 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 Language.LSP.Test
+import Language.LSP.Types
+import Language.LSP.Types.Lens hiding (id, message)
+-- import qualified Language.LSP.Types.Lens as LSP
 import Test.Hls.Util
 import Test.Tasty
 import Test.Tasty.ExpectedFailure (ignoreTestBecause)
@@ -94,7 +94,7 @@ tests = testGroup "deferred responses" [
      testCase "instantly respond to failed modules with no cache" $ runSession hlsCommand fullCaps "test/testdata" $ do
         doc <- openDoc "FuncTestFail.hs" "haskell"
         defs <- getDefinitions doc (Position 1 11)
-        liftIO $ defs @?= []
+        liftIO $ defs @?= InL []
 
     -- TODO: the benefits of caching parsed modules is doubted.
     -- TODO: add issue link
@@ -160,16 +160,16 @@ multiMainTests = testGroup "multiple main modules" [
     testCase "Can load one file at a time, when more than one Main module exists"
         $ runSession hlsCommand fullCaps "test/testdata" $ do
             _doc <- openDoc "ApplyRefact2.hs" "haskell"
-            _diagsRspHlint <- skipManyTill anyNotification message :: Session PublishDiagnosticsNotification
-            diagsRspGhc    <- skipManyTill anyNotification message :: Session PublishDiagnosticsNotification
+            _diagsRspHlint <- skipManyTill anyNotification (message STextDocumentPublishDiagnostics)
+            diagsRspGhc    <- skipManyTill anyNotification (message STextDocumentPublishDiagnostics)
             let (List diags) = diagsRspGhc ^. params . diagnostics
 
             liftIO $ length diags @?= 2
 
             _doc2 <- openDoc "HaReRename.hs" "haskell"
-            _diagsRspHlint2 <- skipManyTill anyNotification message :: Session PublishDiagnosticsNotification
+            _diagsRspHlint2 <- skipManyTill anyNotification (message STextDocumentPublishDiagnostics)
             -- errMsg <- skipManyTill anyNotification notification :: Session ShowMessageNotification
-            diagsRsp2 <- skipManyTill anyNotification message :: Session PublishDiagnosticsNotification
+            diagsRsp2 <- skipManyTill anyNotification (message STextDocumentPublishDiagnostics)
             let (List diags2) = diagsRsp2 ^. params . diagnostics
 
             liftIO $ show diags2 @?= "[]"

test/functional/Definition.hs

@@ -2,9 +2,9 @@ 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 Language.LSP.Test
+import Language.LSP.Types
+import Language.LSP.Types.Lens
 import System.Directory
 import Test.Hls.Util
 import Test.Tasty
@@ -19,7 +19,7 @@ tests = testGroup "definitions" [
         doc <- openDoc "References.hs" "haskell"
         defs <- getDefinitions doc (Position 7 8)
         let expRange = Range (Position 4 0) (Position 4 3)
-        liftIO $ defs @?= [Location (doc ^. uri) expRange]
+        liftIO $ defs @?= InL [Location (doc ^. uri) expRange]
 
   -- -----------------------------------
 
@@ -29,15 +29,15 @@ tests = testGroup "definitions" [
         defs <- getDefinitions doc (Position 2 8)
         liftIO $ do
             fp <- canonicalizePath "test/testdata/definition/Bar.hs"
-            defs @?= [Location (filePathToUri fp) zeroRange]
+            defs @?= InL [Location (filePathToUri fp) zeroRange]
 
   , ignoreTestBecause "Broken: file:///Users/jwindsor/src/haskell-language-server/test/testdata/Bar.hs" $
     testCase "goto's exported modules" $ runSession hlsCommand fullCaps "test/testdata/definition" $ do
         doc <- openDoc "Foo.hs" "haskell"
         defs <- getDefinitions doc (Position 0 15)
         liftIO $ do
             fp <- canonicalizePath "test/testdata/definition/Bar.hs"
-            defs @?= [Location (filePathToUri fp) zeroRange]
+            defs @?= InL [Location (filePathToUri fp) zeroRange]
 
   , ignoreTestBecause "Broken: file:///Users/jwindsor/src/haskell-language-server/test/testdata/Bar.hs" $
     testCase "goto's imported modules that are loaded" $ runSession hlsCommand fullCaps "test/testdata/definition" $ do
@@ -46,7 +46,7 @@ tests = testGroup "definitions" [
         defs <- getDefinitions doc (Position 2 8)
         liftIO $ do
             fp <- canonicalizePath "test/testdata/definition/Bar.hs"
-            defs @?= [Location (filePathToUri fp) zeroRange]
+            defs @?= InL [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" $
@@ -59,7 +59,7 @@ tests = testGroup "definitions" [
             liftIO $ putStrLn "D"
             liftIO $ do
                 fp <- canonicalizePath "test/testdata/definition/Bar.hs"
-                defs @?= [Location (filePathToUri fp) zeroRange]
+                defs @?= InL [Location (filePathToUri fp) zeroRange]
             liftIO $ putStrLn "E" -- AZ
 
             noDiagnostics

test/functional/Diagnostic.hs

@@ -8,9 +8,9 @@ import           Control.Monad.IO.Class
 import           Data.Aeson (toJSON)
 import qualified Data.Default
 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           Language.LSP.Test hiding (message)
+import           Language.LSP.Types
+import qualified Language.LSP.Types.Lens as LSP
 import           Test.Hls.Util
 import           Test.Tasty
 import           Test.Tasty.ExpectedFailure (ignoreTestBecause)
@@ -64,7 +64,7 @@ saveTests = testGroup  "only diagnostics on save" [
     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))
+            sendNotification SWorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
             doc <- openDoc "Hover.hs" "haskell"
             diags <- waitForDiagnosticsFrom doc
 
@@ -75,7 +75,7 @@ saveTests = testGroup  "only diagnostics on save" [
             _ <- applyEdit doc te
             skipManyTill loggingNotification noDiagnostics
 
-            sendNotification TextDocumentDidSave (DidSaveTextDocumentParams doc)
+            sendNotification STextDocumentDidSave (DidSaveTextDocumentParams doc Nothing)
             diags2 <- waitForDiagnosticsFrom doc
             liftIO $
                 length diags2 @?= 1