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   parsingSpec
 100
 101 data ApplyOneParams = AOP
 102   { file      :: Uri
 103   , start_pos :: Position
 104   , hintTitle :: String
 105   } deriving (Generic, ToJSON)
 106
 107 checkNoDiagnostics :: Session ()
 108 checkNoDiagnostics = do
 109   diagsNot <- notification :: Session PublishDiagnosticsNotification
 110   liftIO $ diagsNot ^. params . diagnostics `shouldBe` List []
 111
 112 documentSymbols :: TextDocumentIdentifier -> Session DocumentSymbolsResponse
 113 documentSymbols doc = do
 114   sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams doc)
 115   response