this repo has no description
fmt
+430
-251
+1
-1
xdg-eio/example/dune
+1
-1
xdg-eio/example/dune
+23
-16
xdg-eio/example/xdg_example.ml
+23
-16
xdg-eio/example/xdg_example.ml
···
1
1
let run env app_name config =
2
2
let xdg = Xdge.Cmd.of_t env#fs app_name config in
3
-
Fmt.pr "%a@.%a@.@.%a@.%a@."
4
-
Fmt.(styled `Bold string) "=== Cmdliner Config ==="
5
-
Xdge.Cmd.pp config
6
-
Fmt.(styled `Bold string) "=== XDG Directories ==="
7
-
(Xdge.pp ~brief:false ~sources:true) xdg
3
+
Fmt.pr
4
+
"%a@.%a@.@.%a@.%a@."
5
+
Fmt.(styled `Bold string)
6
+
"=== Cmdliner Config ==="
7
+
Xdge.Cmd.pp
8
+
config
9
+
Fmt.(styled `Bold string)
10
+
"=== XDG Directories ==="
11
+
(Xdge.pp ~brief:false ~sources:true)
12
+
xdg
13
+
;;
8
14
9
-
let main app_name config =
10
-
Eio_main.run @@ fun env ->
11
-
run env app_name config
15
+
let main app_name config = Eio_main.run @@ fun env -> run env app_name config
12
16
13
17
let () =
14
18
Fmt.set_style_renderer Fmt.stdout `Ansi_tty;
15
19
let app_name = "xdg_example" in
16
20
let doc = "Example program demonstrating XDG directory selection with Cmdliner" in
17
-
let man = [
18
-
`S Cmdliner.Manpage.s_description;
19
-
`P "This example shows how to use the Xdge library with Cmdliner \
20
-
to handle XDG Base Directory Specification paths with command-line \
21
-
and environment variable overrides.";
22
-
`S Cmdliner.Manpage.s_environment;
23
-
`P (Xdge.Cmd.env_docs app_name);
24
-
] in
21
+
let man =
22
+
[ `S Cmdliner.Manpage.s_description
23
+
; `P
24
+
"This example shows how to use the Xdge library with Cmdliner to handle XDG Base \
25
+
Directory Specification paths with command-line and environment variable \
26
+
overrides."
27
+
; `S Cmdliner.Manpage.s_environment
28
+
; `P (Xdge.Cmd.env_docs app_name)
29
+
]
30
+
in
25
31
let info = Cmdliner.Cmd.info "xdg_example" ~version:"1.0" ~doc ~man in
26
32
let term =
27
33
let open Cmdliner.Term.Syntax in
···
30
36
in
31
37
let cmd = Cmdliner.Cmd.v info term in
32
38
exit @@ Cmdliner.Cmd.eval cmd
39
+
;;
+1
-1
xdg-eio/lib/dune
+1
-1
xdg-eio/lib/dune
+383
-210
xdg-eio/lib/xdge.ml
+383
-210
xdg-eio/lib/xdge.ml
···
1
-
type source =
1
+
type source =
2
2
| Default
3
3
| Env of string
4
4
| Cmdline
5
5
6
-
type t = {
7
-
app_name : string;
8
-
config_dir : Eio.Fs.dir_ty Eio.Path.t;
9
-
config_dir_source : source;
10
-
data_dir : Eio.Fs.dir_ty Eio.Path.t;
11
-
data_dir_source : source;
12
-
cache_dir : Eio.Fs.dir_ty Eio.Path.t;
13
-
cache_dir_source : source;
14
-
state_dir : Eio.Fs.dir_ty Eio.Path.t;
15
-
state_dir_source : source;
16
-
runtime_dir : Eio.Fs.dir_ty Eio.Path.t option;
17
-
runtime_dir_source : source;
18
-
config_dirs : Eio.Fs.dir_ty Eio.Path.t list;
19
-
data_dirs : Eio.Fs.dir_ty Eio.Path.t list;
20
-
}
6
+
type t =
7
+
{ app_name : string
8
+
; config_dir : Eio.Fs.dir_ty Eio.Path.t
9
+
; config_dir_source : source
10
+
; data_dir : Eio.Fs.dir_ty Eio.Path.t
11
+
; data_dir_source : source
12
+
; cache_dir : Eio.Fs.dir_ty Eio.Path.t
13
+
; cache_dir_source : source
14
+
; state_dir : Eio.Fs.dir_ty Eio.Path.t
15
+
; state_dir_source : source
16
+
; runtime_dir : Eio.Fs.dir_ty Eio.Path.t option
17
+
; runtime_dir_source : source
18
+
; config_dirs : Eio.Fs.dir_ty Eio.Path.t list
19
+
; data_dirs : Eio.Fs.dir_ty Eio.Path.t list
20
+
}
21
21
22
-
let ensure_dir path =
23
-
Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 path
22
+
let ensure_dir path = Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 path
24
23
25
24
let get_home_dir fs =
26
-
let home_str =
25
+
let home_str =
27
26
match Sys.getenv_opt "HOME" with
28
27
| Some home -> home
29
-
| None ->
30
-
match Sys.os_type with
31
-
| "Win32" | "Cygwin" ->
32
-
(match Sys.getenv_opt "USERPROFILE" with
33
-
| Some profile -> profile
34
-
| None -> failwith "Cannot determine home directory")
35
-
| _ ->
36
-
(try Unix.((getpwuid (getuid ())).pw_dir)
37
-
with _ -> failwith "Cannot determine home directory")
28
+
| None ->
29
+
(match Sys.os_type with
30
+
| "Win32" | "Cygwin" ->
31
+
(match Sys.getenv_opt "USERPROFILE" with
32
+
| Some profile -> profile
33
+
| None -> failwith "Cannot determine home directory")
34
+
| _ ->
35
+
(try Unix.((getpwuid (getuid ())).pw_dir) with
36
+
| _ -> failwith "Cannot determine home directory"))
38
37
in
39
38
Eio.Path.(fs / home_str)
39
+
;;
40
40
41
-
let make_env_var_name app_name suffix =
42
-
String.uppercase_ascii app_name ^ "_" ^ suffix
41
+
let make_env_var_name app_name suffix = String.uppercase_ascii app_name ^ "_" ^ suffix
43
42
44
43
let resolve_path fs home_path base_path =
45
-
if Filename.is_relative base_path then
46
-
Eio.Path.(home_path / base_path)
47
-
else
48
-
Eio.Path.(fs / base_path)
44
+
if Filename.is_relative base_path
45
+
then Eio.Path.(home_path / base_path)
46
+
else Eio.Path.(fs / base_path)
47
+
;;
49
48
50
49
(* Helper to resolve system directories (config_dirs or data_dirs) *)
51
50
let resolve_system_dirs fs home_path app_name override_suffix xdg_var default_paths =
52
51
let override_var = make_env_var_name app_name override_suffix in
53
52
match Sys.getenv_opt override_var with
54
-
| Some dirs when dirs <> "" ->
55
-
String.split_on_char ':' dirs
56
-
|> List.filter (fun s -> s <> "")
57
-
|> List.map (fun path -> Eio.Path.(resolve_path fs home_path path / app_name))
58
-
| Some _ | None ->
59
-
match Sys.getenv_opt xdg_var with
60
-
| Some dirs when dirs <> "" ->
61
-
String.split_on_char ':' dirs
62
-
|> List.filter (fun s -> s <> "")
63
-
|> List.map (fun path -> Eio.Path.(resolve_path fs home_path path / app_name))
64
-
| Some _ | None ->
65
-
List.map (fun path -> Eio.Path.(fs / path / app_name)) default_paths
53
+
| Some dirs when dirs <> "" ->
54
+
String.split_on_char ':' dirs
55
+
|> List.filter (fun s -> s <> "")
56
+
|> List.map (fun path -> Eio.Path.(resolve_path fs home_path path / app_name))
57
+
| Some _ | None ->
58
+
(match Sys.getenv_opt xdg_var with
59
+
| Some dirs when dirs <> "" ->
60
+
String.split_on_char ':' dirs
61
+
|> List.filter (fun s -> s <> "")
62
+
|> List.map (fun path -> Eio.Path.(resolve_path fs home_path path / app_name))
63
+
| Some _ | None ->
64
+
List.map (fun path -> Eio.Path.(fs / path / app_name)) default_paths)
65
+
;;
66
66
67
67
(* Helper to resolve a user directory with override precedence *)
68
68
let resolve_user_dir fs home_path app_name xdg_ctx xdg_getter override_suffix =
69
69
let override_var = make_env_var_name app_name override_suffix in
70
70
match Sys.getenv_opt override_var with
71
-
| Some dir when dir <> "" ->
72
-
(resolve_path fs home_path dir, Env override_var)
73
-
| Some _ | None ->
74
-
(Eio.Path.(fs / xdg_getter xdg_ctx / app_name), Default)
71
+
| Some dir when dir <> "" -> resolve_path fs home_path dir, Env override_var
72
+
| Some _ | None -> Eio.Path.(fs / xdg_getter xdg_ctx / app_name), Default
73
+
;;
75
74
76
75
(* Helper to resolve runtime directory (special case since it can be None) *)
77
76
let resolve_runtime_dir fs home_path app_name xdg_ctx =
78
77
let override_var = make_env_var_name app_name "RUNTIME_DIR" in
79
78
match Sys.getenv_opt override_var with
80
-
| Some dir when dir <> "" ->
81
-
(Some (resolve_path fs home_path dir), Env override_var)
82
-
| Some _ | None ->
83
-
(Option.map (fun base -> Eio.Path.(fs / base / app_name)) (Xdg.runtime_dir xdg_ctx), Default)
79
+
| Some dir when dir <> "" -> Some (resolve_path fs home_path dir), Env override_var
80
+
| Some _ | None ->
81
+
( Option.map (fun base -> Eio.Path.(fs / base / app_name)) (Xdg.runtime_dir xdg_ctx)
82
+
, Default )
83
+
;;
84
84
85
85
let create fs app_name =
86
86
let fs = fs in
87
87
let home_path = get_home_dir fs in
88
88
let xdg_ctx = Xdg.create ~env:Sys.getenv_opt () in
89
-
90
89
(* User directories *)
91
-
let (config_dir, config_dir_source) =
92
-
resolve_user_dir fs home_path app_name xdg_ctx Xdg.config_dir "CONFIG_DIR" in
93
-
let (data_dir, data_dir_source) =
94
-
resolve_user_dir fs home_path app_name xdg_ctx Xdg.data_dir "DATA_DIR" in
95
-
let (cache_dir, cache_dir_source) =
96
-
resolve_user_dir fs home_path app_name xdg_ctx Xdg.cache_dir "CACHE_DIR" in
97
-
let (state_dir, state_dir_source) =
98
-
resolve_user_dir fs home_path app_name xdg_ctx Xdg.state_dir "STATE_DIR" in
99
-
90
+
let config_dir, config_dir_source =
91
+
resolve_user_dir fs home_path app_name xdg_ctx Xdg.config_dir "CONFIG_DIR"
92
+
in
93
+
let data_dir, data_dir_source =
94
+
resolve_user_dir fs home_path app_name xdg_ctx Xdg.data_dir "DATA_DIR"
95
+
in
96
+
let cache_dir, cache_dir_source =
97
+
resolve_user_dir fs home_path app_name xdg_ctx Xdg.cache_dir "CACHE_DIR"
98
+
in
99
+
let state_dir, state_dir_source =
100
+
resolve_user_dir fs home_path app_name xdg_ctx Xdg.state_dir "STATE_DIR"
101
+
in
100
102
(* Runtime directory *)
101
-
let (runtime_dir, runtime_dir_source) =
102
-
resolve_runtime_dir fs home_path app_name xdg_ctx in
103
-
103
+
let runtime_dir, runtime_dir_source =
104
+
resolve_runtime_dir fs home_path app_name xdg_ctx
105
+
in
104
106
(* System directories *)
105
-
let config_dirs =
106
-
resolve_system_dirs fs home_path app_name "CONFIG_DIRS" "XDG_CONFIG_DIRS"
107
-
["/etc/xdg"] in
108
-
let data_dirs =
109
-
resolve_system_dirs fs home_path app_name "DATA_DIRS" "XDG_DATA_DIRS"
110
-
["/usr/local/share"; "/usr/share"] in
111
-
107
+
let config_dirs =
108
+
resolve_system_dirs
109
+
fs
110
+
home_path
111
+
app_name
112
+
"CONFIG_DIRS"
113
+
"XDG_CONFIG_DIRS"
114
+
[ "/etc/xdg" ]
115
+
in
116
+
let data_dirs =
117
+
resolve_system_dirs
118
+
fs
119
+
home_path
120
+
app_name
121
+
"DATA_DIRS"
122
+
"XDG_DATA_DIRS"
123
+
[ "/usr/local/share"; "/usr/share" ]
124
+
in
112
125
ensure_dir config_dir;
113
126
ensure_dir data_dir;
114
127
ensure_dir cache_dir;
115
128
ensure_dir state_dir;
116
129
Option.iter ensure_dir runtime_dir;
117
-
118
-
{ app_name; config_dir; config_dir_source; data_dir; data_dir_source;
119
-
cache_dir; cache_dir_source; state_dir; state_dir_source;
120
-
runtime_dir; runtime_dir_source; config_dirs; data_dirs }
130
+
{ app_name
131
+
; config_dir
132
+
; config_dir_source
133
+
; data_dir
134
+
; data_dir_source
135
+
; cache_dir
136
+
; cache_dir_source
137
+
; state_dir
138
+
; state_dir_source
139
+
; runtime_dir
140
+
; runtime_dir_source
141
+
; config_dirs
142
+
; data_dirs
143
+
}
144
+
;;
121
145
122
146
let app_name t = t.app_name
123
147
let config_dir t = t.config_dir
···
132
156
let path = Eio.Path.(base_dir / name) in
133
157
ensure_dir path;
134
158
path
159
+
;;
135
160
136
161
let config_path t name = subdir t.config_dir name
137
162
let data_path t name = subdir t.data_dir name
138
163
let cache_path t name = subdir t.cache_dir name
139
164
let state_path t name = subdir t.state_dir name
140
165
141
-
let pp ?(brief=false) ?(sources=false) ppf t =
166
+
let pp ?(brief = false) ?(sources = false) ppf t =
142
167
let pp_source ppf = function
143
168
| Default -> Fmt.(styled `Faint string) ppf "default"
144
169
| Env var -> Fmt.pf ppf "%a" Fmt.(styled `Yellow string) ("env(" ^ var ^ ")")
145
170
| Cmdline -> Fmt.(styled `Blue string) ppf "cmdline"
146
171
in
147
172
let pp_path_with_source ppf path source =
148
-
if sources then
149
-
Fmt.pf ppf "%a %a"
150
-
Fmt.(styled `Green Eio.Path.pp) path
151
-
Fmt.(styled `Faint (brackets pp_source)) source
152
-
else
153
-
Fmt.(styled `Green Eio.Path.pp) ppf path
173
+
if sources
174
+
then
175
+
Fmt.pf
176
+
ppf
177
+
"%a %a"
178
+
Fmt.(styled `Green Eio.Path.pp)
179
+
path
180
+
Fmt.(styled `Faint (brackets pp_source))
181
+
source
182
+
else Fmt.(styled `Green Eio.Path.pp) ppf path
154
183
in
155
184
let pp_path_opt_with_source ppf path_opt source =
156
185
match path_opt with
157
-
| None ->
158
-
if sources then
159
-
Fmt.pf ppf "%a %a"
160
-
Fmt.(styled `Red string) "<none>"
161
-
Fmt.(styled `Faint (brackets pp_source)) source
162
-
else
163
-
Fmt.(styled `Red string) ppf "<none>"
186
+
| None ->
187
+
if sources
188
+
then
189
+
Fmt.pf
190
+
ppf
191
+
"%a %a"
192
+
Fmt.(styled `Red string)
193
+
"<none>"
194
+
Fmt.(styled `Faint (brackets pp_source))
195
+
source
196
+
else Fmt.(styled `Red string) ppf "<none>"
164
197
| Some path -> pp_path_with_source ppf path source
165
198
in
166
199
let pp_paths ppf paths =
167
200
Fmt.(list ~sep:(any ";@ ") (styled `Green Eio.Path.pp)) ppf paths
168
201
in
169
-
if brief then
170
-
Fmt.pf ppf "%a config=%a data=%a>"
171
-
Fmt.(styled `Cyan string) ("<xdg:" ^ t.app_name)
172
-
(fun ppf (path, source) -> pp_path_with_source ppf path source) (t.config_dir, t.config_dir_source)
173
-
(fun ppf (path, source) -> pp_path_with_source ppf path source) (t.data_dir, t.data_dir_source)
202
+
if brief
203
+
then
204
+
Fmt.pf
205
+
ppf
206
+
"%a config=%a data=%a>"
207
+
Fmt.(styled `Cyan string)
208
+
("<xdg:" ^ t.app_name)
209
+
(fun ppf (path, source) -> pp_path_with_source ppf path source)
210
+
(t.config_dir, t.config_dir_source)
211
+
(fun ppf (path, source) -> pp_path_with_source ppf path source)
212
+
(t.data_dir, t.data_dir_source)
174
213
else (
175
-
Fmt.pf ppf "@[<v>%a@," Fmt.(styled `Bold string) ("XDG directories for '" ^ t.app_name ^ "':");
214
+
Fmt.pf
215
+
ppf
216
+
"@[<v>%a@,"
217
+
Fmt.(styled `Bold string)
218
+
("XDG directories for '" ^ t.app_name ^ "':");
176
219
Fmt.pf ppf "@[<v 2>%a@," Fmt.(styled `Bold string) "User directories:";
177
-
Fmt.pf ppf "%a %a@," Fmt.(styled `Cyan string) "config:" (fun ppf (path, source) -> pp_path_with_source ppf path source) (t.config_dir, t.config_dir_source);
178
-
Fmt.pf ppf "%a %a@," Fmt.(styled `Cyan string) "data:" (fun ppf (path, source) -> pp_path_with_source ppf path source) (t.data_dir, t.data_dir_source);
179
-
Fmt.pf ppf "%a %a@," Fmt.(styled `Cyan string) "cache:" (fun ppf (path, source) -> pp_path_with_source ppf path source) (t.cache_dir, t.cache_dir_source);
180
-
Fmt.pf ppf "%a %a@," Fmt.(styled `Cyan string) "state:" (fun ppf (path, source) -> pp_path_with_source ppf path source) (t.state_dir, t.state_dir_source);
181
-
Fmt.pf ppf "%a %a@]@," Fmt.(styled `Cyan string) "runtime:" (fun ppf (path_opt, source) -> pp_path_opt_with_source ppf path_opt source) (t.runtime_dir, t.runtime_dir_source);
220
+
Fmt.pf
221
+
ppf
222
+
"%a %a@,"
223
+
Fmt.(styled `Cyan string)
224
+
"config:"
225
+
(fun ppf (path, source) -> pp_path_with_source ppf path source)
226
+
(t.config_dir, t.config_dir_source);
227
+
Fmt.pf
228
+
ppf
229
+
"%a %a@,"
230
+
Fmt.(styled `Cyan string)
231
+
"data:"
232
+
(fun ppf (path, source) -> pp_path_with_source ppf path source)
233
+
(t.data_dir, t.data_dir_source);
234
+
Fmt.pf
235
+
ppf
236
+
"%a %a@,"
237
+
Fmt.(styled `Cyan string)
238
+
"cache:"
239
+
(fun ppf (path, source) -> pp_path_with_source ppf path source)
240
+
(t.cache_dir, t.cache_dir_source);
241
+
Fmt.pf
242
+
ppf
243
+
"%a %a@,"
244
+
Fmt.(styled `Cyan string)
245
+
"state:"
246
+
(fun ppf (path, source) -> pp_path_with_source ppf path source)
247
+
(t.state_dir, t.state_dir_source);
248
+
Fmt.pf
249
+
ppf
250
+
"%a %a@]@,"
251
+
Fmt.(styled `Cyan string)
252
+
"runtime:"
253
+
(fun ppf (path_opt, source) -> pp_path_opt_with_source ppf path_opt source)
254
+
(t.runtime_dir, t.runtime_dir_source);
182
255
Fmt.pf ppf "@[<v 2>%a@," Fmt.(styled `Bold string) "System directories:";
183
-
Fmt.pf ppf "%a [@[<hov>%a@]]@," Fmt.(styled `Cyan string) "config_dirs:" pp_paths t.config_dirs;
184
-
Fmt.pf ppf "%a [@[<hov>%a@]]@]@]" Fmt.(styled `Cyan string) "data_dirs:" pp_paths t.data_dirs
185
-
)
256
+
Fmt.pf
257
+
ppf
258
+
"%a [@[<hov>%a@]]@,"
259
+
Fmt.(styled `Cyan string)
260
+
"config_dirs:"
261
+
pp_paths
262
+
t.config_dirs;
263
+
Fmt.pf
264
+
ppf
265
+
"%a [@[<hov>%a@]]@]@]"
266
+
Fmt.(styled `Cyan string)
267
+
"data_dirs:"
268
+
pp_paths
269
+
t.data_dirs)
270
+
;;
186
271
187
272
module Cmd = struct
188
-
189
273
type xdg_t = t
190
-
191
-
type 'a with_source = {
192
-
value : 'a option;
193
-
source : source;
194
-
}
195
-
196
-
type t = {
197
-
config_dir : string with_source;
198
-
data_dir : string with_source;
199
-
cache_dir : string with_source;
200
-
state_dir : string with_source;
201
-
runtime_dir : string with_source;
202
-
}
203
-
274
+
275
+
type 'a with_source =
276
+
{ value : 'a option
277
+
; source : source
278
+
}
279
+
280
+
type t =
281
+
{ config_dir : string with_source
282
+
; data_dir : string with_source
283
+
; cache_dir : string with_source
284
+
; state_dir : string with_source
285
+
; runtime_dir : string with_source
286
+
}
287
+
204
288
let term app_name =
205
289
let open Cmdliner in
206
290
let app_upper = String.uppercase_ascii app_name in
207
-
208
291
let make_dir_arg name env_suffix xdg_var default_path =
209
292
let app_env = app_upper ^ "_" ^ env_suffix in
210
-
let doc =
293
+
let doc =
211
294
match default_path with
212
-
| Some path -> Printf.sprintf
295
+
| Some path ->
296
+
Printf.sprintf
213
297
"Override %s directory. Can also be set with %s or %s. Default: %s"
214
-
name app_env xdg_var path
215
-
| None -> Printf.sprintf
298
+
name
299
+
app_env
300
+
xdg_var
301
+
path
302
+
| None ->
303
+
Printf.sprintf
216
304
"Override %s directory. Can also be set with %s or %s. No default value."
217
-
name app_env xdg_var
305
+
name
306
+
app_env
307
+
xdg_var
308
+
in
309
+
let arg =
310
+
Arg.(value & opt (some string) None & info [ name ^ "-dir" ] ~docv:"DIR" ~doc)
218
311
in
219
-
let arg = Arg.(value & opt (some string) None &
220
-
info [name ^ "-dir"] ~docv:"DIR" ~doc) in
221
-
Term.(const (fun cmdline_val ->
222
-
match cmdline_val with
223
-
| Some v -> { value = Some v; source = Cmdline }
224
-
| None ->
225
-
begin match Sys.getenv_opt app_env with
226
-
| Some v when v <> "" ->
227
-
{ value = Some v; source = Env app_env }
228
-
| Some _ | None -> begin
229
-
match Sys.getenv_opt xdg_var with
230
-
| Some v ->
231
-
{ value = Some v; source = Env xdg_var }
232
-
| None ->
233
-
{ value = None; source = Default }
234
-
end
235
-
end
236
-
) $ arg)
312
+
Term.(
313
+
const (fun cmdline_val ->
314
+
match cmdline_val with
315
+
| Some v -> { value = Some v; source = Cmdline }
316
+
| None ->
317
+
(match Sys.getenv_opt app_env with
318
+
| Some v when v <> "" -> { value = Some v; source = Env app_env }
319
+
| Some _ | None ->
320
+
(match Sys.getenv_opt xdg_var with
321
+
| Some v -> { value = Some v; source = Env xdg_var }
322
+
| None -> { value = None; source = Default })))
323
+
$ arg)
237
324
in
238
-
239
325
let home_prefix = "~" in
240
-
let config_dir = make_dir_arg "config" "CONFIG_DIR" "XDG_CONFIG_HOME"
241
-
(Some (home_prefix ^ "/.config/" ^ app_name)) in
242
-
let data_dir = make_dir_arg "data" "DATA_DIR" "XDG_DATA_HOME"
243
-
(Some (home_prefix ^ "/.local/share/" ^ app_name)) in
244
-
let cache_dir = make_dir_arg "cache" "CACHE_DIR" "XDG_CACHE_HOME"
245
-
(Some (home_prefix ^ "/.cache/" ^ app_name)) in
246
-
let state_dir = make_dir_arg "state" "STATE_DIR" "XDG_STATE_HOME"
247
-
(Some (home_prefix ^ "/.local/state/" ^ app_name)) in
326
+
let config_dir =
327
+
make_dir_arg
328
+
"config"
329
+
"CONFIG_DIR"
330
+
"XDG_CONFIG_HOME"
331
+
(Some (home_prefix ^ "/.config/" ^ app_name))
332
+
in
333
+
let data_dir =
334
+
make_dir_arg
335
+
"data"
336
+
"DATA_DIR"
337
+
"XDG_DATA_HOME"
338
+
(Some (home_prefix ^ "/.local/share/" ^ app_name))
339
+
in
340
+
let cache_dir =
341
+
make_dir_arg
342
+
"cache"
343
+
"CACHE_DIR"
344
+
"XDG_CACHE_HOME"
345
+
(Some (home_prefix ^ "/.cache/" ^ app_name))
346
+
in
347
+
let state_dir =
348
+
make_dir_arg
349
+
"state"
350
+
"STATE_DIR"
351
+
"XDG_STATE_HOME"
352
+
(Some (home_prefix ^ "/.local/state/" ^ app_name))
353
+
in
248
354
let runtime_dir = make_dir_arg "runtime" "RUNTIME_DIR" "XDG_RUNTIME_DIR" None in
249
-
250
-
Term.(const (fun config_dir data_dir cache_dir state_dir runtime_dir ->
251
-
{ config_dir; data_dir; cache_dir; state_dir; runtime_dir })
252
-
$ config_dir $ data_dir $ cache_dir $ state_dir $ runtime_dir)
253
-
355
+
Term.(
356
+
const (fun config_dir data_dir cache_dir state_dir runtime_dir ->
357
+
{ config_dir; data_dir; cache_dir; state_dir; runtime_dir })
358
+
$ config_dir
359
+
$ data_dir
360
+
$ cache_dir
361
+
$ state_dir
362
+
$ runtime_dir)
363
+
;;
364
+
254
365
let of_t fs app_name config =
255
366
let fs = fs in
256
367
let home_path = get_home_dir fs in
257
368
let xdg_ctx = Xdg.create ~env:Sys.getenv_opt () in
258
-
259
369
(* Helper to resolve directory from config with source tracking *)
260
370
let resolve_from_config config_ws xdg_getter =
261
371
match config_ws.value with
262
-
| Some dir -> (resolve_path fs home_path dir, config_ws.source)
372
+
| Some dir -> resolve_path fs home_path dir, config_ws.source
263
373
| None ->
264
-
let xdg_base = xdg_getter xdg_ctx in
265
-
(Eio.Path.(fs / xdg_base / app_name), config_ws.source)
374
+
let xdg_base = xdg_getter xdg_ctx in
375
+
Eio.Path.(fs / xdg_base / app_name), config_ws.source
266
376
in
267
-
268
377
(* User directories *)
269
-
let (config_dir, config_dir_source) = resolve_from_config config.config_dir Xdg.config_dir in
270
-
let (data_dir, data_dir_source) = resolve_from_config config.data_dir Xdg.data_dir in
271
-
let (cache_dir, cache_dir_source) = resolve_from_config config.cache_dir Xdg.cache_dir in
272
-
let (state_dir, state_dir_source) = resolve_from_config config.state_dir Xdg.state_dir in
273
-
378
+
let config_dir, config_dir_source =
379
+
resolve_from_config config.config_dir Xdg.config_dir
380
+
in
381
+
let data_dir, data_dir_source = resolve_from_config config.data_dir Xdg.data_dir in
382
+
let cache_dir, cache_dir_source =
383
+
resolve_from_config config.cache_dir Xdg.cache_dir
384
+
in
385
+
let state_dir, state_dir_source =
386
+
resolve_from_config config.state_dir Xdg.state_dir
387
+
in
274
388
(* Runtime directory *)
275
-
let (runtime_dir, runtime_dir_source) =
389
+
let runtime_dir, runtime_dir_source =
276
390
match config.runtime_dir.value with
277
-
| Some dir -> (Some (resolve_path fs home_path dir), config.runtime_dir.source)
278
-
| None -> (Option.map (fun base -> Eio.Path.(fs / base / app_name)) (Xdg.runtime_dir xdg_ctx), config.runtime_dir.source)
391
+
| Some dir -> Some (resolve_path fs home_path dir), config.runtime_dir.source
392
+
| None ->
393
+
( Option.map
394
+
(fun base -> Eio.Path.(fs / base / app_name))
395
+
(Xdg.runtime_dir xdg_ctx)
396
+
, config.runtime_dir.source )
279
397
in
280
-
281
398
(* System directories - reuse shared helper *)
282
-
let config_dirs =
283
-
resolve_system_dirs fs home_path app_name "CONFIG_DIRS" "XDG_CONFIG_DIRS"
284
-
["/etc/xdg"] in
285
-
let data_dirs =
286
-
resolve_system_dirs fs home_path app_name "DATA_DIRS" "XDG_DATA_DIRS"
287
-
["/usr/local/share"; "/usr/share"] in
288
-
399
+
let config_dirs =
400
+
resolve_system_dirs
401
+
fs
402
+
home_path
403
+
app_name
404
+
"CONFIG_DIRS"
405
+
"XDG_CONFIG_DIRS"
406
+
[ "/etc/xdg" ]
407
+
in
408
+
let data_dirs =
409
+
resolve_system_dirs
410
+
fs
411
+
home_path
412
+
app_name
413
+
"DATA_DIRS"
414
+
"XDG_DATA_DIRS"
415
+
[ "/usr/local/share"; "/usr/share" ]
416
+
in
289
417
ensure_dir config_dir;
290
418
ensure_dir data_dir;
291
419
ensure_dir cache_dir;
292
420
ensure_dir state_dir;
293
421
Option.iter ensure_dir runtime_dir;
294
-
295
-
{ app_name; config_dir; config_dir_source; data_dir; data_dir_source;
296
-
cache_dir; cache_dir_source; state_dir; state_dir_source;
297
-
runtime_dir; runtime_dir_source; config_dirs; data_dirs }
298
-
422
+
{ app_name
423
+
; config_dir
424
+
; config_dir_source
425
+
; data_dir
426
+
; data_dir_source
427
+
; cache_dir
428
+
; cache_dir_source
429
+
; state_dir
430
+
; state_dir_source
431
+
; runtime_dir
432
+
; runtime_dir_source
433
+
; config_dirs
434
+
; data_dirs
435
+
}
436
+
;;
437
+
299
438
let env_docs app_name =
300
439
let app_upper = String.uppercase_ascii app_name in
301
-
Printf.sprintf {|
440
+
Printf.sprintf
441
+
{|
302
442
Configuration Precedence (follows standard Unix conventions):
303
443
1. Command-line flags (e.g., --config-dir) - highest priority
304
444
2. Application-specific environment variable (e.g., %s_CONFIG_DIR)
···
327
467
|}
328
468
app_upper
329
469
app_name
330
-
app_upper app_name
331
-
app_upper app_name
332
-
app_upper app_name
333
-
app_upper app_name
334
-
app_upper app_name
335
-
app_upper app_name
336
-
app_name app_name app_name app_name
337
-
app_name app_name app_name
338
-
470
+
app_upper
471
+
app_name
472
+
app_upper
473
+
app_name
474
+
app_upper
475
+
app_name
476
+
app_upper
477
+
app_name
478
+
app_upper
479
+
app_name
480
+
app_upper
481
+
app_name
482
+
app_name
483
+
app_name
484
+
app_name
485
+
app_name
486
+
app_name
487
+
app_name
488
+
app_name
489
+
;;
490
+
339
491
let pp ppf config =
340
492
let pp_source ppf = function
341
493
| Default -> Fmt.(styled `Faint string) ppf "default"
···
345
497
let pp_with_source name ppf ws =
346
498
match ws.value with
347
499
| None when ws.source = Default -> ()
348
-
| None -> Fmt.pf ppf "@,%a %a %a"
349
-
Fmt.(styled `Cyan string) (name ^ ":")
350
-
Fmt.(styled `Red string) "<unset>"
351
-
Fmt.(styled `Faint (brackets pp_source)) ws.source
352
-
| Some value -> Fmt.pf ppf "@,%a %a %a"
353
-
Fmt.(styled `Cyan string) (name ^ ":")
354
-
Fmt.(styled `Green string) value
355
-
Fmt.(styled `Faint (brackets pp_source)) ws.source
500
+
| None ->
501
+
Fmt.pf
502
+
ppf
503
+
"@,%a %a %a"
504
+
Fmt.(styled `Cyan string)
505
+
(name ^ ":")
506
+
Fmt.(styled `Red string)
507
+
"<unset>"
508
+
Fmt.(styled `Faint (brackets pp_source))
509
+
ws.source
510
+
| Some value ->
511
+
Fmt.pf
512
+
ppf
513
+
"@,%a %a %a"
514
+
Fmt.(styled `Cyan string)
515
+
(name ^ ":")
516
+
Fmt.(styled `Green string)
517
+
value
518
+
Fmt.(styled `Faint (brackets pp_source))
519
+
ws.source
356
520
in
357
-
Fmt.pf ppf "@[<v>%a%a%a%a%a%a@]"
358
-
Fmt.(styled `Bold string) "XDG config:"
359
-
(pp_with_source "config_dir") config.config_dir
360
-
(pp_with_source "data_dir") config.data_dir
361
-
(pp_with_source "cache_dir") config.cache_dir
362
-
(pp_with_source "state_dir") config.state_dir
363
-
(pp_with_source "runtime_dir") config.runtime_dir
521
+
Fmt.pf
522
+
ppf
523
+
"@[<v>%a%a%a%a%a%a@]"
524
+
Fmt.(styled `Bold string)
525
+
"XDG config:"
526
+
(pp_with_source "config_dir")
527
+
config.config_dir
528
+
(pp_with_source "data_dir")
529
+
config.data_dir
530
+
(pp_with_source "cache_dir")
531
+
config.cache_dir
532
+
(pp_with_source "state_dir")
533
+
config.state_dir
534
+
(pp_with_source "runtime_dir")
535
+
config.runtime_dir
536
+
;;
364
537
end
+21
-22
xdg-eio/lib/xdge.mli
+21
-22
xdg-eio/lib/xdge.mli
···
353
353
354
354
This type tracks the provenance of directory paths, which is useful for
355
355
debugging configuration issues and understanding which settings are in effect. *)
356
-
type source =
357
-
| Default (** XDG specification default value was used *)
358
-
| Env of string (** Set via environment variable (includes variable name) *)
359
-
| Cmdline (** Set via command-line argument *)
356
+
type source =
357
+
| Default (** XDG specification default value was used *)
358
+
| Env of string (** Set via environment variable (includes variable name) *)
359
+
| Cmdline (** Set via command-line argument *)
360
360
361
361
(** {1 Cmdliner Integration} *)
362
362
363
363
module Cmd : sig
364
-
365
364
(** The type of the outer XDG context *)
366
365
type xdg_t = t
367
366
(** Cmdliner integration for XDG directory configuration.
···
375
374
- Environment variable detection and precedence handling
376
375
- Source tracking for debugging configuration issues
377
376
- Pretty printing of configuration for --help output *)
378
-
377
+
379
378
(** A configuration value paired with information about its source.
380
379
381
380
This type tracks both the value (if any) and where it came from,
382
381
which is useful for debugging configuration issues. *)
383
-
type 'a with_source = {
384
-
value : 'a option; (** The configuration value, if set *)
385
-
source : source; (** Where the value came from *)
386
-
}
387
-
382
+
type 'a with_source =
383
+
{ value : 'a option (** The configuration value, if set *)
384
+
; source : source (** Where the value came from *)
385
+
}
386
+
388
387
(** Complete XDG configuration gathered from command-line and environment.
389
388
390
389
This record contains all XDG directory paths along with their sources,
391
390
as determined by command-line arguments and environment variables. *)
392
-
type t = {
393
-
config_dir : string with_source; (** Configuration directory path and source *)
394
-
data_dir : string with_source; (** Data directory path and source *)
395
-
cache_dir : string with_source; (** Cache directory path and source *)
396
-
state_dir : string with_source; (** State directory path and source *)
397
-
runtime_dir : string with_source; (** Runtime directory path and source *)
398
-
}
399
-
391
+
type t =
392
+
{ config_dir : string with_source (** Configuration directory path and source *)
393
+
; data_dir : string with_source (** Data directory path and source *)
394
+
; cache_dir : string with_source (** Cache directory path and source *)
395
+
; state_dir : string with_source (** State directory path and source *)
396
+
; runtime_dir : string with_source (** Runtime directory path and source *)
397
+
}
398
+
400
399
(** [term app_name] creates a Cmdliner term for XDG directory configuration.
401
400
402
401
This function generates a Cmdliner term that handles all XDG directory
···
426
425
(* ... *)
427
426
]} *)
428
427
val term : string -> t Cmdliner.Term.t
429
-
428
+
430
429
(** [of_t fs app_name config] creates an XDG context from Cmdliner configuration.
431
430
432
431
This function takes the configuration gathered by {!term} and creates
···
446
445
...
447
446
]} *)
448
447
val of_t : Eio.Fs.dir_ty Eio.Path.t -> string -> t -> xdg_t
449
-
448
+
450
449
(** [env_docs app_name] generates documentation for environment variables.
451
450
452
451
Returns a formatted string documenting all environment variables that
···
467
466
let env_section = Cmdliner.Cmd.Env.info (env_docs "myapp")
468
467
]} *)
469
468
val env_docs : string -> string
470
-
469
+
471
470
(** [pp ppf config] pretty prints a Cmdliner configuration.
472
471
473
472
This function formats the configuration showing each directory path