+8 -4

lib/cmd/build.ml

reviewed

··· 92 92 let padded = Fmt.str "%-*s" handle_width h in 93 93 Fmt.str "%a" Oi.Style.info_string padded 94 94 in 95 95 - Fmt.pr "@."; 95 95 + Oi.Say.newline (); 96 96 + Oi.Say.header "Build summary"; 96 97 List.iter 97 98 (fun (target, handle, r) -> 98 99 if handle_width = 0 then ··· 121 122 Fmt.pr " %a %s@." Oi.Style.dim_string "↳ solver log:" log_path 122 123 | _ -> ()) 123 124 rows; 124 124 - Fmt.pr "@.%d ok, %d failed, %d depext-fail, %d skipped@." n_ok n_failed 125 125 - n_depext n_skipped; 125 125 + Oi.Say.newline (); 126 126 + Fmt.pr " %a %d %a %d %a %d %a %d@." Oi.Style.ok_string "ok" n_ok 127 127 + Oi.Style.error_string "failed" n_failed Oi.Style.warn_string "depext-fail" 128 128 + n_depext Oi.Style.warn_string "skipped" n_skipped; 126 129 (* Dump per-target build-failure output at debug level so `-v` still 127 130 shows the reason, without dumping a compiler transcript by 128 131 default. *) ··· 388 391 end 389 392 else begin 390 393 let layer_hashes = 394 394 + let on_phase msg = Oi.Say.step "%s" msg in 391 395 Oi.Pipeline.build ~sys ~proc_mgr ~fs ~clock ~cache ~data_dir ~conf ~os_key 392 396 ~extra_repos:all_extras ~pins:url_project.pins ~refresh 393 397 ~constraints:extra_constraints ?remote ?jobs ?toolchain 394 394 - ?local_packages_dir:url_project.packages_dir names 398 398 + ?local_packages_dir:url_project.packages_dir ~on_phase names 395 399 in 396 400 match 397 401 find_target_layer ~fs ~cache ~os_key ~pkg_name:target layer_hashes

+63 -46

lib/cmd/clean.ml

reviewed

··· 19 19 let layers_root = Oi.Cache.root_s cache / "layers" / os_key in 20 20 let index_path = Layer_index.ensure_local ~sys ~fs ~clock ~cache ~os_key in 21 21 if not (Eio.Path.is_file Eio.Path.(fs / index_path)) then begin 22 22 - Fmt.pr "No layer index for %s; nothing to do.@." os_key; 22 22 + Oi.Say.info "no layer index for %s; nothing to do" os_key; 23 23 0 24 24 end 25 25 else begin ··· 35 35 |> List.map (fun (n, v, h, _) -> (n, v, h)) 36 36 in 37 37 if direct = [] then begin 38 38 - Fmt.pr "No cached layers found for %s.@." target; 38 38 + Oi.Say.info "no cached layers found for %s" target; 39 39 D10.Index.close db; 40 40 0 41 41 end ··· 51 51 let dependents = close [] direct_hashes in 52 52 let all_hashes = direct_hashes @ dependents in 53 53 let verb = if dry_run then "Would remove" else "Removing" in 54 54 - Fmt.pr "@[<v>%s %d layer(s) for %s:@," verb (List.length direct) target; 55 55 - List.iter (fun (n, v, h) -> Fmt.pr " %s.%s %s@," n v (short h)) direct; 54 54 + let dim s = Fmt.str "%a" Oi.Style.dim_string s in 55 55 + Oi.Say.step "%s %d layer(s) for %s" verb (List.length direct) target; 56 56 + List.iter 57 57 + (fun (n, v, h) -> Oi.Say.info "%s.%s %s" n v (dim (short h))) 58 58 + direct; 56 59 if dependents <> [] then begin 57 57 - Fmt.pr "%s %d dependent layer(s):@," verb (List.length dependents); 58 58 - List.iter (fun h -> Fmt.pr " %s@," (short h)) dependents 60 60 + Oi.Say.step "%s %d dependent layer(s)" verb (List.length dependents); 61 61 + List.iter (fun h -> Oi.Say.info "%s" (dim (short h))) dependents 59 62 end; 60 60 - Fmt.pr "@]@."; 61 63 if not dry_run then begin 62 64 List.iter 63 65 (fun h -> 64 64 - let dir = layers_root / h in 65 65 - Eio.Path.rmtree ~missing_ok:true Eio.Path.(fs / dir)) 66 66 + Eio.Path.rmtree ~missing_ok:true Eio.Path.(fs / layers_root / h)) 66 67 all_hashes; 67 68 D10.Index.delete_layers db ~hashes:all_hashes; 68 68 - Fmt.pr 69 69 - "Removed %d layer(s). Run 'oi build' to rebuild what you still \ 70 70 - need.@." 71 71 - (List.length all_hashes) 69 69 + Oi.Say.ok "removed %d layer(s)" (List.length all_hashes); 70 70 + Oi.Say.info "run 'oi build' to rebuild what you still need" 72 71 end; 73 72 D10.Index.close db; 74 73 List.length all_hashes ··· 79 78 80 79 let cmd = 81 80 let run () cache_dir data_dir all toolchains sources binaries dune_cache repos 82 82 - opam_root dry_run target = 81 81 + opam_root pins dry_run target = 83 82 Harness.run @@ fun env -> 84 83 let { Harness.fs; clock; sys; os_key; cache; _ } = 85 84 Harness.bootstrap env cache_dir 86 85 in 87 86 let bulk_flags = 88 87 all || toolchains || sources || binaries || dune_cache || repos 89 89 - || opam_root 88 88 + || opam_root || pins 90 89 in 91 90 match target with 92 91 | Some t -> 93 92 if bulk_flags then begin 94 94 - Fmt.epr 95 95 - "oi clean: PKG positional cannot be combined with --all / \ 96 96 - --toolchains / --sources / --layers / --dune / --repos / \ 97 97 - --opam-root.@."; 93 93 + Oi.Say.error 94 94 + "PKG positional cannot be combined with bulk flags (--all, \ 95 95 + --toolchains, --sources, --layers, --dune, --repos, --opam-root, \ 96 96 + --pins)"; 98 97 exit 1 99 98 end 100 99 else ··· 135 134 rows 136 135 in 137 136 Tty.Table.pp Fmt.stdout table; 138 138 - Fmt.pr "@.Use --all to clean everything, or select specific items.@." 137 137 + Oi.Say.newline (); 138 138 + Oi.Say.info "use --all to clean everything, or select specific items" 139 139 end 140 140 else begin 141 141 let items = Oi.Cache.cleanable_items cache ~data_dir in 142 142 - let find_item label = 143 143 - List.find_opt (fun (i : Oi.Cache.item) -> i.label = label) items 142 142 + let rm_item (item : Oi.Cache.item) = 143 143 + if Eio.Path.is_directory item.path || Eio.Path.is_file item.path 144 144 + then begin 145 145 + let sz = Oi.Cache.size ~sys item.path in 146 146 + if dry_run then 147 147 + Oi.Say.info "would remove %s (%a) %s" item.label 148 148 + Oi.Cache.pp_size sz 149 149 + (Eio.Path.native_exn item.path) 150 150 + else begin 151 151 + Eio.Path.rmtree ~missing_ok:true item.path; 152 152 + Oi.Say.ok "removed %s (%a)" item.label Oi.Cache.pp_size sz 153 153 + end 154 154 + end 144 155 in 145 145 - let rm label = 146 146 - match find_item label with 147 147 - | None -> () 148 148 - | Some item -> 149 149 - if Eio.Path.is_directory item.path || Eio.Path.is_file item.path 150 150 - then begin 151 151 - let sz = Oi.Cache.size ~sys item.path in 152 152 - if dry_run then 153 153 - Fmt.pr "Would remove %s (%a) %s@." label Oi.Cache.pp_size sz 154 154 - (Eio.Path.native_exn item.path) 155 155 - else begin 156 156 - Eio.Path.rmtree ~missing_ok:true item.path; 157 157 - Fmt.pr "Removed %s (%a)@." label Oi.Cache.pp_size sz 158 158 - end 159 159 - end 156 156 + (* [--all] sweeps everything in [cleanable_items], so adding 157 157 + a new category there picks it up automatically. Per-flag 158 158 + groups bundle related caches: [--layers] for instance also 159 159 + clears the solve cache, run-cache, build state and 160 160 + prefixes, since all of them index off layer hashes that 161 161 + just got dropped. *) 162 162 + let want_label = function 163 163 + | _ when all -> true 164 164 + | "toolchains" -> toolchains 165 165 + | "sources" | "mirror" -> sources 166 166 + | "layers" | "runs" | "run-cache" | "solve-cache" | "build" 167 167 + | "prefixes" -> 168 168 + binaries 169 169 + | "dune" -> dune_cache 170 170 + | "repos" -> repos 171 171 + | "opam-root" -> opam_root 172 172 + | "pins" -> pins 173 173 + | _ -> false 160 174 in 161 161 - if all || toolchains then rm "toolchains"; 162 162 - if all || sources then rm "sources"; 163 163 - if all || binaries then rm "layers"; 164 164 - if all || binaries then rm "runs"; 165 165 - if all || dune_cache then rm "dune"; 166 166 - if all || repos then rm "repos"; 167 167 - if all || opam_root then rm "opam-root"; 168 168 - Fmt.pr "Done.@." 175 175 + List.iter 176 176 + (fun (item : Oi.Cache.item) -> 177 177 + if want_label item.label then rm_item item) 178 178 + items; 179 179 + Oi.Say.step "Done" 169 180 end 170 181 in 171 182 let all = ··· 202 213 Regenerated on demand." 203 214 [ "opam-root" ]) 204 215 in 216 216 + let pins = 217 217 + Arg.( 218 218 + value & flag 219 219 + & info ~doc:"Pin-depends sources and synthesized packages trees." 220 220 + [ "pins" ]) 221 221 + in 205 222 let dry_run = 206 223 Arg.( 207 224 value & flag ··· 240 257 Cmd.v info 241 258 Term.( 242 259 const run $ Terms.log $ Terms.cache_dir $ Terms.data_dir $ all 243 243 - $ toolchains $ sources $ binaries $ dune_cache $ repos $ opam_root 260 260 + $ toolchains $ sources $ binaries $ dune_cache $ repos $ opam_root $ pins 244 261 $ dry_run $ target)

