32 lines
1.3 KiB
Haskell
32 lines
1.3 KiB
Haskell
|
|
{-# LANGUAGE BlockArguments #-}
|
||
|
|
|
||
|
|
module Datalog.LSP.DocChange (docChangeHandler, docOpenHandler) where
|
||
|
|
|
||
|
|
import Control.Concurrent.STM
|
||
|
|
import Control.Monad.Trans
|
||
|
|
import Data.Map qualified as M
|
||
|
|
import Datalog.LSP.Types
|
||
|
|
import Datalog.LSP.Utils (currentBufferText, currentBufferUri)
|
||
|
|
import Datalog.Parser (parseProgram)
|
||
|
|
import Language.LSP.Protocol.Lens (HasParams, HasTextDocument, HasUri)
|
||
|
|
import Language.LSP.Protocol.Message (SMethod (SMethod_TextDocumentDidChange, SMethod_TextDocumentDidOpen))
|
||
|
|
import Language.LSP.Protocol.Types (Uri)
|
||
|
|
import Language.LSP.Server (Handlers, MonadLsp, getConfig, notificationHandler)
|
||
|
|
import Text.Megaparsec
|
||
|
|
|
||
|
|
docOpenHandler :: Handlers DLogLspM
|
||
|
|
docOpenHandler = notificationHandler SMethod_TextDocumentDidOpen updateState
|
||
|
|
|
||
|
|
docChangeHandler :: Handlers DLogLspM
|
||
|
|
docChangeHandler = notificationHandler SMethod_TextDocumentDidChange updateState
|
||
|
|
|
||
|
|
updateState :: (HasParams s a1, MonadLsp LSPContext (t IO), HasUri a2 Uri, HasTextDocument a1 a2, MonadTrans t) => s -> t IO ()
|
||
|
|
updateState req = do
|
||
|
|
let uri = currentBufferUri req
|
||
|
|
LSPContext parseStateRef <- getConfig
|
||
|
|
text <- currentBufferText req
|
||
|
|
lift . atomically $ do
|
||
|
|
v <- readTVar parseStateRef
|
||
|
|
writeTVar parseStateRef $
|
||
|
|
M.insert uri (runParser parseProgram (show uri) text) v
|