this repo has no description
1type report = {
2 base : int;
3 builds : int;
4 docs : int;
5 jtw : int;
6 solutions : int;
7 logs : int;
8 packages : int;
9 total : int;
10}
11
12let dir_size path =
13 let path_s = Fpath.to_string path in
14 if not (Sys.file_exists path_s) then 0
15 else
16 (* Use du -sb for accurate byte count *)
17 let ic = Unix.open_process_in
18 (Printf.sprintf "du -sb %s 2>/dev/null" (Filename.quote path_s)) in
19 let result = try Scanf.sscanf (input_line ic) "%d" Fun.id
20 with _ -> 0 in
21 ignore (Unix.close_process_in ic);
22 result
23
24let sum_matching ~dir prefix =
25 let dir_s = Fpath.to_string dir in
26 if not (Sys.file_exists dir_s) then 0
27 else
28 Sys.readdir dir_s |> Array.to_list
29 |> List.filter (fun name ->
30 String.length name >= String.length prefix
31 && String.sub name 0 (String.length prefix) = prefix)
32 |> List.fold_left (fun acc name ->
33 acc + dir_size Fpath.(dir / name)) 0
34
35let is_layer_dir name =
36 (* Layer dirs are 12-char hex strings (new format) or build-<hex> (legacy) *)
37 let is_hex c = (c >= '0' && c <= '9') || (c >= 'a' && c <= 'f') in
38 (String.length name = 12 && String.for_all is_hex name)
39 || (String.length name > 6
40 && String.sub name 0 6 = "build-")
41
42let scan ~os_dir ~cache_dir =
43 let base = dir_size Fpath.(cache_dir / "base") in
44 let builds =
45 let dir_s = Fpath.to_string os_dir in
46 if not (Sys.file_exists dir_s) then 0
47 else
48 Sys.readdir dir_s |> Array.to_list
49 |> List.filter is_layer_dir
50 |> List.fold_left (fun acc name ->
51 acc + dir_size Fpath.(os_dir / name)) 0
52 in
53 let docs = dir_size Fpath.(os_dir / "odoc-store") in
54 let jtw = sum_matching ~dir:os_dir "jtw-" in
55 let solutions = dir_size Fpath.(cache_dir / "solutions") in
56 let logs = dir_size Fpath.(cache_dir / "logs") in
57 let packages = dir_size Fpath.(os_dir / "packages") in
58 let total = base + builds + docs + jtw + solutions + logs + packages in
59 { base; builds; docs; jtw; solutions; logs; packages; total }
60
61let human_size n =
62 if n >= 1_073_741_824 then Printf.sprintf "%.1f GB" (float n /. 1_073_741_824.)
63 else if n >= 1_048_576 then Printf.sprintf "%.1f MB" (float n /. 1_048_576.)
64 else if n >= 1024 then Printf.sprintf "%.1f KB" (float n /. 1024.)
65 else Printf.sprintf "%d B" n
66
67let pp fmt r =
68 Fmt.pf fmt "@[<v>Base: %s@,Builds: %s@,Docs: %s@,JTW: %s@,Solutions: %s@,Logs: %s@,Packages: %s@,Total: %s@]"
69 (human_size r.base) (human_size r.builds) (human_size r.docs)
70 (human_size r.jtw) (human_size r.solutions) (human_size r.logs)
71 (human_size r.packages) (human_size r.total)