Remove unnecessary boilerplate for accumulating errors
Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
This commit is contained in:
parent
8c41bdc8d2
commit
f899e7be05
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue