-requestHandler :: Client.RequestMessageHandler
-requestHandler = Client.RequestMessageHandler
- (\m -> emptyRsp m <$ print m)
- (\m -> emptyRsp m <$ print m)
- (\m -> emptyRsp m <$ print m)
- (\m -> emptyRsp m <$ print m)
- where emptyRsp :: LSP.RequestMessage m req rsp -> LSP.ResponseMessage a
- emptyRsp m = LSP.ResponseMessage (m ^. LSP.jsonrpc)
- (lspIdToRspId $ m ^. LSP.id)
- Nothing
- Nothing
+-- | A custom type for request message that doesn't
+-- need a response type, allows us to infer the request
+-- message type without using proxies.
+data RequestMessage' a = RequestMessage' T.Text LspId ClientMethod a
+
+instance ToJSON a => ToJSON (RequestMessage' a) where
+ toJSON (RequestMessage' rpc id method params) =
+ object ["jsonrpc" .= rpc, "id" .= id, "method" .= method, "params" .= params]
+
+
+sendRequest' :: (ToJSON a, ToJSON b) => RequestMessage ClientMethod a b -> Session ()
+sendRequest' 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.
+ -> a -- ^ The notification parameters.
+ -> Session ()
+sendNotification method params =
+ let notif = NotificationMessage "2.0" method params
+ in sendNotification' notif
+
+sendNotification' :: (ToJSON a, ToJSON b) => NotificationMessage a b -> Session ()
+sendNotification' = sendMessage
+
+sendResponse :: ToJSON a => ResponseMessage a -> Session ()
+sendResponse = sendMessage
+
+sendMessage :: ToJSON a => a -> Session ()
+sendMessage msg = do
+ h <- serverIn <$> ask
+ liftIO $ B.hPut h $ addHeader (encode msg)
+
+-- | Returns the initialize response that was received from the server.
+-- The initialize requests and responses are not included the session,
+-- so if you need to test it use this.
+getInitializeResponse :: Session InitializeResponse
+getInitializeResponse = initRsp <$> ask >>= (liftIO . readMVar)
+
+-- | Opens a text document and sends a notification to the client.
+openDoc :: FilePath -> String -> Session TextDocumentIdentifier
+openDoc file languageId = do
+ item <- getDocItem file languageId
+ sendNotification TextDocumentDidOpen (DidOpenTextDocumentParams item)
+ TextDocumentIdentifier <$> getDocUri file
+
+-- | Reads in a text document as the first version.
+getDocItem :: FilePath -- ^ The path to the text document to read in.
+ -> String -- ^ The language ID, e.g "haskell" for .hs files.
+ -> Session TextDocumentItem
+getDocItem file languageId = do
+ context <- ask
+ let fp = rootDir context </> file
+ contents <- liftIO $ T.readFile fp
+ return $ TextDocumentItem (filePathToUri fp) (T.pack languageId) 0 contents