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 qualified Data.HashMap.Strict as HM
   8 import           Data.Maybe
   9 import           Control.Monad.IO.Class
  10 import           Control.Lens hiding (List)
  11 import           GHC.Generics
  12 import           Language.Haskell.LSP.Test
  13 import           Language.Haskell.LSP.Test.Replay
  14 import           Language.Haskell.LSP.Types
  15 import           ParsingTests
  16
  17 main = hspec $ do
  18   describe "manual session" $ do
  19     it "passes a test" $
  20       runSession "hie --lsp" "test/data/renamePass" $ do
  21         doc <- openDoc "Desktop/simple.hs" "haskell"
  22
  23         skipMany loggingNotification
  24
  25         checkNoDiagnostics
  26
  27         rspSymbols <- documentSymbols doc
  28
  29         liftIO $ do
  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
  36
  37     it "fails a test" $
  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
  42                       anyRequest
  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
  47
  48   describe "replay session" $ do
  49     it "passes a test" $
  50       replaySession "hie --lsp" "test/data/renamePass" `shouldReturn` True
  51     it "fails a test" $
  52       replaySession "hie --lsp" "test/data/renameFail" `shouldReturn` False
  53
  54   describe "manual javascript session" $
  55     it "passes a test" $
  56       runSession "javascript-typescript-stdio" "test/data/javascriptPass" $ do
  57         doc <- openDoc "test.js" "javascript"
  58
  59         checkNoDiagnostics
  60
  61         rspSymbols <- documentSymbols doc
  62
  63         let (List symbols) = fromJust (rspSymbols ^. result)
  64             fooSymbol = head symbols
  65         liftIO $ do
  66           fooSymbol ^. name `shouldBe` "foo"
  67           fooSymbol ^. kind `shouldBe` SkFunction
  68
  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"
  73
  74         let args = toJSON $ AOP (doc ^. uri)
  75                                 (Position 1 14)
  76                                 "Redundant bracket"
  77             reqParams = ExecuteCommandParams "applyrefact:applyOne" (Just (List [args]))
  78         sendRequest WorkspaceExecuteCommand reqParams
  79         skipMany anyNotification
  80         _ <- response :: Session ExecuteCommandResponse
  81
  82         editReq <- request :: Session ApplyWorkspaceEditRequest
  83         liftIO $ do
  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"]
  88
  89         checkNoDiagnostics
  90
  91   parsingSpec
  92
  93 data ApplyOneParams = AOP
  94   { file      :: Uri
  95   , start_pos :: Position
  96   , hintTitle :: String
  97   } deriving (Generic, ToJSON)
  98
  99 checkNoDiagnostics :: Session ()
 100 checkNoDiagnostics = do
 101   diagsNot <- notification :: Session PublishDiagnosticsNotification
 102   liftIO $ diagsNot ^. params . diagnostics `shouldBe` List []
 103
 104 documentSymbols :: TextDocumentIdentifier -> Session DocumentSymbolsResponse
 105 documentSymbols doc = do
 106   sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams doc)
 107   response