diff --git a/datalog-lsp/src/Datalog/LSP/Highlight.hs b/datalog-lsp/src/Datalog/LSP/Highlight.hs index d627bed..bba76db 100644 --- a/datalog-lsp/src/Datalog/LSP/Highlight.hs +++ b/datalog-lsp/src/Datalog/LSP/Highlight.hs @@ -1,29 +1,35 @@ module Datalog.LSP.Highlight where +import Control.Concurrent.STM +import Control.Monad.Trans import Data.Either (fromRight) +import Data.Map qualified as M import Data.Text qualified as T import Datalog.LSP.Types (DLogLspM, LSPContext (..)) +import Datalog.LSP.Utils (currentBufferUri) import Datalog.Parser (SrcLoc (..)) import Datalog.Syntax (Atom' (Atom), Program' (..), RelId (RelId), Rule' (..), Term' (..)) import Language.LSP.Protocol.Message import Language.LSP.Protocol.Types import Language.LSP.Server -import Control.Monad.Trans -import Control.Concurrent.STM -import qualified Data.Map as M -import Datalog.LSP.Utils (currentBufferUri) tokenHandler :: Handlers DLogLspM tokenHandler = requestHandler SMethod_TextDocumentSemanticTokensFull $ \req responder -> do LSPContext parseRef <- getConfig p <- lift . readTVarIO $ parseRef case M.lookup (currentBufferUri req) p of - Nothing -> responder (Left $ TResponseError (InL LSPErrorCodes_RequestFailed) "Doc not bundle" Nothing) + 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 - let semanticTokens = fromRight (error "") $ makeSemanticTokens defaultSemanticTokensLegend $ highlightProg prog - responder (Right $ InL semanticTokens) + responder + ( Right + . InL + . fromRight (error "") + . makeSemanticTokens defaultSemanticTokensLegend + $ highlightProg prog + ) highlightProg :: Program' SrcLoc -> [SemanticTokenAbsolute] highlightProg (Program _ rs) = rs >>= highlightRule