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