+16 -12

lib/cmd/docker.ml

reviewed

··· 41 41 in 42 42 let df = Registry_docker.dockerfile_project ~cmd ~generator distro in 43 43 Registry_docker.write_dockerfile path df; 44 44 - Fmt.pr "Wrote %s@.Build with: docker build -t %s -f %s %s@." path tag_label 45 45 - path cwd_s 44 44 + Oi.Say.step "Wrote %s" path; 45 45 + Oi.Say.info "build with: docker build -t %s -f %s %s" tag_label path cwd_s 46 46 47 47 (* Multi-distro registry build project: one [Dockerfile.<distro>] per 48 48 target distribution, plus [Dockerfile.oi] (static oi builder) and ··· 54 54 let df_oi = Registry_docker.dockerfile_oi ~src_context in 55 55 let oi_path = output / "Dockerfile.oi" in 56 56 Registry_docker.write_dockerfile oi_path df_oi; 57 57 - Fmt.pr "Computing overlay depexts for %d distros...@." 57 57 + Oi.Say.step "Computing overlay depexts for %d distros" 58 58 (List.length default_distros); 59 59 let per_distro_depexts = 60 60 try ··· 81 81 ~registry_host_path:"./registry" () 82 82 in 83 83 Registry_docker.write_file compose_path compose_yaml; 84 84 - Fmt.pr "Wrote:@."; 85 85 - Fmt.pr " %s@." oi_path; 84 84 + Oi.Say.step "Wrote"; 85 85 + Oi.Say.info "%s" oi_path; 86 86 List.iter 87 87 (fun (_, path, n) -> 88 88 - if n = 0 then Fmt.pr " %s@." path 89 89 - else Fmt.pr " %s (%d overlay depexts)@." path n) 88 88 + if n = 0 then Oi.Say.info "%s" path 89 89 + else 90 90 + Oi.Say.info "%s %a" path Oi.Style.dim_string 91 91 + (Fmt.str "(%d overlay depexts)" n)) 90 92 per_distro_paths; 91 91 - Fmt.pr " %s@.@." compose_path; 92 92 - Fmt.pr "Static oi release binary:@."; 93 93 - Fmt.pr " docker buildx build -f %s --output type=local,dest=./oi-bin .@." 93 93 + Oi.Say.info "%s" compose_path; 94 94 + Oi.Say.newline (); 95 95 + Oi.Say.step "Static oi release binary"; 96 96 + Oi.Say.info "docker buildx build -f %s --output type=local,dest=./oi-bin ." 94 97 oi_path; 95 95 - Fmt.pr "Run the build + export:@."; 96 96 - Fmt.pr " docker compose up --build # writes ./registry/<os_key>/@." 98 98 + Oi.Say.step "Run the build + export"; 99 99 + Oi.Say.info "docker compose up --build %a" Oi.Style.dim_string 100 100 + "# writes ./registry/<os_key>/" 97 101 98 102 let cmd = 99 103 let run () data_dir cache_dir refresh test_mode all distro src_context output

+1 -3

lib/cmd/harness.ml

reviewed

··· 55 55 let net = Eio.Stdenv.net env in 56 56 let stdout = Eio.Stdenv.stdout env in 57 57 let stderr = Eio.Stdenv.stderr env in 58 58 - let sys = 59 59 - D10.Sysops.create ~stdout ~stderr ~proc_mgr ~fs ~net ~clock () 60 60 - in 58 58 + let sys = D10.Sysops.create ~stdout ~stderr ~proc_mgr ~fs ~net ~clock () in 61 59 let platform = Osrel.detect ~proc_mgr ~fs in 62 60 let os_key = D10.Os_key.(to_string (of_platform platform)) in 63 61 let cache = Oi.Cache.create ~root:cache_dir fs in

+33 -6

lib/cmd/layer_index.ml

reviewed

··· 46 46 end; 47 47 index_path 48 48 49 49 - let ensure_remote ~sys ~fs ~cache ~os_key ~registry = 49 49 + let ensure_remote ?on_phase ~sys ~fs ~cache ~os_key ~registry () = 50 50 if registry = "" then None 51 51 else 52 52 let cache_root = Oi.Cache.root_s cache in ··· 65 65 let dst = Eio.Path.(fs / tmp_path) in 66 66 Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 Eio.Path.(fs / os_dir); 67 67 (try Unix.unlink tmp_path with Unix.Unix_error _ -> ()); 68 68 - Logs.app (fun m -> 69 69 - m "Fetching registry index from %s (this may take a moment)..." url); 70 70 - if D10.Sysops.Http.fetch sys ~url ~dst then begin 68 68 + (* Visible status goes through [on_phase] so [oi run] can wire it 69 69 + into its preflight bar; otherwise it's a quiet [Logs.info]. The 70 70 + previous [Logs.app] leaked the message to stderr unconditionally, 71 71 + polluting [oi run]'s output. *) 72 72 + (match on_phase with 73 73 + | Some f -> f "Fetching registry index" 74 74 + | None -> 75 75 + Logs.info (fun m -> 76 76 + m "Fetching registry index from %s (this may take a moment)..." 77 77 + url)); 78 78 + let fmt_size n = 79 79 + if Int64.compare n 1_048_576L >= 0 then 80 80 + Fmt.str "%.1fMB" (Int64.to_float n /. 1_048_576.) 81 81 + else if Int64.compare n 1024L >= 0 then 82 82 + Fmt.str "%.0fKB" (Int64.to_float n /. 1024.) 83 83 + else Fmt.str "%LdB" n 84 84 + in 85 85 + let on_progress = 86 86 + Option.map 87 87 + (fun f ~received ~total -> 88 88 + match total with 89 89 + | Some t when Int64.compare t 0L > 0 -> 90 90 + f 91 91 + (Fmt.str "Fetching registry index (%s / %s)" 92 92 + (fmt_size received) (fmt_size t)) 93 93 + | _ -> 94 94 + f (Fmt.str "Fetching registry index (%s)" (fmt_size received))) 95 95 + on_phase 96 96 + in 97 97 + if D10.Sysops.Http.fetch ?on_progress sys ~url ~dst then begin 71 98 (try Unix.rename tmp_path local_path 72 99 with Unix.Unix_error _ -> ( 73 100 try Unix.unlink tmp_path with Unix.Unix_error _ -> ())); ··· 100 127 try Sys.remove remote_path with Sys_error _ -> ())); 101 128 D10.Index.close db 102 129 103 103 - let binary_to_package ~sys ~fs ~clock ~cache ~os_key ~registry name = 130 130 + let binary_to_package ?on_phase ~sys ~fs ~clock ~cache ~os_key ~registry name = 104 131 let clk = (clock :> D10.Config.clk) in 105 132 let index_path = ensure_local ~sys ~fs ~clock:clk ~cache ~os_key in 106 106 - (match ensure_remote ~sys ~fs ~cache ~os_key ~registry with 133 133 + (match ensure_remote ?on_phase ~sys ~fs ~cache ~os_key ~registry () with 107 134 | Some remote_path -> merge_remote_into_local ~index_path ~remote_path 108 135 | None -> ()); 109 136 if not (Eio.Path.is_file Eio.Path.(fs / index_path)) then None

+13 -2

lib/cmd/layer_index.mli

reviewed

··· 25 25 exceeds the indexed-row count. Returns the index path. *) 26 26 27 27 val ensure_remote : 28 28 + ?on_phase:(string -> unit) -> 28 29 sys:D10.Sysops.t -> 29 30 fs:Eio.Fs.dir_ty Eio.Path.t -> 30 31 cache:Oi.Cache.t -> 31 32 os_key:string -> 32 33 registry:string -> 34 34 + unit -> 33 35 string option 34 36 (** Download the remote registry's [{os_key}/index.db] to a local cache location 35 37 ([<=1h] freshness window, atomic rename). Returns the local path on success, 36 36 - [None] when the registry is empty/unreachable. *) 38 38 + [None] when the registry is empty/unreachable. 39 39 + 40 40 + [on_phase] surfaces the "fetching registry index" status to a caller- 41 41 + supplied sink (e.g. a TTY progress bar). When omitted, the status is routed 42 42 + to [Logs.info] (visible only with [-v]). *) 37 43 38 44 val merge_remote_into_local : index_path:string -> remote_path:string -> unit 39 45 (** Open [index_path] (the local index) and merge every row from [remote_path]. 40 46 A corrupt remote file is unlinked so the next call re-downloads it. *) 41 47 42 48 val binary_to_package : 49 49 + ?on_phase:(string -> unit) -> 43 50 sys:D10.Sysops.t -> 44 51 fs:Eio.Fs.dir_ty Eio.Path.t -> 45 52 clock:_ Eio.Time.clock -> ··· 52 59 merged local+remote index has a row for the binary [name]. The overlay 53 60 handle (if any) is load-bearing: the package may only be available in that 54 61 overlay's [packages/] tree, so callers should add the handle to their repo 55 55 - set before solving. *) 62 62 + set before solving. 63 63 + 64 64 + [on_phase], if supplied, is invoked with status updates while fetching the 65 65 + remote index — used by [oi run]'s preflight bar to keep the user informed 66 66 + during the network call. *)

