pull responder out of case

This commit is contained in:
Patrick Aldis 2026-03-09 16:15:33 +00:00
parent 535d985aa9
commit 6b2ae759ab

View File

@ -17,19 +17,18 @@ tokenHandler :: Handlers DLogLspM
tokenHandler = requestHandler SMethod_TextDocumentSemanticTokensFull $ \req responder -> do
LSPState parseRef <- getConfig
p <- lift . readTVarIO $ parseRef
case M.lookup (currentBufferUri req) p of
Nothing ->
responder (Left $ TResponseError (InL LSPErrorCodes_RequestFailed) "Doc not bundle" Nothing)
Just (Left _) ->
responder (Left $ TResponseError (InL LSPErrorCodes_RequestFailed) "Failed to parse" Nothing)
Just (Right prog) -> do
responder
( Right
responder $
case M.lookup (currentBufferUri req) p of
Nothing ->
Left $ TResponseError (InL LSPErrorCodes_RequestFailed) "Doc not bundle" Nothing
Just (Left _) ->
Left $ TResponseError (InL LSPErrorCodes_RequestFailed) "Failed to parse" Nothing
Just (Right prog) ->
Right
. InL
. fromRight (SemanticTokens Nothing [])
. makeSemanticTokens defaultSemanticTokensLegend
$ highlightProg prog
)
highlightProg :: Program' SrcLoc -> [SemanticTokenAbsolute]
highlightProg (Program _ rs) = rs >>= highlightRule