import Control.Monad.IO.Class
import Control.Monad
import Control.Lens hiding (List)
-import GHC.Generics
import Language.Haskell.LSP.Messages
import Language.Haskell.LSP.Test
import Language.Haskell.LSP.Test.Replay
contents <- getDocumentEdit doc
liftIO $ contents `shouldBe` "howdy:: IO Int\nmain = return (42)\n"
- -- describe "getCodeActions" $
- -- it "works" $ runSession serverExe fullCaps "test/data/refactor" $ do
- -- doc <- openDoc "Main.hs" "haskell"
- -- waitForDiagnostics
- -- [CACodeAction action] <- getCodeActions doc (Range (Position 1 14) (Position 1 18))
- -- liftIO $ action ^. title `shouldBe` "Apply hint:Redundant bracket"
+ describe "getCodeActions" $
+ it "works" $ runSession serverExe fullCaps "test/data/refactor" $ do
+ doc <- openDoc "Main.hs" "haskell"
+ waitForDiagnostics
+ [CACodeAction action] <- getCodeActions doc (Range (Position 1 14) (Position 1 18))
+ liftIO $ action ^. title `shouldBe` "Delete this"
describe "getAllCodeActions" $
it "works" $ runSession serverExe fullCaps "test/data/refactor" $ do
action ^. title `shouldBe` "Delete this"
action ^. command . _Just . command `shouldBe` "deleteThis"
- -- describe "getDocumentSymbols" $
- -- it "works" $ runSession serverExe fullCaps "test/data/renamePass" $ do
- -- doc <- openDoc "Desktop/simple.hs" "haskell"
-
- -- skipMany loggingNotification
+ describe "getDocumentSymbols" $
+ it "works" $ runSession serverExe fullCaps "test/data/renamePass" $ do
+ doc <- openDoc "Desktop/simple.hs" "haskell"
- -- noDiagnostics
+ skipMany loggingNotification
- -- Left (mainSymbol:_) <- getDocumentSymbols doc
+ Left (mainSymbol:_) <- getDocumentSymbols doc
- -- liftIO $ do
- -- mainSymbol ^. name `shouldBe` "main"
- -- mainSymbol ^. kind `shouldBe` SkFunction
- -- mainSymbol ^. range `shouldBe` Range (Position 3 0) (Position 5 30)
+ liftIO $ do
+ mainSymbol ^. name `shouldBe` "foo"
+ mainSymbol ^. kind `shouldBe` SkObject
+ mainSymbol ^. range `shouldBe` mkRange 0 0 3 6
describe "applyEdit" $ do
it "increments the version" $ runSession serverExe docChangesCaps "test/data/renamePass" $ do
-- defs <- getTypeDefinitions doc pos
-- liftIO $ defs `shouldBe` [Location (doc ^. uri) (mkRange 10 0 14 19)] -- Type definition
- -- describe "waitForDiagnosticsSource" $
- -- it "works" $ runSession serverExe fullCaps "test/data" $ do
- -- openDoc "Error.hs" "haskell"
- -- [diag] <- waitForDiagnosticsSource "bios"
- -- liftIO $ do
- -- diag ^. severity `shouldBe` Just DsError
- -- diag ^. source `shouldBe` Just "bios"
+ describe "waitForDiagnosticsSource" $
+ it "works" $ runSession serverExe fullCaps "test/data" $ do
+ openDoc "Error.hs" "haskell"
+ [diag] <- waitForDiagnosticsSource "dummy-server"
+ liftIO $ do
+ diag ^. severity `shouldBe` Just DsWarning
+ diag ^. source `shouldBe` Just "dummy-server"
-- describe "rename" $ do
-- it "works" $ pendingWith "HaRe not in hie-bios yet"
-- rename doc (Position 2 11) "bar"
-- documentContents doc >>= liftIO . (`shouldContain` "function bar()") . T.unpack
- -- describe "getHover" $
- -- it "works" $ runSession serverExe fullCaps "test/data/renamePass" $ do
- -- doc <- openDoc "Desktop/simple.hs" "haskell"
- -- hover <- getHover doc (Position 45 9)
- -- liftIO $ hover `shouldSatisfy` isJust
+ describe "getHover" $
+ it "works" $ runSession serverExe fullCaps "test/data/renamePass" $ do
+ doc <- openDoc "Desktop/simple.hs" "haskell"
+ hover <- getHover doc (Position 45 9)
+ liftIO $ hover `shouldSatisfy` isJust
-- describe "getHighlights" $
-- it "works" $ runSession serverExe fullCaps "test/data/renamePass" $ do
Nothing
SkObject
Nothing
- (Range (Position 0 0) (Position 0 1))
- (Range (Position 0 0) (Position 0 1))
+ (mkRange 0 0 3 6)
+ (mkRange 0 0 3 6)
Nothing
]
, didOpenTextDocumentNotificationHandler = pure $ \noti ->
threadDelay (2 * 10^6)
let NotificationMessage _ _ (DidOpenTextDocumentParams doc) = noti
TextDocumentItem uri _ _ _ = doc
- diag = Diagnostic (Range (Position 0 0) (Position 0 1))
+ diag = Diagnostic (mkRange 0 0 0 1)
(Just DsWarning)
(Just (NumberValue 42))
(Just "dummy-server")
reqId <- readMVar lfvar >>= getNextReqId
let RequestMessage _ _ _ (ExecuteCommandParams "doAnEdit" (Just (List [val])) _) = req
Success docUri = fromJSON val
- edit = List [TextEdit (Range (Position 0 0) (Position 0 5)) "howdy"]
+ edit = List [TextEdit (mkRange 0 0 0 5) "howdy"]
send $ ReqApplyWorkspaceEdit $ fmServerApplyWorkspaceEditRequest reqId $
ApplyWorkspaceEditParams $ WorkspaceEdit (Just (HM.singleton docUri edit))
Nothing
send $ RspCodeAction $ makeResponseMessage req caresults
}
where send msg = readMVar lfvar >>= \lf -> (sendFunc lf) msg
+
+mkRange sl sc el ec = Range (Position sl sc) (Position el ec)
\ No newline at end of file