+2 -2

lib/cmd/registry_docker.ml

reviewed

··· 336 336 safety. Inside a Linux container with a high [nofile] ulimit (set on 337 337 the service below) we want to use every core on the host. *) 338 338 let build_export_cmd () = 339 339 - "OI_BUILD_PARALLELISM=$(nproc) oi build --refresh --all --registry= \ 340 340 - --export /out" 339 339 + "OI_BUILD_PARALLELISM=$(nproc) oi build --refresh --all --registry= --export \ 340 340 + /out" 341 341 342 342 let docker_compose_yaml ~distros ~registry_host_path () = 343 343 let buf = Buffer.create 1024 in

+6 -6

lib/cmd/registry_docker.mli

reviewed

··· 62 62 whose services each bind-mount [registry_host_path] at [/out] and run 63 63 [oi build --refresh --all --export /out]. Every container owns its own oi 64 64 state — [oi] auto-clones the reporepo from its configured default URL 65 65 - (overridable via [OI_REPOREPO_URL] in the service environment) on first 66 66 - use — so containers are independent and safe to run in parallel. Layers 67 67 - are tagged with their overlay handle and version in the per-distro 68 68 - sqlite index so clients can scope queries to a specific overlay. 65 65 + (overridable via [OI_REPOREPO_URL] in the service environment) on first use 66 66 + — so containers are independent and safe to run in parallel. Layers are 67 67 + tagged with their overlay handle and version in the per-distro sqlite index 68 68 + so clients can scope queries to a specific overlay. 69 69 70 70 Each service is generated with [OI_BUILD_PARALLELISM=$(nproc)] in its 71 71 command and a high [nofile] ulimit so the in-container build uses every 72 72 available CPU rather than the [min cpu_count 4] default that 73 73 - {!Oi.Execute.default_build_parallelism} applies for macOS fd-limit 74 74 - safety. Suitable for many-core hosts. *) 73 73 + {!Oi.Execute.default_build_parallelism} applies for macOS fd-limit safety. 74 74 + Suitable for many-core hosts. *) 75 75 76 76 val write_dockerfile : string -> Dockerfile.t -> unit 77 77 (** Serialise a {!Dockerfile.t} to [path] in Dockerfile syntax. *)

+5 -5

lib/cmd/registry_export.ml

reviewed

