gazagnaire.org / ocaml-vlog
Cmdliner terms for ergonomic logging configuration
0
fork

Configure Feed

Select the types of activity you want to include in your feed.

monopam: add --path for partial views of an upstream monorepo

Enable "one global library monorepo + many local product monorepos"
and "two developers sharing a subset of one upstream mono" workflows
by letting monopam add materialize just a subdirectory of a larger
source repo as a local subtree.

monopam add file://upstream.git --path eio

imports only the eio/ subtree of upstream.git into the local mono.
sources.toml gains a per-entry path field that records the split
location, so pull and push know which subdirectory to round-trip.

Implementation:

- Sources_registry.entry gets a new path: string option. TOML codec
reads/writes the field; legacy sources.toml without it loads with
path = None.
- Import.git_url, with a path argument, fetches the upstream full,
calls Git.Subtree.split at the path to get a standalone history,
then Git.Subtree.add that split at the local subtree name. Default
local name becomes the path basename.
- Push.one branches on the entry's path field. For path entries it
calls merge_split_into_path, which splits the local mono,
push_refspecs the split into the checkout (a full clone of the
source), Git.Subtree.merge-s at the path, then lets the existing
to_upstream step push the checkout back to the source. After the
merge it uses Git.Repository.checkout + add_all to sync the
worktree and index.
- Pull.subtree likewise branches on path: fetch the checkout,
Git.Subtree.split at the path, merge into the local mono at the
local prefix.
- Both sites look up sources.toml entries by package name OR repo
name. Previously the lookup used Package.subtree_prefix, which for
path entries is the source repo name ("global"), not the local
subtree name ("eio").

Side fix: Tty.Span.pp used to always emit ANSI even with NO_COLOR
set. vlog already runs Fmt_cli.style_renderer and
Fmt_tty.setup_std_outputs to honor --color; this patch adds a
--no-color cmdliner flag backed by a NO_COLOR Cmd.Env.info to vlog
and forces the style renderer to None when set. Span.render now
consults Fmt.style_renderer on the target formatter instead of a
separate global toggle — single source of truth for colour across
the tree.

Tests:

- monopam/test/subtree_path.t exercises the full path round-trip:
add --path eio, add --path cohttp, edit eio locally, push, verify
global.git received only the eio change, pull a third-party edit,
verify the local mono gets it with cohttp untouched.

Thomas Gazagnaire 75f78115 f81d38ab

+29 -7
+29 -7
lib/vlog.ml
··· 233 233 234 234 type log_flags = { quiet : bool; json : bool } 235 235 236 - let setup_log ~json_reporter app_name style_renderer { quiet; json } verbosity 237 - log_spec trace_file base_tags = 236 + (** POSIX NO_COLOR: any non-empty value disables ANSI colour on stdout/stderr. 237 + Exposed as a cmdliner flag so it is documented in [--help] and composed into 238 + the log setup pipeline alongside [Fmt_cli.style_renderer]. An explicit 239 + [--color=always] still wins — same precedence as POSIX. See 240 + https://no-color.org. *) 241 + let no_color_term = 242 + let env = 243 + Cmd.Env.info "NO_COLOR" 244 + ~doc: 245 + "If set to any non-empty value, disable ANSI colour in all output. \ 246 + Overridden by an explicit --color=always. See https://no-color.org." 247 + in 248 + Arg.(value & flag & info [ "no-color" ] ~doc:"Disable ANSI colour." ~env) 249 + 250 + let setup_log ~json_reporter app_name style_renderer no_color { quiet; json } 251 + verbosity log_spec trace_file base_tags = 252 + let style_renderer = 253 + match style_renderer with 254 + | Some _ -> style_renderer (* explicit --color wins *) 255 + | None when no_color -> Some `None 256 + | None -> None 257 + in 238 258 Fmt_tty.setup_std_outputs ?style_renderer (); 239 259 (* Parse --log / <APP>_LOG spec *) 240 260 let global_override, source_overrides = ··· 287 307 match json_reporter with 288 308 | None -> 289 309 (* JSON disabled: no --json flag or --log-tag exposed *) 290 - let setup_log' style_renderer flags verbosity log_spec trace_file = 310 + let setup_log' style_renderer no_color flags verbosity log_spec trace_file 311 + = 291 312 setup_log 292 313 ~json_reporter:(fun ~app:_ ~base:_ () -> Logs_fmt.reporter ()) 293 - app_name style_renderer flags verbosity log_spec trace_file [] 314 + app_name style_renderer no_color flags verbosity log_spec trace_file 315 + [] 294 316 in 295 317 Term.( 296 - const setup_log' $ Fmt_cli.style_renderer () 318 + const setup_log' $ Fmt_cli.style_renderer () $ no_color_term 297 319 $ Term.(const (fun quiet -> { quiet; json = false }) $ quiet) 298 320 $ verbosity $ log_term app_name $ trace_file) 299 321 | Some r -> 300 322 (* JSON enabled: expose --json flag and --log-tag *) 301 323 Term.( 302 324 const (setup_log ~json_reporter:r app_name) 303 - $ Fmt_cli.style_renderer () $ flags_term $ verbosity $ log_term app_name 304 - $ trace_file $ log_tags) 325 + $ Fmt_cli.style_renderer () $ no_color_term $ flags_term $ verbosity 326 + $ log_term app_name $ trace_file $ log_tags)