import Language.Haskell.LSP.Messages
import Language.Haskell.LSP.Test
import Language.Haskell.LSP.Test.Replay
import Language.Haskell.LSP.Messages
import Language.Haskell.LSP.Test
import Language.Haskell.LSP.Test.Replay
openDoc "Desktop/simple.hs" "haskell"
skipMany loggingNotification
anyRequest
in session `shouldThrow` anyException
openDoc "Desktop/simple.hs" "haskell"
skipMany loggingNotification
anyRequest
in session `shouldThrow` anyException
rsp <- initializeResponse
liftIO $ rsp ^. result `shouldNotBe` Nothing
it "runSessionWithConfig" $
rsp <- initializeResponse
liftIO $ rsp ^. result `shouldNotBe` Nothing
it "runSessionWithConfig" $
openDoc "Desktop/simple.hs" "haskell"
-- won't receive a request - will timeout
-- incoming logging requests shouldn't increase the
openDoc "Desktop/simple.hs" "haskell"
-- won't receive a request - will timeout
-- incoming logging requests shouldn't increase the
openDoc "Desktop/simple.hs" "haskell"
withTimeout 5 $ skipManyTill anyMessage publishDiagnosticsNotification
in void $ timeout 6000000 sesh
openDoc "Desktop/simple.hs" "haskell"
withTimeout 5 $ skipManyTill anyMessage publishDiagnosticsNotification
in void $ timeout 6000000 sesh
doc <- openDoc "Desktop/simple.hs" "haskell"
withTimeout 3 $ getDocumentSymbols doc
liftIO $ threadDelay 5000000
doc <- openDoc "Desktop/simple.hs" "haskell"
withTimeout 3 $ getDocumentSymbols doc
liftIO $ threadDelay 5000000
doc <- openDoc "Desktop/simple.hs" "haskell"
-- shouldn't time out in here since we are overriding it
withTimeout 10 $ liftIO $ threadDelay 7000000
doc <- openDoc "Desktop/simple.hs" "haskell"
-- shouldn't time out in here since we are overriding it
withTimeout 10 $ liftIO $ threadDelay 7000000
doc <- openDoc "Desktop/simple.hs" "haskell"
-- shouldn't time out in here since we are overriding it
withTimeout 10 $ liftIO $ threadDelay 7000000
doc <- openDoc "Desktop/simple.hs" "haskell"
-- shouldn't time out in here since we are overriding it
withTimeout 10 $ liftIO $ threadDelay 7000000
skipMany loggingNotification
_ <- message :: Session ApplyWorkspaceEditRequest
return ()
in sesh `shouldThrow` anySessionException
skipMany loggingNotification
_ <- message :: Session ApplyWorkspaceEditRequest
return ()
in sesh `shouldThrow` anySessionException
it "throws when there's an unexpected message" $
let selector (UnexpectedMessage "Publish diagnostics notification" (NotLogMessage _)) = True
selector _ = False
it "throws when there's an unexpected message" $
let selector (UnexpectedMessage "Publish diagnostics notification" (NotLogMessage _)) = True
selector _ = False
it "provides the correct types that were expected and received" $
let selector (UnexpectedMessage "ResponseMessage WorkspaceEdit" (RspDocumentSymbols _)) = True
selector _ = False
sesh = do
doc <- openDoc "Desktop/simple.hs" "haskell"
it "provides the correct types that were expected and received" $
let selector (UnexpectedMessage "ResponseMessage WorkspaceEdit" (RspDocumentSymbols _)) = True
selector _ = False
sesh = do
doc <- openDoc "Desktop/simple.hs" "haskell"
doc <- openDoc "Main.hs" "haskell"
let args = toJSON $ AOP (doc ^. uri)
(Position 1 14)
"Redundant bracket"
reqParams = ExecuteCommandParams "applyrefact:applyOne" (Just (List [args]))
doc <- openDoc "Main.hs" "haskell"
let args = toJSON $ AOP (doc ^. uri)
(Position 1 14)
"Redundant bracket"
reqParams = ExecuteCommandParams "applyrefact:applyOne" (Just (List [args]))
doc <- openDoc "Main.hs" "haskell"
let args = toJSON $ AOP (doc ^. uri)
(Position 1 14)
"Redundant bracket"
reqParams = ExecuteCommandParams "applyrefact:applyOne" (Just (List [args]))
doc <- openDoc "Main.hs" "haskell"
let args = toJSON $ AOP (doc ^. uri)
(Position 1 14)
"Redundant bracket"
reqParams = ExecuteCommandParams "applyrefact:applyOne" (Just (List [args]))
contents <- getDocumentEdit doc
liftIO $ contents `shouldBe` "main :: IO Int\nmain = return 42\n"
noDiagnostics
describe "getAllCodeActions" $
contents <- getDocumentEdit doc
liftIO $ contents `shouldBe` "main :: IO Int\nmain = return 42\n"
noDiagnostics
describe "getAllCodeActions" $
doc <- openDoc "Desktop/simple.hs" "haskell"
VersionedTextDocumentIdentifier _ (Just oldVersion) <- getVersionedDoc doc
let edit = TextEdit (Range (Position 1 1) (Position 1 3)) "foo"
VersionedTextDocumentIdentifier _ (Just newVersion) <- applyEdit doc edit
liftIO $ newVersion `shouldBe` oldVersion + 1
doc <- openDoc "Desktop/simple.hs" "haskell"
VersionedTextDocumentIdentifier _ (Just oldVersion) <- getVersionedDoc doc
let edit = TextEdit (Range (Position 1 1) (Position 1 3)) "foo"
VersionedTextDocumentIdentifier _ (Just newVersion) <- applyEdit doc edit
liftIO $ newVersion `shouldBe` oldVersion + 1
doc <- openDoc "Desktop/simple.hs" "haskell"
let edit = TextEdit (Range (Position 0 0) (Position 0 2)) "foo"
applyEdit doc edit
doc <- openDoc "Desktop/simple.hs" "haskell"
let edit = TextEdit (Range (Position 0 0) (Position 0 2)) "foo"
applyEdit doc edit
liftIO $ do
item ^. label `shouldBe` "interactWithUser"
item ^. kind `shouldBe` Just CiFunction
item ^. detail `shouldBe` Just "Items -> IO ()\nMain"
describe "getReferences" $
liftIO $ do
item ^. label `shouldBe` "interactWithUser"
item ^. kind `shouldBe` Just CiFunction
item ^. detail `shouldBe` Just "Items -> IO ()\nMain"
describe "getReferences" $
doc <- openDoc "Desktop/simple.hs" "haskell"
let pos = Position 49 25 -- addItem
defs <- getDefinitions doc pos
liftIO $ defs `shouldBe` [Location (doc ^. uri) (mkRange 28 0 28 7)]
describe "waitForDiagnosticsSource" $
doc <- openDoc "Desktop/simple.hs" "haskell"
let pos = Position 49 25 -- addItem
defs <- getDefinitions doc pos
liftIO $ defs `shouldBe` [Location (doc ^. uri) (mkRange 28 0 28 7)]
describe "waitForDiagnosticsSource" $
doc <- openDoc "Rename.hs" "haskell"
rename doc (Position 1 0) "bar"
documentContents doc >>= liftIO . shouldBe "main = bar\nbar = return 42\n"
describe "getHover" $
doc <- openDoc "Rename.hs" "haskell"
rename doc (Position 1 0) "bar"
documentContents doc >>= liftIO . shouldBe "main = bar\nbar = return 42\n"
describe "getHover" $
doc <- openDoc "Desktop/simple.hs" "haskell"
-- hover returns nothing until module is loaded
skipManyTill loggingNotification $ count 2 noDiagnostics
doc <- openDoc "Desktop/simple.hs" "haskell"
-- hover returns nothing until module is loaded
skipManyTill loggingNotification $ count 2 noDiagnostics
doc <- openDoc "Desktop/simple.hs" "haskell"
skipManyTill loggingNotification $ count 2 noDiagnostics
highlights <- getHighlights doc (Position 27 4) -- addItem
liftIO $ length highlights `shouldBe` 4
describe "formatDoc" $
doc <- openDoc "Desktop/simple.hs" "haskell"
skipManyTill loggingNotification $ count 2 noDiagnostics
highlights <- getHighlights doc (Position 27 4) -- addItem
liftIO $ length highlights `shouldBe` 4
describe "formatDoc" $
doc <- openDoc "Format.hs" "haskell"
oldContents <- documentContents doc
formatDoc doc (FormattingOptions 4 True)
documentContents doc >>= liftIO . (`shouldNotBe` oldContents)
describe "formatRange" $
doc <- openDoc "Format.hs" "haskell"
oldContents <- documentContents doc
formatDoc doc (FormattingOptions 4 True)
documentContents doc >>= liftIO . (`shouldNotBe` oldContents)
describe "formatRange" $
doc <- openDoc "Format.hs" "haskell"
oldContents <- documentContents doc
formatRange doc (FormattingOptions 4 True) (Range (Position 1 10) (Position 2 10))
documentContents doc >>= liftIO . (`shouldNotBe` oldContents)
doc <- openDoc "Format.hs" "haskell"
oldContents <- documentContents doc
formatRange doc (FormattingOptions 4 True) (Range (Position 1 10) (Position 2 10))
documentContents doc >>= liftIO . (`shouldNotBe` oldContents)
+ describe "closeDoc" $
+ it "works" $
+ let sesh =
+ runSession "hie --lsp" fullCaps "test/data" $ do
+ doc <- openDoc "Format.hs" "haskell"
+ closeDoc doc
+ -- need to evaluate to throw
+ documentContents doc >>= liftIO . print
+ in sesh `shouldThrow` anyException
+