Compare commits

..

No commits in common. "2222fa87c7dd712a25f35bf04de4b092ab200b98" and "27eb944b071e777b4450eadf1f76cd6a95e94fc9" have entirely different histories.

3 changed files with 12 additions and 11 deletions

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 :: (MonadIO m, MonadLsp LSPState m, HasParams s a1, HasTextDocument a1 a2, HasUri a2 Uri) => s -> m () updateState :: (HasParams s a1, MonadLsp LSPState (t IO), HasUri a2 Uri, HasTextDocument a1 a2, MonadTrans t) => s -> t IO ()
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 <- liftIO . atomically $ do parseResult <- lift . atomically $ do
v <- readTVar parseRef v <- readTVar parseRef
let parsedBuffer = runParser parseProgram (show uri) bufferText let parsedBuffer = runParser parseProgram (show uri) bufferText

View File

@ -17,18 +17,19 @@ 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 ->
Left $ TResponseError (InL LSPErrorCodes_RequestFailed) "Doc not found in bundle" Nothing responder (Left $ TResponseError (InL LSPErrorCodes_RequestFailed) "Doc not bundle" Nothing)
Just (Left _) -> Just (Left _) ->
Left $ TResponseError (InL LSPErrorCodes_RequestFailed) "Failed to parse" Nothing responder (Left $ TResponseError (InL LSPErrorCodes_RequestFailed) "Failed to parse" Nothing)
Just (Right prog) -> Just (Right prog) -> do
Right responder
( 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

View File

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