-
Notifications
You must be signed in to change notification settings - Fork 412
/
Copy pathcache.ml
92 lines (79 loc) · 2.55 KB
/
cache.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
open Stdune
open Import
let name = "cache"
(* CR-someday amokhov: Implement other commands supported by Jenga. *)
let man =
[ `S "DESCRIPTION"
; `P
{|Dune can share build artifacts between workspaces. Currently, the only
action supported by this command is `trim`, but we plan to provide more
functionality soon. |}
; `S "ACTIONS"
; `P {|$(b,trim) trim the shared cache to free space.|}
; `Blocks Common.help_secs
]
let doc = "Manage the shared cache of build artifacts"
let info = Term.info name ~doc ~man
let trim ~trimmed_size ~size =
Log.init_disabled ();
let open Result.O in
match
let+ goal =
match (trimmed_size, size) with
| Some trimmed_size, None -> Result.Ok trimmed_size
| None, Some size ->
Result.Ok (Int64.sub (Dune_cache.Trimmer.overhead_size ()) size)
| _ -> Result.Error "specify either --size or --trimmed-size"
in
Dune_cache.Trimmer.trim ~goal
with
| Error s -> User_error.raise [ Pp.text s ]
| Ok { trimmed_bytes } ->
User_message.print
(User_message.make [ Pp.textf "Freed %Li bytes" trimmed_bytes ])
type mode =
| Trim
| Start_deprecated
| Stop_deprecated
let modes =
[ ("start", Start_deprecated); ("stop", Stop_deprecated); ("trim", Trim) ]
(* CR-someday amokhov: See https://github.com/ocaml/dune/issues/4471. *)
(* We don't want to list deprecated subcommands in help. *)
let non_deprecated_modes = [ ("trim", Trim) ]
(* We do want to print a nice error message if a deprecated subcommand is
run. *)
let deprecated_error () =
User_error.raise
[ Pp.text
"Dune no longer uses the cache daemon, and so the `start` and `stop` \
subcommands of `dune cache` were removed."
]
let term =
Term.ret
@@ let+ mode =
Arg.(
value
& pos 0 (some (enum modes)) None
& info [] ~docv:"ACTION"
~doc:
(Printf.sprintf "The cache action to perform (%s)"
(Arg.doc_alts_enum non_deprecated_modes)))
and+ trimmed_size =
Arg.(
value
& opt (some bytes) None
& info ~docv:"BYTES" [ "trimmed-size" ]
~doc:"size to trim from the cache")
and+ size =
Arg.(
value
& opt (some bytes) None
& info ~docv:"BYTES" [ "size" ] ~doc:"size to trim the cache to")
in
match mode with
| Some Trim -> `Ok (trim ~trimmed_size ~size)
| Some Start_deprecated
| Some Stop_deprecated ->
deprecated_error ()
| None -> `Help (`Pager, Some name)
let command = (term, info)