Skip to content

Commit

Permalink
[display] refactor diagnostics a bit
Browse files Browse the repository at this point in the history 
see #9134
  • Loading branch information
@Simn
Simn committed Feb 13, 2020
1 parent 0a01bda commit 4bf5cce
Show file tree
Hide file tree
Showing 5 changed files with 135 additions and 119 deletions.
6 changes: 5 additions & 1 deletion src/compiler/haxe.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1194,7 +1194,11 @@ with
| Parser.SyntaxCompletion(kind,subj) ->
DisplayOutput.handle_syntax_completion com kind subj;
error ctx ("Error: No completion point was found") null_pos
| DisplayException(ModuleSymbols s | Diagnostics s | Statistics s | Metadata s) ->
| DisplayException(DisplayDiagnostics dctx) ->
let s = Json.string_of_json (DiagnosticsPrinter.json_of_diagnostics dctx) in
DisplayPosition.display_position#reset;
raise (DisplayOutput.Completion s)
| DisplayException(ModuleSymbols s | Statistics s | Metadata s) ->
DisplayPosition.display_position#reset;
raise (DisplayOutput.Completion s)
| EvalExceptions.Sys_exit i | Hlinterp.Sys_exit i ->
Expand Down
132 changes: 17 additions & 115 deletions src/context/display/diagnostics.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,15 +5,9 @@ open Typecore
open Common
open Display
open DisplayTypes.DisplayMode

type diagnostics_context = {
com : Common.context;
mutable removable_code : (string * pos * pos) list;
mutable import_positions : (pos,bool ref) PMap.t;
mutable dead_blocks : (string,(pos * expr) list) Hashtbl.t;
}

open DisplayTypes
open DisplayException
open DiagnosticsTypes

let add_removable_code ctx s p prange =
ctx.removable_code <- (s,p,prange) :: ctx.removable_code
Expand Down Expand Up @@ -95,25 +89,27 @@ let check_other_things com e =
in
loop true e

let prepare_field dctx cf = match cf.cf_expr with
let prepare_field dctx com cf = match cf.cf_expr with
| None -> ()
| Some e ->
find_unused_variables dctx e;
check_other_things dctx.com e;
DeprecationCheck.run_on_expr dctx.com e
check_other_things com e;
DeprecationCheck.run_on_expr com e

let prepare com global =
let dctx = {
global = global;
removable_code = [];
com = com;
import_positions = PMap.empty;
dead_blocks = Hashtbl.create 0;
diagnostics_messages = [];
unresolved_identifiers = [];
} in
List.iter (function
| TClassDecl c when global || DisplayPosition.display_position#is_in_file c.cl_pos.pfile ->
List.iter (prepare_field dctx) c.cl_ordered_fields;
List.iter (prepare_field dctx) c.cl_ordered_statics;
(match c.cl_constructor with None -> () | Some cf -> prepare_field dctx cf);
List.iter (prepare_field dctx com) c.cl_ordered_fields;
List.iter (prepare_field dctx com) c.cl_ordered_statics;
(match c.cl_constructor with None -> () | Some cf -> prepare_field dctx com cf);
| _ ->
()
) com.types;
Expand Down Expand Up @@ -158,6 +154,9 @@ let prepare com global =
| None -> ()
| Some com -> process_modules com
end;
(* We do this at the end because some of the prepare functions might add information to the common context. *)
dctx.diagnostics_messages <- com.shared.shared_display_information.diagnostics_messages;
dctx.unresolved_identifiers <- com.display_information.unresolved_identifiers;
dctx

let is_diagnostics_run p = match (!Parser.display_mode) with
Expand All @@ -168,107 +167,10 @@ let is_diagnostics_run p = match (!Parser.display_mode) with
let secure_generated_code ctx e =
if is_diagnostics_run e.epos then mk (TMeta((Meta.Extern,[],e.epos),e)) e.etype e.epos else e

module Printer = struct
open Json
open DiagnosticsKind
open DisplayTypes

type t = DiagnosticsKind.t * pos

module UnresolvedIdentifierSuggestion = struct
type t =
| UISImport
| UISTypo

let to_int = function
| UISImport -> 0
| UISTypo -> 1
end

open UnresolvedIdentifierSuggestion
open CompletionItem
open CompletionModuleType

