XDG library path support for OCaml via Eio capabilities
anil.recoil.org
linux
macos
ocaml
xdg
1type source = Default | Env of string | Cmdline
2
3type t = {
4 app_name : string;
5 config_dir : Eio.Fs.dir_ty Eio.Path.t;
6 config_dir_source : source;
7 data_dir : Eio.Fs.dir_ty Eio.Path.t;
8 data_dir_source : source;
9 cache_dir : Eio.Fs.dir_ty Eio.Path.t;
10 cache_dir_source : source;
11 state_dir : Eio.Fs.dir_ty Eio.Path.t;
12 state_dir_source : source;
13 runtime_dir : Eio.Fs.dir_ty Eio.Path.t option;
14 runtime_dir_source : source;
15 config_dirs : Eio.Fs.dir_ty Eio.Path.t list;
16 data_dirs : Eio.Fs.dir_ty Eio.Path.t list;
17}
18
19let ensure_dir ?(perm = 0o755) path = Eio.Path.mkdirs ~exists_ok:true ~perm path
20
21let validate_runtime_base_dir base_path =
22 (* Validate the base XDG_RUNTIME_DIR has correct permissions per spec *)
23 try
24 let path_str = Eio.Path.native_exn base_path in
25 let stat = Eio.Path.stat ~follow:true base_path in
26 let current_perm = stat.perm land 0o777 in
27 if current_perm <> 0o700 then
28 failwith
29 (Printf.sprintf
30 "XDG_RUNTIME_DIR base directory %s has incorrect permissions: %o \
31 (must be 0700)"
32 path_str current_perm);
33 (* Check ownership - directory should be owned by current user *)
34 let uid = Unix.getuid () in
35 if stat.uid <> Int64.of_int uid then
36 failwith
37 (Printf.sprintf
38 "XDG_RUNTIME_DIR base directory %s not owned by current user (uid \
39 %d, owner %Ld)"
40 path_str uid stat.uid)
41 (* TODO: Check that directory is on local filesystem (not networked).
42 This would require filesystem type detection which is OS-specific. *)
43 with exn ->
44 failwith
45 (Printf.sprintf "Cannot validate XDG_RUNTIME_DIR: %s"
46 (Printexc.to_string exn))
47
48let ensure_runtime_dir _fs app_runtime_path =
49 (* Base directory validation is done in resolve_runtime_dir,
50 so we just create the app subdirectory *)
51 ensure_dir app_runtime_path
52
53let get_home_dir fs =
54 let home_str =
55 match Sys.getenv_opt "HOME" with
56 | Some home -> home
57 | None -> (
58 match Sys.os_type with
59 | "Win32" | "Cygwin" -> (
60 match Sys.getenv_opt "USERPROFILE" with
61 | Some profile -> profile
62 | None -> failwith "Cannot determine home directory")
63 | _ -> (
64 try Unix.((getpwuid (getuid ())).pw_dir)
65 with _ -> failwith "Cannot determine home directory"))
66 in
67 Eio.Path.(fs / home_str)
68
69let make_env_var_name app_name suffix =
70 String.uppercase_ascii app_name ^ "_" ^ suffix
71
72exception Invalid_xdg_path of string
73
74let validate_absolute_path context path =
75 if Filename.is_relative path then
76 raise
77 (Invalid_xdg_path
78 (Printf.sprintf "%s must be an absolute path, got: %s" context path))
79
80let resolve_path fs home_path base_path =
81 if Filename.is_relative base_path then Eio.Path.(home_path / base_path)
82 else Eio.Path.(fs / base_path)
83
84(* Helper to resolve system directories (config_dirs or data_dirs) *)
85let resolve_system_dirs fs home_path app_name override_suffix xdg_var
86 default_paths =
87 let override_var = make_env_var_name app_name override_suffix in
88 match Sys.getenv_opt override_var with
89 | Some dirs when dirs <> "" ->
90 String.split_on_char ':' dirs
91 |> List.filter (fun s -> s <> "")
92 |> List.filter_map (fun path ->
93 try
94 validate_absolute_path override_var path;
95 Some Eio.Path.(resolve_path fs home_path path / app_name)
96 with Invalid_xdg_path _ -> None)
97 | Some _ | None -> (
98 match Sys.getenv_opt xdg_var with
99 | Some dirs when dirs <> "" ->
100 String.split_on_char ':' dirs
101 |> List.filter (fun s -> s <> "")
102 |> List.filter_map (fun path ->
103 try
104 validate_absolute_path xdg_var path;
105 Some Eio.Path.(resolve_path fs home_path path / app_name)
106 with Invalid_xdg_path _ -> None)
107 | Some _ | None ->
108 List.map
109 (fun path -> Eio.Path.(resolve_path fs home_path path / app_name))
110 default_paths)
111
112(* Helper to resolve a user directory with override precedence *)
113let resolve_user_dir fs home_path app_name xdg_ctx xdg_getter override_suffix =
114 let override_var = make_env_var_name app_name override_suffix in
115 match Sys.getenv_opt override_var with
116 | Some dir when dir <> "" ->
117 validate_absolute_path override_var dir;
118 (Eio.Path.(fs / dir / app_name), Env override_var)
119 | Some _ | None ->
120 let xdg_base = xdg_getter xdg_ctx in
121 let base_path = resolve_path fs home_path xdg_base in
122 (Eio.Path.(base_path / app_name), Default)
123
124(* Helper to resolve runtime directory (special case since it can be None) *)
125let resolve_runtime_dir fs home_path app_name xdg_ctx =
126 let override_var = make_env_var_name app_name "RUNTIME_DIR" in
127 match Sys.getenv_opt override_var with
128 | Some dir when dir <> "" ->
129 validate_absolute_path override_var dir;
130 (* Validate the base runtime directory has correct permissions *)
131 let base_runtime_dir = resolve_path fs home_path dir in
132 validate_runtime_base_dir base_runtime_dir;
133 (Some Eio.Path.(base_runtime_dir / app_name), Env override_var)
134 | Some _ | None ->
135 ( (match Xdg.runtime_dir xdg_ctx with
136 | Some base ->
137 (* Validate the base runtime directory has correct permissions *)
138 let base_runtime_dir = resolve_path fs home_path base in
139 validate_runtime_base_dir base_runtime_dir;
140 Some Eio.Path.(base_runtime_dir / app_name)
141 | None -> None),
142 Default )
143
144let validate_standard_xdg_vars () =
145 (* Validate standard XDG environment variables for absolute paths *)
146 let xdg_vars =
147 [
148 "XDG_CONFIG_HOME";
149 "XDG_DATA_HOME";
150 "XDG_CACHE_HOME";
151 "XDG_STATE_HOME";
152 "XDG_RUNTIME_DIR";
153 "XDG_CONFIG_DIRS";
154 "XDG_DATA_DIRS";
155 ]
156 in
157 List.iter
158 (fun var ->
159 match Sys.getenv_opt var with
160 | Some value when value <> "" ->
161 if String.contains value ':' then
162 (* Colon-separated list - validate each part *)
163 String.split_on_char ':' value
164 |> List.filter (fun s -> s <> "")
165 |> List.iter (fun path -> validate_absolute_path var path)
166 else
167 (* Single path *)
168 validate_absolute_path var value
169 | _ -> ())
170 xdg_vars
171
172let create fs app_name =
173 let fs = fs in
174 let home_path = get_home_dir fs in
175 (* First validate all standard XDG environment variables *)
176 validate_standard_xdg_vars ();
177 let xdg_ctx = Xdg.create ~env:Sys.getenv_opt () in
178 (* User directories *)
179 let config_dir, config_dir_source =
180 resolve_user_dir fs home_path app_name xdg_ctx Xdg.config_dir "CONFIG_DIR"
181 in
182 let data_dir, data_dir_source =
183 resolve_user_dir fs home_path app_name xdg_ctx Xdg.data_dir "DATA_DIR"
184 in
185 let cache_dir, cache_dir_source =
186 resolve_user_dir fs home_path app_name xdg_ctx Xdg.cache_dir "CACHE_DIR"
187 in
188 let state_dir, state_dir_source =
189 resolve_user_dir fs home_path app_name xdg_ctx Xdg.state_dir "STATE_DIR"
190 in
191 (* Runtime directory *)
192 let runtime_dir, runtime_dir_source =
193 resolve_runtime_dir fs home_path app_name xdg_ctx
194 in
195 (* System directories *)
196 let config_dirs =
197 resolve_system_dirs fs home_path app_name "CONFIG_DIRS" "XDG_CONFIG_DIRS"
198 [ "/etc/xdg" ]
199 in
200 let data_dirs =
201 resolve_system_dirs fs home_path app_name "DATA_DIRS" "XDG_DATA_DIRS"
202 [ "/usr/local/share"; "/usr/share" ]
203 in
204 ensure_dir config_dir;
205 ensure_dir data_dir;
206 ensure_dir cache_dir;
207 ensure_dir state_dir;
208 Option.iter (ensure_runtime_dir fs) runtime_dir;
209 {
210 app_name;
211 config_dir;
212 config_dir_source;
213 data_dir;
214 data_dir_source;
215 cache_dir;
216 cache_dir_source;
217 state_dir;
218 state_dir_source;
219 runtime_dir;
220 runtime_dir_source;
221 config_dirs;
222 data_dirs;
223 }
224
225let app_name t = t.app_name
226let config_dir t = t.config_dir
227let data_dir t = t.data_dir
228let cache_dir t = t.cache_dir
229let state_dir t = t.state_dir
230let runtime_dir t = t.runtime_dir
231let config_dirs t = t.config_dirs
232let data_dirs t = t.data_dirs
233
234(* File search following XDG specification *)
235let find_file_in_dirs dirs filename =
236 let rec search_dirs = function
237 | [] -> None
238 | dir :: remaining_dirs -> (
239 let file_path = Eio.Path.(dir / filename) in
240 try
241 (* Try to check if file exists and is readable *)
242 let _ = Eio.Path.stat ~follow:true file_path in
243 Some file_path
244 with _ ->
245 (* File is inaccessible (non-existent, permissions, etc.)
246 Skip and continue with next directory per XDG spec *)
247 search_dirs remaining_dirs)
248 in
249 search_dirs dirs
250
251let find_config_file t filename =
252 (* Search user config dir first, then system config dirs *)
253 find_file_in_dirs (t.config_dir :: t.config_dirs) filename
254
255let find_data_file t filename =
256 (* Search user data dir first, then system data dirs *)
257 find_file_in_dirs (t.data_dir :: t.data_dirs) filename
258
259let pp ?(brief = false) ?(sources = false) ppf t =
260 let pp_source ppf = function
261 | Default -> Fmt.(styled `Faint string) ppf "default"
262 | Env var -> Fmt.pf ppf "%a" Fmt.(styled `Yellow string) ("env(" ^ var ^ ")")
263 | Cmdline -> Fmt.(styled `Blue string) ppf "cmdline"
264 in
265 let pp_path_with_source ppf path source =
266 if sources then
267 Fmt.pf ppf "%a %a"
268 Fmt.(styled `Green Eio.Path.pp)
269 path
270 Fmt.(styled `Faint (brackets pp_source))
271 source
272 else Fmt.(styled `Green Eio.Path.pp) ppf path
273 in
274 let pp_path_opt_with_source ppf path_opt source =
275 match path_opt with
276 | None ->
277 if sources then
278 Fmt.pf ppf "%a %a"
279 Fmt.(styled `Red string)
280 "<none>"
281 Fmt.(styled `Faint (brackets pp_source))
282 source
283 else Fmt.(styled `Red string) ppf "<none>"
284 | Some path -> pp_path_with_source ppf path source
285 in
286 let pp_paths ppf paths =
287 Fmt.(list ~sep:(any ";@ ") (styled `Green Eio.Path.pp)) ppf paths
288 in
289 if brief then
290 Fmt.pf ppf "%a config=%a data=%a>"
291 Fmt.(styled `Cyan string)
292 ("<xdg:" ^ t.app_name)
293 (fun ppf (path, source) -> pp_path_with_source ppf path source)
294 (t.config_dir, t.config_dir_source)
295 (fun ppf (path, source) -> pp_path_with_source ppf path source)
296 (t.data_dir, t.data_dir_source)
297 else (
298 Fmt.pf ppf "@[<v>%a@,"
299 Fmt.(styled `Bold string)
300 ("XDG directories for '" ^ t.app_name ^ "':");
301 Fmt.pf ppf "@[<v 2>%a@," Fmt.(styled `Bold string) "User directories:";
302 Fmt.pf ppf "%a %a@,"
303 Fmt.(styled `Cyan string)
304 "config:"
305 (fun ppf (path, source) -> pp_path_with_source ppf path source)
306 (t.config_dir, t.config_dir_source);
307 Fmt.pf ppf "%a %a@,"
308 Fmt.(styled `Cyan string)
309 "data:"
310 (fun ppf (path, source) -> pp_path_with_source ppf path source)
311 (t.data_dir, t.data_dir_source);
312 Fmt.pf ppf "%a %a@,"
313 Fmt.(styled `Cyan string)
314 "cache:"
315 (fun ppf (path, source) -> pp_path_with_source ppf path source)
316 (t.cache_dir, t.cache_dir_source);
317 Fmt.pf ppf "%a %a@,"
318 Fmt.(styled `Cyan string)
319 "state:"
320 (fun ppf (path, source) -> pp_path_with_source ppf path source)
321 (t.state_dir, t.state_dir_source);
322 Fmt.pf ppf "%a %a@]@,"
323 Fmt.(styled `Cyan string)
324 "runtime:"
325 (fun ppf (path_opt, source) ->
326 pp_path_opt_with_source ppf path_opt source)
327 (t.runtime_dir, t.runtime_dir_source);
328 Fmt.pf ppf "@[<v 2>%a@," Fmt.(styled `Bold string) "System directories:";
329 Fmt.pf ppf "%a [@[<hov>%a@]]@,"
330 Fmt.(styled `Cyan string)
331 "config_dirs:" pp_paths t.config_dirs;
332 Fmt.pf ppf "%a [@[<hov>%a@]]@]@]"
333 Fmt.(styled `Cyan string)
334 "data_dirs:" pp_paths t.data_dirs)
335
336module Cmd = struct
337 type xdg_t = t
338 type 'a with_source = { value : 'a option; source : source }
339
340 type t = {
341 config_dir : string with_source;
342 data_dir : string with_source;
343 cache_dir : string with_source;
344 state_dir : string with_source;
345 runtime_dir : string with_source;
346 }
347
348 type dir = [ `Config | `Cache | `Data | `State | `Runtime ]
349
350 let term app_name fs ?(dirs = [ `Config; `Data; `Cache; `State; `Runtime ]) ()
351 =
352 let open Cmdliner in
353 let app_upper = String.uppercase_ascii app_name in
354 let show_paths =
355 let doc = "Show only the resolved directory paths without formatting" in
356 Arg.(value & flag & info [ "show-paths" ] ~doc)
357 in
358 let has_dir d = List.mem d dirs in
359 let make_dir_arg ~enabled name env_suffix xdg_var default_path =
360 if not enabled then
361 (* Return a term that always gives the environment-only result *)
362 Term.(
363 const (fun () ->
364 let app_env = app_upper ^ "_" ^ env_suffix in
365 match Sys.getenv_opt app_env with
366 | Some v when v <> "" -> { value = Some v; source = Env app_env }
367 | Some _ | None -> (
368 match Sys.getenv_opt xdg_var with
369 | Some v -> { value = Some v; source = Env xdg_var }
370 | None -> { value = None; source = Default }))
371 $ const ())
372 else
373 let app_env = app_upper ^ "_" ^ env_suffix in
374 let doc =
375 match default_path with
376 | Some path ->
377 Printf.sprintf
378 "Override %s directory. Can also be set with %s or %s. \
379 Default: %s"
380 name app_env xdg_var path
381 | None ->
382 Printf.sprintf
383 "Override %s directory. Can also be set with %s or %s. No \
384 default value."
385 name app_env xdg_var
386 in
387 let arg =
388 Arg.(
389 value
390 & opt (some string) None
391 & info [ name ^ "-dir" ] ~docv:"DIR" ~doc)
392 in
393 Term.(
394 const (fun cmdline_val ->
395 match cmdline_val with
396 | Some v -> { value = Some v; source = Cmdline }
397 | None -> (
398 match Sys.getenv_opt app_env with
399 | Some v when v <> "" ->
400 { value = Some v; source = Env app_env }
401 | Some _ | None -> (
402 match Sys.getenv_opt xdg_var with
403 | Some v -> { value = Some v; source = Env xdg_var }
404 | None -> { value = None; source = Default })))
405 $ arg)
406 in
407 let home_prefix = "\\$HOME" in
408 let config_dir =
409 make_dir_arg ~enabled:(has_dir `Config) "config" "CONFIG_DIR"
410 "XDG_CONFIG_HOME"
411 (Some (home_prefix ^ "/.config/" ^ app_name))
412 in
413 let data_dir =
414 make_dir_arg ~enabled:(has_dir `Data) "data" "DATA_DIR" "XDG_DATA_HOME"
415 (Some (home_prefix ^ "/.local/share/" ^ app_name))
416 in
417 let cache_dir =
418 make_dir_arg ~enabled:(has_dir `Cache) "cache" "CACHE_DIR"
419 "XDG_CACHE_HOME"
420 (Some (home_prefix ^ "/.cache/" ^ app_name))
421 in
422 let state_dir =
423 make_dir_arg ~enabled:(has_dir `State) "state" "STATE_DIR"
424 "XDG_STATE_HOME"
425 (Some (home_prefix ^ "/.local/state/" ^ app_name))
426 in
427 let runtime_dir =
428 make_dir_arg ~enabled:(has_dir `Runtime) "runtime" "RUNTIME_DIR"
429 "XDG_RUNTIME_DIR" None
430 in
431 Term.(
432 const
433 (fun
434 show_paths_flag
435 config_dir_ws
436 data_dir_ws
437 cache_dir_ws
438 state_dir_ws
439 runtime_dir_ws
440 ->
441 let config =
442 {
443 config_dir = config_dir_ws;
444 data_dir = data_dir_ws;
445 cache_dir = cache_dir_ws;
446 state_dir = state_dir_ws;
447 runtime_dir = runtime_dir_ws;
448 }
449 in
450 let home_path = get_home_dir fs in
451 (* First validate all standard XDG environment variables *)
452 validate_standard_xdg_vars ();
453 let xdg_ctx = Xdg.create ~env:Sys.getenv_opt () in
454 (* Helper to resolve directory from config with source tracking *)
455 let resolve_from_config config_ws xdg_getter =
456 match config_ws.value with
457 | Some dir -> (resolve_path fs home_path dir, config_ws.source)
458 | None ->
459 let xdg_base = xdg_getter xdg_ctx in
460 let base_path = resolve_path fs home_path xdg_base in
461 (Eio.Path.(base_path / app_name), config_ws.source)
462 in
463 (* User directories *)
464 let config_dir, config_dir_source =
465 resolve_from_config config.config_dir Xdg.config_dir
466 in
467 let data_dir, data_dir_source =
468 resolve_from_config config.data_dir Xdg.data_dir
469 in
470 let cache_dir, cache_dir_source =
471 resolve_from_config config.cache_dir Xdg.cache_dir
472 in
473 let state_dir, state_dir_source =
474 resolve_from_config config.state_dir Xdg.state_dir
475 in
476 (* Runtime directory *)
477 let runtime_dir, runtime_dir_source =
478 match config.runtime_dir.value with
479 | Some dir ->
480 (Some (resolve_path fs home_path dir), config.runtime_dir.source)
481 | None ->
482 ( Option.map
483 (fun base ->
484 let base_path = resolve_path fs home_path base in
485 Eio.Path.(base_path / app_name))
486 (Xdg.runtime_dir xdg_ctx),
487 config.runtime_dir.source )
488 in
489 (* System directories - reuse shared helper *)
490 let config_dirs =
491 resolve_system_dirs fs home_path app_name "CONFIG_DIRS"
492 "XDG_CONFIG_DIRS" [ "/etc/xdg" ]
493 in
494 let data_dirs =
495 resolve_system_dirs fs home_path app_name "DATA_DIRS"
496 "XDG_DATA_DIRS"
497 [ "/usr/local/share"; "/usr/share" ]
498 in
499 ensure_dir config_dir;
500 ensure_dir data_dir;
501 ensure_dir cache_dir;
502 ensure_dir state_dir;
503 Option.iter (ensure_runtime_dir fs) runtime_dir;
504 let xdg =
505 {
506 app_name;
507 config_dir;
508 config_dir_source;
509 data_dir;
510 data_dir_source;
511 cache_dir;
512 cache_dir_source;
513 state_dir;
514 state_dir_source;
515 runtime_dir;
516 runtime_dir_source;
517 config_dirs;
518 data_dirs;
519 }
520 in
521 (* Handle --show-paths option *)
522 if show_paths_flag then (
523 let print_path name path =
524 match path with
525 | None -> Printf.printf "%s: <none>\n" name
526 | Some p -> Printf.printf "%s: %s\n" name (Eio.Path.native_exn p)
527 in
528 let print_paths name paths =
529 match paths with
530 | [] -> Printf.printf "%s: []\n" name
531 | paths ->
532 let paths_str =
533 String.concat ":" (List.map Eio.Path.native_exn paths)
534 in
535 Printf.printf "%s: %s\n" name paths_str
536 in
537 print_path "config_dir" (Some config_dir);
538 print_path "data_dir" (Some data_dir);
539 print_path "cache_dir" (Some cache_dir);
540 print_path "state_dir" (Some state_dir);
541 print_path "runtime_dir" runtime_dir;
542 print_paths "config_dirs" config_dirs;
543 print_paths "data_dirs" data_dirs;
544 Stdlib.exit 0);
545 (xdg, config))
546 $ show_paths $ config_dir $ data_dir $ cache_dir $ state_dir $ runtime_dir)
547
548 let cache_term app_name =
549 let open Cmdliner in
550 let app_upper = String.uppercase_ascii app_name in
551 let app_env = app_upper ^ "_CACHE_DIR" in
552 let xdg_var = "XDG_CACHE_HOME" in
553 let home = Sys.getenv "HOME" in
554 let default_path = home ^ "/.cache/" ^ app_name in
555
556 let doc =
557 Printf.sprintf
558 "Override cache directory. Can also be set with %s or %s. Default: %s"
559 app_env xdg_var default_path
560 in
561
562 let arg =
563 Arg.(
564 value & opt string default_path
565 & info [ "cache-dir"; "c" ] ~docv:"DIR" ~doc)
566 in
567
568 Term.(
569 const (fun cmdline_val ->
570 (* Check command line first *)
571 if cmdline_val <> default_path then cmdline_val
572 else
573 (* Then check app-specific env var *)
574 match Sys.getenv_opt app_env with
575 | Some v when v <> "" -> v
576 | _ -> (
577 (* Then check XDG env var *)
578 match Sys.getenv_opt xdg_var with
579 | Some v when v <> "" -> v ^ "/" ^ app_name
580 | _ -> default_path))
581 $ arg)
582
583 let env_docs app_name =
584 let app_upper = String.uppercase_ascii app_name in
585 Printf.sprintf
586 {|
587Configuration Precedence (follows standard Unix conventions):
588 1. Command-line flags (e.g., --config-dir) - highest priority
589 2. Application-specific environment variable (e.g., %s_CONFIG_DIR)
590 3. XDG standard environment variable (e.g., XDG_CONFIG_HOME)
591 4. Default path (e.g., ~/.config/%s) - lowest priority
592
593 This allows per-application overrides without affecting other XDG-compliant programs.
594 For example, setting %s_CONFIG_DIR only changes the config directory for %s,
595 while XDG_CONFIG_HOME affects all XDG-compliant applications.
596
597Application-specific variables:
598 %s_CONFIG_DIR Override config directory for %s only
599 %s_DATA_DIR Override data directory for %s only
600 %s_CACHE_DIR Override cache directory for %s only
601 %s_STATE_DIR Override state directory for %s only
602 %s_RUNTIME_DIR Override runtime directory for %s only
603
604XDG standard variables (shared by all XDG applications):
605 XDG_CONFIG_HOME User configuration directory (default: ~/.config/%s)
606 XDG_DATA_HOME User data directory (default: ~/.local/share/%s)
607 XDG_CACHE_HOME User cache directory (default: ~/.cache/%s)
608 XDG_STATE_HOME User state directory (default: ~/.local/state/%s)
609 XDG_RUNTIME_DIR User runtime directory (no default)
610 XDG_CONFIG_DIRS System configuration directories (default: /etc/xdg/%s)
611 XDG_DATA_DIRS System data directories (default: /usr/local/share/%s:/usr/share/%s)
612|}
613 app_upper app_name app_upper app_name app_upper app_name app_upper
614 app_name app_upper app_name app_upper app_name app_upper app_name app_name
615 app_name app_name app_name app_name app_name app_name
616
617 let pp ppf config =
618 let pp_source ppf = function
619 | Default -> Fmt.(styled `Faint string) ppf "default"
620 | Env var ->
621 Fmt.pf ppf "%a" Fmt.(styled `Yellow string) ("env(" ^ var ^ ")")
622 | Cmdline -> Fmt.(styled `Blue string) ppf "cmdline"
623 in
624 let pp_with_source name ppf ws =
625 match ws.value with
626 | None when ws.source = Default -> ()
627 | None ->
628 Fmt.pf ppf "@,%a %a %a"
629 Fmt.(styled `Cyan string)
630 (name ^ ":")
631 Fmt.(styled `Red string)
632 "<unset>"
633 Fmt.(styled `Faint (brackets pp_source))
634 ws.source
635 | Some value ->
636 Fmt.pf ppf "@,%a %a %a"
637 Fmt.(styled `Cyan string)
638 (name ^ ":")
639 Fmt.(styled `Green string)
640 value
641 Fmt.(styled `Faint (brackets pp_source))
642 ws.source
643 in
644 Fmt.pf ppf "@[<v>%a%a%a%a%a%a@]"
645 Fmt.(styled `Bold string)
646 "XDG config:"
647 (pp_with_source "config_dir")
648 config.config_dir
649 (pp_with_source "data_dir")
650 config.data_dir
651 (pp_with_source "cache_dir")
652 config.cache_dir
653 (pp_with_source "state_dir")
654 config.state_dir
655 (pp_with_source "runtime_dir")
656 config.runtime_dir
657end