import qualified Data.Text as T
import Language.Haskell.LSP.Capture
import Language.Haskell.LSP.Messages
-import Language.Haskell.LSP.Types as LSP hiding (error)
+import Language.Haskell.LSP.Types
+import Language.Haskell.LSP.Types.Lens as LSP hiding (error)
import Data.Aeson
import Data.Default
import Data.List
import Control.Lens hiding (List)
import Control.Monad
import System.FilePath
+import System.IO
import Language.Haskell.LSP.Test
import Language.Haskell.LSP.Test.Files
import Language.Haskell.LSP.Test.Decoding
import Language.Haskell.LSP.Test.Server
import Language.Haskell.LSP.Test.Session
-
-- | Replays a captured client output and
-- makes sure it matches up with an expected response.
-- The session directory should have a captured session file in it
notification msg@(NotificationMessage _ Exit _) = do
liftIO $ putStrLn "Will send exit notification soon"
liftIO $ threadDelay 10000000
- sendNotification' msg
+ sendMessage msg
liftIO $ error "Done"
notification msg@(NotificationMessage _ m _) = do
- sendNotification' msg
+ sendMessage msg
liftIO $ putStrLn $ "Sent a notification " ++ show m
sendMessages remainingMsgs reqSema rspSema
+sendRequestMessage :: (ToJSON a, ToJSON b) => RequestMessage ClientMethod a b -> Session ()
+sendRequestMessage req = do
+ -- Update the request map
+ reqMap <- requestMap <$> ask
+ liftIO $ modifyMVar_ reqMap $
+ \r -> return $ updateRequestMap r (req ^. LSP.id) (req ^. method)
+
+ sendMessage req
+
isNotification :: FromServerMessage -> Bool
isNotification (NotPublishDiagnostics _) = True
isNotification (NotCancelRequestFromServer _) = True
isNotification _ = False
--- listenServer :: [FromServerMessage]
--- -> RequestMap
--- -> MVar LspId
--- -> MVar LspIdRsp
--- -> MVar ()
--- -> ThreadId
--- -> Handle
--- -> SessionContext
--- -> IO ()
+listenServer :: [FromServerMessage]
+ -> RequestMap
+ -> MVar LspId
+ -> MVar LspIdRsp
+ -> MVar ()
+ -> ThreadId
+ -> Handle
+ -> SessionContext
+ -> IO ()
listenServer [] _ _ _ passSema _ _ _ = putMVar passSema ()
listenServer expectedMsgs reqMap reqSema rspSema passSema mainThreadId serverOut ctx = do