let print_diagnostics dctx com global =
let diag = Hashtbl.create 0 in
let add dk p sev args =
let file = if p = null_pos then p.pfile else Path.get_real_path p.pfile in
let diag = try
Hashtbl.find diag file
with Not_found ->
let d = Hashtbl.create 0 in
Hashtbl.add diag file d;
d
in
if not (Hashtbl.mem diag p) then
Hashtbl.add diag p (dk,p,sev,args)
in
let add dk p sev args =
if global || p = null_pos || DisplayPosition.display_position#is_in_file p.pfile then add dk p sev args
in
List.iter (fun (s,p,suggestions) ->
let suggestions = ExtList.List.filter_map (fun (s,item,r) ->
match item.ci_kind with
| ITType(t,_) when r = 0 ->
let path = if t.module_name = t.name then (t.pack,t.name) else (t.pack @ [t.module_name],t.name) in
Some (JObject [
"kind",JInt (to_int UISImport);
"name",JString (s_type_path path);
])
| _ when r = 0 ->
(* TODO !!! *)
None
| _ ->
Some (JObject [
"kind",JInt (to_int UISTypo);
"name",JString s;
])
) suggestions in
add DKUnresolvedIdentifier p DiagnosticsSeverity.Error (JArray suggestions);
) com.display_information.unresolved_identifiers;
PMap.iter (fun p r ->
if not !r then add DKUnusedImport p DiagnosticsSeverity.Warning (JArray [])
) dctx.import_positions;
List.iter (fun (s,p,kind,sev) ->
add kind p sev (JString s)
) (List.rev com.shared.shared_display_information.diagnostics_messages);
List.iter (fun (s,p,prange) ->
add DKRemovableCode p DiagnosticsSeverity.Warning (JObject ["description",JString s;"range",if prange = null_pos then JNull else Genjson.generate_pos_as_range prange])
) dctx.removable_code;
Hashtbl.iter (fun p s ->
add DKDeprecationWarning p DiagnosticsSeverity.Warning (JString s);
) DeprecationCheck.warned_positions;
Hashtbl.iter (fun file ranges ->
List.iter (fun (p,e) ->
let jo = JObject [
"expr",JObject [
"string",JString (Ast.Printer.s_expr e)
]
] in
add DKInactiveBlock p DiagnosticsSeverity.Hint jo
) ranges
) dctx.dead_blocks;
let jl = Hashtbl.fold (fun file diag acc ->
let jl = Hashtbl.fold (fun _ (dk,p,sev,jargs) acc ->
(JObject [
"kind",JInt (DiagnosticsKind.to_int dk);
"severity",JInt (DiagnosticsSeverity.to_int sev);
"range",Genjson.generate_pos_as_range p;
"args",jargs
]) :: acc
) diag [] in
(JObject [
"file",if file = "?" then JNull else JString file;
"diagnostics",JArray jl
]) :: acc
) diag [] in
let js = JArray jl in
string_of_json js
end

let print com global =
let dctx = prepare com global in
Printer.print_diagnostics dctx com global
Json.string_of_json (DiagnosticsPrinter.json_of_diagnostics dctx)

let run com global =
DisplayException.raise_diagnostics (print com global)
let dctx = prepare com global in
DisplayException.raise_diagnostics dctx
98 changes: 98 additions & 0 deletions src/context/display/diagnosticsPrinter.ml
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,98 @@
open Globals
open Json
open DisplayTypes
open DiagnosticsKind
open DisplayTypes
open DiagnosticsTypes

type t = DiagnosticsKind.t * pos

module UnresolvedIdentifierSuggestion = struct
type t =
| UISImport
| UISTypo

let to_int = function
| UISImport -> 0
| UISTypo -> 1
end

open UnresolvedIdentifierSuggestion
open CompletionItem
open CompletionModuleType

