Publish Diagnistics Improvement

src/protocol/LSP.Basic.pas

@@ -26,7 +26,7 @@
 
 interface
 uses
-  FPJson,
+  FPJson, fgl,
   Classes, SysUtils, LSP.BaseTypes, LSP.Messages;
 
 type
@@ -78,6 +78,7 @@   TRange = class(TLSPStreamable)
     constructor Create(startLine, startColumn: integer; endLine, endColumn: integer); overload;
     Procedure  SetRange(line, column: integer; len: integer = 0); overload;
     Procedure  SetRange(startLine, startColumn: integer; endLine, endColumn: integer); overload;
+    function  InRange(line, column: integer; len: integer = 0): Boolean;
     Destructor destroy; override;
     Procedure Assign(Source : TPersistent); override;
     function ToString: String; override;
@@ -378,7 +379,7 @@   TDiagnostic = class (TCollectionItem)
     fSeverity: TDiagnosticSeverity;
     fCode: TOptionalInteger;
     fSource: TOptionalString;
-    fMessage: string;
+    fMessage: TOptionalString;
     procedure SetRange(AValue: TRange);
   Public
     Constructor Create(ACollection: TCollection); override;
@@ -396,7 +397,7 @@   TDiagnostic = class (TCollectionItem)
     // diagnostic, e.g. 'typescript' or 'super lint'.
     property source: TOptionalString read fSource write fSource;
     // The diagnostic's message.
-    property message: string read fMessage write fMessage;
+    property message: TOptionalString read fMessage write fMessage;
 
     // Additional metadata about the diagnostic.
     // @since 3.15.0
@@ -410,6 +411,7 @@   TDiagnostic = class (TCollectionItem)
   end;
 
   TDiagnosticItems = specialize TGenericCollection<TDiagnostic>;
