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.Messages
15 import Language.Haskell.LSP.Test
16 import Language.Haskell.LSP.Test.Replay
17 import Language.Haskell.LSP.TH.ClientCapabilities
18 import Language.Haskell.LSP.Types hiding (capabilities)
22 describe "manual session" $ do
24 runSession "hie --lsp" "test/data/renamePass" $ do
25 doc <- openDoc "Desktop/simple.hs" "haskell"
27 skipMany loggingNotification
31 rspSymbols <- documentSymbols doc
34 let (List symbols) = fromJust (rspSymbols ^. result)
35 mainSymbol = head symbols
36 mainSymbol ^. name `shouldBe` "main"
37 mainSymbol ^. kind `shouldBe` SkFunction
38 mainSymbol ^. location . range `shouldBe` Range (Position 3 0) (Position 3 4)
39 mainSymbol ^. containerName `shouldBe` Nothing
42 -- TODO: Catch the exception in haskell-lsp-test and provide nicer output
43 let session = runSession "hie --lsp" "test/data/renamePass" $ do
44 openDoc "Desktop/simple.hs" "haskell"
45 skipMany loggingNotification
47 in session `shouldThrow` anyException
48 it "can get initialize response" $ runSession "hie --lsp" "test/data/renamePass" $ do
49 rsp <- getInitializeResponse
50 liftIO $ rsp ^. result `shouldNotBe` Nothing
52 it "can register specific capabilities" $ do
53 let caps = def { _workspace = Just workspaceCaps }
54 workspaceCaps = def { _didChangeConfiguration = Just configCaps }
55 configCaps = DidChangeConfigurationClientCapabilities (Just True)
56 conf = def { capabilities = caps }
57 runSessionWithConfig conf "hie --lsp" "test/data/renamePass" $ return ()
59 describe "exceptions" $ do
60 it "throw on time out" $
61 let sesh = runSessionWithConfig (def {timeout = 10}) "hie --lsp" "test/data/renamePass" $ do
62 skipMany loggingNotification
63 _ <- request :: Session ApplyWorkspaceEditRequest
65 in sesh `shouldThrow` anySessionException
67 it "don't throw when no time out" $ runSessionWithConfig (def {timeout = 10}) "hie --lsp" "test/data/renamePass" $ do
69 liftIO $ threadDelay 5
71 it "throw when there's an unexpected message" $
72 let msgExc (UnexpectedMessageException "Publish diagnostics notification" (NotLogMessage _)) = True
74 in runSession "hie --lsp" "test/data/renamePass" publishDiagnosticsNotification `shouldThrow` msgExc
76 it "throw when there's an unexpected message 2" $
77 let msgExc (UnexpectedMessageException "Response" (NotPublishDiagnostics _)) = True
80 doc <- openDoc "Desktop/simple.hs" "haskell"
81 sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams doc)
82 skipMany anyNotification
83 response :: Session RenameResponse -- the wrong type
84 in runSession "hie --lsp" "test/data/renamePass" sesh
87 describe "replay session" $ do
89 replaySession "hie --lsp" "test/data/renamePass" `shouldReturn` True
91 replaySession "hie --lsp" "test/data/renameFail" `shouldReturn` False
93 describe "manual javascript session" $
95 runSession "javascript-typescript-stdio" "test/data/javascriptPass" $ do
96 doc <- openDoc "test.js" "javascript"
100 rspSymbols <- documentSymbols doc
102 let (List symbols) = fromJust (rspSymbols ^. result)
103 fooSymbol = head symbols
105 fooSymbol ^. name `shouldBe` "foo"
106 fooSymbol ^. kind `shouldBe` SkFunction
108 describe "text document state" $
109 it "sends back didChange notifications" $
110 runSession "hie --lsp" "test/data/refactor" $ do
111 doc <- openDoc "Main.hs" "haskell"
113 let args = toJSON $ AOP (doc ^. uri)
116 reqParams = ExecuteCommandParams "applyrefact:applyOne" (Just (List [args]))
117 sendRequest WorkspaceExecuteCommand reqParams
118 skipMany anyNotification
119 _ <- response :: Session ExecuteCommandResponse
121 editReq <- request :: Session ApplyWorkspaceEditRequest
123 let (Just cs) = editReq ^. params . edit . changes
124 [(u, List es)] = HM.toList cs
125 u `shouldBe` doc ^. uri
126 es `shouldBe` [TextEdit (Range (Position 1 0) (Position 1 18)) "main = return 42"]
130 contents <- documentContents doc
131 liftIO $ contents `shouldBe` "main :: IO Int\nmain = return 42"
135 data ApplyOneParams = AOP
137 , start_pos :: Position
138 , hintTitle :: String
139 } deriving (Generic, ToJSON)
141 checkNoDiagnostics :: Session ()
142 checkNoDiagnostics = do
143 diagsNot <- notification :: Session PublishDiagnosticsNotification
144 liftIO $ diagsNot ^. params . diagnostics `shouldBe` List []
146 documentSymbols :: TextDocumentIdentifier -> Session DocumentSymbolsResponse
147 documentSymbols doc = do
148 sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams doc)