{-# LANGUAGE OverloadedStrings #-}

module Language.LSP.Logging (logToShowMessage, logToLogMessage, defaultClientLogger) where

import Colog.Core
import Data.Text (Text)
import Language.LSP.Protocol.Message
import Language.LSP.Protocol.Types
import Language.LSP.Server.Core

logSeverityToMessageType :: Severity -> MessageType
logSeverityToMessageType :: Severity -> MessageType
logSeverityToMessageType Severity
sev = case Severity
sev of
  Severity
Error -> MessageType
MessageType_Error
  Severity
Warning -> MessageType
MessageType_Warning
  Severity
Info -> MessageType
MessageType_Info
  Severity
Debug -> MessageType
MessageType_Log

-- | Logs messages to the client via @window/logMessage@.
logToLogMessage :: (MonadLsp c m) => LogAction m (WithSeverity Text)
logToLogMessage :: forall c (m :: * -> *).
MonadLsp c m =>
LogAction m (WithSeverity Text)
logToLogMessage = (WithSeverity Text -> m ()) -> LogAction m (WithSeverity Text)
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction ((WithSeverity Text -> m ()) -> LogAction m (WithSeverity Text))
-> (WithSeverity Text -> m ()) -> LogAction m (WithSeverity Text)
forall a b. (a -> b) -> a -> b
$ \(WithSeverity Text
msg Severity
sev) -> do
  FromServerMessage -> m ()
forall config (m :: * -> *).
MonadLsp config m =>
FromServerMessage -> m ()
sendToClient (FromServerMessage -> m ()) -> FromServerMessage -> m ()
forall a b. (a -> b) -> a -> b
$
    TNotificationMessage @'ServerToClient 'Method_WindowLogMessage
-> FromServerMessage
forall (m :: Method 'ServerToClient 'Notification).
((TMessage @'ServerToClient @'Notification m :: *)
 ~ (TNotificationMessage @'ServerToClient m :: *)) =>
TNotificationMessage @'ServerToClient m -> FromServerMessage
fromServerNot (TNotificationMessage @'ServerToClient 'Method_WindowLogMessage
 -> FromServerMessage)
-> TNotificationMessage @'ServerToClient 'Method_WindowLogMessage
-> FromServerMessage
forall a b. (a -> b) -> a -> b
$
      Text
-> SMethod @'ServerToClient @'Notification 'Method_WindowLogMessage
-> MessageParams
     @'ServerToClient @'Notification 'Method_WindowLogMessage
-> TNotificationMessage @'ServerToClient 'Method_WindowLogMessage
forall (f :: MessageDirection) (m :: Method f 'Notification).
Text
-> SMethod @f @'Notification m
-> MessageParams @f @'Notification m
-> TNotificationMessage @f m
TNotificationMessage Text
"2.0" SMethod @'ServerToClient @'Notification 'Method_WindowLogMessage
SMethod_WindowLogMessage (MessageType -> Text -> LogMessageParams
LogMessageParams (Severity -> MessageType
logSeverityToMessageType Severity
sev) Text
msg)

-- | Logs messages to the client via @window/showMessage@.
logToShowMessage :: (MonadLsp c m) => LogAction m (WithSeverity Text)
logToShowMessage :: forall c (m :: * -> *).
MonadLsp c m =>
LogAction m (WithSeverity Text)
logToShowMessage = (WithSeverity Text -> m ()) -> LogAction m (WithSeverity Text)
forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction ((WithSeverity Text -> m ()) -> LogAction m (WithSeverity Text))
-> (WithSeverity Text -> m ()) -> LogAction m (WithSeverity Text)
forall a b. (a -> b) -> a -> b
$ \(WithSeverity Text
msg Severity
sev) -> do
  FromServerMessage -> m ()
forall config (m :: * -> *).
MonadLsp config m =>
FromServerMessage -> m ()
sendToClient (FromServerMessage -> m ()) -> FromServerMessage -> m ()
forall a b. (a -> b) -> a -> b
$
    TNotificationMessage @'ServerToClient 'Method_WindowShowMessage
-> FromServerMessage
forall (m :: Method 'ServerToClient 'Notification).
((TMessage @'ServerToClient @'Notification m :: *)
 ~ (TNotificationMessage @'ServerToClient m :: *)) =>
TNotificationMessage @'ServerToClient m -> FromServerMessage
fromServerNot (TNotificationMessage @'ServerToClient 'Method_WindowShowMessage
 -> FromServerMessage)
-> TNotificationMessage @'ServerToClient 'Method_WindowShowMessage
-> FromServerMessage
forall a b. (a -> b) -> a -> b
$
      Text
-> SMethod
     @'ServerToClient @'Notification 'Method_WindowShowMessage
-> MessageParams
     @'ServerToClient @'Notification 'Method_WindowShowMessage
-> TNotificationMessage @'ServerToClient 'Method_WindowShowMessage
forall (f :: MessageDirection) (m :: Method f 'Notification).
Text
-> SMethod @f @'Notification m
-> MessageParams @f @'Notification m
-> TNotificationMessage @f m
TNotificationMessage Text
"2.0" SMethod @'ServerToClient @'Notification 'Method_WindowShowMessage
SMethod_WindowShowMessage (MessageType -> Text -> ShowMessageParams
ShowMessageParams (Severity -> MessageType
logSeverityToMessageType Severity
sev) Text
msg)

{- | A 'sensible' log action for logging messages to the client:

    * Shows 'Error' logs to the user via @window/showMessage@
    * Logs 'Info' and above logs in the client via @window/logMessage@

 If you want finer control (e.g. the ability to log 'Debug' logs based on a flag, or similar),
 then do not use this and write your own based on 'logToShowMessage' and 'logToLogMessage'.
-}
defaultClientLogger :: (MonadLsp c m) => LogAction m (WithSeverity Text)
defaultClientLogger :: forall c (m :: * -> *).
MonadLsp c m =>
LogAction m (WithSeverity Text)
defaultClientLogger =
  Severity
-> (WithSeverity Text -> Severity)
-> LogAction m (WithSeverity Text)
-> LogAction m (WithSeverity Text)
forall (m :: * -> *) a.
Applicative m =>
Severity -> (a -> Severity) -> LogAction m a -> LogAction m a
filterBySeverity Severity
Error WithSeverity Text -> Severity
forall msg. WithSeverity msg -> Severity
getSeverity LogAction m (WithSeverity Text)
forall c (m :: * -> *).
MonadLsp c m =>
LogAction m (WithSeverity Text)
logToShowMessage
    LogAction m (WithSeverity Text)
-> LogAction m (WithSeverity Text)
-> LogAction m (WithSeverity Text)
forall a. Semigroup a => a -> a -> a
<> Severity
-> (WithSeverity Text -> Severity)
-> LogAction m (WithSeverity Text)
-> LogAction m (WithSeverity Text)
forall (m :: * -> *) a.
Applicative m =>
Severity -> (a -> Severity) -> LogAction m a -> LogAction m a
filterBySeverity Severity
Info WithSeverity Text -> Severity
forall msg. WithSeverity msg -> Severity
getSeverity LogAction m (WithSeverity Text)
forall c (m :: * -> *).
MonadLsp c m =>
LogAction m (WithSeverity Text)
logToLogMessage