X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FSession.hs;h=a64e7ad1baa86057f1e841ba5f939dc38597b9c6;hb=9b771257fb775abdcca8e6b71e2d3d0ec4309670;hp=2418cd5ac6e09cab04be5b23c813a0fe0d987a1a;hpb=a4c1143848809be8aed55403dc3187a256dcbe9b;p=lsp-test.git diff --git a/src/Language/Haskell/LSP/Test/Session.hs b/src/Language/Haskell/LSP/Test/Session.hs index 2418cd5..a64e7ad 100644 --- a/src/Language/Haskell/LSP/Test/Session.hs +++ b/src/Language/Haskell/LSP/Test/Session.hs @@ -9,7 +9,6 @@ module Language.Haskell.LSP.Test.Session , SessionMessage(..) , SessionContext(..) , SessionState(..) - , MonadSessionConfig(..) , runSessionWithHandles , get , put @@ -45,8 +44,9 @@ import qualified Data.Text as T import qualified Data.Text.IO as T import qualified Data.HashMap.Strict as HashMap import Data.Maybe +import Data.Function import Language.Haskell.LSP.Messages -import Language.Haskell.LSP.TH.ClientCapabilities +import Language.Haskell.LSP.Types.Capabilities import Language.Haskell.LSP.Types hiding (error) import Language.Haskell.LSP.VFS import Language.Haskell.LSP.Test.Decoding @@ -79,12 +79,6 @@ data SessionConfig = SessionConfig instance Default SessionConfig where def = SessionConfig def 60 False -class Monad m => MonadSessionConfig m where - sessionConfig :: m SessionConfig - -instance Monad m => MonadSessionConfig (StateT SessionState (ReaderT SessionContext m)) where - sessionConfig = config <$> lift Reader.ask - data SessionMessage = ServerMessage FromServerMessage | TimeoutMessage Int deriving Show @@ -212,6 +206,8 @@ updateState (NotPublishDiagnostics n) = do updateState (ReqApplyWorkspaceEdit r) = do + oldVFS <- vfs <$> get + allChangeParams <- case r ^. params . edit . documentChanges of Just (List cs) -> do mapM_ (checkIfNeedsOpened . (^. textDocument . uri)) cs @@ -222,7 +218,6 @@ updateState (ReqApplyWorkspaceEdit r) = do return $ concatMap (uncurry getChangeParams) (HashMap.toList cs) Nothing -> error "No changes!" - oldVFS <- vfs <$> get newVFS <- liftIO $ changeFromServerVFS oldVFS r modify (\s -> s { vfs = newVFS }) @@ -232,6 +227,18 @@ updateState (ReqApplyWorkspaceEdit r) = do -- TODO: Don't do this when replaying a session forM_ mergedParams (sendMessage . NotificationMessage "2.0" TextDocumentDidChange) + -- Update VFS to new document versions + let sortedVersions = map (sortBy (compare `on` (^. textDocument . version))) groupedParams + latestVersions = map ((^. textDocument) . last) sortedVersions + bumpedVersions = map (version . _Just +~ 1) latestVersions + + forM_ bumpedVersions $ \(VersionedTextDocumentIdentifier uri v) -> + modify $ \s -> + let oldVFS = vfs s + update (VirtualFile oldV t) = VirtualFile (fromMaybe oldV v) t + newVFS = Map.adjust update uri oldVFS + in s { vfs = newVFS } + where checkIfNeedsOpened uri = do oldVFS <- vfs <$> get ctx <- ask @@ -252,7 +259,7 @@ updateState (ReqApplyWorkspaceEdit r) = do let changeEvents = map (\e -> TextDocumentContentChangeEvent (Just (e ^. range)) Nothing (e ^. newText)) edits in DidChangeTextDocumentParams docId (List changeEvents) - textDocumentVersions uri = map (VersionedTextDocumentIdentifier uri) [0..] + textDocumentVersions uri = map (VersionedTextDocumentIdentifier uri . Just) [0..] textDocumentEdits uri edits = map (\(v, e) -> TextDocumentEdit v (List [e])) $ zip (textDocumentVersions uri) edits