X-Git-Url: http://git.lukelau.me/?p=opengl.git;a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FSession.hs;h=0553160aee215862ebb4fbad547f087a9fcbaca6;hp=b38d1b7fe1d4885de1354036be174aa10f484c93;hb=3581d880c87b59cc4c856aee83f77fea9a38890b;hpb=269f303e5e44fba835c51eacfca622c488a06b9f diff --git a/src/Language/Haskell/LSP/Test/Session.hs b/src/Language/Haskell/LSP/Test/Session.hs index b38d1b7..0553160 100644 --- a/src/Language/Haskell/LSP/Test/Session.hs +++ b/src/Language/Haskell/LSP/Test/Session.hs @@ -40,7 +40,7 @@ import qualified Data.HashMap.Strict as HashMap import Data.Maybe import Language.Haskell.LSP.Messages import Language.Haskell.LSP.TH.ClientCapabilities -import Language.Haskell.LSP.Types +import Language.Haskell.LSP.Types hiding (error) import Language.Haskell.LSP.VFS import Language.Haskell.LSP.Test.Compat import Language.Haskell.LSP.Test.Decoding @@ -179,13 +179,22 @@ runSessionWithHandles serverIn serverOut serverHandler config rootDir session = processTextChanges :: FromServerMessage -> SessionProcessor () processTextChanges (ReqApplyWorkspaceEdit r) = do - changeParams <- case r ^. params . edit . documentChanges of - Just (List cs) -> mapM applyTextDocumentEdit cs + + allChangeParams <- case r ^. params . edit . documentChanges of + Just (List cs) -> do + mapM_ (checkIfNeedsOpened . (^. textDocument . uri)) cs + return $ map getParams cs Nothing -> case r ^. params . edit . changes of - Just cs -> concat <$> mapM (uncurry applyChange) (HashMap.toList cs) - Nothing -> return [] + Just cs -> do + mapM_ checkIfNeedsOpened (HashMap.keys cs) + return $ concatMap (uncurry getChangeParams) (HashMap.toList cs) + Nothing -> error "No changes!" - let groupedParams = groupBy (\a b -> (a ^. textDocument == b ^. textDocument)) changeParams + oldVFS <- vfs <$> lift State.get + newVFS <- liftIO $ changeFromServerVFS oldVFS r + lift $ State.modify (\s -> s { vfs = newVFS }) + + let groupedParams = groupBy (\a b -> (a ^. textDocument == b ^. textDocument)) allChangeParams mergedParams = map mergeParams groupedParams ctx <- lift $ lift Reader.ask @@ -196,14 +205,13 @@ processTextChanges (ReqApplyWorkspaceEdit r) = do msg = NotificationMessage "2.0" TextDocumentDidChange p liftIO $ B.hPut h $ addHeader (encode msg) - where applyTextDocumentEdit (TextDocumentEdit docId (List edits)) = do + where checkIfNeedsOpened uri = do oldVFS <- vfs <$> lift State.get ctx <- lift $ lift Reader.ask - -- if its not open, open it - unless ((docId ^. uri) `Map.member` oldVFS) $ do - let fp = fromJust $ uriToFilePath (docId ^. uri) + unless (uri `Map.member` oldVFS) $ do + let fp = fromJust $ uriToFilePath uri contents <- liftIO $ T.readFile fp let item = TextDocumentItem (filePathToUri fp) "" 0 contents msg = NotificationMessage "2.0" TextDocumentDidOpen (DidOpenTextDocumentParams item) @@ -213,21 +221,15 @@ processTextChanges (ReqApplyWorkspaceEdit r) = do newVFS <- liftIO $ openVFS oldVFS msg lift $ State.modify (\s -> s { vfs = newVFS }) - -- we might have updated it above - oldVFS <- vfs <$> lift State.get - + getParams (TextDocumentEdit docId (List edits)) = let changeEvents = map (\e -> TextDocumentContentChangeEvent (Just (e ^. range)) Nothing (e ^. newText)) edits - params = DidChangeTextDocumentParams docId (List changeEvents) - newVFS <- liftIO $ changeVFS oldVFS (fmClientDidChangeTextDocumentNotification params) - lift $ State.modify (\s -> s { vfs = newVFS }) - - return params + in DidChangeTextDocumentParams docId (List changeEvents) textDocumentVersions uri = map (VersionedTextDocumentIdentifier uri) [0..] textDocumentEdits uri edits = map (\(v, e) -> TextDocumentEdit v (List [e])) $ zip (textDocumentVersions uri) edits - applyChange uri (List edits) = mapM applyTextDocumentEdit (textDocumentEdits uri (reverse edits)) + getChangeParams uri (List edits) = map getParams (textDocumentEdits uri (reverse edits)) mergeParams :: [DidChangeTextDocumentParams] -> DidChangeTextDocumentParams mergeParams params = let events = concat (toList (map (toList . (^. contentChanges)) params))