test/Test.hs

   1 {-# LANGUAGE DuplicateRecordFields #-}
   2 {-# LANGUAGE OverloadedStrings #-}
   3 import           Test.Hspec
   4 import           Data.Maybe
   5 import           Control.Monad.IO.Class
   6 import           Control.Lens hiding (List)
   7 import           Language.Haskell.LSP.Test
   8 import           Language.Haskell.LSP.Test.Replay
   9 import           Language.Haskell.LSP.Types
  10 import           ParsingTests
  11
  12 main = hspec $ do
  13   describe "manual session" $ do
  14     it "passes a test" $
  15       runSession "test/recordings/renamePass" $ do
  16         doc <- openDoc "Desktop/simple.hs" "haskell"
  17
  18         skipMany loggingNotification
  19
  20         diagsNot <- notification :: Session PublishDiagnosticsNotification
  21
  22         liftIO $ diagsNot ^. params . diagnostics `shouldBe` List []
  23
  24         sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams doc)
  25
  26         rspSymbols <- response :: Session DocumentSymbolsResponse
  27
  28         liftIO $ do
  29           let (List symbols) = fromJust (rspSymbols ^. result)
  30               mainSymbol = head symbols
  31           mainSymbol ^. name `shouldBe` "main"
  32           mainSymbol ^. kind `shouldBe` SkFunction
  33           mainSymbol ^. location . range `shouldBe` Range (Position 3 0) (Position 3 4)
  34           mainSymbol ^. containerName `shouldBe` Nothing
  35
  36     it "fails a test" $
  37       -- TODO: Catch the exception in haskell-lsp-test and provide nicer output
  38       let session = runSession "test/recordings/renamePass" $ do
  39                       openDoc "Desktop/simple.hs" "haskell"
  40                       skipMany loggingNotification
  41                       anyRequest
  42         in session `shouldThrow` anyException
  43
  44   describe "replay session" $ do
  45     it "passes a test" $
  46       replaySession "test/recordings/renamePass" `shouldReturn` True
  47     it "fails a test" $
  48       replaySession "test/recordings/renameFail" `shouldReturn` False
  49
  50   parsingSpec