Added co-log-core logging for lsp server

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

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

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,44 +48,55 @@ 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)
          (Msg.MessageResult Msg.Method_TextDocumentFormatting)
        -> 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)
+        )

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

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)