Remove unecessary haskell-lsp-types dependency

[lsp-test.git] / src / Language / Haskell / LSP / Test / Session.hs

diff --git a/src/Language/Haskell/LSP/Test/Session.hs b/src/Language/Haskell/LSP/Test/Session.hs
index 2418cd5ac6e09cab04be5b23c813a0fe0d987a1a..a64e7ad1baa86057f1e841ba5f939dc38597b9c6 100644 (file)
--- 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