Update command uniquing to match hie

diff --git a/.travis.yml b/.travis.yml
index 73de261bb86aa00e9fd950420e77a4dd0a87f33b..c677e482f543cfbe6c2bf26f3e2f3e4c6917b78b 100644 (file)
--- 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 256106f248c4cef4d6bca8708c0f28597abd0031..0c12d5ee7a6efcb272807290b1834306f8922616 100644 (file)
--- 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 7def859a2e9bda826d40d10602bad9f6a9897afc..0be0c54d3736d4e90d920271af8125a4107f327b 100644 (file)
--- 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 99246af4a2cf84d342718b04aeb3679e88e25c9a..2a259c8e7ea8da53ec78b37615b430e18793c82f 100644 (file)
--- 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"}}]}