parent
99b0d94335
commit
21b29b0cb6
|
@ -365,41 +365,33 @@ module Scheduler = struct
|
||||||
| Some (ctx, filename) ->
|
| Some (ctx, filename) ->
|
||||||
split_paths (Path.to_string filename :: targets_acc) (ctx :: ctxs_acc) rest in
|
split_paths (Path.to_string filename :: targets_acc) (ctx :: ctxs_acc) rest in
|
||||||
let target_names, contexts = split_paths [] [] targets in
|
let target_names, contexts = split_paths [] [] targets in
|
||||||
let rec group_by_ext = function
|
let target_names_grouped_by_prefix =
|
||||||
| [] -> []
|
List.map target_names ~f:Filename.split_extension_after_dot
|
||||||
| x :: xs ->
|
|> String_map.of_alist_multi
|
||||||
let eq_ext a b =
|
|> String_map.bindings
|
||||||
let chop s =
|
in
|
||||||
try Filename.chop_extension s with Invalid_argument _ -> s in
|
|
||||||
chop a = chop b in
|
|
||||||
let (similar, rest) = List.partition ~f:(eq_ext x) xs in
|
|
||||||
(x :: similar) :: group_by_ext rest in
|
|
||||||
let pp_ext ppf filename =
|
|
||||||
let ext =
|
|
||||||
match Filename.extension filename with
|
|
||||||
| "" -> ""
|
|
||||||
| s -> String.sub ~pos:1 ~len:(String.length s - 1) s
|
|
||||||
in
|
|
||||||
Format.fprintf ppf "%s" ext in
|
|
||||||
let pp_comma ppf () = Format.fprintf ppf "," in
|
let pp_comma ppf () = Format.fprintf ppf "," in
|
||||||
let pp_group ppf = function
|
let pp_group ppf (prefix, suffixes) =
|
||||||
|
match suffixes with
|
||||||
| [] -> assert false
|
| [] -> assert false
|
||||||
| [s] -> Format.fprintf ppf "%s" s
|
| [suffix] -> Format.fprintf ppf "%s%s" prefix suffix
|
||||||
| (x :: _) as group ->
|
| _ ->
|
||||||
Format.fprintf ppf "%s.{%a}"
|
Format.fprintf ppf "%s{%a}"
|
||||||
(Filename.chop_extension x)
|
prefix
|
||||||
(Format.pp_print_list ~pp_sep:pp_comma pp_ext)
|
(Format.pp_print_list ~pp_sep:pp_comma Format.pp_print_string)
|
||||||
group in
|
suffixes
|
||||||
|
in
|
||||||
let pp_contexts ppf = function
|
let pp_contexts ppf = function
|
||||||
| [] -> ()
|
| [] -> ()
|
||||||
| ctxs ->
|
| ctxs ->
|
||||||
Format.fprintf ppf " @{<details>[%a]@}"
|
Format.fprintf ppf " @{<details>[%a]@}"
|
||||||
(Format.pp_print_list ~pp_sep:pp_comma
|
(Format.pp_print_list ~pp_sep:pp_comma
|
||||||
(fun ppf s -> Format.fprintf ppf "%s" s))
|
(fun ppf s -> Format.fprintf ppf "%s" s))
|
||||||
ctxs in
|
ctxs
|
||||||
|
in
|
||||||
Format.fprintf ppf "%a%a"
|
Format.fprintf ppf "%a%a"
|
||||||
(Format.pp_print_list ~pp_sep:pp_comma pp_group)
|
(Format.pp_print_list ~pp_sep:pp_comma pp_group)
|
||||||
(group_by_ext target_names)
|
target_names_grouped_by_prefix
|
||||||
pp_contexts
|
pp_contexts
|
||||||
contexts;
|
contexts;
|
||||||
|
|
||||||
|
|
|
@ -165,6 +165,7 @@ module Map = struct
|
||||||
| Error _ -> invalid_arg "Map.of_alist_exn"
|
| Error _ -> invalid_arg "Map.of_alist_exn"
|
||||||
|
|
||||||
let of_alist_multi l =
|
let of_alist_multi l =
|
||||||
|
let l = List.rev l in
|
||||||
List.fold_left l ~init:empty ~f:(fun acc (key, data) ->
|
List.fold_left l ~init:empty ~f:(fun acc (key, data) ->
|
||||||
add_multi acc ~key ~data)
|
add_multi acc ~key ~data)
|
||||||
|
|
||||||
|
@ -318,6 +319,15 @@ module Filename = struct
|
||||||
(String.sub fn ~pos:0 ~len:i,
|
(String.sub fn ~pos:0 ~len:i,
|
||||||
String.sub fn ~pos:i ~len:(String.length fn - i))
|
String.sub fn ~pos:i ~len:(String.length fn - i))
|
||||||
|
|
||||||
|
let split_extension_after_dot fn =
|
||||||
|
let i = extension_start fn + 1 in
|
||||||
|
let len = String.length fn in
|
||||||
|
if i > len then
|
||||||
|
(fn, "")
|
||||||
|
else
|
||||||
|
(String.sub fn ~pos:0 ~len:i,
|
||||||
|
String.sub fn ~pos:i ~len:(String.length fn - i))
|
||||||
|
|
||||||
let extension fn =
|
let extension fn =
|
||||||
let i = extension_start fn in
|
let i = extension_start fn in
|
||||||
String.sub fn ~pos:i ~len:(String.length fn - i)
|
String.sub fn ~pos:i ~len:(String.length fn - i)
|
||||||
|
|
Loading…
Reference in New Issue