diff --git a/jbeam-edit.cabal b/jbeam-edit.cabal index a1ec9448..efec9fca 100644 --- a/jbeam-edit.cabal +++ b/jbeam-edit.cabal @@ -165,6 +165,7 @@ library jbeam-edit-transformation library jbeam-language-server exposed-modules: JbeamEdit.LSP.Handlers.Formatting + JbeamEdit.LSP.Logging JbeamEdit.LSP.Server JbeamEdit.LSP.Services.DocumentStore @@ -197,7 +198,9 @@ library jbeam-language-server ghc-options: -optc-Os -optl-static if flag(lsp-server) - build-depends: lsp >=2.7 + build-depends: + co-log-core, + lsp >=2.7 else buildable: False diff --git a/package.yaml b/package.yaml index c9c7443a..26219c53 100644 --- a/package.yaml +++ b/package.yaml @@ -93,7 +93,7 @@ internal-libraries: when: condition: flag(lsp-server) then: - dependencies: [lsp >= 2.7] + dependencies: [lsp >= 2.7, co-log-core] else: buildable: false source-dirs: src-extra/language-server diff --git a/src-extra/language-server/JbeamEdit/LSP/Handlers/Formatting.hs b/src-extra/language-server/JbeamEdit/LSP/Handlers/Formatting.hs index 19260338..f967c023 100644 --- a/src-extra/language-server/JbeamEdit/LSP/Handlers/Formatting.hs +++ b/src-extra/language-server/JbeamEdit/LSP/Handlers/Formatting.hs @@ -3,6 +3,10 @@ module JbeamEdit.LSP.Handlers.Formatting (handlers) where +import Colog.Core ( + LogAction (..), + WithSeverity (..), + ) import Control.Monad.IO.Class import Data.Bool (bool) import Data.ByteString.Lazy qualified as LBS @@ -12,7 +16,7 @@ import Data.Text.Encoding (encodeUtf8) import JbeamEdit.Core.Node (Node) import JbeamEdit.Formatting qualified as Fmt import JbeamEdit.Formatting.Rules (RuleSet) -import JbeamEdit.IOUtils +import JbeamEdit.LSP.Logging import JbeamEdit.LSP.Services.DocumentStore qualified as Docs import JbeamEdit.Parsing.Jbeam qualified as JbeamP import Language.LSP.Protocol.Message qualified as Msg @@ -23,15 +27,16 @@ import Language.LSP.Protocol.Types qualified as J ( Range (..), TextDocumentIdentifier (..), TextEdit (..), + Uri (..), type (|?) (..), ) import Language.LSP.Server qualified as S -putErrorLine' :: MonadIO m => Text -> m () -putErrorLine' = liftIO . putErrorLine - -handlers :: RuleSet -> S.Handlers (S.LspM config) -handlers rs = +handlers + :: RuleSet + -> LogAction IO (WithSeverity String) + -> S.Handlers (S.LspM config) +handlers rs logAction = S.requestHandler Msg.SMethod_TextDocumentFormatting formattingHandler where formattingHandler @@ -43,12 +48,13 @@ handlers rs = ) -> S.LspM config () formattingHandler req responder = do - putErrorLine' "DEBUG: formattingHandler invoked" + logDebug logAction "formattingHandler invoked" let Msg.TRequestMessage _ _ _ (params :: J.DocumentFormattingParams) = req - handleParams rs params responder + handleParams rs logAction params responder handleParams :: RuleSet + -> LogAction IO (WithSeverity String) -> J.DocumentFormattingParams -> ( Either (Msg.TResponseError Msg.Method_TextDocumentFormatting) @@ -56,31 +62,41 @@ handleParams -> S.LspM config () ) -> S.LspM config () -handleParams rs params responder = do +handleParams rs logAction params responder = do let J.DocumentFormattingParams {J._textDocument = textDocId} = params J.TextDocumentIdentifier {J._uri = uri} = textDocId sendNoUpdate = responder (Right (J.InR J.Null)) + mText <- liftIO $ Docs.get uri case mText of - Nothing -> - putErrorLine' ("DEBUG: no document in store for " <> T.show uri) - >> sendNoUpdate + Nothing -> do + logDebug logAction ("no document in store for " <> J.getUri uri) + sendNoUpdate Just txt -> case JbeamP.parseNodes . LBS.fromStrict . encodeUtf8 $ txt of - Left err -> - putErrorLine' ("Parse error: " <> T.show err) >> sendNoUpdate + Left err -> do + logError logAction ("Parse error: " <> err) + sendNoUpdate Right node -> case runFormatNode rs txt node of - Nothing -> responder (Right (J.InR J.Null)) - Just edit -> responder (Right (J.InL [edit])) + Nothing -> + sendNoUpdate + Just edit -> + responder (Right (J.InL [edit])) runFormatNode :: RuleSet -> T.Text -> Node -> Maybe J.TextEdit runFormatNode ruleSet txt node = let newText = Fmt.formatNode ruleSet node - edit = J.TextEdit {J._range = wholeRange txt, J._newText = newText} - in bool Nothing (Just edit) (newText /= txt) + edit = + J.TextEdit + { J._range = wholeRange txt + , J._newText = newText + } + in if newText /= txt + then Just edit + else Nothing -wholeRange :: Text -> J.Range +wholeRange :: T.Text -> J.Range wholeRange txt = let ls = T.lines txt numLines = max 1 (length ls) @@ -90,4 +106,7 @@ wholeRange txt = (lastLine : _) -> T.length lastLine in J.Range (J.Position 0 0) - (J.Position (fromIntegral numLines) (fromIntegral lastLineLen)) + ( J.Position + (fromIntegral numLines) + (fromIntegral lastLineLen) + ) diff --git a/src-extra/language-server/JbeamEdit/LSP/Logging.hs b/src-extra/language-server/JbeamEdit/LSP/Logging.hs new file mode 100644 index 00000000..e3c100e3 --- /dev/null +++ b/src-extra/language-server/JbeamEdit/LSP/Logging.hs @@ -0,0 +1,25 @@ +module JbeamEdit.LSP.Logging (logDebug, logInfo, logWarning, logError) where + +import Colog.Core (LogAction (..), Severity (..), WithSeverity (..)) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.Text (Text) +import Data.Text qualified as T (unpack) + +logMsg + :: MonadIO m => Severity -> LogAction IO (WithSeverity String) -> Text -> m () +logMsg sev logAction msg = + let msgTxt = T.unpack msg + msgWithSeverity = WithSeverity msgTxt sev + in liftIO (unLogAction logAction msgWithSeverity) + +logDebug :: MonadIO m => LogAction IO (WithSeverity String) -> Text -> m () +logDebug = logMsg Debug + +logInfo :: MonadIO m => LogAction IO (WithSeverity String) -> Text -> m () +logInfo = logMsg Info + +logWarning :: MonadIO m => LogAction IO (WithSeverity String) -> Text -> m () +logWarning = logMsg Warning + +logError :: MonadIO m => LogAction IO (WithSeverity String) -> Text -> m () +logError = logMsg Error diff --git a/src-extra/language-server/JbeamEdit/LSP/Server.hs b/src-extra/language-server/JbeamEdit/LSP/Server.hs index 5969abc9..46346e5f 100644 --- a/src-extra/language-server/JbeamEdit/LSP/Server.hs +++ b/src-extra/language-server/JbeamEdit/LSP/Server.hs @@ -4,11 +4,12 @@ module JbeamEdit.LSP.Server (runServer) where +import Colog.Core (LogAction (..), WithSeverity (..)) import Control.Monad.IO.Class import Data.Kind (Type) import JbeamEdit.Formatting.Rules (RuleSet) -import JbeamEdit.IOUtils import JbeamEdit.LSP.Handlers.Formatting qualified as Formatting +import JbeamEdit.LSP.Logging import JbeamEdit.LSP.Services.DocumentStore qualified as Docs import Language.LSP.Protocol.Message qualified as Msg import Language.LSP.Protocol.Types qualified as J ( @@ -22,23 +23,34 @@ import Language.LSP.Protocol.Types qualified as J ( TextDocumentItem (..), TextDocumentSyncKind (..), TextDocumentSyncOptions (..), + Uri (..), VersionedTextDocumentIdentifier (..), type (|?) (..), ) import Language.LSP.Server qualified as S +import System.IO (hPutStrLn, stderr) -staticHandlers :: RuleSet -> S.Handlers (S.LspM config) -staticHandlers rs = +staticHandlers + :: RuleSet -> LogAction IO (WithSeverity String) -> S.Handlers (S.LspM config) +staticHandlers rs logAction = mconcat - [ S.notificationHandler Msg.SMethod_Initialized $ \_notif -> - liftIO $ putErrorLine "Client initialized" - , S.notificationHandler Msg.SMethod_WorkspaceDidChangeConfiguration $ \_notif -> - liftIO $ putErrorLine "Configuration changed" - , S.notificationHandler Msg.SMethod_TextDocumentDidOpen handleDidOpen - , S.notificationHandler Msg.SMethod_TextDocumentDidClose handleDidClose - , S.notificationHandler Msg.SMethod_TextDocumentDidChange handleDidChange + [ S.notificationHandler Msg.SMethod_Initialized $ \_ -> + logInfo logAction "Client initialized" + , S.notificationHandler Msg.SMethod_WorkspaceDidChangeConfiguration $ \_ -> + logInfo logAction "Configuration changed" + , S.notificationHandler Msg.SMethod_TextDocumentDidOpen $ + handleDidOpen logAction + , S.notificationHandler Msg.SMethod_TextDocumentDidClose $ + handleDidClose logAction + , S.notificationHandler Msg.SMethod_TextDocumentDidChange $ + handleDidChange logAction ] - <> Formatting.handlers rs + <> Formatting.handlers rs logAction + +stderrLogger :: LogAction IO (WithSeverity String) +stderrLogger = + LogAction $ \(WithSeverity msg sev) -> + hPutStrLn stderr ("[" <> show sev <> "] " <> msg) -- | Starta LSP-servern runServer :: RuleSet -> IO Int @@ -49,8 +61,8 @@ runServer rs = , parseConfig = \_ _ -> Right () , onConfigChange = const >> pure $ pure () , defaultConfig = () - , doInitialize = \env _req -> pure (Right env) - , staticHandlers = const $ staticHandlers rs + , doInitialize = \env _ -> pure (Right env) + , staticHandlers = const $ staticHandlers rs stderrLogger , interpretHandler = \env -> S.Iso (S.runLspT env) liftIO , options = S.defaultOptions @@ -73,11 +85,19 @@ handleDidOpen {f :: Msg.MessageDirection} {m1 :: Msg.Method f Msg.Notification} {m2 :: Type -> Type} - . (MonadIO m2, Msg.MessageParams m1 ~ J.DidOpenTextDocumentParams) - => Msg.TNotificationMessage m1 -> m2 () -handleDidOpen (Msg.TNotificationMessage _ _ (J.DidOpenTextDocumentParams textDoc)) = - let J.TextDocumentItem {J._uri = uri, J._text = txt} = textDoc - in liftIO $ Docs.open uri txt + . ( MonadIO m2 + , Msg.MessageParams m1 ~ J.DidOpenTextDocumentParams + ) + => LogAction IO (WithSeverity String) + -> Msg.TNotificationMessage m1 + -> m2 () +handleDidOpen + logAction + (Msg.TNotificationMessage _ _ (J.DidOpenTextDocumentParams textDoc)) = + let J.TextDocumentItem {J._uri = uri, J._text = txt} = textDoc + in liftIO $ do + Docs.open uri txt + logInfo logAction ("Document opened: " <> J.getUri uri) -- | didChange: update document in DocumentStore handleDidChange @@ -88,15 +108,24 @@ handleDidChange . ( MonadIO m2 , Msg.MessageParams m1 ~ J.DidChangeTextDocumentParams ) - => Msg.TNotificationMessage m1 -> m2 () -handleDidChange (Msg.TNotificationMessage _ _ (J.DidChangeTextDocumentParams docId changes)) = - let J.VersionedTextDocumentIdentifier {_uri = uri} = docId - in case changes of - (J.TextDocumentContentChangeEvent change : _) -> - case change of - J.InL (J.TextDocumentContentChangePartial {J._text = txt}) -> liftIO $ Docs.update uri txt - J.InR (J.TextDocumentContentChangeWholeDocument txt) -> liftIO $ Docs.update uri txt - _ -> pure () + => LogAction IO (WithSeverity String) + -> Msg.TNotificationMessage m1 + -> m2 () +handleDidChange + logAction + (Msg.TNotificationMessage _ _ (J.DidChangeTextDocumentParams docId changes)) = + let J.VersionedTextDocumentIdentifier {_uri = uri} = docId + in liftIO $ + case changes of + (J.TextDocumentContentChangeEvent change : _) -> do + case change of + J.InL (J.TextDocumentContentChangePartial {J._text = txt}) -> + Docs.update uri txt + J.InR (J.TextDocumentContentChangeWholeDocument txt) -> + Docs.update uri txt + + logInfo logAction ("Document changed: " <> J.getUri uri) + _ -> pure () handleDidClose :: forall @@ -106,6 +135,13 @@ handleDidClose . ( MonadIO m2 , Msg.MessageParams m1 ~ J.DidCloseTextDocumentParams ) - => Msg.TNotificationMessage m1 -> m2 () -handleDidClose (Msg.TNotificationMessage _ _ (J.DidCloseTextDocumentParams docId)) = - let J.TextDocumentIdentifier {_uri = uri} = docId in liftIO (Docs.delete uri) + => LogAction IO (WithSeverity String) + -> Msg.TNotificationMessage m1 + -> m2 () +handleDidClose + logAction + (Msg.TNotificationMessage _ _ (J.DidCloseTextDocumentParams docId)) = + let J.TextDocumentIdentifier {_uri = uri} = docId + in liftIO $ do + Docs.delete uri + logInfo logAction ("Document closed: " <> J.getUri uri)