{-# LANGUAGE OverloadedStrings #-}
module Language.LSP.Logging (logToShowMessage, logToLogMessage, defaultClientLogger) where

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

logSeverityToMessageType :: Severity -> MessageType
logSeverityToMessageType :: Severity -> MessageType
logSeverityToMessageType Severity
sev = case Severity
sev of
  Severity
Error -> MessageType
MtError
  Severity
Warning -> MessageType
MtWarning
  Severity
Info -> MessageType
MtInfo
  Severity
Debug -> MessageType
MtLog

-- | Logs messages to the client via @window/logMessage@.
logToLogMessage :: (MonadLsp c m) => LogAction m (WithSeverity Text)
logToLogMessage :: 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
$ NotificationMessage @'FromServer 'WindowLogMessage
-> FromServerMessage
forall (m :: Method 'FromServer 'Notification).
((Message @'FromServer @'Notification m :: *)
 ~ (NotificationMessage @'FromServer m :: *)) =>
NotificationMessage @'FromServer m -> FromServerMessage
fromServerNot (NotificationMessage @'FromServer 'WindowLogMessage
 -> FromServerMessage)
-> NotificationMessage @'FromServer 'WindowLogMessage
-> FromServerMessage
forall a b. (a -> b) -> a -> b
$
    Text
-> SMethod @'FromServer @'Notification 'WindowLogMessage
-> MessageParams @'FromServer @'Notification 'WindowLogMessage
-> NotificationMessage @'FromServer 'WindowLogMessage
forall (f :: From) (m :: Method f 'Notification).
Text
-> SMethod @f @'Notification m
-> MessageParams @f @'Notification m
-> NotificationMessage @f m
NotificationMessage Text
"2.0" SMethod @'FromServer @'Notification 'WindowLogMessage
SWindowLogMessage (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 :: 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
$ NotificationMessage @'FromServer 'WindowShowMessage
-> FromServerMessage
forall (m :: Method 'FromServer 'Notification).
((Message @'FromServer @'Notification m :: *)
 ~ (NotificationMessage @'FromServer m :: *)) =>
NotificationMessage @'FromServer m -> FromServerMessage
fromServerNot (NotificationMessage @'FromServer 'WindowShowMessage
 -> FromServerMessage)
-> NotificationMessage @'FromServer 'WindowShowMessage
-> FromServerMessage
forall a b. (a -> b) -> a -> b
$
    Text
-> SMethod @'FromServer @'Notification 'WindowShowMessage
-> MessageParams @'FromServer @'Notification 'WindowShowMessage
-> NotificationMessage @'FromServer 'WindowShowMessage
forall (f :: From) (m :: Method f 'Notification).
Text
-> SMethod @f @'Notification m
-> MessageParams @f @'Notification m
-> NotificationMessage @f m
NotificationMessage Text
"2.0" SMethod @'FromServer @'Notification 'WindowShowMessage
SWindowShowMessage (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 :: 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