+ return result
+
+-- | Listens to the server output, makes sure it matches the record and
+-- signals any semaphores
+listenServer :: Handle -> Session ()
+listenServer serverOut = do
+ context <- lift ask
+ msgBytes <- liftIO $ getNextMessage serverOut
+
+ liftIO $ case decode msgBytes :: Maybe LogMessageNotification of
+ -- Just print log and show messages
+ Just (NotificationMessage _ WindowLogMessage (LogMessageParams _ msg)) -> T.putStrLn msg
+ _ -> case decode msgBytes :: Maybe ShowMessageNotification of
+ Just (NotificationMessage _ WindowShowMessage (ShowMessageParams _ msg)) -> T.putStrLn msg
+ -- Give everything else for getMessage to handle
+ _ -> putMVar (messageSema context) msgBytes
+
+ listenServer serverOut
+
+-- | Sends a request to the server.
+--
+-- @
+-- sendRequest (Proxy :: Proxy DocumentSymbolRequest)
+-- TextDocumentDocumentSymbol
+-- (DocumentSymbolParams docId)
+-- @
+sendRequest
+ :: forall params resp. (ToJSON params, ToJSON resp, FromJSON resp)
+ => Proxy (RequestMessage ClientMethod params resp) -- ^ A proxy to provide more type information about the request.
+ -> ClientMethod -- ^ The request method.
+ -> params -- ^ The request parameters.
+ -> Session LspId -- ^ The id of the request that was sent.
+sendRequest _ method params = do
+ id <- curReqId <$> get
+ get >>= \c -> put c { curReqId = nextId id }
+
+ let req = RequestMessage "2.0" id method params :: RequestMessage ClientMethod params resp
+
+ sendRequest' req
+
+ return id
+
+ where nextId (IdInt i) = IdInt (i + 1)
+ nextId (IdString s) = IdString $ T.pack $ show $ read (T.unpack s) + 1
+
+sendRequest' :: (ToJSON a, ToJSON b, ToJSON c) => RequestMessage a b c -> Session ()
+sendRequest' = sendMessage
+
+-- | 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 <$> lift ask
+ liftIO $ B.hPut h $ addHeader (encode msg)
+
+-- | Reads in a message from the server.
+getMessage :: FromJSON a => Session a
+getMessage = do
+ sema <- messageSema <$> lift ask
+ bytes <- liftIO $ takeMVar sema
+ return $ fromMaybe (error $ "Wrong type! Got: " ++ show bytes) (decode bytes)
+
+-- | 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 <- lift ask
+ let fp = rootDir context </> file
+ contents <- liftIO $ T.readFile fp
+ return $ TextDocumentItem (filePathToUri fp) (T.pack languageId) 0 contents
+
+-- | Gets the Uri for the file corrected to the session directory.
+getDocUri :: FilePath -> Session Uri
+getDocUri file = do
+ context <- lift ask
+ let fp = rootDir context </> file
+ return $ filePathToUri fp
\ No newline at end of file