module Unison.LSP.Diagnostics
  ( reportDiagnostics,
    mkDiagnostic,
    DiagnosticSeverity (..),
  )
where

import Language.LSP.Protocol.Message qualified as Msg
import Language.LSP.Protocol.Types
import Unison.LSP.Types
import Unison.Prelude
import Unison.Util.Monoid qualified as Monoid

reportDiagnostics ::
  (Foldable f) =>
  Uri ->
  Maybe FileVersion ->
  -- | Note, it's important to still send an empty list of diagnostics if there aren't any
  -- because it clears existing diagnostics in the editor
  f Diagnostic ->
  Lsp ()
reportDiagnostics :: forall (f :: * -> *).
Foldable f =>
Uri -> Maybe FileVersion -> f Diagnostic -> Lsp ()
reportDiagnostics Uri
docUri Maybe FileVersion
fileVersion f Diagnostic
diags = do
  let jsonRPC :: Text
jsonRPC = Text
"2.0"
  let params :: PublishDiagnosticsParams
params = PublishDiagnosticsParams {$sel:_uri:PublishDiagnosticsParams :: Uri
_uri = Uri
docUri, $sel:_version:PublishDiagnosticsParams :: Maybe FileVersion
_version = FileVersion -> FileVersion
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FileVersion -> FileVersion)
-> Maybe FileVersion -> Maybe FileVersion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FileVersion
fileVersion, $sel:_diagnostics:PublishDiagnosticsParams :: [Diagnostic]
_diagnostics = f Diagnostic -> [Diagnostic]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (f Diagnostic -> [Diagnostic]) -> f Diagnostic -> [Diagnostic]
forall a b. (a -> b) -> a -> b
$ f Diagnostic
diags}
  TNotificationMessage 'Method_TextDocumentPublishDiagnostics
-> Lsp ()
forall (m :: Method 'ServerToClient 'Notification).
(TMessage m ~ TNotificationMessage m) =>
TNotificationMessage m -> Lsp ()
sendNotification (Text
-> SMethod 'Method_TextDocumentPublishDiagnostics
-> MessageParams 'Method_TextDocumentPublishDiagnostics
-> TNotificationMessage 'Method_TextDocumentPublishDiagnostics
forall (f :: MessageDirection) (m :: Method f 'Notification).
Text -> SMethod m -> MessageParams m -> TNotificationMessage m
Msg.TNotificationMessage Text
jsonRPC SMethod 'Method_TextDocumentPublishDiagnostics
Msg.SMethod_TextDocumentPublishDiagnostics PublishDiagnosticsParams
MessageParams 'Method_TextDocumentPublishDiagnostics
params)

mkDiagnostic :: Uri -> Range -> DiagnosticSeverity -> [DiagnosticTag] -> Text -> [(Text, Range)] -> Diagnostic
mkDiagnostic :: Uri
-> Range
-> DiagnosticSeverity
-> [DiagnosticTag]
-> Text
-> [(Text, Range)]
-> Diagnostic
mkDiagnostic Uri
uri Range
r DiagnosticSeverity
severity [DiagnosticTag]
tags Text
msg [(Text, Range)]
references =
  Diagnostic
    { $sel:_range:Diagnostic :: Range
_range = Range
r,
      $sel:_severity:Diagnostic :: Maybe DiagnosticSeverity
_severity = DiagnosticSeverity -> Maybe DiagnosticSeverity
forall a. a -> Maybe a
Just DiagnosticSeverity
severity,
      $sel:_code:Diagnostic :: Maybe (FileVersion |? Text)
_code = Maybe (FileVersion |? Text)
forall a. Maybe a
Nothing, -- We could eventually pass error codes here
      $sel:_source:Diagnostic :: Maybe Text
_source = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"unison",
      $sel:_message:Diagnostic :: Text
_message = Text
msg,
      $sel:_tags:Diagnostic :: Maybe [DiagnosticTag]
_tags = Bool -> Maybe [DiagnosticTag] -> Maybe [DiagnosticTag]
forall a. Monoid a => Bool -> a -> a
Monoid.whenM (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [DiagnosticTag] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DiagnosticTag]
tags) ([DiagnosticTag] -> Maybe [DiagnosticTag]
forall a. a -> Maybe a
Just [DiagnosticTag]
tags),
      $sel:_relatedInformation:Diagnostic :: Maybe [DiagnosticRelatedInformation]
_relatedInformation =
        case [(Text, Range)]
references of
          [] -> Maybe [DiagnosticRelatedInformation]
forall a. Maybe a
Nothing
          [(Text, Range)]
refs ->
            [DiagnosticRelatedInformation]
-> Maybe [DiagnosticRelatedInformation]
forall a. a -> Maybe a
Just ([DiagnosticRelatedInformation]
 -> Maybe [DiagnosticRelatedInformation])
-> [DiagnosticRelatedInformation]
-> Maybe [DiagnosticRelatedInformation]
forall a b. (a -> b) -> a -> b
$
              [(Text, Range)]
refs [(Text, Range)]
-> ((Text, Range) -> DiagnosticRelatedInformation)
-> [DiagnosticRelatedInformation]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Text
msg, Range
range) ->
                Location -> Text -> DiagnosticRelatedInformation
DiagnosticRelatedInformation (Uri -> Range -> Location
Location Uri
uri Range
range) Text
msg,
      -- Could put links to the website in here with more info about specific errors.
      $sel:_codeDescription:Diagnostic :: Maybe CodeDescription
_codeDescription = Maybe CodeDescription
forall a. Maybe a
Nothing,
      $sel:_data_:Diagnostic :: Maybe Value
_data_ = Maybe Value
forall a. Maybe a
Nothing
    }