From d25de2bf28d472df5d1d3e050090d243247dab1b Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Thu, 14 Jun 2018 23:49:50 -0400 Subject: [PATCH] Update command uniquing to match hie --- .travis.yml | 4 +-- haskell-lsp-test.cabal | 4 +-- src/Language/Haskell/LSP/Test/Replay.hs | 34 +++++++++++++++---------- test/data/renameFail/session.log | 2 +- 4 files changed, 24 insertions(+), 20 deletions(-) diff --git a/.travis.yml b/.travis.yml index 73de261..c677e48 100644 --- a/.travis.yml +++ b/.travis.yml @@ -20,9 +20,9 @@ before_install: - npm update install: - - git clone https://github.com/haskell/haskell-ide-engine.git --recursive + - git clone https://github.com/Bubba/haskell-ide-engine.git --recursive - cd haskell-ide-engine - - git checkout c4190b22afa307bf8761d14ec71e17db79d7f395 + - git checkout pid-commands - git submodule update - stack --no-terminal --skip-ghc-check install -j2 - stack exec hoogle generate diff --git a/haskell-lsp-test.cabal b/haskell-lsp-test.cabal index 256106f..0c12d5e 100644 --- a/haskell-lsp-test.cabal +++ b/haskell-lsp-test.cabal @@ -32,13 +32,11 @@ library , lens , parser-combinators , process >= 1.6.3 - , random , text , transformers - , uuid , unordered-containers if os(windows) - build-depends: win32 + build-depends: Win32 else build-depends: unix other-modules: Language.Haskell.LSP.Test.Compat diff --git a/src/Language/Haskell/LSP/Test/Replay.hs b/src/Language/Haskell/LSP/Test/Replay.hs index 7def859..0be0c54 100644 --- a/src/Language/Haskell/LSP/Test/Replay.hs +++ b/src/Language/Haskell/LSP/Test/Replay.hs @@ -11,7 +11,6 @@ import Control.Exception import Control.Monad.IO.Class import qualified Data.ByteString.Lazy.Char8 as B import qualified Data.Text as T -import Data.UUID import Language.Haskell.LSP.Capture import Language.Haskell.LSP.Messages import Language.Haskell.LSP.Types hiding (error) @@ -22,7 +21,6 @@ import Control.Lens hiding (List) import Control.Monad import System.IO import System.FilePath -import System.Random import Language.Haskell.LSP.Test import Language.Haskell.LSP.Test.Files import Language.Haskell.LSP.Test.Decoding @@ -46,7 +44,7 @@ replaySession serverExe sessionDir = do withServer serverExe $ \serverIn serverOut pid -> do - events <- swapUUIDs pid <$> swapFiles sessionDir unswappedEvents + events <- swapCommands pid <$> swapFiles sessionDir unswappedEvents let clientEvents = filter isClientMsg events serverEvents = filter isServerMsg events @@ -199,18 +197,26 @@ shouldSkip (NotShowMessage _) = True shouldSkip (ReqShowMessage _) = True shouldSkip _ = False --- | Swaps out the expected UUIDs to match the current process ID -swapUUIDs :: Int -> [Event] -> [Event] -swapUUIDs _ [] = [] -swapUUIDs pid (FromServer t (RspInitialize rsp):xs) = FromServer t (RspInitialize swapped):swapUUIDs pid xs +-- | Swaps out any commands uniqued with process IDs to match the specified process ID +swapCommands :: Int -> [Event] -> [Event] +swapCommands _ [] = [] + +swapCommands pid (FromClient t (ReqExecuteCommand req):xs) = FromClient t (ReqExecuteCommand swapped):swapCommands pid xs + where swapped = params . command .~ newCmd $ req + newCmd = swapPid pid (req ^. params . command) + +swapCommands pid (FromServer t (RspInitialize rsp):xs) = FromServer t (RspInitialize swapped):swapCommands pid xs where swapped = case newCommands of Just cmds -> result . _Just . capabilities . executeCommandProvider . _Just . commands .~ cmds $ rsp Nothing -> rsp oldCommands = rsp ^? result . _Just . capabilities . executeCommandProvider . _Just . commands - newCommands = fmap (fmap swap) oldCommands - swap cmd - | isUuid cmd = T.append uuid $ T.dropWhile (/= ':') cmd - | otherwise = cmd - uuid = toText $ fst $ random $ mkStdGen pid - isUuid = isJust . fromText . T.takeWhile (/= ':') -swapUUIDs pid (x:xs) = x:swapUUIDs pid xs \ No newline at end of file + newCommands = fmap (fmap (swapPid pid)) oldCommands + +swapCommands pid (x:xs) = x:swapCommands pid xs + +hasPid :: T.Text -> Bool +hasPid = (>= 2) . T.length . T.filter (':' ==) +swapPid :: Int -> T.Text -> T.Text +swapPid pid t + | hasPid t = T.append (T.pack $ show pid) $ T.dropWhile (/= ':') t + | otherwise = t \ No newline at end of file diff --git a/test/data/renameFail/session.log b/test/data/renameFail/session.log index 99246af..2a259c8 100644 --- a/test/data/renameFail/session.log +++ b/test/data/renameFail/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":["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":"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":["68838662-a601-4b47-9f9a-0d5d69b7f5b2:applyrefact:applyOne","68838662-a601-4b47-9f9a-0d5d69b7f5b2: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"}}]} -- 2.30.2