X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FReplay.hs;h=861d6f770dc503208bd05cef6fe03a5500cc31dc;hb=ddf9bc17ce8a548a927c201c6b0edb8cf1c9fcad;hp=b20eb08f9cb6d3a7a005e82ca61ccf44806747e3;hpb=1b1df64886e90bb77c2804452945ff0d66963e0a;p=lsp-test.git diff --git a/src/Language/Haskell/LSP/Test/Replay.hs b/src/Language/Haskell/LSP/Test/Replay.hs index b20eb08..861d6f7 100644 --- a/src/Language/Haskell/LSP/Test/Replay.hs +++ b/src/Language/Haskell/LSP/Test/Replay.hs @@ -13,7 +13,7 @@ import qualified Data.Text as T import Language.Haskell.LSP.Capture import Language.Haskell.LSP.Messages import Language.Haskell.LSP.Types -import Language.Haskell.LSP.Types.Lens as LSP hiding (error) +import Language.Haskell.LSP.Types.Lens as LSP import Data.Aeson import Data.Default import Data.List @@ -66,7 +66,7 @@ replaySession serverExe sessionDir = do def fullCaps sessionDir - exitServer + (return ()) -- No finalizer cleanup (sendMessages clientMsgs reqSema rspSema) takeMVar passSema killThread sessionThread @@ -108,7 +108,7 @@ sendMessages (nextMsg:remainingMsgs) reqSema rspSema = sendMessages remainingMsgs reqSema rspSema - response msg@(ResponseMessage _ id _ _) = do + response msg@(ResponseMessage _ id _) = do liftIO $ putStrLn $ "Waiting for request id " ++ show id ++ " from the server" reqId <- liftIO $ takeMVar reqSema if responseId reqId /= id @@ -220,9 +220,9 @@ swapCommands pid (FromClient t (ReqExecuteCommand req):xs) = FromClient t (ReqE swapCommands pid (FromServer t (RspInitialize rsp):xs) = FromServer t (RspInitialize swapped):swapCommands pid xs where swapped = case newCommands of - Just cmds -> result . _Just . LSP.capabilities . executeCommandProvider . _Just . commands .~ cmds $ rsp + Just cmds -> result . _Right . LSP.capabilities . executeCommandProvider . _Just . commands .~ cmds $ rsp Nothing -> rsp - oldCommands = rsp ^? result . _Just . LSP.capabilities . executeCommandProvider . _Just . commands + oldCommands = rsp ^? result . _Right . LSP.capabilities . executeCommandProvider . _Just . commands newCommands = fmap (fmap (swapPid pid)) oldCommands swapCommands pid (x:xs) = x:swapCommands pid xs