From d7593d08be8201ef453c53a2205f4aa4a893df4c Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Wed, 1 Aug 2018 13:01:15 +0100 Subject: [PATCH] Hide some internals --- src/Language/Haskell/LSP/Test.hs | 20 +++----------------- src/Language/Haskell/LSP/Test/Replay.hs | 13 +++++++++++-- 2 files changed, 14 insertions(+), 19 deletions(-) diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs index 17cdd85..b7057c2 100644 --- a/src/Language/Haskell/LSP/Test.hs +++ b/src/Language/Haskell/LSP/Test.hs @@ -33,8 +33,6 @@ module Language.Haskell.LSP.Test , request_ , sendRequest , sendNotification - , sendRequestMessage - , sendNotification' , sendResponse -- * Receving , message @@ -250,15 +248,6 @@ instance ToJSON a => ToJSON (RequestMessage' a) where object ["jsonrpc" .= rpc, "id" .= id, "method" .= method, "params" .= params] -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 - -- | Sends a notification to the server. sendNotification :: ToJSON a => ClientMethod -- ^ The notification method. @@ -273,7 +262,7 @@ sendNotification TextDocumentDidOpen params = do oldVFS <- vfs <$> get newVFS <- liftIO $ openVFS oldVFS n modify (\s -> s { vfs = newVFS }) - sendNotification' n + sendMessage n -- | Close a virtual file if we send a close text document notification sendNotification TextDocumentDidClose params = do @@ -283,12 +272,9 @@ sendNotification TextDocumentDidClose params = do oldVFS <- vfs <$> get newVFS <- liftIO $ closeVFS oldVFS n modify (\s -> s { vfs = newVFS }) - sendNotification' n - -sendNotification method params = sendNotification' (NotificationMessage "2.0" method params) + sendMessage n -sendNotification' :: (ToJSON a, ToJSON b) => NotificationMessage a b -> Session () -sendNotification' = sendMessage +sendNotification method params = sendMessage (NotificationMessage "2.0" method params) sendResponse :: ToJSON a => ResponseMessage a -> Session () sendResponse = sendMessage diff --git a/src/Language/Haskell/LSP/Test/Replay.hs b/src/Language/Haskell/LSP/Test/Replay.hs index 73151d7..6c049d0 100644 --- a/src/Language/Haskell/LSP/Test/Replay.hs +++ b/src/Language/Haskell/LSP/Test/Replay.hs @@ -84,12 +84,12 @@ sendMessages (nextMsg:remainingMsgs) reqSema rspSema = 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 @@ -116,6 +116,15 @@ sendMessages (nextMsg:remainingMsgs) reqSema rspSema = 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 -- 2.30.2