File: cache.ml

package info (click to toggle)
ocaml-dune 3.20.2-3
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 33,564 kB
  • sloc: ml: 175,178; asm: 28,570; ansic: 5,251; sh: 1,096; lisp: 625; makefile: 148; python: 125; cpp: 48; javascript: 10
file content (117 lines) | stat: -rw-r--r-- 3,469 bytes parent folder | download | duplicates (2)
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 ]
;;