··· 41 41 let dst = Eio.Path.(fs / output) in 42 42 Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 dst; 43 43 let count = D10.Layer.export_all d10 ~dst in 44 44 - Fmt.pr "Exported %d layer(s) to %s@." count output; 44 44 + Oi.Say.step "Exported %d layer(s) to %s" count output; 45 45 if Eio.Path.is_directory Eio.Path.(fs / output / os_key) then begin 46 46 let index_path = output / os_key / "index.db" in 47 47 (try Sys.remove index_path with Sys_error _ -> ()); ··· 70 70 let nl, nb, _ = D10.Index.stats db ~os_key in 71 71 D10.Index.close db; 72 72 finalize_sqlite_for_publish index_path; 73 73 - Fmt.pr " %s: %d layers, %d binaries@." os_key nl nb 73 73 + Oi.Say.field "index" "%s: %d layers, %d binaries" os_key nl nb 74 74 end; 75 75 let n_sources = Oi.Source.Mirror.export ~cache ~dst in 76 76 if n_sources > 0 then 77 77 - Fmt.pr " sources: %d blob(s) at %s/sources/@." n_sources output; 77 77 + Oi.Say.field "sources" "%d blob(s) at %s/sources/" n_sources output; 78 78 (* Manifest = Provenance ⨝ Audit. Provenance gives us one entry per 79 79 successfully committed layer with its content fields; the audit log 80 80 gives us a [callers[]] history per layer. Failed-build events that ··· 95 95 with 96 96 | Ok s -> 97 97 Eio.Path.save ~create:(`Or_truncate 0o644) Eio.Path.(fs / path) s; 98 98 - Fmt.pr " manifest: %d entry(ies) at %s@." manifest.n_packages path 98 98 + Oi.Say.field "manifest" "%d entry(ies) at %s" manifest.n_packages path 99 99 | Error e -> Logs.warn (fun m -> m "manifest encode failed: %s" e)); 100 100 (* Ship the per-os audit slice so multi-host registry merges can 101 101 union events. Sorted by event_id (ULID = monotonic) so the file is 102 102 deterministic. *) 103 103 if events <> [] then begin 104 104 Oi.Audit.write_per_os ~fs ~output_dir:output ~os_key events; 105 105 - Fmt.pr " audit: %d event(s) at %s/audit.jsonl@." (List.length events) 105 105 + Oi.Say.field "audit" "%d event(s) at %s/audit.jsonl" (List.length events) 106 106 (output / os_key) 107 107 end 108 108 end

+79 -7

lib/cmd/run.ml

reviewed

··· 230 230 can include them and suggest the right [oi run --with=…] 231 231 invocation. *) 232 232 let unfound_bins = ref [] in 233 233 + (* TTY-only preflight spinner wrapper around [Pipeline.build]. 234 234 + Renders a single-line animated braille spinner with a status 235 235 + message that updates at each preflight phase boundary (and at 236 236 + ~20Hz during [fetch_remote_layers]'s byte counter). The line is 237 237 + wiped clean by [preflight_done] before [Execute.run] takes over 238 238 + with its own progress bar. 239 239 + 240 240 + We don't use [Tty.Progress] here because preflight phases don't 241 241 + have a meaningful numeric progress fraction — the bar would just 242 242 + show [0/1] forever, which is visual noise. A spinner says "I'm 243 243 + alive, here's what I'm doing" without pretending to know how 244 244 + close to done we are. 245 245 + 246 246 + On non-TTY, [enabled=false] makes everything a no-op so 247 247 + [oi run]'s contract of "stdout is for the executed binary, not 248 248 + oi narration" holds. *) 249 249 + let with_preflight_bar f = 250 250 + Eio.Switch.run @@ fun sw -> 251 251 + let enabled = Tty.is_tty () in 252 252 + let stopped = ref false in 253 253 + let msg = ref "Preparing" in 254 254 + let frames = [| "⠋"; "⠙"; "⠹"; "⠸"; "⠼"; "⠴"; "⠦"; "⠧"; "⠇"; "⠏" |] in 255 255 + let frame = ref 0 in 256 256 + (* Erase the current line and redraw spinner+message in place. 257 257 + [\r] returns to column 0; [\027[K] erases to end-of-line. The 258 258 + trailing [%!] flushes the formatter so the line shows up 259 259 + immediately rather than at the OS buffer's discretion. *) 260 260 + let render () = 261 261 + if enabled && not !stopped then 262 262 + Fmt.pr "\r\027[K%a %s%!" Oi.Style.accent_string 263 263 + frames.(!frame mod Array.length frames) 264 264 + !msg 265 265 + in 266 266 + let clear_line () = if enabled then Fmt.pr "\r\027[K%!" in 267 267 + Eio.Fiber.fork_daemon ~sw (fun () -> 268 268 + let rec loop () = 269 269 + Eio.Time.sleep clock 0.1; 270 270 + if !stopped then `Stop_daemon 271 271 + else begin 272 272 + incr frame; 273 273 + render (); 274 274 + loop () 275 275 + end 276 276 + in 277 277 + loop ()); 278 278 + let on_phase m = 279 279 + if not !stopped then begin 280 280 + msg := m; 281 281 + render () 282 282 + end 283 283 + in 284 284 + let preflight_done () = 285 285 + stopped := true; 286 286 + clear_line () 287 287 + in 288 288 + Fun.protect 289 289 + ~finally:(fun () -> 290 290 + stopped := true; 291 291 + clear_line ()) 292 292 + (fun () -> f ~on_phase ~preflight_done) 293 293 + in 233 294 (* Solve [pkg_names], assemble the consumer prefix, exec 234 295 [bin/<binary_name>] if it exists; falls back to looking under a 235 296 non-relocatable toolchain's fixed prefix before giving up. ··· 245 306 ~toolchain 246 307 in 247 308 let layer_hashes = 309 309 + with_preflight_bar @@ fun ~on_phase ~preflight_done -> 248 310 Oi.Pipeline.build ~sys ~proc_mgr ~fs ~clock ~cache ~data_dir ~conf ~os_key 249 311 ~dry_run ~extra_repos:all_extras ~pins:project_pins ~refresh ?remote 250 312 ?jobs ?toolchain ~constraints:extra_constraints ?local_packages_dir 251 251 - names 313 313 + ~on_phase ~preflight_done names 252 314 in 253 315 Logs.info (fun m -> m "Got %d layer hashes" (List.length layer_hashes)); 254 316 let prefix = ··· 350 412 let layer_hashes = 351 413 if dep_opam_names = [] then [] 352 414 else 415 415 + with_preflight_bar @@ fun ~on_phase ~preflight_done -> 353 416 Oi.Pipeline.build ~sys ~proc_mgr ~fs ~clock ~cache ~data_dir ~conf 354 417 ~os_key ~dry_run ~extra_repos:all_extras ~pins:project_pins ~refresh 355 355 - ?remote ?jobs ?toolchain ~constraints ?local_packages_dir 356 356 - dep_opam_names 418 418 + ?remote ?jobs ?toolchain ~constraints ?local_packages_dir ~on_phase 419 419 + ~preflight_done dep_opam_names 357 420 in 358 421 if dry_run && dep_opam_names = [] then 359 422 (* No deps to solve, but still in dry-run mode — just exit *) ··· 486 549 overlay (when present) through [@handle/pkg] so the 487 550 overlay is added to [with_repos], then re-solve. *) 488 551 let clk = (Eio.Stdenv.clock env :> D10.Config.clk) in 552 552 + (* Open a TTY-only spinner around the index lookup so the multi- 553 553 + second registry fetch isn't a silent freeze on cold caches. 554 554 + The bar auto-clears when the lookup returns. *) 489 555 let from_index = 490 490 - match 491 491 - Layer_index.binary_to_package ~sys ~fs ~clock:clk ~cache ~os_key 492 492 - ~registry binary_name 493 493 - with 556 556 + with_preflight_bar @@ fun ~on_phase ~preflight_done -> 557 557 + let r = 558 558 + Layer_index.binary_to_package ~on_phase ~sys ~fs ~clock:clk ~cache 559 559 + ~os_key ~registry binary_name 560 560 + in 561 561 + preflight_done (); 562 562 + r 563 563 + in 564 564 + let from_index = 565 565 + match from_index with 494 566 | Some (pkg_name, _) when pkg_name <> binary_name -> 495 567 (* Layer index says [bin/<binary_name>] is shipped by 496 568 [pkg_name] (and optionally an overlay handle).

+1 -1

lib/cmd/search.ml

reviewed

··· 177 177 let index_path = 178 178 Layer_index.ensure_local ~sys ~fs ~clock:clk ~cache ~os_key 179 179 in 180 180 - (match Layer_index.ensure_remote ~sys ~fs ~cache ~os_key ~registry with 180 180 + (match Layer_index.ensure_remote ~sys ~fs ~cache ~os_key ~registry () with 181 181 | Some remote_path -> 182 182 Layer_index.merge_remote_into_local ~index_path ~remote_path 183 183 | None -> ());

+35 -19

lib/cmd/sync.ml

reviewed

··· 37 37 let install_tools ?(quiet = false) ?refresh ?jobs ~proc_mgr ~fs ~clock ~sys 38 38 ~cache ~data_dir ~conf ~os_key ~extra_repos ~pins ?toolchain ?remote ~cwd () 39 39 = 40 40 - let say fmt = 40 40 + let say_step fmt = 41 41 if quiet then Fmt.kstr (fun s -> Logs.info (fun m -> m "%s" s)) fmt 42 42 - else Fmt.kstr (fun s -> Fmt.pr "%s@." s) fmt 42 42 + else Fmt.kstr (fun s -> Oi.Say.step "%s" s) fmt 43 43 + in 44 44 + let say_info fmt = 45 45 + if quiet then Fmt.kstr (fun s -> Logs.info (fun m -> m "%s" s)) fmt 46 46 + else Fmt.kstr (fun s -> Oi.Say.info "%s" s) fmt 43 47 in 44 48 let warn_named name fmt = 45 45 - Fmt.kstr 46 46 - (fun s -> Fmt.epr "%a tool %s: %s@." Oi.Style.warn_string "WARN" name s) 47 47 - fmt 49 49 + Fmt.kstr (fun s -> Oi.Say.warn "tool %s: %s" name s) fmt 48 50 in 49 51 let install_named ~tool_name ~constraints = 50 52 let name = OpamPackage.Name.of_string tool_name in ··· 59 61 warn_named tool_name "layer for leaf package not found"; 60 62 None 61 63 | Some h -> 62 62 - say "Tool %s: %d dep(s) built, leaf layer %s" tool_name 64 64 + say_info "tool %s: %d dep(s) built, leaf layer %s" tool_name 63 65 (List.length hashes - 1) 64 66 (short_hash h); 65 67 Some h ··· 90 92 let probed_hits = Oi.Project.Tool.(hits (probe ~fs cwd)) in 91 93 match (toolchain_tools, probed_hits) with 92 94 | [], [] -> 93 93 - say "No dev tools to install"; 95 95 + say_info "no dev tools to install"; 94 96 None 95 97 | _ -> ( 96 98 let from_toolchain = ··· 111 113 let unique = List.sort_uniq String.compare leaves in 112 114 D10.Prefix.assemble d10 ~layer_hashes:unique 113 115 ~dst:Eio.Path.(fs / tools_dir); 114 114 - say "Tools assembled at %s (%d tool(s), %d leaf layer(s))" tools_dir 115 115 - (List.length leaves) (List.length unique); 116 116 + say_step "Tools assembled at %s (%d tool(s), %d leaf layer(s))" 117 117 + tools_dir (List.length leaves) (List.length unique); 116 118 Some tools_dir) 117 119 118 120 (* -- sync ---------------------------------------------------------------- *) ··· 184 186 ?(envrc_mode = `Detect) ~proc_mgr ~fs ~clock ~sys ~platform ~os_key ~cache 185 187 ~data_dir ~registry ~cwd () = 186 188 let toolchain_override = toolchain in 187 187 - let say fmt = 189 189 + let say_step fmt = 188 190 if quiet then Fmt.kstr (fun s -> Logs.info (fun m -> m "%s" s)) fmt 189 189 - else Fmt.kstr (fun s -> Fmt.pr "%s@." s) fmt 191 191 + else Fmt.kstr (fun s -> Oi.Say.step "%s" s) fmt 192 192 + in 193 193 + let say_field label fmt = 194 194 + if quiet then 195 195 + Fmt.kstr (fun s -> Logs.info (fun m -> m "%s: %s" label s)) fmt 196 196 + else Fmt.kstr (fun s -> Oi.Say.field label "%s" s) fmt 197 197 + in 198 198 + let say_info fmt = 199 199 + if quiet then Fmt.kstr (fun s -> Logs.info (fun m -> m "%s" s)) fmt 200 200 + else Fmt.kstr (fun s -> Oi.Say.info "%s" s) fmt 190 201 in 191 202 Oi.Pipeline.init_opam_root ~fs ~data_dir; 192 203 ignore (Oi.Source.Reporepo.ensure_base ~fs ~sys ~data_dir ~refresh ()); ··· 199 210 let deps = project.deps in 200 211 if deps = [] && extra_cli = [] && url_project.roots = [] then 201 212 Oi.Error.config_error "No .opam files found in %s." cwd; 202 202 - say "Dependencies from opam files: %s" (String.concat ", " deps); 213 213 + say_step "Sync %s" cwd; 214 214 + if deps <> [] then say_field "deps" "%s" (String.concat ", " deps); 203 215 if url_project.roots <> [] then 204 204 - say "URL-supplied packages: %s" (String.concat ", " url_project.roots); 216 216 + say_field "with-deps" "%s" (String.concat ", " url_project.roots); 205 217 let conf = 206 218 Oi.Pipeline.make_conf ~platform ~ocaml_version:Workspace.ocaml_version 207 219 in ··· 223 235 ~reporepo_path:(Terms.reporepo_path ()) ~toolchain candidate_overlays 224 236 in 225 237 if project_overlays <> [] then 226 226 - say "Project overlays (from x-repos): %s" 227 227 - (String.concat ", " project_overlays); 238 238 + say_field "overlays" "%s" (String.concat ", " project_overlays); 228 239 let with_repos = project_overlays @ with_repos in 229 240 let all_extras = 230 241 Target.merge_extras ··· 232 243 ~project:(project.extra_repos @ url_project.extra_repos) 233 244 in 234 245 if all_extras <> [] then 235 235 - say "Extra repositories: %s" 246 246 + say_field "extra-repos" "%s" 236 247 (String.concat ", " 237 248 (List.map 238 249 (fun (e : Oi.Project.extra_repo) -> Fmt.str "%s (%s)" e.name e.url) ··· 258 269 | Some _ -> project.packages_dir 259 270 | None -> url_project.packages_dir 260 271 in 272 272 + let on_phase msg = 273 273 + if quiet then Logs.info (fun m -> m "%s" msg) else Oi.Say.step "%s" msg 274 274 + in 261 275 Oi.Pipeline.build ~sys ~proc_mgr ~fs ~clock ~cache ~data_dir ~conf ~os_key 262 276 ~extra_repos:all_extras 263 277 ~pins:(project.pins @ url_project.pins) 264 278 ~refresh ~constraints:extra_constraints ~project_root:cwd ?remote ?jobs 265 265 - ?toolchain ?local_packages_dir names 279 279 + ?toolchain ?local_packages_dir ~on_phase names 266 280 in 267 281 let oi_dir = cwd / "_oi" in 268 282 let prefix = oi_dir / "prefix" in ··· 285 299 in 286 300 (try Eio.Path.unlink envrc_path with Eio.Exn.Io _ -> ()); 287 301 Eio.Path.save ~create:(`Exclusive 0o644) envrc_path envrc; 288 288 - say "Wrote .envrc (run 'direnv allow' to activate)" 302 302 + say_step "Wrote .envrc"; 303 303 + say_info "run 'direnv allow' to activate" 289 304 end 290 305 else 291 306 Logs.info (fun m -> 292 307 m "Skipping .envrc (--envrc=%a)" pp_envrc_mode envrc_mode); 293 293 - say "Prefix assembled at %s (%d packages)" prefix (List.length layer_hashes); 308 308 + say_step "Prefix assembled at %s (%d packages)" prefix 309 309 + (List.length layer_hashes); 294 310 (prefix, toolchain) 295 311 296 312 (* True if [cwd]/_oi/prefix is missing, or any *.opam in [cwd] has been

+11 -2

lib/d10/dune

reviewed

··· 1 1 (library 2 2 (name d10) 3 3 (public_name d10) 4 4 - (libraries osrel eio opam-format jsont jsont.bytesrw sqlite3 fmt logs 5 5 - requests nox-crypto-rng.unix)) 4 4 + (libraries 5 5 + osrel 6 6 + eio 7 7 + opam-format 8 8 + jsont 9 9 + jsont.bytesrw 10 10 + sqlite3 11 11 + fmt 12 12 + logs 13 13 + requests 14 14 + nox-crypto-rng.unix))

+2 -2

lib/d10/layer.ml

reviewed

··· 214 214 215 215 (* -- Remote pull --------------------------------------------------------- *) 216 216 217 217 - let pull_remote (c : Config.t) ~remote ~hash ?sha256 () = 217 217 + let pull_remote (c : Config.t) ~remote ~hash ?on_progress ?sha256 () = 218 218 if succeeded c ~hash then true 219 219 else begin 220 220 let url = ··· 226 226 let layer_dir = dir c ~hash in 227 227 let tmp_file = Eio.Path.(os_layer_dir / (hash ^ ".tar.zst.tmp")) in 228 228 Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 os_layer_dir; 229 229 - let ok = Sysops.Http.fetch c.sys ~url ~dst:tmp_file in 229 229 + let ok = Sysops.Http.fetch ?on_progress c.sys ~url ~dst:tmp_file in 230 230 let cleanup_tmp () = try Eio.Path.unlink tmp_file with _ -> () in 231 231 if ok then begin 232 232 (* Verify sha256 if provided *)

+11 -2

lib/d10/layer.mli

reviewed

··· 125 125 and size. Returns an empty table on failure. *) 126 126 127 127 val pull_remote : 128 128 - Config.t -> remote:remote -> hash:string -> ?sha256:string -> unit -> bool 128 128 + Config.t -> 129 129 + remote:remote -> 130 130 + hash:string -> 131 131 + ?on_progress:(received:int64 -> total:int64 option -> unit) -> 132 132 + ?sha256:string -> 133 133 + unit -> 134 134 + bool 129 135 (** [pull_remote c ~remote ?sha256 ~hash] downloads layer [hash] from [remote], 130 136 optionally verifying the SHA-256 checksum of the downloaded archive. Returns 131 137 [true] if the layer is now available with [exit_status = 0]. No-op (returns 132 132 - [true]) if the layer already exists locally. *) 138 138 + [true]) if the layer already exists locally. 139 139 + 140 140 + [on_progress] forwards through to {!Sysops.Http.fetch} for download 141 141 + progress; see that function's docs. *) 133 142 134 143 (** {1 Export} *) 135 144

+45 -8

lib/d10/sysops.ml

reviewed

··· 121 121 { 122 122 proc_mgr :> pm; 123 123 fs; 124 124 - net = (net :> net); 125 125 - clock = (clock :> clk); 124 124 + net :> net; 125 125 + clock :> clk; 126 126 stdout; 127 127 stderr; 128 128 tools = { tar = "tar" }; ··· 205 205 end 206 206 207 207 module Http = struct 208 208 + (* Stream [src] into [sink] while invoking [on_progress] with the 209 209 + running byte count. Throttles callbacks to ~20Hz so a fast 210 210 + download doesn't spam the renderer (each [Tty.Progress.set] is 211 211 + a synchronous ANSI write that's expensive on slow terminals). 212 212 + The final tick fires unconditionally so the bar always settles 213 213 + at 100% / total. *) 214 214 + let copy_with_progress ?on_progress ?total src sink = 215 215 + match on_progress with 216 216 + | None -> Eio.Flow.copy src sink 217 217 + | Some on_progress -> 218 218 + let buf = Cstruct.create 65536 in 219 219 + let received = ref 0L in 220 220 + let last_tick = ref 0.0 in 221 221 + let throttle_s = 0.05 in 222 222 + let maybe_tick () = 223 223 + let now = Unix.gettimeofday () in 224 224 + if now -. !last_tick >= throttle_s then begin 225 225 + last_tick := now; 226 226 + on_progress ~received:!received ~total 227 227 + end 228 228 + in 229 229 + (try 230 230 + while true do 231 231 + let n = Eio.Flow.single_read src buf in 232 232 + Eio.Flow.write sink [ Cstruct.sub buf 0 n ]; 233 233 + received := Int64.add !received (Int64.of_int n); 234 234 + maybe_tick () 235 235 + done 236 236 + with End_of_file -> ()); 237 237 + on_progress ~received:!received ~total 238 238 + 208 239 (* In-process HTTP fetch via the [requests] library. Behaviour: 209 240 210 241 - silent: no progress output to stdout/stderr ··· 216 247 Returns [true] on a 2xx response with the body fully written to 217 248 [dst]; [false] on any error (4xx/5xx, network failure, TLS error, 218 249 timeout). Never raises — callers use the [if not (fetch …) then …] 219 219 - pattern. *) 220 220 - let fetch t ~url ~dst = 250 250 + pattern. 251 251 + 252 252 + [on_progress], when supplied, is called periodically with 253 253 + [(received, total)] where [total = Some n] when the response carries 254 254 + a [Content-Length] header and [None] otherwise (chunked transfer). 255 255 + Throttled to ~20Hz inside [copy_with_progress] so terminal redraws 256 256 + don't dominate the wall-clock cost on a fast LAN. *) 257 257 + let fetch ?on_progress t ~url ~dst = 221 258 Eio.Switch.run @@ fun sw -> 222 259 try 223 223 - let resp = 224 224 - Requests.One.get ~sw ~clock:t.clock ~net:t.net url 225 225 - in 260 260 + let resp = Requests.One.get ~sw ~clock:t.clock ~net:t.net url in 226 261 if not (Requests.Response.ok resp) then begin 227 262 Log.debug (fun m -> 228 263 m "http %s: status %d" url (Requests.Response.status_code resp)); 229 264 false 230 265 end 231 266 else begin 267 267 + let total = Requests.Response.content_length resp in 268 268 + let body = Requests.Response.body resp in 232 269 Eio.Path.with_open_out ~create:(`Or_truncate 0o644) dst (fun out -> 233 233 - Eio.Flow.copy (Requests.Response.body resp) out); 270 270 + copy_with_progress ?on_progress ?total body out); 234 271 true 235 272 end 236 273 with exn ->

+19 -8

lib/d10/sysops.mli

reviewed

··· 23 23 unit -> 24 24 t 25 25 (** [create ?stdout ?stderr ~proc_mgr ~fs ~net ~clock ()] detects tool paths 26 26 - (tar variant) by probing the system via [which]. Pass the parent's 27 27 - [stdout] and [stderr] to enable {!Cmd.run_inherit}, which streams 28 28 - subprocess output to the user's terminal. [net] and [clock] are needed 29 29 - by {!Http.fetch} for in-process HTTP downloads. Call once at startup. *) 26 26 + (tar variant) by probing the system via [which]. Pass the parent's [stdout] 27 27 + and [stderr] to enable {!Cmd.run_inherit}, which streams subprocess output 28 28 + to the user's terminal. [net] and [clock] are needed by {!Http.fetch} for 29 29 + in-process HTTP downloads. Call once at startup. *) 30 30 31 31 (** {1 File queries} *) 32 32 ··· 57 57 end 58 58 59 59 module Http : sig 60 60 - val fetch : t -> url:string -> dst:_ Eio.Path.t -> bool 60 60 + val fetch : 61 61 + ?on_progress:(received:int64 -> total:int64 option -> unit) -> 62 62 + t -> 63 63 + url:string -> 64 64 + dst:_ Eio.Path.t -> 65 65 + bool 61 66 (** [fetch t ~url ~dst] downloads [url] to [dst] via the in-process HTTP 62 67 client (the [requests] library). Follows redirects, requires a 2xx 63 63 - response, writes nothing on failure. Returns [true] on success, 64 64 - [false] on any error (HTTP 4xx/5xx, network failure, TLS handshake 65 65 - error, timeout). Never raises. *) 68 68 + response, writes nothing on failure. Returns [true] on success, [false] on 69 69 + any error (HTTP 4xx/5xx, network failure, TLS handshake error, timeout). 70 70 + Never raises. 71 71 + 72 72 + [on_progress] is invoked periodically (throttled to ~20Hz) with the 73 73 + running byte count. [total] is [Some n] when the server sent a 74 74 + [Content-Length] header, [None] for chunked-transfer responses where the 75 75 + size isn't known up front. The final invocation always fires with the 76 76 + final byte count so a UI bar can settle at 100%. *) 66 77 end 67 78 68 79 (** {1 Low-level command execution} *)

