From e0926c045ccd5444f3112cb231cc3590c600d48d Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Thu, 26 Jul 2018 21:58:47 +0100 Subject: [PATCH] Make ClientCapabilities a mandatory parameter Closes #13 --- .gitignore | 2 + example/Main.hs | 2 +- haskell-lsp-test.cabal | 3 +- src/Language/Haskell/LSP/Test.hs | 15 +++-- src/Language/Haskell/LSP/Test/Capabilities.hs | 51 +++++++++++++++ src/Language/Haskell/LSP/Test/Replay.hs | 1 + src/Language/Haskell/LSP/Test/Session.hs | 16 +++-- test/Test.hs | 65 +++++++++---------- test/data/renamePass/session.log | 2 +- 9 files changed, 109 insertions(+), 48 deletions(-) create mode 100644 src/Language/Haskell/LSP/Test/Capabilities.hs diff --git a/.gitignore b/.gitignore index 93b38a2..f78eac2 100644 --- a/.gitignore +++ b/.gitignore @@ -6,3 +6,5 @@ cabal.project.local* **/.DS_Store *.swp +# used for rerunning failed hspec tests +.hspec-failures diff --git a/example/Main.hs b/example/Main.hs index c992b8e..a6bafe9 100644 --- a/example/Main.hs +++ b/example/Main.hs @@ -3,7 +3,7 @@ import Control.Monad.IO.Class import Language.Haskell.LSP.Test import Language.Haskell.LSP.Types -main = runSession "hie --lsp" "test/recordings/renamePass" $ do +main = runSession "hie --lsp" fullCaps "test/recordings/renamePass" $ do docItem <- openDoc "Desktop/simple.hs" "haskell" -- Use your favourite favourite combinators. diff --git a/haskell-lsp-test.cabal b/haskell-lsp-test.cabal index 860c29b..d3e9b20 100644 --- a/haskell-lsp-test.cabal +++ b/haskell-lsp-test.cabal @@ -46,7 +46,8 @@ library build-depends: Win32 else build-depends: unix - other-modules: Language.Haskell.LSP.Test.Compat + other-modules: Language.Haskell.LSP.Test.Capabilities + Language.Haskell.LSP.Test.Compat Language.Haskell.LSP.Test.Decoding Language.Haskell.LSP.Test.Exceptions Language.Haskell.LSP.Test.Files diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs index 60f13b1..aeae56b 100644 --- a/src/Language/Haskell/LSP/Test.hs +++ b/src/Language/Haskell/LSP/Test.hs @@ -24,6 +24,8 @@ module Language.Haskell.LSP.Test , SessionException(..) , anySessionException , withTimeout + -- * Capabilities + , fullCaps -- * Sending , sendRequest , sendRequest_ @@ -99,6 +101,7 @@ import qualified Language.Haskell.LSP.Types as LSP import qualified Language.Haskell.LSP.Types.Capabilities as LSP import Language.Haskell.LSP.Messages import Language.Haskell.LSP.VFS +import Language.Haskell.LSP.Test.Capabilities import Language.Haskell.LSP.Test.Compat import Language.Haskell.LSP.Test.Decoding import Language.Haskell.LSP.Test.Exceptions @@ -112,18 +115,20 @@ import qualified Yi.Rope as Rope -- | Starts a new session. runSession :: String -- ^ The command to run the server. + -> LSP.ClientCapabilities -- ^ The capabilities that the client should declare. -> FilePath -- ^ The filepath to the root directory for the session. -> Session a -- ^ The session to run. -> IO a runSession = runSessionWithConfig def -- | Starts a new sesion with a client with the specified capabilities. -runSessionWithConfig :: SessionConfig -- ^ The capabilities the client should have. +runSessionWithConfig :: SessionConfig -- ^ Configuration options for the session. -> String -- ^ The command to run the server. + -> LSP.ClientCapabilities -- ^ The capabilities that the client should declare. -> FilePath -- ^ The filepath to the root directory for the session. -> Session a -- ^ The session to run. -> IO a -runSessionWithConfig config serverExe rootDir session = do +runSessionWithConfig config serverExe caps rootDir session = do pid <- getCurrentProcessID absRootDir <- canonicalizePath rootDir @@ -131,10 +136,10 @@ runSessionWithConfig config serverExe rootDir session = do (Just $ T.pack absRootDir) (Just $ filePathToUri absRootDir) Nothing - (capabilities config) + caps (Just TraceOff) withServer serverExe (logStdErr config) $ \serverIn serverOut _ -> - runSessionWithHandles serverIn serverOut listenServer config rootDir $ do + runSessionWithHandles serverIn serverOut listenServer config caps rootDir $ do -- Wrap the session around initialize and shutdown calls initRspMsg <- sendRequest Initialize initializeParams :: Session InitializeResponse @@ -420,7 +425,7 @@ applyEdit doc edit = do verDoc <- getVersionedDoc doc - caps <- asks (capabilities . config) + caps <- asks sessionCapabilities let supportsDocChanges = fromMaybe False $ do let LSP.ClientCapabilities mWorkspace _ _ = caps diff --git a/src/Language/Haskell/LSP/Test/Capabilities.hs b/src/Language/Haskell/LSP/Test/Capabilities.hs new file mode 100644 index 0000000..f1237e3 --- /dev/null +++ b/src/Language/Haskell/LSP/Test/Capabilities.hs @@ -0,0 +1,51 @@ +module Language.Haskell.LSP.Test.Capabilities where +import Language.Haskell.LSP.Types +import Language.Haskell.LSP.Types.Capabilities + +-- | Capabilities for full conformance to the LSP specification. +-- The whole shebang. +fullCaps :: ClientCapabilities +fullCaps = ClientCapabilities (Just w) (Just td) Nothing + where + w = WorkspaceClientCapabilities + (Just True) + (Just (WorkspaceEditClientCapabilities (Just True))) + (Just (DidChangeConfigurationClientCapabilities (Just True))) + (Just (DidChangeWatchedFilesClientCapabilities (Just True))) + (Just (SymbolClientCapabilities (Just True))) + (Just (ExecuteClientCapabilities (Just True))) + td = TextDocumentClientCapabilities + (Just sync) + (Just (CompletionClientCapabilities + (Just True) + (Just (CompletionItemClientCapabilities (Just True))))) + (Just (HoverClientCapabilities (Just True))) + (Just (SignatureHelpClientCapabilities (Just True))) + (Just (ReferencesClientCapabilities (Just True))) + (Just (DocumentHighlightClientCapabilities (Just True))) + (Just (DocumentSymbolClientCapabilities (Just True))) + (Just (FormattingClientCapabilities (Just True))) + (Just (RangeFormattingClientCapabilities (Just True))) + (Just (OnTypeFormattingClientCapabilities (Just True))) + (Just (DefinitionClientCapabilities (Just True))) + (Just codeAction) + (Just (CodeLensClientCapabilities (Just True))) + (Just (DocumentLinkClientCapabilities (Just True))) + (Just (RenameClientCapabilities (Just True))) + sync = SynchronizationTextDocumentClientCapabilities + (Just True) + (Just True) + (Just True) + (Just True) + codeAction = CodeActionClientCapabilities + (Just True) + (Just (CodeActionLiteralSupport kinds)) + kinds = CodeActionKindValueSet + (List [ CodeActionQuickFix + , CodeActionRefactor + , CodeActionRefactorExtract + , CodeActionRefactorInline + , CodeActionRefactorRewrite + , CodeActionSource + , CodeActionSourceOrganizeImports + ]) diff --git a/src/Language/Haskell/LSP/Test/Replay.hs b/src/Language/Haskell/LSP/Test/Replay.hs index 979b789..23e6137 100644 --- a/src/Language/Haskell/LSP/Test/Replay.hs +++ b/src/Language/Haskell/LSP/Test/Replay.hs @@ -61,6 +61,7 @@ replaySession serverExe sessionDir = do serverOut (listenServer serverMsgs requestMap reqSema rspSema passSema mainThread) def + fullCaps sessionDir (sendMessages clientMsgs reqSema rspSema) takeMVar passSema diff --git a/src/Language/Haskell/LSP/Test/Session.hs b/src/Language/Haskell/LSP/Test/Session.hs index 218defb..c923478 100644 --- a/src/Language/Haskell/LSP/Test/Session.hs +++ b/src/Language/Haskell/LSP/Test/Session.hs @@ -72,13 +72,13 @@ type Session = ParserStateReader FromServerMessage SessionState SessionContext I -- | Stuff you can configure for a 'Session'. data SessionConfig = SessionConfig { - capabilities :: ClientCapabilities -- ^ Specific capabilities the client should advertise. Default is yes to everything. - , messageTimeout :: Int -- ^ Maximum time to wait for a message in seconds. Defaults to 60. - , logStdErr :: Bool -- ^ When True redirects the servers stderr output to haskell-lsp-test's stdout. Defaults to False + messageTimeout :: Int -- ^ Maximum time to wait for a message in seconds. Defaults to 60. + , logStdErr :: Bool -- ^ When True redirects the servers stderr output to haskell-lsp-test's stdout. Defaults to False. + , logMessages :: Bool -- ^ When True traces the communication between client and server to stdout. Defaults to True. } instance Default SessionConfig where - def = SessionConfig def 60 False + def = SessionConfig 60 False True data SessionMessage = ServerMessage FromServerMessage | TimeoutMessage Int @@ -92,6 +92,7 @@ data SessionContext = SessionContext , requestMap :: MVar RequestMap , initRsp :: MVar InitializeResponse , config :: SessionConfig + , sessionCapabilities :: ClientCapabilities } class Monad m => HasReader r m where @@ -170,10 +171,11 @@ runSessionWithHandles :: Handle -- ^ Server in -> Handle -- ^ Server out -> (Handle -> SessionContext -> IO ()) -- ^ Server listener -> SessionConfig - -> FilePath + -> ClientCapabilities + -> FilePath -- ^ Root directory -> Session a -> IO a -runSessionWithHandles serverIn serverOut serverHandler config rootDir session = do +runSessionWithHandles serverIn serverOut serverHandler config caps rootDir session = do absRootDir <- canonicalizePath rootDir hSetBuffering serverIn NoBuffering @@ -183,7 +185,7 @@ runSessionWithHandles serverIn serverOut serverHandler config rootDir session = messageChan <- newChan initRsp <- newEmptyMVar - let context = SessionContext serverIn absRootDir messageChan reqMap initRsp config + let context = SessionContext serverIn absRootDir messageChan reqMap initRsp config caps initState = SessionState (IdInt 0) mempty mempty 0 False Nothing threadId <- forkIO $ void $ serverHandler serverOut context diff --git a/test/Test.hs b/test/Test.hs index a4a4173..08c21be 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -29,22 +29,21 @@ main = hspec $ do describe "Session" $ do it "fails a test" $ -- TODO: Catch the exception in haskell-lsp-test and provide nicer output - let session = runSession "hie --lsp" "test/data/renamePass" $ do + let session = runSession "hie --lsp" fullCaps "test/data/renamePass" $ do openDoc "Desktop/simple.hs" "haskell" skipMany loggingNotification anyRequest in session `shouldThrow` anyException - it "initializeResponse" $ runSession "hie --lsp" "test/data/renamePass" $ do + it "initializeResponse" $ runSession "hie --lsp" fullCaps "test/data/renamePass" $ do rsp <- initializeResponse liftIO $ rsp ^. result `shouldNotBe` Nothing it "runSessionWithConfig" $ - runSessionWithConfig (def { capabilities = didChangeCaps }) - "hie --lsp" "test/data/renamePass" $ return () + runSession "hie --lsp" didChangeCaps "test/data/renamePass" $ return () describe "withTimeout" $ do it "times out" $ - let sesh = runSession "hie --lsp" "test/data/renamePass" $ do + let sesh = runSession "hie --lsp" fullCaps "test/data/renamePass" $ do openDoc "Desktop/simple.hs" "haskell" -- won't receive a request - will timeout -- incoming logging requests shouldn't increase the @@ -55,12 +54,12 @@ main = hspec $ do in timeout 6000000 sesh `shouldThrow` anySessionException it "doesn't time out" $ - let sesh = runSession "hie --lsp" "test/data/renamePass" $ do + let sesh = runSession "hie --lsp" fullCaps "test/data/renamePass" $ do openDoc "Desktop/simple.hs" "haskell" withTimeout 5 $ skipManyTill anyMessage publishDiagnosticsNotification in void $ timeout 6000000 sesh - it "further timeout messages are ignored" $ runSession "hie --lsp" "test/data/renamePass" $ do + it "further timeout messages are ignored" $ runSession "hie --lsp" fullCaps "test/data/renamePass" $ do doc <- openDoc "Desktop/simple.hs" "haskell" withTimeout 3 $ getDocumentSymbols doc liftIO $ threadDelay 5000000 @@ -70,7 +69,7 @@ main = hspec $ do it "overrides global message timeout" $ let sesh = - runSessionWithConfig (def { messageTimeout = 5 }) "hie --lsp" "test/data/renamePass" $ do + runSessionWithConfig (def { messageTimeout = 5 }) "hie --lsp" fullCaps "test/data/renamePass" $ do doc <- openDoc "Desktop/simple.hs" "haskell" -- shouldn't time out in here since we are overriding it withTimeout 10 $ liftIO $ threadDelay 7000000 @@ -80,7 +79,7 @@ main = hspec $ do it "unoverrides global message timeout" $ let sesh = - runSessionWithConfig (def { messageTimeout = 5 }) "hie --lsp" "test/data/renamePass" $ do + runSessionWithConfig (def { messageTimeout = 5 }) "hie --lsp" fullCaps "test/data/renamePass" $ do doc <- openDoc "Desktop/simple.hs" "haskell" -- shouldn't time out in here since we are overriding it withTimeout 10 $ liftIO $ threadDelay 7000000 @@ -92,13 +91,13 @@ main = hspec $ do describe "SessionException" $ do it "throw on time out" $ - let sesh = runSessionWithConfig (def {messageTimeout = 10}) "hie --lsp" "test/data/renamePass" $ do + let sesh = runSessionWithConfig (def {messageTimeout = 10}) "hie --lsp" fullCaps "test/data/renamePass" $ do skipMany loggingNotification _ <- message :: Session ApplyWorkspaceEditRequest return () in sesh `shouldThrow` anySessionException - it "don't throw when no time out" $ runSessionWithConfig (def {messageTimeout = 5}) "hie --lsp" "test/data/renamePass" $ do + it "don't throw when no time out" $ runSessionWithConfig (def {messageTimeout = 5}) "hie --lsp" fullCaps "test/data/renamePass" $ do loggingNotification liftIO $ threadDelay 10 _ <- openDoc "Desktop/simple.hs" "haskell" @@ -108,7 +107,7 @@ main = hspec $ do it "throws when there's an unexpected message" $ let selector (UnexpectedMessage "Publish diagnostics notification" (NotLogMessage _)) = True selector _ = False - in runSession "hie --lsp" "test/data/renamePass" publishDiagnosticsNotification `shouldThrow` selector + in runSession "hie --lsp" fullCaps "test/data/renamePass" publishDiagnosticsNotification `shouldThrow` selector it "provides the correct types that were expected and received" $ let selector (UnexpectedMessage "ResponseMessage WorkspaceEdit" (RspDocumentSymbols _)) = True selector _ = False @@ -117,7 +116,7 @@ main = hspec $ do sendRequest' TextDocumentDocumentSymbol (DocumentSymbolParams doc) skipMany anyNotification message :: Session RenameResponse -- the wrong type - in runSession "hie --lsp" "test/data/renamePass" sesh + in runSession "hie --lsp" fullCaps "test/data/renamePass" sesh `shouldThrow` selector describe "replaySession" $ do @@ -130,7 +129,7 @@ main = hspec $ do describe "manual javascript session" $ it "passes a test" $ - runSession "javascript-typescript-stdio" "test/data/javascriptPass" $ do + runSession "javascript-typescript-stdio" fullCaps "test/data/javascriptPass" $ do doc <- openDoc "test.js" "javascript" noDiagnostics @@ -143,7 +142,7 @@ main = hspec $ do describe "text document VFS" $ it "sends back didChange notifications" $ - runSession "hie --lsp" "test/data/refactor" $ do + runSession "hie --lsp" def "test/data/refactor" $ do doc <- openDoc "Main.hs" "haskell" let args = toJSON $ AOP (doc ^. uri) @@ -166,7 +165,7 @@ main = hspec $ do describe "getDocumentEdit" $ it "automatically consumes applyedit requests" $ - runSession "hie --lsp" "test/data/refactor" $ do + runSession "hie --lsp" fullCaps "test/data/refactor" $ do doc <- openDoc "Main.hs" "haskell" let args = toJSON $ AOP (doc ^. uri) @@ -179,17 +178,17 @@ main = hspec $ do noDiagnostics describe "getAllCodeActions" $ - it "works" $ runSession "hie --lsp" "test/data/refactor" $ do + it "works" $ runSession "hie --lsp" fullCaps "test/data/refactor" $ do doc <- openDoc "Main.hs" "haskell" _ <- waitForDiagnostics actions <- getAllCodeActions doc liftIO $ do - let [CommandOrCodeActionCommand action] = actions + let [CommandOrCodeActionCodeAction action] = actions action ^. title `shouldBe` "Apply hint:Redundant bracket" - action ^. command `shouldSatisfy` T.isSuffixOf ":applyrefact:applyOne" + action ^. command . _Just . command `shouldSatisfy` T.isSuffixOf ":applyrefact:applyOne" describe "getDocumentSymbols" $ - it "works" $ runSession "hie --lsp" "test/data/renamePass" $ do + it "works" $ runSession "hie --lsp" fullCaps "test/data/renamePass" $ do doc <- openDoc "Desktop/simple.hs" "haskell" skipMany loggingNotification @@ -205,13 +204,13 @@ main = hspec $ do mainSymbol ^. containerName `shouldBe` Nothing describe "applyEdit" $ do - it "increments the version" $ runSessionWithConfig (def { capabilities = docChangesCaps }) "hie --lsp" "test/data/renamePass" $ do + it "increments the version" $ runSession "hie --lsp" docChangesCaps "test/data/renamePass" $ do 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 - it "changes the document contents" $ runSession "hie --lsp" "test/data/renamePass" $ do + it "changes the document contents" $ runSession "hie --lsp" fullCaps "test/data/renamePass" $ do doc <- openDoc "Desktop/simple.hs" "haskell" let edit = TextEdit (Range (Position 0 0) (Position 0 2)) "foo" applyEdit doc edit @@ -219,16 +218,16 @@ main = hspec $ do liftIO $ contents `shouldSatisfy` T.isPrefixOf "foodule" describe "getCompletions" $ - it "works" $ runSession "hie --lsp" "test/data/renamePass" $ do + it "works" $ runSession "hie --lsp" def "test/data/renamePass" $ do doc <- openDoc "Desktop/simple.hs" "haskell" - [item] <- getCompletions doc (Position 5 5) + item:_ <- getCompletions doc (Position 5 5) liftIO $ do item ^. label `shouldBe` "interactWithUser" item ^. kind `shouldBe` Just CiFunction item ^. detail `shouldBe` Just "Items -> IO ()\nMain" describe "getReferences" $ - it "works" $ runSession "hie --lsp" "test/data/renamePass" $ do + it "works" $ runSession "hie --lsp" fullCaps "test/data/renamePass" $ do doc <- openDoc "Desktop/simple.hs" "haskell" let pos = Position 40 3 -- interactWithUser uri = doc ^. LSP.uri @@ -240,14 +239,14 @@ main = hspec $ do ] describe "getDefinitions" $ - it "works" $ runSession "hie --lsp" "test/data/renamePass" $ do + it "works" $ runSession "hie --lsp" fullCaps "test/data/renamePass" $ do 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" $ - it "works" $ runSession "hie --lsp" "test/data" $ do + it "works" $ runSession "hie --lsp" fullCaps "test/data" $ do openDoc "Error.hs" "haskell" [diag] <- waitForDiagnosticsSource "ghcmod" liftIO $ do @@ -255,13 +254,13 @@ main = hspec $ do diag ^. source `shouldBe` Just "ghcmod" describe "rename" $ - it "works" $ runSession "hie --lsp" "test/data" $ do + it "works" $ runSession "hie --lsp" fullCaps "test/data" $ do doc <- openDoc "Rename.hs" "haskell" rename doc (Position 1 0) "bar" documentContents doc >>= liftIO . shouldBe "main = bar\nbar = return 42\n" describe "getHover" $ - it "works" $ runSession "hie --lsp" "test/data/renamePass" $ do + it "works" $ runSession "hie --lsp" fullCaps "test/data/renamePass" $ do doc <- openDoc "Desktop/simple.hs" "haskell" -- hover returns nothing until module is loaded skipManyTill loggingNotification $ count 2 noDiagnostics @@ -269,21 +268,21 @@ main = hspec $ do liftIO $ hover `shouldSatisfy` isJust describe "getHighlights" $ - it "works" $ runSession "hie --lsp" "test/data/renamePass" $ do + it "works" $ runSession "hie --lsp" fullCaps "test/data/renamePass" $ do 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" $ - it "works" $ runSession "hie --lsp" "test/data" $ do + it "works" $ runSession "hie --lsp" fullCaps "test/data" $ do doc <- openDoc "Format.hs" "haskell" oldContents <- documentContents doc formatDoc doc (FormattingOptions 4 True) documentContents doc >>= liftIO . (`shouldNotBe` oldContents) describe "formatRange" $ - it "works" $ runSession "hie --lsp" "test/data" $ do + it "works" $ runSession "hie --lsp" fullCaps "test/data" $ do doc <- openDoc "Format.hs" "haskell" oldContents <- documentContents doc formatRange doc (FormattingOptions 4 True) (Range (Position 1 10) (Position 2 10)) @@ -292,7 +291,7 @@ main = hspec $ do describe "closeDoc" $ it "works" $ let sesh = - runSession "hie --lsp" "test/data" $ do + runSession "hie --lsp" fullCaps "test/data" $ do doc <- openDoc "Format.hs" "haskell" closeDoc doc -- need to evaluate to throw diff --git a/test/data/renamePass/session.log b/test/data/renamePass/session.log index 4cf5766..1648ff7 100644 --- a/test/data/renamePass/session.log +++ b/test/data/renamePass/session.log @@ -1,5 +1,5 @@ {"tag":"FromClient","contents":["2018-06-03T04:08:38.856591Z",{"tag":"ReqInitialize","contents":{"jsonrpc":"2.0","params":{"rootUri":"file:///Users/luke","processId":7558,"rootPath":"/Users/luke","capabilities":{"textDocument":{"completion":{"completionItem":{"snippetSupport":false}}}},"trace":"off"},"method":"initialize","id":9}}]} -{"tag":"FromServer","contents":["2018-06-03T04:08:38.873087Z",{"tag":"RspInitialize","contents":{"result":{"capabilities":{"textDocumentSync":{"openClose":true,"change":2,"willSave":false,"willSaveWaitUntil":false,"save":{"includeText":false}},"documentRangeFormattingProvider":true,"documentHighlightProvider":true,"executeCommandProvider":{"commands":["1234:applyrefact:applyOne","1234:hare:demote","16026:hie:applyWorkspaceEdit","16026:hsimport:import","16026:package:add"]},"renameProvider":true,"definitionProvider":true,"hoverProvider":true,"codeActionProvider":true,"completionProvider":{"triggerCharacters":["."],"resolveProvider":true},"documentSymbolProvider":true,"documentFormattingProvider":true,"referencesProvider":true}},"jsonrpc":"2.0","id":9}}]} +{"tag":"FromServer","contents":["2018-06-03T04:08:38.873087Z",{"tag":"RspInitialize","contents":{"result":{"capabilities":{"textDocumentSync":{"openClose":true,"change":2,"willSave":false,"willSaveWaitUntil":false,"save":{"includeText":false}},"documentRangeFormattingProvider":true,"documentHighlightProvider":true,"executeCommandProvider":{"commands":["7796:applyrefact:applyOne","7796:applyrefact:applyAll","7796:applyrefact:lint","7796:base:version","7796:base:plugins","7796:base:commands","7796:base:commandDetail","7796:brittany:format","7796:build:prepare","7796:build:isConfigured","7796:build:configure","7796:build:listTargets","7796:build:listFlags","7796:build:buildDirectory","7796:build:buildTarget","7796:eg2:sayHello","7796:eg2:sayHelloTo ","7796:ghcmod:check","7796:ghcmod:lint","7796:ghcmod:info","7796:ghcmod:type","7796:ghcmod:casesplit","7796:hare:demote","7796:hare:dupdef","7796:hare:iftocase","7796:hare:liftonelevel","7796:hare:lifttotoplevel","7796:hare:rename","7796:hare:deletedef","7796:hare:genapplicative","7796:hoogle:info","7796:hoogle:lookup","7796:hsimport:import","7796:package:add"]},"renameProvider":true,"definitionProvider":true,"hoverProvider":true,"codeActionProvider":true,"completionProvider":{"triggerCharacters":["."],"resolveProvider":true},"documentSymbolProvider":true,"documentFormattingProvider":true,"referencesProvider":true}},"jsonrpc":"2.0","id":9}}]} {"tag":"FromClient","contents":["2018-06-03T04:08:39.325465Z",{"tag":"NotInitialized","contents":{"jsonrpc":"2.0","params":{},"method":"initialized"}}]} {"tag":"FromClient","contents":["2018-06-03T04:08:39.325807Z",{"tag":"NotDidChangeConfiguration","contents":{"jsonrpc":"2.0","params":{"settings":{}},"method":"workspace/didChangeConfiguration"}}]} {"tag":"FromClient","contents":["2018-06-03T04:08:39.326177Z",{"tag":"NotDidOpenTextDocument","contents":{"jsonrpc":"2.0","params":{"textDocument":{"languageId":"haskell","text":"module Main where\n\nmain :: IO ()\nmain = do\n let initialList = []\n interactWithUser initialList\n\ntype Item = String\ntype Items = [Item]\n\ndata Command = Quit\n | DisplayItems\n | AddItem String\n | RemoveItem Int\n | Help\n\ntype Error = String\n\nparseCommand :: String -> Either Error Command\nparseCommand line = case words line of\n [\"quit\"] -> Right Quit\n [\"items\"] -> Right DisplayItems\n \"add\" : item -> Right $ AddItem $ unwords item\n \"remove\" : i -> Right $ RemoveItem $ read $ unwords i\n [\"help\"] -> Right Help\n _ -> Left \"Unknown command\"\n\naddItem :: Item -> Items -> Items\naddItem = (:)\n\ndisplayItems :: Items -> String\ndisplayItems = unlines . map (\"- \" ++)\n\nremoveItem :: Int -> Items -> Either Error Items\nremoveItem i items\n | i < 0 || i >= length items = Left \"Out of range\"\n | otherwise = Right result\n where (front, back) = splitAt (i + 1) items\n result = init front ++ back\n\ninteractWithUser :: Items -> IO ()\ninteractWithUser items = do\n line <- getLine\n case parseCommand line of\n Right DisplayItems -> do\n putStrLn $ displayItems items\n interactWithUser items\n\n Right (AddItem item) -> do\n let newItems = addItem item items\n putStrLn \"Added\"\n interactWithUser newItems\n\n Right (RemoveItem i) ->\n case removeItem i items of\n Right newItems -> do\n putStrLn $ \"Removed \" ++ items !! i\n interactWithUser newItems\n Left err -> do\n putStrLn err\n interactWithUser items\n\n\n Right Quit -> return ()\n\n Right Help -> do\n putStrLn \"Commands:\"\n putStrLn \"help\"\n putStrLn \"items\"\n putStrLn \"add\"\n putStrLn \"quit\"\n interactWithUser items\n\n Left err -> do\n putStrLn $ \"Error: \" ++ err\n interactWithUser items\n","uri":"file:///Users/luke/Desktop/simple.hs","version":0}},"method":"textDocument/didOpen"}}]} -- 2.30.2