X-Git-Url: https://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FLSP%2FTest%2FSession.hs;h=ac668e6fab51dc0254edcc4252779e51c573e802;hb=cd644f52c5c564403b5f3b0a8652e7f4154f8d6a;hp=5839a15619a18963296a35d632a1f4233a95944c;hpb=cf9e06e2eb79b113ff861866690f14166d1fa4e7;p=lsp-test.git

diff --git a/src/Language/LSP/Test/Session.hs b/src/Language/LSP/Test/Session.hs
index 5839a15..ac668e6 100644
--- a/src/Language/LSP/Test/Session.hs
+++ b/src/Language/LSP/Test/Session.hs
@@ -6,6 +6,7 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeInType #-}
 
 module Language.LSP.Test.Session
   ( Session(..)
@@ -28,6 +29,7 @@ module Language.LSP.Test.Session
   , bumpTimeoutId
   , logMsg
   , LogMsgType(..)
+  , documentChangeUri
   )
 
 where
@@ -134,7 +136,7 @@ data SessionContext = SessionContext
   -- Keep curTimeoutId in SessionContext, as its tied to messageChan
   , curTimeoutId :: MVar Int -- ^ The current timeout we are waiting on
   , requestMap :: MVar RequestMap
-  , initRsp :: MVar InitializeResponse
+  , initRsp :: MVar (ResponseMessage Initialize)
   , config :: SessionConfig
   , sessionCapabilities :: ClientCapabilities
   }
@@ -274,7 +276,10 @@ runSession' serverIn serverOut mServerProc serverHandler config caps rootDir exi
         let cleanup
               | Just sp <- mServerProc = do
                   -- Give the server some time to exit cleanly
+                  -- It makes the server hangs in windows so we have to avoid it
+#ifndef mingw32_HOST_OS
                   timeout msgTimeoutMs (waitForProcess sp)
+#endif
                   cleanupProcess (Just serverIn, Just serverOut, Nothing, sp)
               | otherwise = pure ()
         finally (timeout msgTimeoutMs (runSession' exitServer))
@@ -292,6 +297,14 @@ updateStateC = awaitForever $ \msg -> do
   updateState msg
   yield msg
 
+-- extract Uri out from DocumentChange
+-- didn't put this in `lsp-types` because TH was getting in the way
+documentChangeUri :: DocumentChange -> Uri
+documentChangeUri (InL x) = x ^. textDocument . uri
+documentChangeUri (InR (InL x)) = x ^. uri
+documentChangeUri (InR (InR (InL x))) = x ^. oldUri
+documentChangeUri (InR (InR (InR x))) = x ^. uri
+
 updateState :: (MonadIO m, HasReader SessionContext m, HasState SessionState m)
             => FromServerMessage -> m ()
 
@@ -319,8 +332,8 @@ updateState (FromServerMess SWorkspaceApplyEdit r) = do
   -- First, prefer the versioned documentChanges field
   allChangeParams <- case r ^. params . edit . documentChanges of
     Just (List cs) -> do
-      mapM_ (checkIfNeedsOpened . (^. textDocument . uri)) cs
-      return $ map getParams cs
+      mapM_ (checkIfNeedsOpened . documentChangeUri) cs
+      return $ mapMaybe getParamsFromDocumentChange cs
     -- Then fall back to the changes field
     Nothing -> case r ^. params . edit . changes of
       Just cs -> do
@@ -367,10 +380,16 @@ updateState (FromServerMess SWorkspaceApplyEdit r) = do
               let (newVFS,_) = openVFS (vfs s) msg
               return $ s { vfs = newVFS }
 
-        getParams (TextDocumentEdit docId (List edits)) =
+        getParamsFromTextDocumentEdit :: TextDocumentEdit -> DidChangeTextDocumentParams
+        getParamsFromTextDocumentEdit (TextDocumentEdit docId (List edits)) = 
           let changeEvents = map (\e -> TextDocumentContentChangeEvent (Just (e ^. range)) Nothing (e ^. newText)) edits
             in DidChangeTextDocumentParams docId (List changeEvents)
 
+        getParamsFromDocumentChange :: DocumentChange -> Maybe DidChangeTextDocumentParams
+        getParamsFromDocumentChange (InL textDocumentEdit) = Just $ getParamsFromTextDocumentEdit textDocumentEdit
+        getParamsFromDocumentChange _ = Nothing
+
+
         -- For a uri returns an infinite list of versions [n,n+1,n+2,...]
         -- where n is the current version
         textDocumentVersions uri = do
@@ -383,8 +402,8 @@ updateState (FromServerMess SWorkspaceApplyEdit r) = do
           vers <- textDocumentVersions uri
           pure $ map (\(v, e) -> TextDocumentEdit v (List [e])) $ zip vers edits
 
-        getChangeParams uri (List edits) =
-          map <$> pure getParams <*> textDocumentEdits uri (reverse edits)
+        getChangeParams uri (List edits) = do 
+          map <$> pure getParamsFromTextDocumentEdit <*> textDocumentEdits uri (reverse edits)
 
         mergeParams :: [DidChangeTextDocumentParams] -> DidChangeTextDocumentParams
         mergeParams params = let events = concat (toList (map (toList . (^. contentChanges)) params))