{-# 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 :: forall c (m :: * -> *).
MonadLsp c m =>
LogAction m (WithSeverity Text)
logToLogMessage = forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction forall a b. (a -> b) -> a -> b
$ \(WithSeverity Text
msg Severity
sev) -> do
  forall config (m :: * -> *).
MonadLsp config m =>
FromServerMessage -> m ()
sendToClient forall a b. (a -> b) -> a -> b
$ forall (m :: Method 'FromServer 'Notification).
((Message @'FromServer @'Notification m :: *)
 ~ (NotificationMessage @'FromServer m :: *)) =>
NotificationMessage @'FromServer m -> FromServerMessage
fromServerNot forall a b. (a -> b) -> a -> b
$
    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 :: forall c (m :: * -> *).
MonadLsp c m =>
LogAction m (WithSeverity Text)
logToShowMessage = forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction forall a b. (a -> b) -> a -> b
$ \(WithSeverity Text
msg Severity
sev) -> do
  forall config (m :: * -> *).
MonadLsp config m =>
FromServerMessage -> m ()
sendToClient forall a b. (a -> b) -> a -> b
$ forall (m :: Method 'FromServer 'Notification).
((Message @'FromServer @'Notification m :: *)
 ~ (NotificationMessage @'FromServer m :: *)) =>
NotificationMessage @'FromServer m -> FromServerMessage
fromServerNot forall a b. (a -> b) -> a -> b
$
    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 :: forall c (m :: * -> *).
MonadLsp c m =>
LogAction m (WithSeverity Text)
defaultClientLogger =
  forall (m :: * -> *) a.
Applicative m =>
Severity -> (a -> Severity) -> LogAction m a -> LogAction m a
filterBySeverity Severity
Error forall msg. WithSeverity msg -> Severity
getSeverity forall c (m :: * -> *).
MonadLsp c m =>
LogAction m (WithSeverity Text)
logToShowMessage
  forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *) a.
Applicative m =>
Severity -> (a -> Severity) -> LogAction m a -> LogAction m a
filterBySeverity Severity
Info forall msg. WithSeverity msg -> Severity
getSeverity forall c (m :: * -> *).
MonadLsp c m =>
LogAction m (WithSeverity Text)
logToLogMessage