From: Luke Lau Date: Sun, 3 Jun 2018 18:11:46 +0000 (-0400) Subject: Start work on moving to new session file format X-Git-Tag: 0.1.0.0~98 X-Git-Url: http://git.lukelau.me/?p=lsp-test.git;a=commitdiff_plain;h=2560f39d64911bc247fa479868052545dca4f827 Start work on moving to new session file format --- diff --git a/example/Recorded.hs b/example/Recorded.hs index 63ee877..ce61cb1 100644 --- a/example/Recorded.hs +++ b/example/Recorded.hs @@ -3,6 +3,6 @@ import System.Directory import System.Environment main = do - [client, server, dir] <- (take 3 <$> getArgs) >>= mapM canonicalizePath - passed <- replay client server dir + [session, dir] <- (take 2 <$> getArgs) >>= mapM canonicalizePath + passed <- replay session dir putStrLn $ if passed then "Passed" else "Failed" diff --git a/src/Language/Haskell/LSP/Test/Files.hs b/src/Language/Haskell/LSP/Test/Files.hs index f59551a..9f78ec1 100644 --- a/src/Language/Haskell/LSP/Test/Files.hs +++ b/src/Language/Haskell/LSP/Test/Files.hs @@ -7,68 +7,76 @@ module Language.Haskell.LSP.Test.Files ) where +import Language.Haskell.LSP.Capture import Language.Haskell.LSP.Types hiding ( error ) +import Language.Haskell.LSP.Messages import Control.Lens import Data.Aeson -import Data.Aeson.Types import qualified Data.ByteString.Lazy.Char8 as B +import qualified Data.HashMap.Strict as HM import qualified Data.Text as T -import qualified Data.HashMap.Strict as HashMap import Data.Maybe import System.Directory import System.FilePath -swapFiles :: FilePath -> FilePath -> [B.ByteString] -> IO [B.ByteString] -swapFiles recBaseDir relCurBaseDir msgs = do +swapFiles :: FilePath -> [Event] -> IO [Event] +swapFiles relCurBaseDir msgs = do + let capturedBaseDir = rootDir msgs + curBaseDir <- ( relCurBaseDir) <$> getCurrentDirectory let transform uri = let fp = fromMaybe (error "Couldn't transform uri") (uriToFilePath uri) - newFp = curBaseDir makeRelative recBaseDir fp + newFp = curBaseDir makeRelative capturedBaseDir fp in filePathToUri newFp - newMsgs = map (mapUris transform) msgs :: [B.ByteString] + newMsgs = map (mapUris transform) msgs return newMsgs -rootDir :: [B.ByteString] -> FilePath -rootDir msgs = fromMaybe (error "Couldn't find root dir") $ do - req <- decode (head msgs) :: Maybe InitializeRequest +rootDir :: [Event] -> FilePath +rootDir (FromClient _ (ReqInitialize req):_) = + fromMaybe (error "Couldn't find root dir") $ do rootUri <- req ^. params .rootUri uriToFilePath rootUri +rootDir _ = error "Couldn't find initialize request in session" -mapUris :: (Uri -> Uri) -> B.ByteString -> B.ByteString -mapUris f msg = - case decode msg :: Maybe Object of - Just obj -> encode $ HashMap.map (mapValue f) obj - Nothing -> error "Couldn't decode message" +mapUris :: (Uri -> Uri) -> Event -> Event +mapUris f event = + case event of + FromClient t msg -> FromClient t (fromClientMsg msg) + FromServer t msg -> FromServer t (fromServerMsg msg) where - mapValue :: (Uri -> Uri) -> Value -> Value - mapValue f x = case parse parseJSON x :: Result VersionedTextDocumentIdentifier of - Success doc -> transform doc - Error _ -> case parse parseJSON x :: Result TextDocumentIdentifier of - Success doc -> transform doc - Error _ -> case parse parseJSON x :: Result InitializeParams of - Success params -> transformInit params - Error _ -> case parse parseJSON x :: Result Object of - Success obj -> Object $ HashMap.map (mapValue f) obj - Error _ -> x + fromClientMsg (NotDidOpenTextDocument n) = NotDidOpenTextDocument $ swapUri (params . textDocument) n + fromClientMsg (NotDidChangeTextDocument n) = NotDidChangeTextDocument $ swapUri (params . textDocument) n + fromClientMsg (NotWillSaveTextDocument n) = NotWillSaveTextDocument $ swapUri (params . textDocument) n + fromClientMsg (NotDidSaveTextDocument n) = NotDidSaveTextDocument $ swapUri (params . textDocument) n + fromClientMsg (NotDidCloseTextDocument n) = NotDidCloseTextDocument $ swapUri (params . textDocument) n + fromClientMsg (ReqInitialize r) = ReqInitialize $ params .~ (transformInit (r ^. params)) $ r + fromClientMsg x = x + + fromServerMsg :: FromServerMessage -> FromServerMessage + fromServerMsg (ReqApplyWorkspaceEdit r) = + let newDocChanges = fmap (fmap (swapUri textDocument)) $ r ^. params . edit . documentChanges + r1 = (params . edit . documentChanges) .~ newDocChanges $ r + newChanges = fmap (swapKeys f) $ r1 ^. params . edit . changes + r2 = (params . edit . changes) .~ newChanges $ r1 + in ReqApplyWorkspaceEdit r2 + fromServerMsg x = x - -- parsing with just JSON - -- mapValueWithKey :: (Uri -> Uri) -> T.Text -> Value -> Value - -- mapValueWithKey f "uri" (String s) = fromMaybe (error "Couldn't convert uri") $ do - -- let uri = filePathToUri $ T.unpack s - -- String <$> (fmap T.pack (uriToFilePath $ f uri)) - -- mapValueWithKey f _ (Array xs) = Array $ fmap (mapValue f) xs - -- mapValueWithKey f _ (Object x) = Object $ HashMap.mapWithKey (mapValueWithKey f) x + swapKeys :: (Uri -> Uri) -> HM.HashMap Uri b -> HM.HashMap Uri b + swapKeys f = HM.foldlWithKey' (\acc k v -> HM.insert (f k) v acc) HM.empty - transform x = toJSON $ x & uri .~ f (x ^. uri) + swapUri :: HasUri b Uri => Lens' a b -> a -> a + swapUri lens x = + let newUri = f (x ^. lens . uri) + in (lens . uri) .~ newUri $ x - -- transform rootUri/rootPath - transformInit :: InitializeParams -> Value + -- | Transforms rootUri/rootPath. + transformInit :: InitializeParams -> InitializeParams transformInit x = let newRootUri = fmap f (x ^. rootUri) newRootPath = do fp <- T.unpack <$> x ^. rootPath let uri = filePathToUri fp T.pack <$> uriToFilePath (f uri) - in toJSON $ (rootUri .~ newRootUri) $ (rootPath .~ newRootPath) x + in (rootUri .~ newRootUri) $ (rootPath .~ newRootPath) x diff --git a/src/Language/Haskell/LSP/Test/Recorded.hs b/src/Language/Haskell/LSP/Test/Recorded.hs index 41df16d..f856144 100644 --- a/src/Language/Haskell/LSP/Test/Recorded.hs +++ b/src/Language/Haskell/LSP/Test/Recorded.hs @@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} -- | A testing tool for replaying recorded client logs back to a server, -- and validating that the server output matches up with another log. module Language.Haskell.LSP.Test.Recorded @@ -11,8 +12,10 @@ import Control.Concurrent import Control.Monad.Trans.Class import Control.Monad.Trans.Reader import Data.Default -import Language.Haskell.LSP.Control as Control import qualified Data.ByteString.Lazy.Char8 as B +import Data.List +import Language.Haskell.LSP.Capture +import Language.Haskell.LSP.Messages import Language.Haskell.LSP.Core import qualified Language.Haskell.LSP.Types as LSP import Data.Aeson @@ -28,11 +31,10 @@ import Language.Haskell.LSP.Test.Parsing -- | Replays a recorded client output and -- makes sure it matches up with an expected response. replay - :: FilePath -- ^ The client output to replay to the server. - -> FilePath -- ^ The expected response from the server. + :: FilePath -- ^ The recorded session file. -> FilePath -- ^ The root directory of the project -> IO Bool -replay cfp sfp curRootDir = do +replay sessionFp curRootDir = do -- need to keep hold of current directory since haskell-lsp changes it prevDir <- getCurrentDirectory @@ -51,43 +53,22 @@ replay cfp sfp curRootDir = do didPass <- newEmptyMVar - -- the recorded client input to the server - clientRecIn <- openFile cfp ReadMode - serverRecIn <- openFile sfp ReadMode - null <- openFile "/dev/null" WriteMode + entries <- B.lines <$> B.readFile sessionFp + -- decode session + let unswappedEvents = map (fromJust . decode) entries - unswappedClientMsgs <- getAllMessages clientRecIn + events <- swapFiles curRootDir unswappedEvents - let recRootDir = rootDir unswappedClientMsgs - - clientMsgs <- swapFiles recRootDir curRootDir unswappedClientMsgs - - print clientMsgs - error "sdaf" - - tmpDir <- getTemporaryDirectory - (mappedClientRecFp, mappedClientRecIn) <- openTempFile tmpDir "clientRecInMapped" - mapM_ (B.hPut mappedClientRecIn . addHeader) clientMsgs - hSeek mappedClientRecIn AbsoluteSeek 0 - - expectedMsgs <- swapFiles recRootDir curRootDir =<< getAllMessages serverRecIn + let clientEvents = map (\(FromClient _ msg) -> msg) $ filter isClientMsg events + serverEvents = map (\(FromServer _ msg) -> msg) $ filter isServerMsg events -- listen to server - forkIO $ runReaderT (listenServer expectedMsgs serverOut semas) didPass + forkIO $ runReaderT (listenServer serverEvents serverOut semas) didPass - -- start client replay - forkIO $ do - Control.runWithHandles mappedClientRecIn - null - (const $ Right (), const $ return Nothing) - (handlers serverIn semas) - def - Nothing - Nothing + forM_ clientEvents (processClient serverIn) - -- todo: we shouldn't do this, we should check all notifications were delivered first - putMVar didPass True + print events result <- takeMVar didPass terminateProcess serverProc @@ -95,15 +76,88 @@ replay cfp sfp curRootDir = do -- restore directory setCurrentDirectory prevDir - -- cleanup temp files - removeFile mappedClientRecFp - return result + where + isClientMsg (FromClient _ _) = True + isClientMsg _ = False + + isServerMsg (FromServer _ _) = True + isServerMsg _ = False + +processEvent :: Handle -> MVar LSP.LspId -> MVar LSP.LspIdRsp -> Event -> IO () +processEvent serverH rspSema reqSema (FromClient _ msg) = processClient serverH rspSema reqSema msg +processEvent _ _ _ (FromServer _ msg) = processServer msg + +processClient + :: Handle -> MVar LSP.LspId -> MVar LSP.LspIdRsp -> FromClientMessage -> IO () +processClient serverH rspSema reqSema msg = case msg of + ReqInitialize m -> request m + ReqShutdown m -> request m + ReqHover m -> request m + ReqCompletion m -> request m + ReqCompletionItemResolve m -> request m + ReqSignatureHelp m -> request m + ReqDefinition m -> request m + ReqFindReferences m -> request m + ReqDocumentHighlights m -> request m + ReqDocumentSymbols m -> request m + ReqWorkspaceSymbols m -> request m + ReqCodeAction m -> request m + ReqCodeLens m -> request m + ReqCodeLensResolve m -> request m + ReqDocumentFormatting m -> request m + ReqDocumentRangeFormatting m -> request m + ReqDocumentOnTypeFormatting m -> request m + ReqRename m -> request m + ReqExecuteCommand m -> request m + ReqDocumentLink m -> request m + ReqDocumentLinkResolve m -> request m + ReqWillSaveWaitUntil m -> request m + where + -- TODO: May need to prevent premature exit notification being sent + notification msg@(LSP.NotificationMessage _ LSP.Exit _) = do + putStrLn "Will send exit notification soon" + threadDelay 10000000 + B.hPut serverH $ addHeader (encode msg) + notification msg@(LSP.NotificationMessage _ m _) = do + B.hPut serverH $ addHeader (encode msg) + + putStrLn $ "Sent a notification " ++ show m + + request msg@(LSP.RequestMessage _ id m _) = do + + when (m == LSP.TextDocumentDocumentSymbol) $ threadDelay 5000000 + + B.hPut serverH $ addHeader (encode msg) + putStrLn + $ "Sent a request id " + ++ show id + ++ ": " + ++ show m + ++ "\nWaiting for a response" + + rspId <- takeMVar reqSema + when (LSP.responseId id /= rspId) + $ error + $ "Expected id " + ++ show id + ++ ", got " + ++ show rspId + + response msg@(LSP.ResponseMessage _ id _ _) = do + putStrLn $ "Waiting for request id " ++ show id ++ " from the server" + reqId <- takeMVar rspSema + if LSP.responseId reqId /= id + then error $ "Expected id " ++ show reqId ++ ", got " ++ show reqId + else do + B.hPut serverH $ addHeader (encode msg) + putStrLn $ "Sent response to request id " ++ show id -- | The internal monad for tests that can fail or pass, -- ending execution early. type Session = ReaderT (MVar Bool) IO +-- TODO: Make return type polymoprhic more like error failSession :: String -> Session () failSession reason = do lift $ putStrLn reason @@ -117,7 +171,7 @@ passSession = do -- | Listens to the server output, makes sure it matches the record and -- signals any semaphores -listenServer :: [B.ByteString] -> Handle -> (MVar LSP.LspIdRsp, MVar LSP.LspId) -> Session () +listenServer :: [FromServerMessage] -> Handle -> (MVar LSP.LspIdRsp, MVar LSP.LspId) -> Session () listenServer [] _ _ = passSession listenServer expectedMsgs h semas@(reqSema, rspSema) = do msg <- lift $ getNextMessage h @@ -132,8 +186,7 @@ listenServer expectedMsgs h semas@(reqSema, rspSema) = do listenServer newExpectedMsgs h semas - - where response :: LSP.ResponseMessage Value -> Session [B.ByteString] + where response :: LSP.ResponseMessage a -> Session [FromServerMessage] response res = do lift $ putStrLn $ "Got response for id " ++ show (res ^. LSP.id) @@ -145,7 +198,7 @@ listenServer expectedMsgs h semas@(reqSema, rspSema) = do markReceived res - request :: LSP.RequestMessage LSP.ServerMethod Value Value -> Session [B.ByteString] + request :: LSP.RequestMessage LSP.ServerMethod a b -> Session [FromServerMessage] request req = do lift $ putStrLn $ "Got request for id " ++ show (req ^. LSP.id) ++ " " ++ show (req ^. LSP.method) @@ -157,7 +210,7 @@ listenServer expectedMsgs h semas@(reqSema, rspSema) = do markReceived req - notification :: LSP.NotificationMessage LSP.ServerMethod Value -> Session [B.ByteString] + notification :: LSP.NotificationMessage LSP.ServerMethod a -> Session [FromServerMessage] notification n = do lift $ putStrLn $ "Got notification " ++ show (n ^. LSP.method) lift $ print n @@ -173,24 +226,22 @@ listenServer expectedMsgs h semas@(reqSema, rspSema) = do _ = expected == msg -- make expected type same as res failSession ("Out of order\nExpected\n" ++ show expected ++ "\nGot\n" ++ show msg ++ "\n") + markReceived :: Eq a => a -> [FromServerMessage] -> Session [FromServerMessage] markReceived msg = - let new = deleteFirstJson msg expectedMsgs + -- TODO: Find some way of equating FromServerMessage and LSP.ResponseMessage etc. + let new = delete msg expectedMsgs in if new == expectedMsgs then failSession ("Unexpected message: " ++ show msg) >> return new else return new - deleteFirstJson _ [] = [] - deleteFirstJson msg (x:xs) - | Just msg == decode x = xs - | otherwise = x:deleteFirstJson msg xs - firstExpected = head $ filter (not . isNotification) expectedMsgs - - -isNotification :: B.ByteString -> Bool -isNotification msg = - isJust (decode msg :: Maybe (LSP.NotificationMessage Value Value)) +isNotification :: FromServerMessage -> Bool +isNotification (NotPublishDiagnostics _) = True +isNotification (NotLogMessage _) = True +isNotification (NotShowMessage _) = True +isNotification (NotCancelRequestFromServer _) = True +isNotification _ = False -- TODO: QuickCheck tests? -- | Checks wether or not the message appears in the right order @@ -211,78 +262,3 @@ inRightOrder received (expected:msgs) | Just received == decode expected = True | isNotification expected = inRightOrder received msgs | otherwise = False \ No newline at end of file - - -handlers :: Handle -> (MVar LSP.LspIdRsp, MVar LSP.LspId) -> Handlers -handlers serverH (reqSema, rspSema) = def - { - -- Requests - hoverHandler = Just request - , completionHandler = Just request - , completionResolveHandler = Just request - , signatureHelpHandler = Just request - , definitionHandler = Just request - , referencesHandler = Just request - , documentHighlightHandler = Just request - , documentSymbolHandler = Just request - , workspaceSymbolHandler = Just request - , codeActionHandler = Just request - , codeLensHandler = Just request - , codeLensResolveHandler = Just request - , documentFormattingHandler = Just request - , documentRangeFormattingHandler = Just request - , documentTypeFormattingHandler = Just request - , renameHandler = Just request - , documentLinkHandler = Just request - , documentLinkResolveHandler = Just request - , executeCommandHandler = Just request - , initializeRequestHandler = Just request - -- Notifications - , didChangeConfigurationParamsHandler = Just notification - , didOpenTextDocumentNotificationHandler = Just notification - , didChangeTextDocumentNotificationHandler = Just notification - , didCloseTextDocumentNotificationHandler = Just notification - , didSaveTextDocumentNotificationHandler = Just notification - , didChangeWatchedFilesNotificationHandler = Just notification - , initializedHandler = Just notification - , willSaveTextDocumentNotificationHandler = Just notification - , cancelNotificationHandler = Just notification - , exitNotificationHandler = Just notification - -- Responses - , responseHandler = Just response - } - where - - -- TODO: May need to prevent premature exit notification being sent - notification msg@(LSP.NotificationMessage _ LSP.Exit _) = do - putStrLn "Will send exit notification soon" - threadDelay 10000000 - B.hPut serverH $ addHeader (encode msg) - notification msg@(LSP.NotificationMessage _ m _) = do - B.hPut serverH $ addHeader (encode msg) - - putStrLn $ "Sent a notification " ++ show m - - request msg@(LSP.RequestMessage _ id m _) = do - - when (m == LSP.TextDocumentDocumentSymbol) $ threadDelay 5000000 - - B.hPut serverH $ addHeader (encode msg) - putStrLn $ "Sent a request id " ++ show id ++ ": " ++ show m ++ "\nWaiting for a response" - - rspId <- takeMVar reqSema - when (LSP.responseId id /= rspId) - $ error - $ "Expected id " - ++ show id - ++ ", got " - ++ show rspId - - response msg@(LSP.ResponseMessage _ id _ _) = do - putStrLn $ "Waiting for request id " ++ show id ++ " from the server" - reqId <- takeMVar rspSema - if LSP.responseId reqId /= id - then error $ "Expected id " ++ show reqId ++ ", got " ++ show reqId - else do - B.hPut serverH $ addHeader (encode msg) - putStrLn $ "Sent response to request id " ++ show id diff --git a/stack.yaml b/stack.yaml index ce80d88..a94e4be 100644 --- a/stack.yaml +++ b/stack.yaml @@ -7,7 +7,7 @@ extra-deps: commit: b7cf14eb48837a73032e867dab90db1708220c66 - haskell-lsp-types-0.2.2.0 - github: Bubba/haskell-lsp - commit: 04eeb0e676a344612073fa7c615a4bfa033c793a + commit: 8a9f16e11f1ca921f8316e3e7cd2b4756598775c - sorted-list-0.2.1.0 - github: yi-editor/yi-rope commit: 7867909f4f20952be051fd4252cca5bbfc80cf41 diff --git a/test/recordings/renamePass/client.log b/test/recordings/renamePass/clientold.log similarity index 100% rename from test/recordings/renamePass/client.log rename to test/recordings/renamePass/clientold.log diff --git a/test/recordings/renamePass/server.log b/test/recordings/renamePass/serverold.log similarity index 100% rename from test/recordings/renamePass/server.log rename to test/recordings/renamePass/serverold.log diff --git a/test/recordings/renamePass/session.log b/test/recordings/renamePass/session.log new file mode 100644 index 0000000..0e9be02 --- /dev/null +++ b/test/recordings/renamePass/session.log @@ -0,0 +1,18 @@ +{"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":["applyrefact:applyOne","hare:demote"]},"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"}}]} +{"tag":"FromServer","contents":["2018-06-03T04:08:39.327288Z",{"tag":"NotLogMessage","contents":{"jsonrpc":"2.0","params":{"type":1,"message":"haskell-lsp:didChangeConfiguration error. NotificationMessage {_jsonrpc = \"2.0\", _method = WorkspaceDidChangeConfiguration, _params = DidChangeConfigurationParams {_settings = Object (fromList [])}} \"key \\\"languageServerHaskell\\\" not present\""},"method":"window/logMessage"}}]} +{"tag":"FromServer","contents":["2018-06-03T04:08:39.327577Z",{"tag":"NotLogMessage","contents":{"jsonrpc":"2.0","params":{"type":4,"message":"Using hie version: Version 0.2.0.0, Git revision d4fe878a545c2d1b9247c1ddf5e6174eeed066cb (1431 commits) x86_64 ghc-8.4.2"},"method":"window/logMessage"}}]} +{"tag":"FromServer","contents":["2018-06-03T04:08:39.328266Z",{"tag":"NotLogMessage","contents":{"jsonrpc":"2.0","params":{"type":4,"message":"Using hoogle db at: /Users/luke/.hoogle/default-haskell-5.0.17.hoo"},"method":"window/logMessage"}}]} +{"tag":"FromServer","contents":["2018-06-03T04:08:39.524239Z",{"tag":"NotPublishDiagnostics","contents":{"jsonrpc":"2.0","params":{"uri":"file:///Users/luke/Desktop/simple.hs","diagnostics":[]},"method":"textDocument/publishDiagnostics"}}]} +{"tag":"FromServer","contents":["2018-06-03T04:08:39.714012Z",{"tag":"NotPublishDiagnostics","contents":{"jsonrpc":"2.0","params":{"uri":"file:///Users/luke/Desktop/simple.hs","diagnostics":[]},"method":"textDocument/publishDiagnostics"}}]} +{"tag":"FromClient","contents":["2018-06-03T04:08:40.844374Z",{"tag":"ReqDocumentSymbols","contents":{"jsonrpc":"2.0","params":{"textDocument":{"uri":"file:///Users/luke/Desktop/simple.hs"}},"method":"textDocument/documentSymbol","id":25}}]} +{"tag":"FromServer","contents":["2018-06-03T04:08:40.859268Z",{"tag":"RspDocumentSymbols","contents":{"result":[{"location":{"uri":"file:///Users/luke/Desktop/simple.hs","range":{"start":{"line":3,"character":0},"end":{"line":3,"character":4}}},"kind":12,"name":"main"},{"location":{"uri":"file:///Users/luke/Desktop/simple.hs","range":{"start":{"line":7,"character":5},"end":{"line":7,"character":9}}},"kind":5,"name":"Item"},{"location":{"uri":"file:///Users/luke/Desktop/simple.hs","range":{"start":{"line":8,"character":5},"end":{"line":8,"character":10}}},"kind":5,"name":"Items"},{"location":{"uri":"file:///Users/luke/Desktop/simple.hs","range":{"start":{"line":10,"character":5},"end":{"line":10,"character":12}}},"kind":5,"name":"Command"},{"location":{"uri":"file:///Users/luke/Desktop/simple.hs","range":{"start":{"line":10,"character":15},"end":{"line":10,"character":19}}},"kind":9,"containerName":"Command","name":"Quit"},{"location":{"uri":"file:///Users/luke/Desktop/simple.hs","range":{"start":{"line":11,"character":15},"end":{"line":11,"character":27}}},"kind":9,"containerName":"Command","name":"DisplayItems"},{"location":{"uri":"file:///Users/luke/Desktop/simple.hs","range":{"start":{"line":12,"character":15},"end":{"line":12,"character":22}}},"kind":9,"containerName":"Command","name":"AddItem"},{"location":{"uri":"file:///Users/luke/Desktop/simple.hs","range":{"start":{"line":13,"character":15},"end":{"line":13,"character":25}}},"kind":9,"containerName":"Command","name":"RemoveItem"},{"location":{"uri":"file:///Users/luke/Desktop/simple.hs","range":{"start":{"line":14,"character":15},"end":{"line":14,"character":19}}},"kind":9,"containerName":"Command","name":"Help"},{"location":{"uri":"file:///Users/luke/Desktop/simple.hs","range":{"start":{"line":16,"character":5},"end":{"line":16,"character":10}}},"kind":5,"name":"Error"},{"location":{"uri":"file:///Users/luke/Desktop/simple.hs","range":{"start":{"line":19,"character":0},"end":{"line":19,"character":12}}},"kind":12,"name":"parseCommand"},{"location":{"uri":"file:///Users/luke/Desktop/simple.hs","range":{"start":{"line":28,"character":0},"end":{"line":28,"character":7}}},"kind":12,"name":"addItem"},{"location":{"uri":"file:///Users/luke/Desktop/simple.hs","range":{"start":{"line":31,"character":0},"end":{"line":31,"character":12}}},"kind":12,"name":"displayItems"},{"location":{"uri":"file:///Users/luke/Desktop/simple.hs","range":{"start":{"line":34,"character":0},"end":{"line":34,"character":10}}},"kind":12,"name":"removeItem"},{"location":{"uri":"file:///Users/luke/Desktop/simple.hs","range":{"start":{"line":41,"character":0},"end":{"line":41,"character":16}}},"kind":12,"name":"interactWithUser"}],"jsonrpc":"2.0","id":25}}]} +{"tag":"FromClient","contents":["2018-06-03T04:08:46.24927Z",{"tag":"ReqRename","contents":{"jsonrpc":"2.0","params":{"newName":"arseCommand","textDocument":{"uri":"file:///Users/luke/Desktop/simple.hs"},"position":{"line":19,"character":0}},"method":"textDocument/rename","id":32}}]} +{"tag":"FromServer","contents":["2018-06-03T04:08:46.528715Z",{"tag":"RspRename","contents":{"result":{"changes":{"file:///Users/luke/Desktop/simple.hs":[{"range":{"start":{"line":43,"character":0},"end":{"line":43,"character":27}},"newText":" case arseCommand line of"},{"range":{"start":{"line":18,"character":0},"end":{"line":19,"character":38}},"newText":"arseCommand :: String -> Either Error Command\narseCommand line = case words line of"}]}},"jsonrpc":"2.0","id":32}}]} +{"tag":"FromClient","contents":["2018-06-03T04:08:48.300837Z",{"tag":"NotDidChangeTextDocument","contents":{"jsonrpc":"2.0","params":{"contentChanges":[{"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\narseCommand :: String -> Either Error Command\narseCommand 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 arseCommand 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"}],"textDocument":{"uri":"file:///Users/luke/Desktop/simple.hs","version":1}},"method":"textDocument/didChange"}}]} +{"tag":"FromServer","contents":["2018-06-03T04:08:48.357517Z",{"tag":"NotPublishDiagnostics","contents":{"jsonrpc":"2.0","params":{"uri":"file:///Users/luke/Desktop/simple.hs","diagnostics":[]},"method":"textDocument/publishDiagnostics"}}]} +{"tag":"FromServer","contents":["2018-06-03T04:08:48.397078Z",{"tag":"NotPublishDiagnostics","contents":{"jsonrpc":"2.0","params":{"uri":"file:///Users/luke/Desktop/simple.hs","diagnostics":[]},"method":"textDocument/publishDiagnostics"}}]} +{"tag":"FromClient","contents":["2018-06-03T04:08:51.543574Z",{"tag":"NotExit","contents":{"jsonrpc":"2.0","params":null,"method":"exit"}}]}