1 {-# LANGUAGE DuplicateRecordFields #-}
2 {-# LANGUAGE OverloadedStrings #-}
3 {-# LANGUAGE DeriveGeneric #-}
4 {-# LANGUAGE DeriveAnyClass #-}
8 import qualified Data.HashMap.Strict as HM
10 import Control.Concurrent
11 import Control.Monad.IO.Class
12 import Control.Lens hiding (List)
14 import Language.Haskell.LSP.Test
15 import Language.Haskell.LSP.Test.Replay
16 import Language.Haskell.LSP.TH.ClientCapabilities
17 import Language.Haskell.LSP.Types hiding (capabilities)
21 describe "manual session" $ do
23 runSession "hie --lsp" "test/data/renamePass" $ do
24 doc <- openDoc "Desktop/simple.hs" "haskell"
26 skipMany loggingNotification
30 rspSymbols <- documentSymbols doc
33 let (List symbols) = fromJust (rspSymbols ^. result)
34 mainSymbol = head symbols
35 mainSymbol ^. name `shouldBe` "main"
36 mainSymbol ^. kind `shouldBe` SkFunction
37 mainSymbol ^. location . range `shouldBe` Range (Position 3 0) (Position 3 4)
38 mainSymbol ^. containerName `shouldBe` Nothing
41 -- TODO: Catch the exception in haskell-lsp-test and provide nicer output
42 let session = runSession "hie --lsp" "test/data/renamePass" $ do
43 openDoc "Desktop/simple.hs" "haskell"
44 skipMany loggingNotification
46 in session `shouldThrow` anyException
47 it "can get initialize response" $ runSession "hie --lsp" "test/data/renamePass" $ do
48 rsp <- getInitializeResponse
49 liftIO $ rsp ^. result `shouldNotBe` Nothing
51 it "can register specific capabilities" $ do
52 let caps = def { _workspace = Just workspaceCaps }
53 workspaceCaps = def { _didChangeConfiguration = Just configCaps }
54 configCaps = DidChangeConfigurationClientCapabilities (Just True)
55 conf = def { capabilities = caps }
56 runSessionWithConfig conf "hie --lsp" "test/data/renamePass" $ return ()
59 let sesh = runSessionWithConfig (def {timeout = 10}) "hie --lsp" "test/data/renamePass" $ do
60 skipMany loggingNotification
61 _ <- request :: Session ApplyWorkspaceEditRequest
63 in sesh `shouldThrow` anySessionException
65 it "doesn't time out" $ runSessionWithConfig (def {timeout = 10}) "hie --lsp" "test/data/renamePass" $ do
67 liftIO $ threadDelay 5
70 describe "replay session" $ do
72 replaySession "hie --lsp" "test/data/renamePass" `shouldReturn` True
74 replaySession "hie --lsp" "test/data/renameFail" `shouldReturn` False
76 describe "manual javascript session" $
78 runSession "javascript-typescript-stdio" "test/data/javascriptPass" $ do
79 doc <- openDoc "test.js" "javascript"
83 rspSymbols <- documentSymbols doc
85 let (List symbols) = fromJust (rspSymbols ^. result)
86 fooSymbol = head symbols
88 fooSymbol ^. name `shouldBe` "foo"
89 fooSymbol ^. kind `shouldBe` SkFunction
91 describe "text document state" $
92 it "sends back didChange notifications" $
93 runSession "hie --lsp" "test/data/refactor" $ do
94 doc <- openDoc "Main.hs" "haskell"
96 let args = toJSON $ AOP (doc ^. uri)
99 reqParams = ExecuteCommandParams "applyrefact:applyOne" (Just (List [args]))
100 sendRequest WorkspaceExecuteCommand reqParams
101 skipMany anyNotification
102 _ <- response :: Session ExecuteCommandResponse
104 editReq <- request :: Session ApplyWorkspaceEditRequest
106 let (Just cs) = editReq ^. params . edit . changes
107 [(u, List es)] = HM.toList cs
108 u `shouldBe` doc ^. uri
109 es `shouldBe` [TextEdit (Range (Position 1 0) (Position 1 18)) "main = return 42"]
113 contents <- documentContents doc
114 liftIO $ contents `shouldBe` "main :: IO Int\nmain = return 42"
118 data ApplyOneParams = AOP
120 , start_pos :: Position
121 , hintTitle :: String
122 } deriving (Generic, ToJSON)
124 checkNoDiagnostics :: Session ()
125 checkNoDiagnostics = do
126 diagsNot <- notification :: Session PublishDiagnosticsNotification
127 liftIO $ diagsNot ^. params . diagnostics `shouldBe` List []
129 documentSymbols :: TextDocumentIdentifier -> Session DocumentSymbolsResponse
130 documentSymbols doc = do
131 sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams doc)