test/Test.hs

   1 {-# LANGUAGE DuplicateRecordFields #-}
   2 {-# LANGUAGE OverloadedStrings #-}
   3 {-# LANGUAGE DeriveGeneric #-}
   4 {-# LANGUAGE DeriveAnyClass #-}
   5 import           Test.Hspec
   6 import           Data.Aeson
   7 import           Data.Default
   8 import qualified Data.HashMap.Strict as HM
   9 import           Data.Maybe
  10 import           Control.Monad.IO.Class
  11 import           Control.Lens hiding (List)
  12 import           GHC.Generics
  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
  17 import           ParsingTests
  18
  19 main = hspec $ do
  20   describe "manual session" $ do
  21     it "passes a test" $
  22       runSession "hie --lsp" "test/data/renamePass" $ do
  23         doc <- openDoc "Desktop/simple.hs" "haskell"
  24
  25         skipMany loggingNotification
  26
  27         checkNoDiagnostics
  28
  29         rspSymbols <- documentSymbols doc
  30
  31         liftIO $ do
  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
  38
  39     it "fails a test" $
  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
  44                       anyRequest
  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
  49
  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 ()
  55
  56   describe "replay session" $ do
  57     it "passes a test" $
  58       replaySession "hie --lsp" "test/data/renamePass" `shouldReturn` True
  59     it "fails a test" $
  60       replaySession "hie --lsp" "test/data/renameFail" `shouldReturn` False
  61
  62   describe "manual javascript session" $
  63     it "passes a test" $
  64       runSession "javascript-typescript-stdio" "test/data/javascriptPass" $ do
  65         doc <- openDoc "test.js" "javascript"
  66
  67         checkNoDiagnostics
  68
  69         rspSymbols <- documentSymbols doc
  70
  71         let (List symbols) = fromJust (rspSymbols ^. result)
  72             fooSymbol = head symbols
  73         liftIO $ do
  74           fooSymbol ^. name `shouldBe` "foo"
  75           fooSymbol ^. kind `shouldBe` SkFunction
  76
  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"
  81
  82         let args = toJSON $ AOP (doc ^. uri)
  83                                 (Position 1 14)
  84                                 "Redundant bracket"
  85             reqParams = ExecuteCommandParams "applyrefact:applyOne" (Just (List [args]))
  86         sendRequest WorkspaceExecuteCommand reqParams
  87         skipMany anyNotification
  88         _ <- response :: Session ExecuteCommandResponse
  89
  90         editReq <- request :: Session ApplyWorkspaceEditRequest
  91         liftIO $ do
  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"]
  96
  97         checkNoDiagnostics
  98
  99         contents <- documentContents doc
 100         liftIO $ contents `shouldBe` "main :: IO Int\nmain = return 42"
 101
 102   parsingSpec
 103
 104 data ApplyOneParams = AOP
 105   { file      :: Uri
 106   , start_pos :: Position
 107   , hintTitle :: String
 108   } deriving (Generic, ToJSON)
 109
 110 checkNoDiagnostics :: Session ()
 111 checkNoDiagnostics = do
 112   diagsNot <- notification :: Session PublishDiagnosticsNotification
 113   liftIO $ diagsNot ^. params . diagnostics `shouldBe` List []
 114
 115 documentSymbols :: TextDocumentIdentifier -> Session DocumentSymbolsResponse
 116 documentSymbols doc = do
 117   sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams doc)
 118   response