1 {-# LANGUAGE DuplicateRecordFields #-}
2 {-# LANGUAGE OverloadedStrings #-}
3 {-# LANGUAGE DeriveGeneric #-}
4 {-# LANGUAGE DeriveAnyClass #-}
7 import qualified Data.HashMap.Strict as HM
9 import Control.Monad.IO.Class
10 import Control.Lens hiding (List)
12 import Language.Haskell.LSP.Test
13 import Language.Haskell.LSP.Test.Replay
14 import Language.Haskell.LSP.Types
18 describe "manual session" $ do
20 runSession "hie --lsp" "test/data/renamePass" $ do
21 doc <- openDoc "Desktop/simple.hs" "haskell"
23 skipMany loggingNotification
27 rspSymbols <- documentSymbols doc
30 let (List symbols) = fromJust (rspSymbols ^. result)
31 mainSymbol = head symbols
32 mainSymbol ^. name `shouldBe` "main"
33 mainSymbol ^. kind `shouldBe` SkFunction
34 mainSymbol ^. location . range `shouldBe` Range (Position 3 0) (Position 3 4)
35 mainSymbol ^. containerName `shouldBe` Nothing
38 -- TODO: Catch the exception in haskell-lsp-test and provide nicer output
39 let session = runSession "hie --lsp" "test/data/renamePass" $ do
40 openDoc "Desktop/simple.hs" "haskell"
41 skipMany loggingNotification
43 in session `shouldThrow` anyException
44 it "can get initialize response" $ runSession "hie --lsp" "test/data/renamePass" $ do
45 rsp <- getInitializeResponse
46 liftIO $ rsp ^. result `shouldNotBe` Nothing
48 describe "replay session" $ do
50 replaySession "hie --lsp" "test/data/renamePass" `shouldReturn` True
52 replaySession "hie --lsp" "test/data/renameFail" `shouldReturn` False
54 describe "manual javascript session" $
56 runSession "javascript-typescript-stdio" "test/data/javascriptPass" $ do
57 doc <- openDoc "test.js" "javascript"
61 rspSymbols <- documentSymbols doc
63 let (List symbols) = fromJust (rspSymbols ^. result)
64 fooSymbol = head symbols
66 fooSymbol ^. name `shouldBe` "foo"
67 fooSymbol ^. kind `shouldBe` SkFunction
69 describe "text document state" $
70 it "sends back didChange notifications" $
71 runSession "hie --lsp" "test/data/refactor" $ do
72 doc <- openDoc "Main.hs" "haskell"
74 let args = toJSON $ AOP (doc ^. uri)
77 reqParams = ExecuteCommandParams "applyrefact:applyOne" (Just (List [args]))
78 sendRequest WorkspaceExecuteCommand reqParams
79 skipMany anyNotification
80 _ <- response :: Session ExecuteCommandResponse
82 editReq <- request :: Session ApplyWorkspaceEditRequest
84 let (Just cs) = editReq ^. params . edit . changes
85 [(u, List es)] = HM.toList cs
86 u `shouldBe` doc ^. uri
87 es `shouldBe` [TextEdit (Range (Position 1 0) (Position 1 18)) "main = return 42"]
91 contents <- documentContents doc
92 liftIO $ contents `shouldBe` "main :: IO Int\nmain = return 42"
96 data ApplyOneParams = AOP
98 , start_pos :: Position
100 } deriving (Generic, ToJSON)
102 checkNoDiagnostics :: Session ()
103 checkNoDiagnostics = do
104 diagsNot <- notification :: Session PublishDiagnosticsNotification
105 liftIO $ diagsNot ^. params . diagnostics `shouldBe` List []
107 documentSymbols :: TextDocumentIdentifier -> Session DocumentSymbolsResponse
108 documentSymbols doc = do
109 sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams doc)