this repo has no description
1(** profile command: create, show, list, delete profiles *)
2
3open Cmdliner
4
5let profile_dir_term =
6 let doc = "Profile directory (default ~/.day11)" in
7 Arg.(value & opt string "" & info [ "profile-dir" ] ~docv:"DIR" ~doc)
8
9let resolve_profile_dir s =
10 if s = "" then Day11_batch.Profile.default_dir ()
11 else Fpath.v s
12
13let name_term =
14 let doc = "Profile name" in
15 Arg.(required & opt (some string) None & info [ "name" ] ~docv:"NAME" ~doc)
16
17(* ── create ────────────────────────────────────────────────────── *)
18
19let opam_repo_term =
20 let doc = "opam-repository path (repeatable, layered in order)" in
21 Arg.(non_empty & opt_all string [] &
22 info [ "opam-repository" ] ~docv:"DIR" ~doc)
23
24let odoc_repo_term =
25 let doc = "Local odoc checkout to pin" in
26 Arg.(value & opt (some string) None & info [ "odoc-repo" ] ~docv:"DIR" ~doc)
27
28let opam_build_repo_term =
29 let doc = "Local opam-build checkout" in
30 Arg.(value & opt (some string) None &
31 info [ "opam-build-repo" ] ~docv:"DIR" ~doc)
32
33let compiler_term =
34 let doc = "Compiler version constraint (e.g. ocaml-base-compiler.5.4.1)" in
35 Arg.(value & opt (some string) None &
36 info [ "compiler" ] ~docv:"PKG" ~doc)
37
38let all_versions_term =
39 let doc = "Build all versions of each package" in
40 Arg.(value & flag & info [ "all-versions" ] ~doc)
41
42let small_universe_term =
43 let doc = "Build a curated small universe" in
44 Arg.(value & flag & info [ "small-universe" ] ~doc)
45
46let with_doc_term =
47 let doc = "Generate documentation" in
48 Arg.(value & flag & info [ "with-doc" ] ~doc)
49
50let arch_term =
51 let doc = "Architecture (default x86_64)" in
52 Arg.(value & opt string "x86_64" & info [ "arch" ] ~docv:"ARCH" ~doc)
53
54let os_distribution_term =
55 let doc = "OS distribution (default debian)" in
56 Arg.(value & opt string "debian" &
57 info [ "os-distribution" ] ~docv:"DIST" ~doc)
58
59let os_version_term =
60 let doc = "OS version (default bookworm)" in
61 Arg.(value & opt string "bookworm" &
62 info [ "os-version" ] ~docv:"VER" ~doc)
63
64let driver_compiler_term =
65 let doc = "Compiler for doc driver tools (default: auto-detect from solutions)" in
66 Arg.(value & opt string "" &
67 info [ "driver-compiler" ] ~docv:"PKG" ~doc)
68
69let run_create profile_dir name opam_repositories odoc_repo opam_build_repo
70 compiler all_versions small_universe with_doc
71 arch os_distribution os_version driver_compiler =
72 let dir = Fpath.(resolve_profile_dir profile_dir / "profiles") in
73 let target_mode =
74 if all_versions then Day11_batch.Profile.All_versions
75 else if small_universe then Day11_batch.Profile.Small_universe
76 else Day11_batch.Profile.All_versions
77 in
78 let profile : Day11_batch.Profile.t = {
79 name;
80 opam_repositories;
81 odoc_repo;
82 opam_build_repo;
83 compiler;
84 target_mode;
85 with_doc;
86 with_jtw = false;
87 jtw_repo = None;
88 arch;
89 os_distribution;
90 os_version;
91 driver_compiler;
92 extra_pins = [];
93 patches_dir = None;
94 base_image_digest = None;
95 base_image_updated = None;
96 } in
97 match Day11_batch.Profile.save ~dir profile with
98 | Ok () ->
99 Printf.printf "Profile '%s' created.\n%!" name;
100 Fmt.pr "%a@." Day11_batch.Profile.pp profile;
101 0
102 | Error (`Msg e) ->
103 Printf.eprintf "Error: %s\n%!" e; 1
104
105let create_cmd =
106 let doc = "Create a new profile" in
107 let info = Cmd.info "create" ~doc in
108 Cmd.v info
109 Term.(const run_create
110 $ profile_dir_term $ name_term
111 $ opam_repo_term $ odoc_repo_term $ opam_build_repo_term
112 $ compiler_term $ all_versions_term $ small_universe_term
113 $ with_doc_term
114 $ arch_term $ os_distribution_term $ os_version_term
115 $ driver_compiler_term)
116
117(* ── show ──────────────────────────────────────────────────────── *)
118
119let run_show profile_dir name =
120 let dir = Fpath.(resolve_profile_dir profile_dir / "profiles") in
121 match Day11_batch.Profile.load ~dir ~name with
122 | Ok profile ->
123 Fmt.pr "%a@." Day11_batch.Profile.pp profile;
124 0
125 | Error (`Msg e) ->
126 Printf.eprintf "Error: %s\n%!" e; 1
127
128let show_cmd =
129 let doc = "Show a profile" in
130 let info = Cmd.info "show" ~doc in
131 Cmd.v info Term.(const run_show $ profile_dir_term $ name_term)
132
133(* ── list ──────────────────────────────────────────────────────── *)
134
135let run_list profile_dir =
136 let dir = Fpath.(resolve_profile_dir profile_dir / "profiles") in
137 let names = Day11_batch.Profile.list ~dir in
138 if names = [] then
139 Printf.printf "No profiles found in %s\n%!" (Fpath.to_string dir)
140 else
141 List.iter (fun name -> Printf.printf "%s\n" name) names;
142 0
143
144let list_cmd =
145 let doc = "List profiles" in
146 let info = Cmd.info "list" ~doc in
147 Cmd.v info Term.(const run_list $ profile_dir_term)
148
149(* ── delete ────────────────────────────────────────────────────── *)
150
151let run_delete profile_dir name =
152 let dir = Fpath.(resolve_profile_dir profile_dir / "profiles") in
153 match Day11_batch.Profile.delete ~dir ~name with
154 | Ok () ->
155 Printf.printf "Profile '%s' deleted.\n%!" name; 0
156 | Error (`Msg e) ->
157 Printf.eprintf "Error: %s\n%!" e; 1
158
159let delete_cmd =
160 let doc = "Delete a profile" in
161 let info = Cmd.info "delete" ~doc in
162 Cmd.v info Term.(const run_delete $ profile_dir_term $ name_term)
163
164(* ── refresh-base ──────────────────────────────────────────────── *)
165
166let run_refresh_base profile_dir name =
167 let dir = Fpath.(resolve_profile_dir profile_dir / "profiles") in
168 match Day11_batch.Profile.load ~dir ~name with
169 | Error (`Msg e) -> Printf.eprintf "Error: %s\n%!" e; 1
170 | Ok profile ->
171 Printf.printf "Resolving digest for %s (this may take ~15s)...\n%!"
172 (Day11_batch.Profile.base_image_tag profile);
173 match Day11_batch.Profile.refresh_base_digest profile with
174 | Error (`Msg e) -> Printf.eprintf "Error: %s\n%!" e; 1
175 | Ok updated ->
176 match Day11_batch.Profile.save ~dir updated with
177 | Ok () ->
178 Printf.printf "Base image digest updated:\n %s\n%!"
179 (Option.value ~default:"?" updated.base_image_digest);
180 0
181 | Error (`Msg e) ->
182 Printf.eprintf "Error saving: %s\n%!" e; 1
183
184let refresh_base_cmd =
185 let doc = "Resolve and pin the base Docker image digest from the registry" in
186 let info = Cmd.info "refresh-base" ~doc in
187 Cmd.v info Term.(const run_refresh_base $ profile_dir_term $ name_term)
188
189(* ── group ─────────────────────────────────────────────────────── *)
190
191let cmd =
192 let doc = "Manage analysis profiles" in
193 let info = Cmd.info "profile" ~doc in
194 Cmd.group info [ create_cmd; show_cmd; list_cmd; delete_cmd;
195 refresh_base_cmd ]