X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FSession.hs;h=46155f0607cfa1b752b541b755a761b1551b4b30;hb=5fed47500d838f468dbb26eaf96e67afcfa5f05e;hp=a3ba35b3a1a46f723d4ca0fce59775991680c862;hpb=07287dee784681a0334eae15cd6c158321941b60;p=lsp-test.git diff --git a/src/Language/Haskell/LSP/Test/Session.hs b/src/Language/Haskell/LSP/Test/Session.hs index a3ba35b..46155f0 100644 --- a/src/Language/Haskell/LSP/Test/Session.hs +++ b/src/Language/Haskell/LSP/Test/Session.hs @@ -128,7 +128,7 @@ data SessionState = SessionState { curReqId :: LspId , vfs :: VFS - , curDiagnostics :: Map.Map Uri [Diagnostic] + , curDiagnostics :: Map.Map NormalizedUri [Diagnostic] , curTimeoutId :: Int , overridingTimeout :: Bool -- ^ The last received message from the server. @@ -197,6 +197,10 @@ runSessionWithHandles serverIn serverOut serverHandler config caps rootDir sessi hSetBuffering serverIn NoBuffering hSetBuffering serverOut NoBuffering + -- This is required to make sure that we don’t get any + -- newline conversion or weird encoding issues. + hSetBinaryMode serverIn True + hSetBinaryMode serverOut True reqMap <- newMVar newRequestMap messageChan <- newChan @@ -223,7 +227,7 @@ updateState (NotPublishDiagnostics n) = do let List diags = n ^. params . diagnostics doc = n ^. params . uri modify (\s -> - let newDiags = Map.insert doc diags (curDiagnostics s) + let newDiags = Map.insert (toNormalizedUri doc) diags (curDiagnostics s) in s { curDiagnostics = newDiags }) updateState (ReqApplyWorkspaceEdit r) = do @@ -242,7 +246,7 @@ updateState (ReqApplyWorkspaceEdit r) = do newVFS <- liftIO $ changeFromServerVFS (vfs s) r return $ s { vfs = newVFS } - let groupedParams = groupBy (\a b -> (a ^. textDocument == b ^. textDocument)) allChangeParams + let groupedParams = groupBy (\a b -> a ^. textDocument == b ^. textDocument) allChangeParams mergedParams = map mergeParams groupedParams -- TODO: Don't do this when replaying a session @@ -257,7 +261,7 @@ updateState (ReqApplyWorkspaceEdit r) = do modify $ \s -> let oldVFS = vfs s update (VirtualFile oldV t mf) = VirtualFile (fromMaybe oldV v) t mf - newVFS = Map.adjust update uri oldVFS + newVFS = Map.adjust update (toNormalizedUri uri) oldVFS in s { vfs = newVFS } where checkIfNeedsOpened uri = do @@ -265,7 +269,7 @@ updateState (ReqApplyWorkspaceEdit r) = do ctx <- ask -- if its not open, open it - unless (uri `Map.member` oldVFS) $ do + unless (toNormalizedUri uri `Map.member` oldVFS) $ do let fp = fromJust $ uriToFilePath uri contents <- liftIO $ T.readFile fp let item = TextDocumentItem (filePathToUri fp) "" 0 contents