+21 -37

lib/oi/cache.ml

reviewed

··· 88 88 let cleanable_items t ~data_dir = 89 89 let p sub = Eio.Path.(t.fs / t.root / sub) in 90 90 let d sub = Eio.Path.(t.fs / data_dir / sub) in 91 91 + let item label path description = { label; path; description } in 91 92 [ 92 92 - { 93 93 - label = "sources"; 94 94 - path = p "sources"; 95 95 - description = "Downloaded source tarballs"; 96 96 - }; 97 97 - { 98 98 - label = "layers"; 99 99 - path = p "layers"; 100 100 - description = "Binary layer cache (day10 format)"; 101 101 - }; 102 102 - { label = "runs"; path = p "runs"; description = "Cached script builds" }; 103 103 - { 104 104 - label = "prefixes"; 105 105 - path = p "prefixes"; 106 106 - description = "Assembled prefix cache (hardlinks)"; 107 107 - }; 108 108 - { label = "dune"; path = p "dune"; description = "Dune shared build cache" }; 109 109 - { label = "repos"; path = d "repos"; description = "Cloned repositories" }; 110 110 - { 111 111 - label = "opam-root"; 112 112 - path = d "opam-root"; 113 113 - description = "Opam scaffolding (regenerated on demand)"; 114 114 - }; 115 115 - { 116 116 - label = "pins"; 117 117 - path = p "pins"; 118 118 - description = "Pin-depends sources and synthesized packages trees"; 119 119 - }; 120 120 - { 121 121 - (* Resolved via [toolchains_root] rather than [p "toolchains"] 122 122 - because the toolchain path is XDG-derived independently of 123 123 - [OI_CACHE_DIR], and we want clean to nuke what's actually on 124 124 - disk regardless of any env mismatch. *) 125 125 - label = "toolchains"; 126 126 - path = Eio.Path.(t.fs / toolchains_root ()); 127 127 - description = "Built compiler toolchains (oxcaml, etc.)"; 128 128 - }; 93 93 + item "sources" (p "sources") "Downloaded source tarballs"; 94 94 + item "mirror" (p "mirror") "Content-addressed source mirror"; 95 95 + item "layers" (p "layers") "Binary layer cache (day10 format)"; 96 96 + item "build" (p "build") "Build state: prefix, _build/, logs, audit log"; 97 97 + item "prefixes" (p "prefixes") "Assembled prefix cache (hardlinks)"; 98 98 + item "pins" (p "pins") "Pin-depends sources and synthesized packages trees"; 99 99 + item "solve-cache" (p "solve-cache") 100 100 + "Solver memoisation (regenerated on demand)"; 101 101 + item "runs" (p "runs") "Cached script builds"; 102 102 + item "run-cache" (p "run-cache") "Fast-exec cache for [oi run]"; 103 103 + item "dune" (p "dune") "Dune shared build cache"; 104 104 + item "repos" (d "repos") "Cloned repositories"; 105 105 + item "opam-root" (d "opam-root") "Opam scaffolding (regenerated on demand)"; 106 106 + (* The toolchain path is XDG-derived independently of [OI_CACHE_DIR], 107 107 + so we resolve it via [toolchains_root] rather than [p "toolchains"] 108 108 + — clean should nuke what's actually on disk regardless of any env 109 109 + mismatch. *) 110 110 + item "toolchains" 111 111 + Eio.Path.(t.fs / toolchains_root ()) 112 112 + "Built compiler toolchains (oxcaml, etc.)"; 129 113 ] 130 114 131 115 let size ~sys path =

+5 -6

lib/oi/outcome.mli

reviewed

··· 65 65 (** {1 Classification} *) 66 66 67 67 val classify_fetch_msg : string -> fetch_kind 68 68 - (** Best-effort classification of an opam-side fetch error message. The 69 69 - message originates from {!OpamRepository.pull_*}, which itself shells 70 70 - out to git or an HTTP backend, so the strings being matched here are 71 71 - the surface-level forms those tools surface — e.g. ["fatal: …"] from 72 72 - git, [HTTP <code>] from the HTTP backend, ["could not resolve host"] 73 73 - from the resolver. *) 68 68 + (** Best-effort classification of an opam-side fetch error message. The message 69 69 + originates from {!OpamRepository.pull_*}, which itself shells out to git or 70 70 + an HTTP backend, so the strings being matched here are the surface-level 71 71 + forms those tools surface — e.g. ["fatal: …"] from git, [HTTP <code>] from 72 72 + the HTTP backend, ["could not resolve host"] from the resolver. *)

+109 -37

lib/oi/pipeline.ml

reviewed

··· 168 168 match int_of_string_opt s with Some n when n > 0 -> n | _ -> 4) 169 169 | None -> min (Domain.recommended_domain_count ()) 4) 170 170 171 171 - let fetch_remote_layers ?jobs ~remote ~d10 ~packages_dirs ~ctx ~pkgs build_plan 172 172 - = 171 171 + let fmt_mb n = 172 172 + if Int64.compare n 1_048_576L >= 0 then 173 173 + Fmt.str "%.1fMB" (Int64.to_float n /. 1_048_576.) 174 174 + else if Int64.compare n 1024L >= 0 then 175 175 + Fmt.str "%.0fKB" (Int64.to_float n /. 1024.) 176 176 + else Fmt.str "%LdB" n 177 177 + 178 178 + let fetch_remote_layers ?on_phase ?jobs ~remote ~d10 ~packages_dirs ~ctx ~pkgs 179 179 + build_plan = 173 180 match remote with 174 181 | None -> build_plan 175 182 | Some r -> ··· 194 201 build_plan 195 202 end 196 203 else begin 204 204 + let n_total = List.length available in 197 205 Logs.info (fun m -> 198 198 - m "Fetching %d layer(s) from registry (%d needed)..." 199 199 - (List.length available) 206 206 + m "Fetching %d layer(s) from registry (%d needed)..." n_total 200 207 (List.length source_hashes)); 208 208 + (* Aggregate parallel fiber progress into one status line. 209 209 + [done_count] increments on each successful pull; 210 210 + [bytes_total] accumulates received bytes across all 211 211 + in-flight fibers. We're under [Eio.Fiber.List.iter] which 212 212 + on the default [Eio_posix] backend uses fibers (cooperative, 213 213 + no preemption between yield points), so a plain ref is 214 214 + safe — no mutex needed. *) 215 215 + let done_count = ref 0 in 216 216 + let bytes_total = ref 0L in 217 217 + let last_emit = ref 0.0 in 218 218 + let throttle_s = 0.05 in 219 219 + let emit () = 220 220 + match on_phase with 221 221 + | None -> () 222 222 + | Some f -> 223 223 + let now = Unix.gettimeofday () in 224 224 + if now -. !last_emit >= throttle_s then begin 225 225 + last_emit := now; 226 226 + f 227 227 + (Fmt.str "Fetching layers from registry (%d/%d, %s)" 228 228 + !done_count n_total (fmt_mb !bytes_total)) 229 229 + end 230 230 + in 231 231 + (* Per-fiber received counter so we don't double-count when 232 232 + retries / chunked downloads call [on_progress] cumulatively 233 233 + within one fiber. *) 234 234 + let fiber_progress hash_ref ~received ~total:_ = 235 235 + let prev = !hash_ref in 236 236 + hash_ref := received; 237 237 + bytes_total := Int64.add !bytes_total (Int64.sub received prev); 238 238 + emit () 239 239 + in 201 240 Eio.Fiber.List.iter 202 241 ~max_fibers:(fetch_parallelism ?jobs ()) 203 242 (fun hash -> ··· 206 245 (fun (e : D10.Layer.index_entry) -> e.sha256) 207 246 (Hashtbl.find_opt index hash) 208 247 in 209 209 - if D10.Layer.pull_remote d10 ~remote:r ~hash ?sha256 () then 210 210 - Logs.info (fun m -> m "Fetched %s from registry" hash)) 248 248 + let received_ref = ref 0L in 249 249 + let on_progress = fiber_progress received_ref in 250 250 + if 251 251 + D10.Layer.pull_remote d10 ~remote:r ~hash ~on_progress ?sha256 252 252 + () 253 253 + then begin 254 254 + incr done_count; 255 255 + emit (); 256 256 + Logs.info (fun m -> m "Fetched %s from registry" hash) 257 257 + end) 211 258 available; 259 259 + (* Final line — guaranteed past the throttle window. *) 260 260 + (match on_phase with 261 261 + | None -> () 262 262 + | Some f -> 263 263 + f 264 264 + (Fmt.str "Fetched %d/%d layers from registry (%s)" !done_count 265 265 + n_total (fmt_mb !bytes_total))); 212 266 Plan.build ctx ~d10 ~packages_dirs pkgs 213 267 end 214 268 end ··· 218 272 let build ~sys ~proc_mgr ~fs ~clock ~cache ~data_dir ~conf ~os_key 219 273 ?(dry_run = false) ?(extra_repos = []) ?(pins = []) ?(refresh = false) 220 274 ?remote ?jobs ?toolchain ?(constraints = OpamPackage.Name.Map.empty) 221 221 - ?project_root ?local_packages_dir names = 275 275 + ?project_root ?local_packages_dir ?on_phase ?preflight_done names = 276 276 + let _ = preflight_done in 277 277 + let on_phase = 278 278 + match on_phase with 279 279 + | Some f -> f 280 280 + | None -> fun s -> Logs.info (fun m -> m "%s" s) 281 281 + in 222 282 let extra_pkg_dirs = 223 283 Source.Repo.ensure_extra ~fs ~data_dir ~refresh extra_repos 224 284 in ··· 275 335 m "layer cache entry stale (layers missing), falling through"); 276 336 None) 277 337 in 338 338 + let fire_preflight_done () = 339 339 + match preflight_done with Some f -> f () | None -> () 340 340 + in 278 341 match fast_hashes with 279 342 | Some hashes -> 280 343 Logs.info (fun m -> 281 344 m "layer cache hit %s (%d layers), skipping solve" 282 345 (String.sub (Stdlib.Option.get layer_cache_key) 0 12) 283 346 (List.length hashes)); 347 347 + fire_preflight_done (); 284 348 hashes 285 349 | None -> 350 350 + (* Phase narration funneled through [on_phase] so the caller picks 351 351 + the visual: [oi run] feeds into a TTY-only spinner that clears 352 352 + on exit; [oi sync] / [oi build] feeds into [Say.step] for a 353 353 + visible audit trail. *) 354 354 + on_phase 355 355 + (Fmt.str "Building solver context (%d package dirs)" 356 356 + (List.length packages_dirs)); 286 357 let build_prefix = cache_root / "build" / "prefix" in 287 358 let ctx = 288 359 Solver.Ctx.create ~prefix:build_prefix ~packages_dirs ~conf 289 360 ?toolchain:toolchain_ctx () 290 361 in 362 362 + on_phase 363 363 + (Fmt.str "Solving for %d root%s" (List.length names) 364 364 + (if List.length names = 1 then "" else "s")); 291 365 let pkgs = 292 366 match 293 367 Solver.solve ~fs ~cache_root ctx ~packages_dirs ~constraints names ··· 295 369 | Ok pkgs -> pkgs 296 370 | Error msg -> Error.no_solution msg 297 371 in 372 372 + on_phase 373 373 + (Fmt.str "Planning %d package%s" (List.length pkgs) 374 374 + (if List.length pkgs = 1 then "" else "s")); 298 375 let build_plan = Plan.build ctx ~d10 ~packages_dirs pkgs in 299 376 if dry_run then begin 300 377 let remote_has = ··· 308 385 exit 0 309 386 end; 310 387 let build_plan = 311 311 - fetch_remote_layers ?jobs ~remote ~d10 ~packages_dirs ~ctx ~pkgs 312 312 - build_plan 388 388 + match remote with 389 389 + | None -> build_plan 390 390 + | Some _ -> 391 391 + on_phase "Checking registry for prebuilt layers"; 392 392 + fetch_remote_layers ~on_phase ?jobs ~remote ~d10 ~packages_dirs ~ctx 393 393 + ~pkgs build_plan 313 394 in 314 395 let hashes = Plan.layer_hashes build_plan in 315 396 (* Every layer in the plan must be cached (Binary method) to skip ··· 327 408 | None -> () 328 409 | Some k -> Solver.Cache.store_layers ~fs ~cache_root ~key:k hashes 329 410 in 411 411 + (* Hand off to the caller: the preflight bar (if any) clears here, 412 412 + either because we're about to skip Execute.run (all-cached) or 413 413 + because Execute.run is about to open its own progress bar. *) 414 414 + fire_preflight_done (); 330 415 if all_layers_cached then begin 331 416 Logs.info (fun m -> m "Layers cached, skipping build"); 332 417 persist_layer_cache (); ··· 347 432 in 348 433 Log.info (fun m -> 349 434 m 350 350 - "depext check: %d source pkg(s); platform os=%s os-distribution=%s \ 351 351 - os-family=%s" 435 435 + "depext check: %d source pkg(s); platform os=%s \ 436 436 + os-distribution=%s os-family=%s" 352 437 (List.length source_pkgs) conf.os conf.os_distribution 353 438 conf.os_family); 354 439 if source_pkgs <> [] then begin ··· 370 455 we emit a one-liner so the user isn't blindsided by a 371 456 low-level [./configure] failure with no prior warning. *) 372 457 if OpamSysPkg.Set.is_empty all && conf.os = "macos" then 373 373 - Fmt.epr 374 374 - "%a no system depexts matched for %d source package(s) on \ 375 375 - macOS. If the build fails with missing headers (gmp.h, \ 376 376 - openssl/ssl.h, …), install them with %a.@." 377 377 - Style.warn_string "note:" 378 378 - (List.length source_pkgs) 379 379 - Style.accent_string "brew install <pkg>"; 458 458 + Say.warn 459 459 + "no system depexts matched for %d source package(s) on macOS. If \ 460 460 + the build fails with missing headers (gmp.h, openssl/ssl.h, …), \ 461 461 + install them with: brew install <pkg>" 462 462 + (List.length source_pkgs); 380 463 if not (OpamSysPkg.Set.is_empty all) then ( 381 464 let st = Depexts.status all in 382 465 Log.info (fun m -> ··· 384 467 (OpamSysPkg.Set.cardinal st.installed) 385 468 (OpamSysPkg.Set.cardinal st.missing) 386 469 (OpamSysPkg.Set.cardinal st.not_found)); 387 387 - if not (OpamSysPkg.Set.is_empty st.missing) then begin 388 388 - Fmt.epr 389 389 - "%a system packages are not installed. The build may fail at \ 390 390 - compile time. Install them with:@. %s@." 391 391 - Style.warn_string "warning:" 470 470 + if not (OpamSysPkg.Set.is_empty st.missing) then 471 471 + Say.warn 472 472 + "system packages are not installed. The build may fail at \ 473 473 + compile time. Install them with: %s" 392 474 (st.missing |> OpamSysPkg.Set.elements 393 475 |> List.map OpamSysPkg.to_string 394 394 - |> String.concat " ") 395 395 - end; 476 476 + |> String.concat " "); 396 477 if not (OpamSysPkg.Set.is_empty st.not_found) then 397 397 - Fmt.epr 398 398 - "%a system packages are not known to the host package manager: \ 399 399 - %s@." 400 400 - Style.warn_string "warning:" 478 478 + Say.warn 479 479 + "system packages are not known to the host package manager: %s" 401 480 (st.not_found |> OpamSysPkg.Set.elements 402 481 |> List.map OpamSysPkg.to_string 403 403 - |> String.concat ", ")); 404 404 - (* Force the warnings out to the terminal *before* Plan.resolve 405 405 - takes a few seconds and the Execute.run progress bar takes 406 406 - over the cursor. Format's [@.] does flush, but we belt-and- 407 407 - braces it here because [Ui] uses ANSI cursor moves that have 408 408 - been observed to interleave oddly with buffered stderr in 409 409 - some macOS terminals. *) 410 410 - (try Stdlib.flush stderr with _ -> ()) 482 482 + |> String.concat ", ")) 411 483 end; 412 484 let exec_plan = 413 485 Plan.resolve ctx ~packages_dirs ~cache_root ~os_key

+19 -1

lib/oi/pipeline.mli

reviewed

··· 111 111 registry, also the registry's [sources/] subtree. *) 112 112 113 113 val fetch_remote_layers : 114 114 + ?on_phase:(string -> unit) -> 114 115 ?jobs:int -> 115 116 remote:D10.Layer.remote option -> 116 117 d10:D10.Config.t -> ··· 121 122 Plan.graph 122 123 (** Try fetching uncached [Source] layers from [remote]. Returns a new plan 123 124 graph with downloaded layers promoted to [Binary]. No-op when 124 124 - [remote = None] or every layer is already cached. *) 125 125 + [remote = None] or every layer is already cached. 126 126 + 127 127 + [on_phase] receives aggregated status across the parallel fiber pool — both 128 128 + completed-layer counts and cumulative bytes received. Throttled to ~20Hz 129 129 + internally; safe to wire into a [Tty.Progress] sink. *) 125 130 126 131 val build : 127 132 sys:D10.Sysops.t -> ··· 142 147 ?constraints:OpamFormula.version_constraint OpamTypes.name_map -> 143 148 ?project_root:string -> 144 149 ?local_packages_dir:string -> 150 150 + ?on_phase:(string -> unit) -> 151 151 + ?preflight_done:(unit -> unit) -> 145 152 OpamPackage.Name.t list -> 146 153 string list 147 154 (** [build] solves for [names], ensures every needed layer exists (building from ··· 151 158 [project_root] is the directory that holds the project's [_oi/] tree; when 152 159 supplied, every pin's URL is sha-pinned via [_oi/oi.lock] before fetch. The 153 160 lock is transient build state, regenerated as needed. 161 161 + 162 162 + [on_phase] is invoked once per slow preflight step ("Building solver 163 163 + context", "Solving for N roots", "Planning M packages", "Checking 164 164 + registry"). [oi sync] / [oi build] route this to [Say.step] for visible 165 165 + narration; [oi run] routes it to a TTY spinner that auto-clears. Defaults to 166 166 + a [Logs.info] dispatcher. 167 167 + 168 168 + [preflight_done] is called exactly once just before the build phase starts 169 169 + (i.e. before [Execute.run] takes over the cursor) — the cue for callers to 170 170 + clear their own preflight progress bar so it doesn't fight the per-package 171 171 + build bar. 154 172 155 173 When [dry_run] is [true] the function prints the build plan and calls 156 174 [Stdlib.exit 0] — same behaviour as [oi show]. *)

