From e912ada234b1983b58fb527c8780575544a0e35c Mon Sep 17 00:00:00 2001 From: webdevred <148627186+webdevred@users.noreply.github.com> Date: Mon, 15 Dec 2025 19:17:50 +0100 Subject: [PATCH 1/4] Added co-log-core logging for lsp server --- jbeam-edit.cabal | 4 +- package.yaml | 2 +- .../JbeamEdit/LSP/Handlers/Formatting.hs | 38 ++++---- .../language-server/JbeamEdit/LSP/Server.hs | 91 +++++++++++++------ 4 files changed, 86 insertions(+), 49 deletions(-) diff --git a/jbeam-edit.cabal b/jbeam-edit.cabal index a1ec9448..a2033abf 100644 --- a/jbeam-edit.cabal +++ b/jbeam-edit.cabal @@ -197,7 +197,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..d3c79a2c 100644 --- a/src-extra/language-server/JbeamEdit/LSP/Handlers/Formatting.hs +++ b/src-extra/language-server/JbeamEdit/LSP/Handlers/Formatting.hs @@ -3,6 +3,7 @@ module JbeamEdit.LSP.Handlers.Formatting (handlers) where +import Colog.Core (LogAction (..)) import Control.Monad.IO.Class import Data.Bool (bool) import Data.ByteString.Lazy qualified as LBS @@ -12,7 +13,6 @@ 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.Services.DocumentStore qualified as Docs import JbeamEdit.Parsing.Jbeam qualified as JbeamP import Language.LSP.Protocol.Message qualified as Msg @@ -27,13 +27,13 @@ import Language.LSP.Protocol.Types qualified as J ( ) 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 String -> S.Handlers (S.LspM config) +handlers rs logAction = S.requestHandler Msg.SMethod_TextDocumentFormatting formattingHandler where + logMsg :: MonadIO m => String -> m () + logMsg = liftIO . unLogAction logAction + formattingHandler :: Msg.TRequestMessage Msg.Method_TextDocumentFormatting -> ( Either @@ -43,12 +43,12 @@ handlers rs = ) -> S.LspM config () formattingHandler req responder = do - putErrorLine' "DEBUG: formattingHandler invoked" + logMsg "DEBUG: formattingHandler invoked" let Msg.TRequestMessage _ _ _ (params :: J.DocumentFormattingParams) = req - handleParams rs params responder - + handleParams rs logMsg params responder handleParams :: RuleSet + -> (String -> S.LspM config ()) -> J.DocumentFormattingParams -> ( Either (Msg.TResponseError Msg.Method_TextDocumentFormatting) @@ -56,23 +56,27 @@ handleParams -> S.LspM config () ) -> S.LspM config () -handleParams rs params responder = do +handleParams rs logMsg 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 + logMsg ("DEBUG: no document in store for " <> show uri) + sendNoUpdate Just txt -> case JbeamP.parseNodes . LBS.fromStrict . encodeUtf8 $ txt of - Left err -> - putErrorLine' ("Parse error: " <> T.show err) >> sendNoUpdate + Left err -> do + logMsg ("Parse error: " <> show 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 -> + responder (Right (J.InR J.Null)) + Just edit -> + responder (Right (J.InL [edit])) runFormatNode :: RuleSet -> T.Text -> Node -> Maybe J.TextEdit runFormatNode ruleSet txt node = diff --git a/src-extra/language-server/JbeamEdit/LSP/Server.hs b/src-extra/language-server/JbeamEdit/LSP/Server.hs index 5969abc9..030896cc 100644 --- a/src-extra/language-server/JbeamEdit/LSP/Server.hs +++ b/src-extra/language-server/JbeamEdit/LSP/Server.hs @@ -4,10 +4,10 @@ module JbeamEdit.LSP.Server (runServer) where +import Colog.Core (LogAction (..)) 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.Services.DocumentStore qualified as Docs import Language.LSP.Protocol.Message qualified as Msg @@ -26,19 +26,26 @@ import Language.LSP.Protocol.Types qualified as J ( 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 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 $ \_ -> + liftIO $ unLogAction logAction "Client initialized" + , S.notificationHandler Msg.SMethod_WorkspaceDidChangeConfiguration $ \_ -> + liftIO $ unLogAction 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 String +stderrLogger = LogAction (hPutStrLn stderr) -- | Starta LSP-servern runServer :: RuleSet -> IO Int @@ -49,8 +56,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 +80,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 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 + unLogAction logAction ("Document opened: " <> show uri) -- | didChange: update document in DocumentStore handleDidChange @@ -88,15 +103,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 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 + + unLogAction logAction ("Document changed: " <> show uri) + _ -> pure () handleDidClose :: forall @@ -106,6 +130,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 String + -> Msg.TNotificationMessage m1 + -> m2 () +handleDidClose + logAction + (Msg.TNotificationMessage _ _ (J.DidCloseTextDocumentParams docId)) = + let J.TextDocumentIdentifier {_uri = uri} = docId + in liftIO $ do + Docs.delete uri + unLogAction logAction ("Document closed: " <> show uri) From c6fae3f1d37967b251a6af1c369df6abf1ea2758 Mon Sep 17 00:00:00 2001 From: webdevred <148627186+webdevred@users.noreply.github.com> Date: Mon, 15 Dec 2025 22:02:08 +0100 Subject: [PATCH 2/4] Better co-log usage --- .../JbeamEdit/LSP/Handlers/Formatting.hs | 44 +++++++++++++------ .../language-server/JbeamEdit/LSP/Server.hs | 31 ++++++++----- 2 files changed, 50 insertions(+), 25 deletions(-) diff --git a/src-extra/language-server/JbeamEdit/LSP/Handlers/Formatting.hs b/src-extra/language-server/JbeamEdit/LSP/Handlers/Formatting.hs index d3c79a2c..138e9fb9 100644 --- a/src-extra/language-server/JbeamEdit/LSP/Handlers/Formatting.hs +++ b/src-extra/language-server/JbeamEdit/LSP/Handlers/Formatting.hs @@ -3,7 +3,11 @@ module JbeamEdit.LSP.Handlers.Formatting (handlers) where -import Colog.Core (LogAction (..)) +import Colog.Core ( + LogAction (..), + Severity (..), + WithSeverity (..), + ) import Control.Monad.IO.Class import Data.Bool (bool) import Data.ByteString.Lazy qualified as LBS @@ -27,12 +31,16 @@ import Language.LSP.Protocol.Types qualified as J ( ) import Language.LSP.Server qualified as S -handlers :: RuleSet -> LogAction IO String -> S.Handlers (S.LspM config) +handlers + :: RuleSet + -> LogAction IO (WithSeverity String) + -> S.Handlers (S.LspM config) handlers rs logAction = S.requestHandler Msg.SMethod_TextDocumentFormatting formattingHandler where - logMsg :: MonadIO m => String -> m () - logMsg = liftIO . unLogAction logAction + logMsg :: MonadIO m => Severity -> String -> m () + logMsg sev msg = + liftIO $ unLogAction logAction (WithSeverity msg sev) formattingHandler :: Msg.TRequestMessage Msg.Method_TextDocumentFormatting @@ -43,12 +51,13 @@ handlers rs logAction = ) -> S.LspM config () formattingHandler req responder = do - logMsg "DEBUG: formattingHandler invoked" + logMsg Debug "formattingHandler invoked" let Msg.TRequestMessage _ _ _ (params :: J.DocumentFormattingParams) = req handleParams rs logMsg params responder + handleParams :: RuleSet - -> (String -> S.LspM config ()) + -> (Severity -> String -> S.LspM config ()) -> J.DocumentFormattingParams -> ( Either (Msg.TResponseError Msg.Method_TextDocumentFormatting) @@ -64,27 +73,33 @@ handleParams rs logMsg params responder = do mText <- liftIO $ Docs.get uri case mText of Nothing -> do - logMsg ("DEBUG: no document in store for " <> show uri) + logMsg Debug ("no document in store for " <> show uri) sendNoUpdate Just txt -> case JbeamP.parseNodes . LBS.fromStrict . encodeUtf8 $ txt of Left err -> do - logMsg ("Parse error: " <> show err) + logMsg Error ("Parse error: " <> show err) sendNoUpdate Right node -> case runFormatNode rs txt node of Nothing -> - responder (Right (J.InR J.Null)) + 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) @@ -94,4 +109,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/Server.hs b/src-extra/language-server/JbeamEdit/LSP/Server.hs index 030896cc..499bd09f 100644 --- a/src-extra/language-server/JbeamEdit/LSP/Server.hs +++ b/src-extra/language-server/JbeamEdit/LSP/Server.hs @@ -4,7 +4,7 @@ module JbeamEdit.LSP.Server (runServer) where -import Colog.Core (LogAction (..)) +import Colog.Core (LogAction (..), Severity (..), WithSeverity (..)) import Control.Monad.IO.Class import Data.Kind (Type) import JbeamEdit.Formatting.Rules (RuleSet) @@ -28,13 +28,18 @@ import Language.LSP.Protocol.Types qualified as J ( import Language.LSP.Server qualified as S import System.IO (hPutStrLn, stderr) -staticHandlers :: RuleSet -> LogAction IO String -> S.Handlers (S.LspM config) +logInfo :: MonadIO m => LogAction IO (WithSeverity String) -> String -> m () +logInfo la msg = + liftIO $ unLogAction la (WithSeverity msg Info) + +staticHandlers + :: RuleSet -> LogAction IO (WithSeverity String) -> S.Handlers (S.LspM config) staticHandlers rs logAction = mconcat [ S.notificationHandler Msg.SMethod_Initialized $ \_ -> - liftIO $ unLogAction logAction "Client initialized" + logInfo logAction "Client initialized" , S.notificationHandler Msg.SMethod_WorkspaceDidChangeConfiguration $ \_ -> - liftIO $ unLogAction logAction "Configuration changed" + logInfo logAction "Configuration changed" , S.notificationHandler Msg.SMethod_TextDocumentDidOpen $ handleDidOpen logAction , S.notificationHandler Msg.SMethod_TextDocumentDidClose $ @@ -44,8 +49,10 @@ staticHandlers rs logAction = ] <> Formatting.handlers rs logAction -stderrLogger :: LogAction IO String -stderrLogger = LogAction (hPutStrLn stderr) +stderrLogger :: LogAction IO (WithSeverity String) +stderrLogger = + LogAction $ \(WithSeverity msg sev) -> + hPutStrLn stderr (show sev <> ": " <> msg) -- | Starta LSP-servern runServer :: RuleSet -> IO Int @@ -83,7 +90,7 @@ handleDidOpen . ( MonadIO m2 , Msg.MessageParams m1 ~ J.DidOpenTextDocumentParams ) - => LogAction IO String + => LogAction IO (WithSeverity String) -> Msg.TNotificationMessage m1 -> m2 () handleDidOpen @@ -92,7 +99,7 @@ handleDidOpen let J.TextDocumentItem {J._uri = uri, J._text = txt} = textDoc in liftIO $ do Docs.open uri txt - unLogAction logAction ("Document opened: " <> show uri) + logInfo logAction ("Document opened: " <> show uri) -- | didChange: update document in DocumentStore handleDidChange @@ -103,7 +110,7 @@ handleDidChange . ( MonadIO m2 , Msg.MessageParams m1 ~ J.DidChangeTextDocumentParams ) - => LogAction IO String + => LogAction IO (WithSeverity String) -> Msg.TNotificationMessage m1 -> m2 () handleDidChange @@ -119,7 +126,7 @@ handleDidChange J.InR (J.TextDocumentContentChangeWholeDocument txt) -> Docs.update uri txt - unLogAction logAction ("Document changed: " <> show uri) + logInfo logAction ("Document changed: " <> show uri) _ -> pure () handleDidClose @@ -130,7 +137,7 @@ handleDidClose . ( MonadIO m2 , Msg.MessageParams m1 ~ J.DidCloseTextDocumentParams ) - => LogAction IO String + => LogAction IO (WithSeverity String) -> Msg.TNotificationMessage m1 -> m2 () handleDidClose @@ -139,4 +146,4 @@ handleDidClose let J.TextDocumentIdentifier {_uri = uri} = docId in liftIO $ do Docs.delete uri - unLogAction logAction ("Document closed: " <> show uri) + logInfo logAction ("Document closed: " <> show uri) From 7eaf7270bae6497687991bbffd806a1dd2032a20 Mon Sep 17 00:00:00 2001 From: webdevred <148627186+webdevred@users.noreply.github.com> Date: Mon, 15 Dec 2025 23:27:37 +0100 Subject: [PATCH 3/4] log helper module --- jbeam-edit.cabal | 1 + .../JbeamEdit/LSP/Handlers/Formatting.hs | 19 ++++++-------- .../language-server/JbeamEdit/LSP/Logging.hs | 25 +++++++++++++++++++ .../language-server/JbeamEdit/LSP/Server.hs | 11 +++----- 4 files changed, 38 insertions(+), 18 deletions(-) create mode 100644 src-extra/language-server/JbeamEdit/LSP/Logging.hs diff --git a/jbeam-edit.cabal b/jbeam-edit.cabal index a2033abf..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 diff --git a/src-extra/language-server/JbeamEdit/LSP/Handlers/Formatting.hs b/src-extra/language-server/JbeamEdit/LSP/Handlers/Formatting.hs index 138e9fb9..f967c023 100644 --- a/src-extra/language-server/JbeamEdit/LSP/Handlers/Formatting.hs +++ b/src-extra/language-server/JbeamEdit/LSP/Handlers/Formatting.hs @@ -5,7 +5,6 @@ module JbeamEdit.LSP.Handlers.Formatting (handlers) where import Colog.Core ( LogAction (..), - Severity (..), WithSeverity (..), ) import Control.Monad.IO.Class @@ -17,6 +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.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 @@ -27,6 +27,7 @@ import Language.LSP.Protocol.Types qualified as J ( Range (..), TextDocumentIdentifier (..), TextEdit (..), + Uri (..), type (|?) (..), ) import Language.LSP.Server qualified as S @@ -38,10 +39,6 @@ handlers handlers rs logAction = S.requestHandler Msg.SMethod_TextDocumentFormatting formattingHandler where - logMsg :: MonadIO m => Severity -> String -> m () - logMsg sev msg = - liftIO $ unLogAction logAction (WithSeverity msg sev) - formattingHandler :: Msg.TRequestMessage Msg.Method_TextDocumentFormatting -> ( Either @@ -51,13 +48,13 @@ handlers rs logAction = ) -> S.LspM config () formattingHandler req responder = do - logMsg Debug "formattingHandler invoked" + logDebug logAction "formattingHandler invoked" let Msg.TRequestMessage _ _ _ (params :: J.DocumentFormattingParams) = req - handleParams rs logMsg params responder + handleParams rs logAction params responder handleParams :: RuleSet - -> (Severity -> String -> S.LspM config ()) + -> LogAction IO (WithSeverity String) -> J.DocumentFormattingParams -> ( Either (Msg.TResponseError Msg.Method_TextDocumentFormatting) @@ -65,7 +62,7 @@ handleParams -> S.LspM config () ) -> S.LspM config () -handleParams rs logMsg 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)) @@ -73,12 +70,12 @@ handleParams rs logMsg params responder = do mText <- liftIO $ Docs.get uri case mText of Nothing -> do - logMsg Debug ("no document in store for " <> show uri) + logDebug logAction ("no document in store for " <> J.getUri uri) sendNoUpdate Just txt -> case JbeamP.parseNodes . LBS.fromStrict . encodeUtf8 $ txt of Left err -> do - logMsg Error ("Parse error: " <> show err) + logError logAction ("Parse error: " <> err) sendNoUpdate Right node -> case runFormatNode rs txt node of 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 499bd09f..86493ae6 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 (..), Severity (..), WithSeverity (..)) +import Colog.Core (LogAction (..), WithSeverity (..)) import Control.Monad.IO.Class import Data.Kind (Type) import JbeamEdit.Formatting.Rules (RuleSet) 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 ( @@ -28,10 +29,6 @@ import Language.LSP.Protocol.Types qualified as J ( import Language.LSP.Server qualified as S import System.IO (hPutStrLn, stderr) -logInfo :: MonadIO m => LogAction IO (WithSeverity String) -> String -> m () -logInfo la msg = - liftIO $ unLogAction la (WithSeverity msg Info) - staticHandlers :: RuleSet -> LogAction IO (WithSeverity String) -> S.Handlers (S.LspM config) staticHandlers rs logAction = @@ -52,7 +49,7 @@ staticHandlers rs logAction = stderrLogger :: LogAction IO (WithSeverity String) stderrLogger = LogAction $ \(WithSeverity msg sev) -> - hPutStrLn stderr (show sev <> ": " <> msg) + hPutStrLn stderr ("[" <> show sev <> "] " <> msg) -- | Starta LSP-servern runServer :: RuleSet -> IO Int @@ -146,4 +143,4 @@ handleDidClose let J.TextDocumentIdentifier {_uri = uri} = docId in liftIO $ do Docs.delete uri - logInfo logAction ("Document closed: " <> show uri) + logInfo logAction ("Document closed: " <> show uri) From f554a667c316bbf638088917f144690d614577c6 Mon Sep 17 00:00:00 2001 From: webdevred <148627186+webdevred@users.noreply.github.com> Date: Tue, 16 Dec 2025 01:28:17 +0100 Subject: [PATCH 4/4] Fixed Server.hs log messages --- src-extra/language-server/JbeamEdit/LSP/Server.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src-extra/language-server/JbeamEdit/LSP/Server.hs b/src-extra/language-server/JbeamEdit/LSP/Server.hs index 86493ae6..46346e5f 100644 --- a/src-extra/language-server/JbeamEdit/LSP/Server.hs +++ b/src-extra/language-server/JbeamEdit/LSP/Server.hs @@ -23,6 +23,7 @@ import Language.LSP.Protocol.Types qualified as J ( TextDocumentItem (..), TextDocumentSyncKind (..), TextDocumentSyncOptions (..), + Uri (..), VersionedTextDocumentIdentifier (..), type (|?) (..), ) @@ -96,7 +97,7 @@ handleDidOpen let J.TextDocumentItem {J._uri = uri, J._text = txt} = textDoc in liftIO $ do Docs.open uri txt - logInfo logAction ("Document opened: " <> show uri) + logInfo logAction ("Document opened: " <> J.getUri uri) -- | didChange: update document in DocumentStore handleDidChange @@ -123,7 +124,7 @@ handleDidChange J.InR (J.TextDocumentContentChangeWholeDocument txt) -> Docs.update uri txt - logInfo logAction ("Document changed: " <> show uri) + logInfo logAction ("Document changed: " <> J.getUri uri) _ -> pure () handleDidClose @@ -143,4 +144,4 @@ handleDidClose let J.TextDocumentIdentifier {_uri = uri} = docId in liftIO $ do Docs.delete uri - logInfo logAction ("Document closed: " <> show uri) + logInfo logAction ("Document closed: " <> J.getUri uri)