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"
)
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
{-# 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
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
-- | 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
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
-- 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
-- | 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
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)
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)
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
_ = 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
| 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
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
--- /dev/null
+{"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"}}]}
projects / lsp-test.git / commitdiff