1 {-# LANGUAGE DuplicateRecordFields #-}
2 {-# LANGUAGE OverloadedStrings #-}
3 {-# LANGUAGE DeriveGeneric #-}
4 {-# LANGUAGE DeriveAnyClass #-}
8 import qualified Data.HashMap.Strict as HM
10 import Control.Monad.IO.Class
11 import Control.Lens hiding (List)
13 import Language.Haskell.LSP.Test
14 import Language.Haskell.LSP.Test.Replay
15 import Language.Haskell.LSP.TH.ClientCapabilities
16 import Language.Haskell.LSP.Types
20 describe "manual session" $ do
22 runSession "hie --lsp" "test/data/renamePass" $ do
23 doc <- openDoc "Desktop/simple.hs" "haskell"
25 skipMany loggingNotification
29 rspSymbols <- documentSymbols doc
32 let (List symbols) = fromJust (rspSymbols ^. result)
33 mainSymbol = head symbols
34 mainSymbol ^. name `shouldBe` "main"
35 mainSymbol ^. kind `shouldBe` SkFunction
36 mainSymbol ^. location . range `shouldBe` Range (Position 3 0) (Position 3 4)
37 mainSymbol ^. containerName `shouldBe` Nothing
40 -- TODO: Catch the exception in haskell-lsp-test and provide nicer output
41 let session = runSession "hie --lsp" "test/data/renamePass" $ do
42 openDoc "Desktop/simple.hs" "haskell"
43 skipMany loggingNotification
45 in session `shouldThrow` anyException
46 it "can get initialize response" $ runSession "hie --lsp" "test/data/renamePass" $ do
47 rsp <- getInitializeResponse
48 liftIO $ rsp ^. result `shouldNotBe` Nothing
50 it "can register specific capabilities" $ do
51 let caps = def { _workspace = Just workspaceCaps }
52 workspaceCaps = def { _didChangeConfiguration = Just configCaps }
53 configCaps = DidChangeConfigurationClientCapabilities (Just True)
54 runSessionWithCapabilities caps "hie --lsp" "test/data/renamePass" $ return ()
56 describe "replay session" $ do
58 replaySession "hie --lsp" "test/data/renamePass" `shouldReturn` True
60 replaySession "hie --lsp" "test/data/renameFail" `shouldReturn` False
62 describe "manual javascript session" $
64 runSession "javascript-typescript-stdio" "test/data/javascriptPass" $ do
65 doc <- openDoc "test.js" "javascript"
69 rspSymbols <- documentSymbols doc
71 let (List symbols) = fromJust (rspSymbols ^. result)
72 fooSymbol = head symbols
74 fooSymbol ^. name `shouldBe` "foo"
75 fooSymbol ^. kind `shouldBe` SkFunction
77 describe "text document state" $
78 it "sends back didChange notifications" $
79 runSession "hie --lsp" "test/data/refactor" $ do
80 doc <- openDoc "Main.hs" "haskell"
82 let args = toJSON $ AOP (doc ^. uri)
85 reqParams = ExecuteCommandParams "applyrefact:applyOne" (Just (List [args]))
86 sendRequest WorkspaceExecuteCommand reqParams
87 skipMany anyNotification
88 _ <- response :: Session ExecuteCommandResponse
90 editReq <- request :: Session ApplyWorkspaceEditRequest
92 let (Just cs) = editReq ^. params . edit . changes
93 [(u, List es)] = HM.toList cs
94 u `shouldBe` doc ^. uri
95 es `shouldBe` [TextEdit (Range (Position 1 0) (Position 1 18)) "main = return 42"]
99 contents <- documentContents doc
100 liftIO $ contents `shouldBe` "main :: IO Int\nmain = return 42"
104 data ApplyOneParams = AOP
106 , start_pos :: Position
107 , hintTitle :: String
108 } deriving (Generic, ToJSON)
110 checkNoDiagnostics :: Session ()
111 checkNoDiagnostics = do
112 diagsNot <- notification :: Session PublishDiagnosticsNotification
113 liftIO $ diagsNot ^. params . diagnostics `shouldBe` List []
115 documentSymbols :: TextDocumentIdentifier -> Session DocumentSymbolsResponse
116 documentSymbols doc = do
117 sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams doc)