+68

lib/oi/say.ml

reviewed

··· 1 1 + (* Width chosen so the most common labels (deps, with-deps, overlays, 2 2 + extra-repos, prefix, tools, toolchain) all align to the same column. 3 3 + Longer labels overflow gracefully — they push the value over rather 4 4 + than truncating. *) 5 5 + let label_width = 12 6 6 + 7 7 + (* Flush stdout after every visible line so [oi run]'s preflight steps 8 8 + appear as soon as they're printed rather than at the OS buffer's 9 9 + discretion. The caller often immediately enters a slow phase 10 10 + (toolchain solve, opam-file parsing) where the next output won't come 11 11 + for hundreds of ms or more — without an explicit flush, line-buffered 12 12 + stdout silently swallows the marker. *) 13 13 + let flush_out () = try Stdlib.flush stdout with _ -> () 14 14 + 15 15 + let step fmt = 16 16 + Fmt.kstr 17 17 + (fun s -> 18 18 + Fmt.pr "%a %s@." Style.accent_string "▸" s; 19 19 + flush_out ()) 20 20 + fmt 21 21 + 22 22 + let info fmt = 23 23 + Fmt.kstr 24 24 + (fun s -> 25 25 + Fmt.pr " %s@." s; 26 26 + flush_out ()) 27 27 + fmt 28 28 + 29 29 + let field label fmt = 30 30 + Fmt.kstr 31 31 + (fun v -> 32 32 + Fmt.pr " %a %s@." Style.dim_string 33 33 + (Fmt.str "%-*s" label_width (label ^ ":")) 34 34 + v; 35 35 + flush_out ()) 36 36 + fmt 37 37 + 38 38 + let header fmt = 39 39 + Fmt.kstr 40 40 + (fun s -> 41 41 + Fmt.pr "%a@." Style.header_string s; 42 42 + flush_out ()) 43 43 + fmt 44 44 + 45 45 + let ok fmt = 46 46 + Fmt.kstr 47 47 + (fun s -> 48 48 + Fmt.pr " %a %s@." Style.ok_string "✓" s; 49 49 + flush_out ()) 50 50 + fmt 51 51 + 52 52 + let warn fmt = 53 53 + Fmt.kstr 54 54 + (fun s -> 55 55 + Fmt.epr "%a %s@." Style.warn_string "warning:" s; 56 56 + try Stdlib.flush stderr with _ -> ()) 57 57 + fmt 58 58 + 59 59 + let error fmt = 60 60 + Fmt.kstr 61 61 + (fun s -> 62 62 + Fmt.epr "%a %s@." Style.error_string "error:" s; 63 63 + try Stdlib.flush stderr with _ -> ()) 64 64 + fmt 65 65 + 66 66 + let newline () = 67 67 + Fmt.pr "@."; 68 68 + flush_out ()