let json_of_diagnostics dctx =
let diag = Hashtbl.create 0 in
let add dk p sev args =
let file = if p = null_pos then p.pfile else Path.get_real_path p.pfile in
let diag = try
Hashtbl.find diag file
with Not_found ->
let d = Hashtbl.create 0 in
Hashtbl.add diag file d;
d
in
if not (Hashtbl.mem diag p) then
Hashtbl.add diag p (dk,p,sev,args)
in
let add dk p sev args =
if dctx.global || p = null_pos || DisplayPosition.display_position#is_in_file p.pfile then add dk p sev args
in
List.iter (fun (s,p,suggestions) ->
let suggestions = ExtList.List.filter_map (fun (s,item,r) ->
match item.ci_kind with
| ITType(t,_) when r = 0 ->
let path = if t.module_name = t.name then (t.pack,t.name) else (t.pack @ [t.module_name],t.name) in
Some (JObject [
"kind",JInt (to_int UISImport);
"name",JString (s_type_path path);
])
| _ when r = 0 ->
(* TODO !!! *)
None
| _ ->
Some (JObject [
"kind",JInt (to_int UISTypo);
"name",JString s;
])
) suggestions in
add DKUnresolvedIdentifier p DiagnosticsSeverity.Error (JArray suggestions);
) dctx.unresolved_identifiers;
PMap.iter (fun p r ->
if not !r then add DKUnusedImport p DiagnosticsSeverity.Warning (JArray [])
) dctx.import_positions;
List.iter (fun (s,p,kind,sev) ->
add kind p sev (JString s)
) (List.rev dctx.diagnostics_messages);
List.iter (fun (s,p,prange) ->
add DKRemovableCode p DiagnosticsSeverity.Warning (JObject ["description",JString s;"range",if prange = null_pos then JNull else Genjson.generate_pos_as_range prange])
) dctx.removable_code;
Hashtbl.iter (fun p s ->
add DKDeprecationWarning p DiagnosticsSeverity.Warning (JString s);
) DeprecationCheck.warned_positions;
Hashtbl.iter (fun file ranges ->
List.iter (fun (p,e) ->
let jo = JObject [
"expr",JObject [
"string",JString (Ast.Printer.s_expr e)
]
] in
add DKInactiveBlock p DiagnosticsSeverity.Hint jo
) ranges
) dctx.dead_blocks;
let jl = Hashtbl.fold (fun file diag acc ->
let jl = Hashtbl.fold (fun _ (dk,p,sev,jargs) acc ->
(JObject [
"kind",JInt (DiagnosticsKind.to_int dk);
"severity",JInt (DiagnosticsSeverity.to_int sev);
"range",Genjson.generate_pos_as_range p;
"args",jargs
]) :: acc
) diag [] in
(JObject [
"file",if file = "?" then JNull else JString file;
"diagnostics",JArray jl
]) :: acc
) diag [] in
let js = JArray jl in
js
11 changes: 11 additions & 0 deletions src/context/display/diagnosticsTypes.ml
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,11 @@
open Globals
open Ast

type diagnostics_context = {
global : bool;
mutable removable_code : (string * pos * pos) list;
mutable import_positions : (pos,bool ref) PMap.t;
mutable dead_blocks : (string,(pos * expr) list) Hashtbl.t;
mutable unresolved_identifiers : (string * pos * (string * CompletionItem.t * int) list) list;
mutable diagnostics_messages : (string * pos * DisplayTypes.DiagnosticsKind.t * DisplayTypes.DiagnosticsSeverity.t) list;
}
7 changes: 4 additions & 3 deletions src/context/display/displayException.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,7 @@ type signature_kind =
| SKArrayAccess

type kind =
| Diagnostics of string
| DisplayDiagnostics of DiagnosticsTypes.diagnostics_context
| Statistics of string
| ModuleSymbols of string
| Metadata of string
Expand All @@ -34,7 +34,7 @@ type kind =

exception DisplayException of kind

let raise_diagnostics s = raise (DisplayException(Diagnostics s))
let raise_diagnostics s = raise (DisplayException(DisplayDiagnostics s))
let raise_statistics s = raise (DisplayException(Statistics s))
let raise_module_symbols s = raise (DisplayException(ModuleSymbols s))
let raise_metadata s = raise (DisplayException(Metadata s))
Expand Down Expand Up @@ -167,12 +167,13 @@ let fields_to_json ctx fields kind subj =

let to_json ctx de =
match de with
| Diagnostics _
| Statistics _
| ModuleSymbols _
| Metadata _ -> assert false
| DisplaySignatures None ->
jnull
| DisplayDiagnostics dctx ->
DiagnosticsPrinter.json_of_diagnostics dctx
| DisplaySignatures Some(sigs,isig,iarg,kind) ->
(* We always want full info for signatures *)
let ctx = Genjson.create_context GMFull in
Expand Down

0 comments on commit 4bf5cce

Please sign in to comment.