-inRightOrder :: B.ByteString -> [B.ByteString] -> Bool
-inRightOrder _ [] = error "why is this empty"
-inRightOrder received msgs = received `elem` valid
- where
- valid = takeWhile canSkip msgs ++ firstNonSkip
- -- we don't care about the order of notifications
- canSkip = isNotification
- nonSkip = dropWhile canSkip msgs
- firstNonSkip | null nonSkip = []
- | otherwise = [head nonSkip]
-
-getAllMessages :: Handle -> IO [B.ByteString]
-getAllMessages h = do
- done <- hIsEOF h
- if done
- then return []
- else do
- msg <- getNextMessage h
- (msg :) <$> getAllMessages h
-
--- | Fetches the next message bytes based on
--- the Content-Length header
-getNextMessage :: Handle -> IO B.ByteString
-getNextMessage h = do
- headers <- getHeaders h
- case read . init <$> lookup "Content-Length" headers of
- Nothing -> error "Couldn't read Content-Length header"
- Just size -> B.hGet h size
-
-
-handlers :: Handle -> (MVar LSP.LspIdRsp, MVar LSP.LspId) -> Handlers
-handlers serverH (reqSema, rspSema) = def
- {
- -- Requests
- hoverHandler = Just request
- , completionHandler = Just request
- , completionResolveHandler = Just request
- , signatureHelpHandler = Just request
- , definitionHandler = Just request
- , referencesHandler = Just request
- , documentHighlightHandler = Just request
- , documentSymbolHandler = Just request
- , workspaceSymbolHandler = Just request
- , codeActionHandler = Just request
- , codeLensHandler = Just request
- , codeLensResolveHandler = Just request
- , documentFormattingHandler = Just request
- , documentRangeFormattingHandler = Just request
- , documentTypeFormattingHandler = Just request
- , renameHandler = Just request
- , documentLinkHandler = Just request
- , documentLinkResolveHandler = Just request
- , executeCommandHandler = Just request
- , initializeRequestHandler = Just request
- -- Notifications
- , didChangeConfigurationParamsHandler = Just notification
- , didOpenTextDocumentNotificationHandler = Just notification
- , didChangeTextDocumentNotificationHandler = Just notification
- , didCloseTextDocumentNotificationHandler = Just notification
- , didSaveTextDocumentNotificationHandler = Just notification
- , didChangeWatchedFilesNotificationHandler = Just notification
- , initializedHandler = Just notification
- , willSaveTextDocumentNotificationHandler = Just notification
- , cancelNotificationHandler = Just notification
- , exitNotificationHandler = Just notification
- -- Responses
- , responseHandler = Just response
- }
- where
- -- TODO: May need to prevent premature exit notification being sent
- -- notification msg@(LSP.NotificationMessage _ LSP.Exit _) = do
- -- putStrLn "Will send exit notification soon"
- -- threadDelay 10000000
- -- B.hPut serverH $ addHeader (encode msg)
- notification msg@(LSP.NotificationMessage _ m _) = do
- B.hPut serverH $ addHeader (encode msg)
-
- putStrLn $ "Sent a notification " ++ show m
-
- request msg@(LSP.RequestMessage _ id m _) = do
- B.hPut serverH $ addHeader (encode msg)
- putStrLn $ "Sent a request id " ++ show id ++ ": " ++ show m ++ "\nWaiting for a response"
-
- rspId <- takeMVar reqSema
- when (LSP.responseId id /= rspId)
- $ error
- $ "Expected id "
- ++ show id
- ++ ", got "
- ++ show rspId