+43

lib/oi/say.mli

reviewed

··· 1 1 + (** Consistent narration primitives for CLI commands. 2 2 + 3 3 + Every command's "I'm doing X" output should go through one of these helpers 4 4 + so colour, indentation, and the [▸] / [✓] / [⚠] / [✗] markers stay 5 5 + consistent across the codebase. Plain [Fmt.pr] calls in command bodies tend 6 6 + to drift in style (different prefixes, ad-hoc colours, inconsistent 7 7 + capitalization); routing through [Say.*] keeps them uniform. 8 8 + 9 9 + Output goes to stdout for {!step}, {!info}, {!field}, {!header}, {!ok}, and 10 10 + to stderr for {!warn} and {!error}. None of these helpers interact with the 11 11 + progress bar — callers inside an {!Ui.run} body should use {!Ui.log} or 12 12 + {!Ui.suspend} instead. *) 13 13 + 14 14 + val step : ('a, Format.formatter, unit, unit) format4 -> 'a 15 15 + (** [step "%s" msg] prints ["▸ msg"] in accent style — used for top-level action 16 16 + steps ("Solving", "Assembling prefix", "Wrote .envrc"). *) 17 17 + 18 18 + val info : ('a, Format.formatter, unit, unit) format4 -> 'a 19 19 + (** [info "%s" msg] prints [" msg"] in default style — secondary lines indented 20 20 + under a {!step}. *) 21 21 + 22 22 + val field : string -> ('a, Format.formatter, unit, unit) format4 -> 'a 23 23 + (** [field "deps" "%s" v] prints [" deps: v"] with the label dim and a fixed 24 24 + alignment column for the value. *) 25 25 + 26 26 + val header : ('a, Format.formatter, unit, unit) format4 -> 'a 27 27 + (** [header "%s" h] prints ["h"] in bold — used for section headers in 28 28 + multi-block reports ([oi show], [oi config]). *) 29 29 + 30 30 + val ok : ('a, Format.formatter, unit, unit) format4 -> 'a 31 31 + (** [ok "%s" msg] prints [" ✓ msg"] in success-green. *) 32 32 + 33 33 + val warn : ('a, Format.formatter, unit, unit) format4 -> 'a 34 34 + (** [warn "%s" msg] prints ["warning: msg"] in yellow on stderr, then flushes — 35 35 + protects against the message being eaten by a subsequent progress bar 36 36 + redraw. *) 37 37 + 38 38 + val error : ('a, Format.formatter, unit, unit) format4 -> 'a 39 39 + (** [error "%s" msg] prints ["error: msg"] in red on stderr, then flushes. *) 40 40 + 41 41 + val newline : unit -> unit 42 42 + (** Emit a blank line on stdout — used to vertically separate logical sections. 43 43 + *)

+4 -2

lib/osrel/osrel.ml

reviewed

··· 178 178 let detect_macos ~fs ~proc_mgr = 179 179 let brew_paths = 180 180 [ 181 181 - "/opt/homebrew/bin/brew"; (* Apple Silicon default *) 182 182 - "/usr/local/bin/brew"; (* Intel default *) 181 181 + "/opt/homebrew/bin/brew"; 182 182 + (* Apple Silicon default *) 183 183 + "/usr/local/bin/brew"; 184 184 + (* Intel default *) 183 185 ] 184 186 in 185 187 let port_paths = [ "/opt/local/bin/port" ] in