patrickaldis/geolog-lsp
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

pull responder out of case

Browse Source
This commit is contained in:
Patrick Aldis 2026-03-09 16:15:33 +00:00
parent 535d985aa9
commit 6b2ae759ab
1 changed files with 8 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
datalog-lsp/src/Datalog/LSP/Highlight.hs
View File

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