-
Notifications
You must be signed in to change notification settings - Fork 412
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Signed-off-by: Ali Caglayan <alizter@gmail.com>
- Loading branch information
Showing
15 changed files
with
784 additions
and
138 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,2 @@ | ||
- RPC message styles are now serialised meaning that RPC diagnostics keep their Ansi | ||
styling. (#8516, fixes #6921, @Alizter) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,118 @@ | ||
open Import | ||
open Exported_types | ||
|
||
module Related = struct | ||
type t = | ||
{ message : unit Pp.t | ||
; loc : Loc.t | ||
} | ||
|
||
let sexp = | ||
let open Conv in | ||
let loc = field "loc" (required Loc.sexp) in | ||
let message = field "message" (required sexp_pp_unit) in | ||
let to_ (loc, message) = { loc; message } in | ||
let from { loc; message } = loc, message in | ||
iso (record (both loc message)) to_ from | ||
;; | ||
|
||
let to_diagnostic_related t : Diagnostic.Related.t = | ||
{ message = t.message |> Pp.map_tags ~f:(fun _ -> User_message.Style.Details) | ||
; loc = t.loc | ||
} | ||
;; | ||
|
||
let of_diagnostic_related (t : Diagnostic.Related.t) = | ||
{ message = t.message |> Pp.map_tags ~f:(fun _ -> ()); loc = t.loc } | ||
;; | ||
end | ||
|
||
type t = | ||
{ targets : Target.t list | ||
; id : Diagnostic.Id.t | ||
; message : unit Pp.t | ||
; loc : Loc.t option | ||
; severity : Diagnostic.severity option | ||
; promotion : Diagnostic.Promotion.t list | ||
; directory : string option | ||
; related : Related.t list | ||
} | ||
|
||
let sexp_severity = | ||
let open Conv in | ||
enum [ "error", Diagnostic.Error; "warning", Warning ] | ||
;; | ||
|
||
let sexp = | ||
let open Conv in | ||
let from { targets; message; loc; severity; promotion; directory; id; related } = | ||
targets, message, loc, severity, promotion, directory, id, related | ||
in | ||
let to_ (targets, message, loc, severity, promotion, directory, id, related) = | ||
{ targets; message; loc; severity; promotion; directory; id; related } | ||
in | ||
let loc = field "loc" (optional Loc.sexp) in | ||
let message = field "message" (required sexp_pp_unit) in | ||
let targets = field "targets" (required (list Target.sexp)) in | ||
let severity = field "severity" (optional sexp_severity) in | ||
let directory = field "directory" (optional string) in | ||
let promotion = field "promotion" (required (list Diagnostic.Promotion.sexp)) in | ||
let id = field "id" (required Diagnostic.Id.sexp) in | ||
let related = field "related" (required (list Related.sexp)) in | ||
iso | ||
(record (eight targets message loc severity promotion directory id related)) | ||
to_ | ||
from | ||
;; | ||
|
||
let to_diagnostic t : Diagnostic.t = | ||
{ targets = t.targets | ||
; message = t.message |> Pp.map_tags ~f:(fun _ -> User_message.Style.Details) | ||
; loc = t.loc | ||
; severity = t.severity | ||
; promotion = t.promotion | ||
; directory = t.directory | ||
; id = t.id | ||
; related = t.related |> List.map ~f:Related.to_diagnostic_related | ||
} | ||
;; | ||
|
||
let of_diagnostic (t : Diagnostic.t) = | ||
{ targets = t.targets | ||
; message = t.message |> Pp.map_tags ~f:(fun _ -> ()) | ||
; loc = t.loc | ||
; severity = t.severity | ||
; promotion = t.promotion | ||
; directory = t.directory | ||
; id = t.id | ||
; related = t.related |> List.map ~f:Related.of_diagnostic_related | ||
} | ||
;; | ||
|
||
module Event = struct | ||
type nonrec t = | ||
| Add of t | ||
| Remove of t | ||
|
||
let sexp = | ||
let diagnostic = sexp in | ||
let open Conv in | ||
let add = constr "Add" diagnostic (fun a -> Add a) in | ||
let remove = constr "Remove" diagnostic (fun a -> Remove a) in | ||
sum | ||
[ econstr add; econstr remove ] | ||
(function | ||
| Add t -> case t add | ||
| Remove t -> case t remove) | ||
;; | ||
|
||
let to_event : t -> Diagnostic.Event.t = function | ||
| Add t -> Add (to_diagnostic t) | ||
| Remove t -> Remove (to_diagnostic t) | ||
;; | ||
|
||
let of_event : Diagnostic.Event.t -> t = function | ||
| Add t -> Add (of_diagnostic t) | ||
| Remove t -> Remove (of_diagnostic t) | ||
;; | ||
end |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,22 @@ | ||
(** V1 of the diagnostics module. *) | ||
|
||
module Related : sig | ||
type t | ||
|
||
val to_diagnostic_related : t -> Exported_types.Diagnostic.Related.t | ||
val of_diagnostic_related : Exported_types.Diagnostic.Related.t -> t | ||
end | ||
|
||
type t | ||
|
||
val sexp : (t, Conv.values) Conv.t | ||
val to_diagnostic : t -> Exported_types.Diagnostic.t | ||
val of_diagnostic : Exported_types.Diagnostic.t -> t | ||
|
||
module Event : sig | ||
type t | ||
|
||
val sexp : (t, Conv.values) Conv.t | ||
val to_event : t -> Exported_types.Diagnostic.Event.t | ||
val of_event : Exported_types.Diagnostic.Event.t -> t | ||
end |
Oops, something went wrong.