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.Concurrent
  11 import           Control.Monad.IO.Class
  12 import           Control.Lens hiding (List)
  13 import           GHC.Generics
  14 import           Language.Haskell.LSP.Messages
  15 import           Language.Haskell.LSP.Test
  16 import           Language.Haskell.LSP.Test.Replay
  17 import           Language.Haskell.LSP.TH.ClientCapabilities
  18 import           Language.Haskell.LSP.Types hiding (capabilities)
  19 import           ParsingTests
  20
  21 main = hspec $ do
  22   describe "manual session" $ do
  23     it "passes a test" $
  24       runSession "hie --lsp" "test/data/renamePass" $ do
  25         doc <- openDoc "Desktop/simple.hs" "haskell"
  26
  27         skipMany loggingNotification
  28
  29         checkNoDiagnostics
  30
  31         rspSymbols <- documentSymbols doc
  32
  33         liftIO $ do
  34           let (List symbols) = fromJust (rspSymbols ^. result)
  35               mainSymbol = head symbols
  36           mainSymbol ^. name `shouldBe` "main"
  37           mainSymbol ^. kind `shouldBe` SkFunction
  38           mainSymbol ^. location . range `shouldBe` Range (Position 3 0) (Position 3 4)
  39           mainSymbol ^. containerName `shouldBe` Nothing
  40
  41     it "fails a test" $
  42       -- TODO: Catch the exception in haskell-lsp-test and provide nicer output
  43       let session = runSession "hie --lsp" "test/data/renamePass" $ do
  44                       openDoc "Desktop/simple.hs" "haskell"
  45                       skipMany loggingNotification
  46                       anyRequest
  47         in session `shouldThrow` anyException
  48     it "can get initialize response" $ runSession "hie --lsp" "test/data/renamePass" $ do
  49       rsp <- getInitializeResponse
  50       liftIO $ rsp ^. result `shouldNotBe` Nothing
  51
  52     it "can register specific capabilities" $ do
  53       let caps = def { _workspace = Just workspaceCaps }
  54           workspaceCaps = def { _didChangeConfiguration = Just configCaps }
  55           configCaps = DidChangeConfigurationClientCapabilities (Just True)
  56           conf = def { capabilities = caps }
  57       runSessionWithConfig conf "hie --lsp" "test/data/renamePass" $ return ()
  58
  59     describe "exceptions" $ do
  60       it "throw on time out" $
  61         let sesh = runSessionWithConfig (def {timeout = 10}) "hie --lsp" "test/data/renamePass" $ do
  62                 skipMany loggingNotification
  63                 _ <- request :: Session ApplyWorkspaceEditRequest
  64                 return ()
  65         in sesh `shouldThrow` anySessionException
  66
  67       it "don't throw when no time out" $ runSessionWithConfig (def {timeout = 10}) "hie --lsp" "test/data/renamePass" $ do
  68         loggingNotification
  69         liftIO $ threadDelay 5
  70
  71       it "throw when there's an unexpected message" $
  72         let msgExc (UnexpectedMessageException "Publish diagnostics notification" (NotLogMessage _)) = True
  73             msgExc _ = False
  74           in runSession "hie --lsp" "test/data/renamePass" publishDiagnosticsNotification `shouldThrow` msgExc
  75
  76       it "throw when there's an unexpected message 2" $
  77         let msgExc (UnexpectedMessageException "Response" (NotPublishDiagnostics _)) = True
  78             msgExc _ = False
  79             sesh = do
  80               doc <- openDoc "Desktop/simple.hs" "haskell"
  81               sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams doc)
  82               skipMany anyNotification
  83               response :: Session RenameResponse -- the wrong type
  84           in runSession "hie --lsp" "test/data/renamePass" sesh
  85             `shouldThrow` msgExc
  86
  87   describe "replay session" $ do
  88     it "passes a test" $
  89       replaySession "hie --lsp" "test/data/renamePass" `shouldReturn` True
  90     it "fails a test" $
  91       replaySession "hie --lsp" "test/data/renameFail" `shouldReturn` False
  92
  93   describe "manual javascript session" $
  94     it "passes a test" $
  95       runSession "javascript-typescript-stdio" "test/data/javascriptPass" $ do
  96         doc <- openDoc "test.js" "javascript"
  97
  98         checkNoDiagnostics
  99
 100         rspSymbols <- documentSymbols doc
 101
 102         let (List symbols) = fromJust (rspSymbols ^. result)
 103             fooSymbol = head symbols
 104         liftIO $ do
 105           fooSymbol ^. name `shouldBe` "foo"
 106           fooSymbol ^. kind `shouldBe` SkFunction
 107
 108   describe "text document state" $
 109     it "sends back didChange notifications" $
 110       runSession "hie --lsp" "test/data/refactor" $ do
 111         doc <- openDoc "Main.hs" "haskell"
 112
 113         let args = toJSON $ AOP (doc ^. uri)
 114                                 (Position 1 14)
 115                                 "Redundant bracket"
 116             reqParams = ExecuteCommandParams "applyrefact:applyOne" (Just (List [args]))
 117         sendRequest WorkspaceExecuteCommand reqParams
 118         skipMany anyNotification
 119         _ <- response :: Session ExecuteCommandResponse
 120
 121         editReq <- request :: Session ApplyWorkspaceEditRequest
 122         liftIO $ do
 123           let (Just cs) = editReq ^. params . edit . changes
 124               [(u, List es)] = HM.toList cs
 125           u `shouldBe` doc ^. uri
 126           es `shouldBe` [TextEdit (Range (Position 1 0) (Position 1 18)) "main = return 42"]
 127
 128         checkNoDiagnostics
 129
 130         contents <- documentContents doc
 131         liftIO $ contents `shouldBe` "main :: IO Int\nmain = return 42"
 132
 133   parsingSpec
 134
 135 data ApplyOneParams = AOP
 136   { file      :: Uri
 137   , start_pos :: Position
 138   , hintTitle :: String
 139   } deriving (Generic, ToJSON)
 140
 141 checkNoDiagnostics :: Session ()
 142 checkNoDiagnostics = do
 143   diagsNot <- notification :: Session PublishDiagnosticsNotification
 144   liftIO $ diagsNot ^. params . diagnostics `shouldBe` List []
 145
 146 documentSymbols :: TextDocumentIdentifier -> Session DocumentSymbolsResponse
 147 documentSymbols doc = do
 148   sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams doc)
 149   response