Skip to content

Commit

Permalink
refactor: move build errors to own module (#8530)
Browse files Browse the repository at this point in the history 
Signed-off-by: Rudi Grinberg <me@rgrinberg.com>
  • Loading branch information
@rgrinberg
rgrinberg authored Aug 28, 2023
1 parent 104d242 commit 9432577
Show file tree
Hide file tree
Showing 11 changed files with 194 additions and 200 deletions.
3 changes: 2 additions & 1 deletion bin/import.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,7 @@ include struct
open Dune_engine
module Build_config = Build_config
module Build_system = Build_system
module Build_system_error = Build_system_error
module Load_rules = Load_rules
module Hooks = Hooks
module Action_builder = Action_builder
Expand Down Expand Up @@ -157,7 +158,7 @@ module Scheduler = struct
| Failure ->
let failure_message =
match
Build_system.Error.(
Build_system_error.(
Id.Map.cardinal (Set.current (Fiber.Svar.read Build_system.errors)))
with
| 1 -> Pp.textf "Had 1 error"
Expand Down
127 changes: 1 addition & 126 deletions src/dune_engine/build_system.ml
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
open Import
open Memo.O
module Action_builder = Action_builder0
module Error = Build_system_error

module Progress = struct
type t =
Expand All @@ -26,132 +27,6 @@ module Progress = struct
;;
end

module Error = struct
module Id = Id.Make ()

type t =
| Exn of
{ id : Id.t
; exn : Exn_with_backtrace.t
}
| Diagnostic of
{ id : Id.t
; diagnostic : Compound_user_error.t
; dir : Path.t option
; promotion : Diff_promotion.Annot.t option
}

module Event = struct
type nonrec t =
| Add of t
| Remove of t
end

let of_exn (exn : Exn_with_backtrace.t) =
let exn =
match exn.exn with
| Memo.Error.E e -> { exn with exn = Memo.Error.get e }
| _ -> exn
in
match exn.exn with
| User_error.E main ->
let dir = User_message.Annots.find main.annots Process.with_directory_annot in
let promotion = User_message.Annots.find main.annots Diff_promotion.Annot.annot in
(match User_message.Annots.find main.annots Compound_user_error.annot with
| None ->
[ Diagnostic
{ dir
; id = Id.gen ()
; diagnostic = Compound_user_error.make ~main ~related:[]
; promotion
}
]
| Some diagnostics ->
List.map diagnostics ~f:(fun diagnostic ->
Diagnostic { id = Id.gen (); diagnostic; dir; promotion }))
| _ -> [ Exn { id = Id.gen (); exn } ]
;;

let promotion = function
| Exn _ -> None
| Diagnostic d -> d.promotion
;;

let id = function
| Exn d -> d.id
| Diagnostic d -> d.id
;;

let dir = function
| Exn _ -> None
| Diagnostic d -> d.dir
;;

let description = function
| Exn e -> `Exn e.exn
| Diagnostic d -> `Diagnostic d.diagnostic
;;

module For_tests = struct
let make ~description ~dir ~promotion () =
let id = Id.gen () in
match description with
| `Exn exn -> Exn { id; exn }
| `Diagnostic diagnostic -> Diagnostic { id; diagnostic; dir; promotion }
;;
end

module Set : sig
type error := t

type nonrec t = private
{ current : t Id.Map.t
; stamp : int
; last_event : Event.t option
}

val add : t -> error -> t
val one_event_diff : prev:t -> next:t -> Event.t option
val equal : t -> t -> bool
val current : t -> error Id.Map.t
val empty : t
end = struct
type nonrec t =
{ current : t Id.Map.t
; stamp : int
; last_event : Event.t option
}

let add t error =
let current = Id.Map.set t.current (id error) error in
{ current; stamp = t.stamp + 1; last_event = Some (Add error) }
;;

let equal t { current; stamp; last_event } =
Int.equal t.stamp stamp
&&
match t.last_event, last_event with
| None, None ->
assert (Id.Map.is_empty t.current && Id.Map.is_empty current);
true (* only possible when both sets are empty *)
| Some x, Some y ->
(match x, y with
| Add x, Add y -> Id.equal (id x) (id y)
| Add _, _ -> false
| Remove x, Remove y -> Id.equal (id x) (id y)
| Remove _, _ -> false)
| Some _, None | None, Some _ -> false
;;

let one_event_diff ~prev ~next =
if prev.stamp + 1 = next.stamp then next.last_event else None
;;

let current t = t.current
let empty = { current = Id.Map.empty; stamp = 0; last_event = None }
end
end

module State = struct
module Svar = Fiber.Svar

Expand Down
62 changes: 1 addition & 61 deletions src/dune_engine/build_system.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -81,65 +81,5 @@ end

val state : State.t Fiber.Svar.t

(** Errors found when building targets. *)
module Error : sig
module Id : sig
type t

module Map : Map.S with type key = t

val compare : t -> t -> Ordering.t
val to_int : t -> int
val to_dyn : t -> Dyn.t
end

type t

val id : t -> Id.t

(** the directory where the rule the error is originating from *)
val dir : t -> Path.t option

(** The description of the error. Errors from build rules contain useful
metadata that are extracted into [`Diagnostic] *)
val description
: t
-> [ `Exn of Exn_with_backtrace.t | `Diagnostic of Compound_user_error.t ]

val promotion : t -> Diff_promotion.Annot.t option

module Event : sig
type nonrec t =
| Add of t
| Remove of t
end

module Set : sig
type error := t
type t

(** [one_event_diff ~prev ~next] returns the event that constructs [next]
from [prev] if [next] is in the successive "generation" of [prev] *)
val one_event_diff : prev:t -> next:t -> Event.t option

val equal : t -> t -> bool
val current : t -> error Id.Map.t
val empty : t
end

module For_tests : sig
(** Internal helpers for testing purposes. Do not use. *)

(** Construct an [Error.t] *)
val make
: description:
[ `Exn of Exn_with_backtrace.t | `Diagnostic of Compound_user_error.t ]
-> dir:Path.t option
-> promotion:Diff_promotion.Annot.t option
-> unit
-> t
end
end

(** The current set of active errors. *)
val errors : Error.Set.t Fiber.Svar.t
val errors : Build_system_error.Set.t Fiber.Svar.t
112 changes: 112 additions & 0 deletions src/dune_engine/build_system_error.ml
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,112 @@
open Import
module Id = Id.Make ()

type t =
| Exn of
{ id : Id.t
; exn : Exn_with_backtrace.t
}
| Diagnostic of
{ id : Id.t
; diagnostic : Compound_user_error.t
; dir : Path.t option
; promotion : Diff_promotion.Annot.t option
}

module Event = struct
type nonrec t =
| Add of t
| Remove of t
end

let of_exn (exn : Exn_with_backtrace.t) =
let exn =
match exn.exn with
| Memo.Error.E e -> { exn with exn = Memo.Error.get e }
| _ -> exn
in
match exn.exn with
| User_error.E main ->
let dir = User_message.Annots.find main.annots Process.with_directory_annot in
let promotion = User_message.Annots.find main.annots Diff_promotion.Annot.annot in
(match User_message.Annots.find main.annots Compound_user_error.annot with
| None ->
[ Diagnostic
{ dir
; id = Id.gen ()
; diagnostic = Compound_user_error.make ~main ~related:[]
; promotion
}
]
| Some diagnostics ->
List.map diagnostics ~f:(fun diagnostic ->
Diagnostic { id = Id.gen (); diagnostic; dir; promotion }))
| _ -> [ Exn { id = Id.gen (); exn } ]
;;

let promotion = function
| Exn _ -> None
| Diagnostic d -> d.promotion
;;

let id = function
| Exn d -> d.id
| Diagnostic d -> d.id
;;

let dir = function
| Exn _ -> None
| Diagnostic d -> d.dir
;;

let description = function
| Exn e -> `Exn e.exn
| Diagnostic d -> `Diagnostic d.diagnostic
;;

module Set = struct
type error = t

type t =
{ current : error Id.Map.t
; stamp : int
; last_event : Event.t option
}

let add t error =
let current = Id.Map.set t.current (id error) error in
{ current; stamp = t.stamp + 1; last_event = Some (Add error) }
;;

let equal t { current; stamp; last_event } =
Int.equal t.stamp stamp
&&
match t.last_event, last_event with
| None, None ->
assert (Id.Map.is_empty t.current && Id.Map.is_empty current);
true (* only possible when both sets are empty *)
| Some x, Some y ->
(match x, y with
| Add x, Add y -> Id.equal (id x) (id y)
| Add _, _ -> false
| Remove x, Remove y -> Id.equal (id x) (id y)
| Remove _, _ -> false)
| Some _, None | None, Some _ -> false
;;

let one_event_diff ~prev ~next =
if prev.stamp + 1 = next.stamp then next.last_event else None
;;

let current t = t.current
let empty = { current = Id.Map.empty; stamp = 0; last_event = None }
end

module For_tests = struct
let make ~description ~dir ~promotion () =
let id = Id.gen () in
match description with
| `Exn exn -> Exn { id; exn }
| `Diagnostic diagnostic -> Diagnostic { id; diagnostic; dir; promotion }
;;
end
Loading

0 comments on commit 9432577

Please sign in to comment.