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 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117
|
open Import
(* CR-someday amokhov: Implement other commands supported by Jenga. *)
let trim =
let info =
let doc = "Trim the Dune cache." in
let man =
[ `P "Trim the Dune cache to a specified size or by a specified amount."
; `S "EXAMPLES"
; `Pre
{|Trimming the Dune cache to 1 GB.
\$ dune cache trim --size=1GB |}
; `Pre
{|Trimming 500 MB from the Dune cache.
\$ dune cache trim --trimmed-size=500MB |}
]
in
Cmd.info "trim" ~doc ~man
in
Cmd.v info
@@ let+ trimmed_size =
Arg.(
value
& opt (some bytes) None
& info
~docv:"BYTES"
[ "trimmed-size" ]
~doc:"Size to trim from the cache. $(docv) is the same as for --size.")
and+ size =
Arg.(
value
& opt (some bytes) None
& info
~docv:"BYTES"
[ "size" ]
~doc:
(sprintf
"Size to trim the cache to. $(docv) is the number of bytes followed by \
a unit. Byte units can be one of %s."
(String.enumerate_or
(List.map
~f:(fun (units, _) -> List.hd units)
Bytes_unit.conversion_table))))
in
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 "please specify either --size or --trimmed-size"
in
Dune_cache.Trimmer.trim ~goal
with
| Error s -> User_error.raise [ Pp.text s ]
| Ok { trimmed_bytes; number_of_files_removed } ->
User_message.print
(User_message.make
[ Pp.textf
"Freed %s (%d files removed)"
(Bytes_unit.pp trimmed_bytes)
number_of_files_removed
])
;;
let size =
let info =
let doc = "Query the size of the Dune cache." in
let man =
[ `P
"Compute the total size of files in the Dune cache which are not hardlinked \
from any build directory and output it in a human-readable form."
]
in
Cmd.info "size" ~doc ~man
in
Cmd.v info
@@ let+ machine_readable =
Arg.(
value
& flag
& info [ "machine-readable" ] ~doc:"Outputs size as a plain number of bytes.")
in
let size = Dune_cache.Trimmer.overhead_size () in
if machine_readable
then User_message.print (User_message.make [ Pp.textf "%Ld" size ])
else User_message.print (User_message.make [ Pp.textf "%s" (Bytes_unit.pp size) ])
;;
let clear =
let info =
let doc = "Clear the Dune cache." in
let man = [ `P "Remove any traces of the Dune cache." ] in
Cmd.info "clear" ~doc ~man
in
Cmd.v info @@ Term.(const Dune_cache_storage.clear $ const ())
;;
let command =
let info =
let doc = "Manage Dune's shared cache of build artifacts." in
let man =
[ `S "DESCRIPTION"
; `P
"Dune can share build artifacts between workspaces. We currently only support \
a few subcommands; however, we plan to provide more functionality soon."
]
in
Cmd.info "cache" ~doc ~man
in
Cmd.group info [ trim; size; clear ]
;;
|