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 = 5}) "hie --lsp" "test/data/renamePass" $ do
69 liftIO $ threadDelay 10
70 _ <- openDoc "Desktop/simple.hs" "haskell"
73 it "throw when there's an unexpected message" $
74 let selector (UnexpectedMessageException "Publish diagnostics notification" (NotLogMessage _)) = True
76 in runSession "hie --lsp" "test/data/renamePass" publishDiagnosticsNotification `shouldThrow` selector
78 it "throw when there's an unexpected message 2" $
79 let selector (UnexpectedMessageException "Response" (NotPublishDiagnostics _)) = True
82 doc <- openDoc "Desktop/simple.hs" "haskell"
83 sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams doc)
84 skipMany anyNotification
85 response :: Session RenameResponse -- the wrong type
86 in runSession "hie --lsp" "test/data/renamePass" sesh
87 `shouldThrow` selector
89 describe "replay session" $ do
91 replaySession "hie --lsp" "test/data/renamePass"
93 let selector (ReplayOutOfOrderException _ _) = True
95 in replaySession "hie --lsp" "test/data/renameFail" `shouldThrow` selector
97 describe "manual javascript session" $
99 runSession "javascript-typescript-stdio" "test/data/javascriptPass" $ do
100 doc <- openDoc "test.js" "javascript"
104 rspSymbols <- documentSymbols doc
106 let (List symbols) = fromJust (rspSymbols ^. result)
107 fooSymbol = head symbols
109 fooSymbol ^. name `shouldBe` "foo"
110 fooSymbol ^. kind `shouldBe` SkFunction
112 describe "text document state" $
113 it "sends back didChange notifications" $
114 runSession "hie --lsp" "test/data/refactor" $ do
115 doc <- openDoc "Main.hs" "haskell"
117 let args = toJSON $ AOP (doc ^. uri)
120 reqParams = ExecuteCommandParams "applyrefact:applyOne" (Just (List [args]))
121 sendRequest WorkspaceExecuteCommand reqParams
122 skipMany anyNotification
123 _ <- response :: Session ExecuteCommandResponse
125 editReq <- request :: Session ApplyWorkspaceEditRequest
127 let (Just cs) = editReq ^. params . edit . changes
128 [(u, List es)] = HM.toList cs
129 u `shouldBe` doc ^. uri
130 es `shouldBe` [TextEdit (Range (Position 1 0) (Position 1 18)) "main = return 42"]
134 contents <- documentContents doc
135 liftIO $ contents `shouldBe` "main :: IO Int\nmain = return 42"
139 data ApplyOneParams = AOP
141 , start_pos :: Position
142 , hintTitle :: String
143 } deriving (Generic, ToJSON)
145 checkNoDiagnostics :: Session ()
146 checkNoDiagnostics = do
147 diagsNot <- notification :: Session PublishDiagnosticsNotification
148 liftIO $ diagsNot ^. params . diagnostics `shouldBe` List []
150 documentSymbols :: TextDocumentIdentifier -> Session DocumentSymbolsResponse
151 documentSymbols doc = do
152 sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams doc)