Remove unnecessary boilerplate for accumulating errors

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
This commit is contained in:
Rudi Grinberg 2018-09-04 12:58:39 +04:00
parent 8c41bdc8d2
commit f899e7be05
1 changed files with 27 additions and 58 deletions

View File

@ -53,19 +53,6 @@ end = struct
Errors.fail loc "Module %a doesn't exist." Module.Name.pp s) Errors.fail loc "Module %a doesn't exist." Module.Name.pp s)
) )
type field =
| Modules
| Intf_only
type incorrect_field =
{ correct_field : field
; module_: Loc.t * Module.t
}
type error =
| Incorrect_field of incorrect_field
| Virtual_intf_overlap of (Loc.t * Module.t)
module Module_errors = struct module Module_errors = struct
type t = type t =
{ missing_modules : (Loc.t * Module.t) list { missing_modules : (Loc.t * Module.t) list
@ -86,47 +73,43 @@ end = struct
} }
end end
let fold_errors ~f ~init ~modules ~intf_only ~virtual_modules = let find_errors ~modules ~intf_only ~virtual_modules =
let init = let missing_modules =
Module.Name.Map.fold intf_only ~init Module.Name.Map.fold intf_only ~init:[]
~f:(fun ((_, (module_ : Module.t)) as module_loc) acc -> ~f:(fun ((_, (module_ : Module.t)) as module_loc) acc ->
if Option.is_none module_.impl then if Option.is_none module_.impl then
acc acc
else else
f (Incorrect_field module_loc :: acc)
{ correct_field = Modules
; module_ = module_loc
}
) acc)
in in
let init = let errors =
Module.Name.Map.fold virtual_modules ~init Module.Name.Map.fold virtual_modules ~init:Module_errors.empty
~f:(fun (_, (module_ : Module.t) as module_loc) acc -> ~f:(fun (_, (module_ : Module.t) as module_loc) acc ->
if Option.is_some module_.impl then if Option.is_some module_.impl then
f (Incorrect_field { acc with missing_modules = module_loc :: acc.missing_modules }
{ correct_field = Modules
; module_ = module_loc
}
) acc
else if Module.Name.Map.mem intf_only (Module.name module_) then else if Module.Name.Map.mem intf_only (Module.name module_) then
f (Virtual_intf_overlap module_loc) acc { acc with virt_intf_overlaps = module_loc :: acc.virt_intf_overlaps
}
else else
acc) acc)
in in
Module.Name.Map.fold modules ~init let missing_intf_only =
~f:(fun (_, (module_ : Module.t) as module_loc) acc -> Module.Name.Map.fold modules ~init:[]
if Option.is_some module_.impl then ~f:(fun (_, (module_ : Module.t) as module_loc) acc ->
acc if Option.is_some module_.impl then
else if not (Module.Name.Map.mem intf_only (Module.name module_)) acc
&& not (Module.Name.Map.mem virtual_modules (Module.name module_)) else if not (Module.Name.Map.mem intf_only (Module.name module_))
then && not (Module.Name.Map.mem virtual_modules (Module.name module_))
f (Incorrect_field then
{ correct_field = Intf_only module_loc :: acc
; module_ = module_loc else
} acc) in
) acc assert (List.is_empty errors.missing_intf_only);
else { errors with
acc) missing_modules = List.rev_append errors.missing_modules missing_modules
; missing_intf_only
}
|> Module_errors.map ~f:List.rev
let check_invalid_module_listing ~(buildable : Buildable.t) ~intf_only let check_invalid_module_listing ~(buildable : Buildable.t) ~intf_only
~modules ~virtual_modules = ~modules ~virtual_modules =
@ -134,21 +117,7 @@ end = struct
missing_modules missing_modules
; missing_intf_only ; missing_intf_only
; virt_intf_overlaps ; virt_intf_overlaps
} = } = find_errors ~modules ~intf_only ~virtual_modules
fold_errors ~init:Module_errors.empty ~modules ~intf_only ~virtual_modules
~f:(fun e (errors : Module_errors.t) ->
match e with
| Incorrect_field { correct_field = Modules; module_ } ->
{ errors with missing_modules = module_ :: errors.missing_modules}
| Incorrect_field { correct_field = Intf_only; module_ } ->
{ errors with
missing_intf_only = module_ :: errors.missing_intf_only
}
| Virtual_intf_overlap module_ ->
{ errors with
virt_intf_overlaps = module_ :: errors.virt_intf_overlaps
})
|> Module_errors.map ~f:List.rev
in in
let uncapitalized = let uncapitalized =
List.map ~f:(fun (_, m) -> Module.name m |> Module.Name.uncapitalize) in List.map ~f:(fun (_, m) -> Module.name m |> Module.Name.uncapitalize) in