+  TUriDiagnostics = specialize TFPGMapObject<string, TDiagnosticItems>;
 
   { TCommand
     https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/#command
@@ -976,6 +978,17 @@ procedure TRange.SetRange(startLine, startColumn: integer; endLine,
   fEnd.Character:=endColumn;
 end;
 
+function TRange.InRange(line, column: integer; len: integer): Boolean;
+begin
+  Result := ((fStart.line < line) and (fEnd.line > line)) or 
+    ((fStart.line = line) and (fStart.character <= column) and 
+      ((fEnd.line > line) or (fEnd.character >= column))
+    ) or
+    ((fEnd.line = line) and (fEnd.character >= column) and 
+      ((fStart.line < line) or (fStart.character <= column))
+    );
+end;
+
 destructor TRange.destroy;
 begin
   FreeAndNil(fStart);
@@ -1106,9 +1119,15 @@ procedure TDiagnostic.Assign(Source : TPersistent);
     Range:=Src.Range;
     Severity:=Src.severity;
     Code:=Src.Code;
-    self.Source:=Src.Source;
     if Src.source.HasValue then
-      Message:=Src.Source.Value;
+      self.Source:=Src.Source.Value
+    else 
+      self.Source:=Nil;
+
+    if Src.message.HasValue then
+      self.message:=Src.message.Value
+    else 
+      self.message:=Nil;
     end
   else
     inherited Assign(Source);

src/protocol/LSP.Diagnostics.pas

@@ -69,13 +69,23 @@   TPublishDiagnosticsParams = class(TLSPStreamable)
 
   TPublishDiagnostics = class(TNotificationMessage)
   private
+    fUserMessages: TDiagnosticItems;
+    fCodeToolErrors: TUriDiagnostics;
+    fParserErrors: TUriDiagnostics;
+
     function GetDiagnosticParams: TPublishDiagnosticsParams;
   public
     constructor Create; override;
     destructor Destroy; override;
-    function HaveDiagnostics : Boolean;
+    procedure SendDiagnostics(fileName: string; aTransport : TMessageTransport);
     Property DiagnosticParams : TPublishDiagnosticsParams Read GetDiagnosticParams;
+    procedure AddCodeToolError(fileName, message: string; line, column, code: integer; severity: TDiagnosticSeverity);
+    procedure AddParserError(fileName, message: string; line, column, code: integer; severity: TDiagnosticSeverity);
+    procedure AddUserMessage(message: string; line, column, code: integer; severity: TDiagnosticSeverity);
     procedure Add(fileName, message: string; line, column, code: integer; severity: TDiagnosticSeverity);
+    procedure ClearCodeToolErrors(fileName: string);
+    procedure ClearParserError(fileName: string);
+    procedure ClearUserMessages;
     procedure Clear(fileName: string);
   end;
 
@@ -86,6 +96,127 @@ implementation
 
 { TPublishDiagnostics }
 
+procedure TPublishDiagnostics.ClearUserMessages;
+begin
+  DiagnosticParams.uri := '';
+  fUserMessages.Clear;
+end;
+
+procedure TPublishDiagnostics.ClearCodeToolErrors(fileName: string);
+var
+  CodeToolErrorsDiagnostics: TDiagnosticItems;
+begin
+  DiagnosticParams.uri := PathToURI(fileName);
+  if not fCodeToolErrors.
+    TryGetData(DiagnosticParams.uri, CodeToolErrorsDiagnostics)
+  then
+    begin
+      CodeToolErrorsDiagnostics := TDiagnosticItems.Create;
+      fCodeToolErrors.Add(DiagnosticParams.uri, CodeToolErrorsDiagnostics);
+    end;
+
+  CodeToolErrorsDiagnostics.Clear;
+end;
+
+procedure TPublishDiagnostics.ClearParserError(fileName: string);
+var
+  CodeToolErrorsDiagnostics: TDiagnosticItems;
+begin
+  DiagnosticParams.uri := PathToURI(fileName);
+  if not fParserErrors.
+    TryGetData(DiagnosticParams.uri, CodeToolErrorsDiagnostics)
+  then
+    begin
+      CodeToolErrorsDiagnostics := TDiagnosticItems.Create;
+      fParserErrors.Add(DiagnosticParams.uri, CodeToolErrorsDiagnostics);
+    end;
+
+  CodeToolErrorsDiagnostics.Clear;
+end;
+
+procedure TPublishDiagnostics.AddUserMessage(
+    message: string;
+    line, column, code: integer;
+    severity: TDiagnosticSeverity
+  );
+var
+  Diagnostic: TDiagnostic;
+begin
+  DiagnosticParams.uri := '';
+  Diagnostic := fUserMessages.Add;
+  Diagnostic.range.SetRange(line, column);
+  Diagnostic.severity := severity;
+  Diagnostic.code := code;
+  Diagnostic.source := 'Free Pascal Compiler';
+  Diagnostic.message := message;
+end;
+
+procedure TPublishDiagnostics.AddCodeToolError(
+    fileName, message: string;
+    line, column, code: integer;
+    severity: TDiagnosticSeverity
+  );
+var
+  CodeToolErrorsDiagnostics: TDiagnosticItems;
+  Diagnostic: TDiagnostic;
+  i: Integer;
+begin
+  DiagnosticParams.uri := PathToURI(fileName);
+  if not fCodeToolErrors.
+    TryGetData(DiagnosticParams.uri, CodeToolErrorsDiagnostics)
+  then
+    begin
+      CodeToolErrorsDiagnostics := TDiagnosticItems.Create;
+      fCodeToolErrors.Add(DiagnosticParams.uri, CodeToolErrorsDiagnostics);
+    end;
+
+  i := 0;
+  while i < CodeToolErrorsDiagnostics.Count do
+    begin
+      Diagnostic := CodeToolErrorsDiagnostics.Items[i];
+      if Diagnostic.range.InRange(line, column) then
+        Break;
+      Inc(i);
+    end;
+
+  if i >= CodeToolErrorsDiagnostics.Count then
+    begin
+      Diagnostic := CodeToolErrorsDiagnostics.Add;
+    end;
+
+  Diagnostic.range.SetRange(line, column);
+  Diagnostic.severity := severity;
+  Diagnostic.code := code;
+  Diagnostic.source := 'Free Pascal Compiler';
+  Diagnostic.message := message;
+end;
+
+procedure TPublishDiagnostics.AddParserError(
+    fileName, message: string;
+    line, column, code: integer;
+    severity: TDiagnosticSeverity
+  );
+var
+  CodeToolErrorsDiagnostics: TDiagnosticItems;
+  Diagnostic: TDiagnostic;
+begin
+  DiagnosticParams.uri := PathToURI(fileName);
+  if not fParserErrors.
+    TryGetData(DiagnosticParams.uri, CodeToolErrorsDiagnostics)
+  then
+    begin
+      CodeToolErrorsDiagnostics := TDiagnosticItems.Create;
+      fParserErrors.Add(DiagnosticParams.uri, CodeToolErrorsDiagnostics);
+    end;
+
+  Diagnostic := CodeToolErrorsDiagnostics.Add;
+  Diagnostic.range.SetRange(line, column);
+  Diagnostic.severity := severity;
+  Diagnostic.code := code;
+  Diagnostic.source := 'Free Pascal Compiler';
+  Diagnostic.message := message;
+end;
+
 procedure TPublishDiagnostics.Clear(fileName: string);
 begin
   DiagnosticParams.uri := PathToURI(fileName);
@@ -96,7 +227,11 @@ procedure TPublishDiagnostics.Add(fileName, message: string; line, column, code:
 var
   Diagnostic: TDiagnostic;
 begin
-  DiagnosticParams.uri := PathToURI(fileName);
+  if Length(fileName) = 0 then
+    DiagnosticParams.uri := ''
+  else
+    DiagnosticParams.uri := PathToURI(fileName);
+
   Diagnostic := DiagnosticParams.diagnostics.Add;
   Diagnostic.range.SetRange(line, column);
   Diagnostic.severity := severity;
@@ -111,23 +246,77 @@ function TPublishDiagnostics.GetDiagnosticParams: TPublishDiagnosticsParams;
   Result:=Params as TPublishDiagnosticsParams;
 end;
 
+procedure TPublishDiagnostics.SendDiagnostics(
+    fileName: string;
+    aTransport: TMessageTransport
+  );
+var
+  Diagnostic, sentDiagnostic: TDiagnostic;
+
+  procedure IterateDiagnosticItems(uriDiagnostics: TUriDiagnostics);
+  var
+    DiagnosticItems: TDiagnosticItems;
+  begin
+    if not uriDiagnostics.
+      TryGetData(PathToURI(fileName), DiagnosticItems) 
+    then
+      begin
+        DiagnosticItems := TDiagnosticItems.Create;
+        uriDiagnostics.Add(PathToURI(fileName), DiagnosticItems);
+      end;
+
+    for TCollectionItem(Diagnostic) in DiagnosticItems do
+      begin
+        sentDiagnostic := DiagnosticParams.diagnostics.Add;
+        sentDiagnostic.Assign(Diagnostic);
+      end;
+  end;
+
+begin
+  DiagnosticParams.diagnostics.Clear;
+    // if fUserMessages.count > 0 add to DiagnosticParams.diagnostics
+  if Length(fileName) = 0 then
+    begin
+      DiagnosticParams.uri := '';
+      for TCollectionItem(Diagnostic) in fUserMessages do
+        begin
+          sentDiagnostic := DiagnosticParams.diagnostics.Add;
+          sentDiagnostic.Assign(Diagnostic);
+        end;
+    end
+  else
+    begin
+      DiagnosticParams.uri := PathToURI(fileName);
+
+        // loop over all fCodeToolErrors[fileName] and fParserErrors[fileName]
+        // add to DiagnosticParams.diagnostics
+      IterateDiagnosticItems(fCodeToolErrors);
+      IterateDiagnosticItems(fParserErrors);
+    end;
+
+  Send(aTransport);
+end;
+
 constructor TPublishDiagnostics.Create;
 begin  
+  fUserMessages := TDiagnosticItems.Create;
+  fCodeToolErrors := TUriDiagnostics.Create(True);
+  fParserErrors := TUriDiagnostics.Create(True);
+
   params := TPublishDiagnosticsParams.Create;
   method := 'textDocument/publishDiagnostics';
 end;
 
 destructor TPublishDiagnostics.Destroy; 
 begin
   params.Free;
+  fCodeToolErrors.Free;
+  fUserMessages.Free;
+  fParserErrors.Free;
+
   inherited;
 end;
 
-function TPublishDiagnostics.HaveDiagnostics: Boolean;
-begin
-  Result:=DiagnosticParams.diagnostics.Count>0;
-end;
-
 { TPublishDiagnosticsParams }
 
 procedure TPublishDiagnosticsParams.SetDiagnostics(AValue: TDiagnosticItems);