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

Compare commits

base: patrickaldis:27eb944b071e777b4450eadf1f76cd6a95e94fc9
Branches Tags
patrickaldis:master
...
compare: patrickaldis:2222fa87c7dd712a25f35bf04de4b092ab200b98
Branches Tags
patrickaldis:master

5 Commits
27eb944b07 ... 2222fa87c7

Author SHA1 Message Date
Patrick Aldis
2222fa87c7 newtype over data 2026-03-09 16:18:15 +00:00
Patrick Aldis
6f37a60f3b more sensible error message 2026-03-09 16:17:25 +00:00
Patrick Aldis
6b2ae759ab pull responder out of case 2026-03-09 16:15:33 +00:00
Patrick Aldis
535d985aa9 better ordered typeclasses 2026-03-09 16:07:21 +00:00
Patrick Aldis
5c97fd64db updateState has more general type 2026-03-09 16:05:37 +00:00
3 changed files with 11 additions and 12 deletions
Show Stats Expand all files Collapse all files

4
datalog-lsp/src/Datalog/LSP/DocChange.hs
View File

@ -23,13 +23,13 @@ docOpenHandler = notificationHandler SMethod_TextDocumentDidOpen updateState
docChangeHandler :: Handlers DLogLspM docChangeHandler :: Handlers DLogLspM
docChangeHandler = notificationHandler SMethod_TextDocumentDidChange updateState docChangeHandler = notificationHandler SMethod_TextDocumentDidChange updateState
updateState :: (HasParams s a1, MonadLsp LSPState (t IO), HasUri a2 Uri, HasTextDocument a1 a2, MonadTrans t) => s -> t IO () updateState :: (MonadIO m, MonadLsp LSPState m, HasParams s a1, HasTextDocument a1 a2, HasUri a2 Uri) => s -> m ()
updateState req = do updateState req = do
let uri = currentBufferUri req let uri = currentBufferUri req
parseRef <- parseState <$> getConfig parseRef <- parseState <$> getConfig
bufferText <- currentBufferText req bufferText <- currentBufferText req
parseResult <- lift . atomically $ do parseResult <- liftIO . atomically $ do
v <- readTVar parseRef v <- readTVar parseRef
let parsedBuffer = runParser parseProgram (show uri) bufferText let parsedBuffer = runParser parseProgram (show uri) bufferText

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 found in 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

2
datalog-lsp/src/Datalog/LSP/Types.hs
View File

@ -14,6 +14,6 @@ type DLogLspM = LspM LSPState
type UriBundle a = Map J.NormalizedUri a type UriBundle a = Map J.NormalizedUri a
data LSPState = LSPState newtype LSPState = LSPState
{ parseState :: TVar (UriBundle (Either (ParseErrorBundle Text Void) (Program' SrcLoc))) { parseState :: TVar (UriBundle (Either (ParseErrorBundle Text Void) (Program' SrcLoc)))
} }