anil.recoil.org
The unpac monorepo manager self-hosting as a monorepo using unpac
More rearrangements.
+3
-3
README.md
+3
-3
README.md
···
2
-------------------------------------------------------------------------------
3
v%%VERSION%%
4
5
-
Fpath is an OCaml module for handling file system paths on POSIX and
6
-
Windows operating systems. Fpath processes paths without accessing the
7
-
file system and is independent from any system library.
8
9
Fpath depends on [Astring][astring] and is distributed under the ISC
10
license.
···
2
-------------------------------------------------------------------------------
3
v%%VERSION%%
4
5
+
Fpath is an OCaml module for handling file system paths with POSIX or
6
+
Windows conventions. Fpath processes paths without accessing the file
7
+
system and is independent from any system library.
8
9
Fpath depends on [Astring][astring] and is distributed under the ISC
10
license.
+230
-266
src/fpath.ml
+230
-266
src/fpath.ml
···
25
let dir_sep_char = if windows then '\\' else '/'
26
let dir_sep = String.of_char dir_sep_char
27
let dir_sep_sub = String.sub dir_sep
28
29
let dot = "."
30
let dot_sub = String.sub dot
···
35
let dotdot_dir = dotdot ^ dir_sep
36
let dotdot_dir_sub = String.sub dotdot_dir
37
38
-
(* Structural preliminaries *)
39
40
-
let validate_and_collapse_seps p =
41
-
(* collapse non-initial sequences of [dir_sep] to a single one and checks
42
-
no null byte *)
43
-
let max_idx = String.length p - 1 in
44
-
let rec with_buf b last_sep k i = (* k is the write index in b *)
45
-
if i > max_idx then Some (Bytes.sub_string b 0 k) else
46
-
let c = string_unsafe_get p i in
47
-
if c = '\x00' then None else
48
-
if c <> dir_sep_char
49
-
then (bytes_unsafe_set b k c; with_buf b false (k + 1) (i + 1)) else
50
-
if not last_sep
51
-
then (bytes_unsafe_set b k c; with_buf b true (k + 1) (i + 1)) else
52
-
with_buf b true k (i + 1)
53
-
in
54
-
let rec try_no_alloc last_sep i =
55
-
if i > max_idx then Some p else
56
-
let c = string_unsafe_get p i in
57
-
if c = '\x00' then None else
58
-
if c <> dir_sep_char then try_no_alloc false (i + 1) else
59
-
if not last_sep then try_no_alloc true (i + 1) else
60
-
let b = Bytes.of_string p in (* copy and overwrite starting from i *)
61
-
with_buf b true i (i + 1)
62
-
in
63
-
let start = (* Allow initial double sep *)
64
-
if max_idx > 0 then (if p.[0] = dir_sep_char then 1 else 0) else 0
65
-
in
66
-
try_no_alloc false start
67
68
-
let is_unc_path_windows p = String.is_prefix "\\\\" p
69
-
let windows_non_unc_path_start_index p =
70
-
match String.find (Char.equal ':') p with
71
| None -> 0
72
| Some i -> i + 1 (* exists by construction *)
73
74
-
let parse_unc_windows s =
75
-
(* parses an UNC path, the \\ prefix was already parsed, adds a root path
76
-
if there's only a volume, UNC paths are always absolute. *)
77
-
let p = String.sub ~start:2 s in
78
-
let not_bslash c = c <> '\\' in
79
-
let parse_seg p = String.Sub.span ~min:1 ~sat:not_bslash p in
80
-
let ensure_root r = Some (if String.Sub.is_empty r then (s ^ "\\") else s) in
81
-
match parse_seg p with
82
-
| (seg1, _) when String.Sub.is_empty seg1 -> None (* \\ or \\\ *)
83
-
| (seg1, rest) ->
84
-
let seg1_len = String.Sub.length seg1 in
85
-
match String.Sub.get_head ~rev:true seg1 with
86
-
| '.' when seg1_len = 1 -> (* \\.\device\ *)
87
-
begin match parse_seg (String.Sub.tail rest) with
88
-
| (seg, _) when String.Sub.is_empty seg -> None
89
-
| (_, rest) -> ensure_root rest
90
-
end
91
-
| '?' when seg1_len = 1 ->
92
-
begin match parse_seg (String.Sub.tail rest) with
93
-
| (seg2, _) when String.Sub.is_empty seg2 -> None
94
-
| (seg2, rest) ->
95
-
if (String.Sub.get_head ~rev:true seg2 = ':') (* \\?\drive:\ *)
96
-
then (ensure_root rest) else
97
-
if not (String.Sub.equal_bytes seg2 (String.sub "UNC"))
98
-
then begin (* \\?\server\share\ *)
99
-
match parse_seg (String.Sub.tail rest) with
100
-
| (seg, _) when String.Sub.is_empty seg -> None
101
-
| (_, rest) -> ensure_root rest
102
-
end else begin (* \\?\UNC\server\share\ *)
103
-
match parse_seg (String.Sub.tail rest) with
104
-
| (seg, _) when String.Sub.is_empty seg -> None
105
-
| (_, rest) ->
106
-
match parse_seg (String.Sub.tail rest) with
107
-
| (seg, _) when String.Sub.is_empty seg -> None
108
-
| (_, rest) -> ensure_root rest
109
-
end
110
-
end
111
-
| _ -> (* \\server\share\ *)
112
-
begin match parse_seg (String.Sub.tail rest) with
113
-
| (seg, _) when String.Sub.is_empty seg -> None
114
-
| (_, rest) -> ensure_root rest
115
-
end
116
117
-
let sub_split_volume_windows p =
118
-
(* splits a windows path into its volume (or drive) and actual file
119
-
path. When called the path in [p] is guaranteed to be non empty
120
-
and if [p] is an UNC path it is guaranteed to the be parseable by
121
-
parse_unc_windows. *)
122
-
let split_before i = String.sub p ~stop:i, String.sub p ~start:i in
123
-
if not (is_unc_path_windows p) then
124
-
begin match String.find (Char.equal ':') p with
125
-
| None -> String.Sub.empty, String.sub p
126
-
| Some i -> split_before (i + 1)
127
-
end
128
-
else
129
-
let bslash ~start = match String.find ~start (Char.equal '\\') p with
130
-
| None -> assert false | Some i -> i
131
-
in
132
-
let i = bslash ~start:2 in
133
-
let j = bslash ~start:(i + 1) in
134
-
match p.[i-1] with
135
-
| '.' when i = 3 -> split_before j
136
-
| '?' when i = 3 ->
137
-
if p.[j-1] = ':' then split_before j else
138
-
if (String.Sub.equal_bytes
139
-
(String.sub p ~start:(i + 1) ~stop:j)
140
-
(String.sub "UNC"))
141
-
then split_before (bslash ~start:((bslash ~start:(j + 1)) + 1))
142
else split_before (bslash ~start:(j + 1))
143
-
| _ -> split_before j
144
145
-
let is_root_posix p = String.equal p dir_sep || String.equal p "//"
146
-
let is_root_windows p =
147
-
let _, p = sub_split_volume_windows p in
148
-
String.Sub.equal_bytes dir_sep_sub p
149
150
(* Segments *)
151
···
159
160
let is_seg = if windows then is_seg_windows else is_seg_posix
161
162
-
let not_dir_sep c = c <> dir_sep_char
163
-
164
let _split_last_seg p = String.Sub.span ~rev:true ~sat:not_dir_sep p
165
let _sub_last_seg p = String.Sub.take ~rev:true ~sat:not_dir_sep p
166
-
let sub_last_seg_windows p = _sub_last_seg (snd (sub_split_volume_windows p))
167
-
let sub_last_seg_posix p = _sub_last_seg (String.sub p)
168
-
let sub_last_seg = if windows then sub_last_seg_windows else sub_last_seg_posix
169
-
170
-
let _sub_last_non_empty_seg p = (* result is empty only roots *)
171
let dir, last = _split_last_seg p in
172
match String.Sub.is_empty last with
173
| false -> last
174
| true -> _sub_last_seg (String.Sub.tail ~rev:true dir)
175
176
let sub_last_non_empty_seg_windows p =
177
-
_sub_last_non_empty_seg (snd (sub_split_volume_windows p))
178
179
let sub_last_non_empty_seg_posix p =
180
_sub_last_non_empty_seg (String.sub p)
···
183
if windows then sub_last_non_empty_seg_windows else
184
sub_last_non_empty_seg_posix
185
186
-
let _split_last_non_empty_seg p =
187
-
let (dir, last_seg as r) = _split_last_seg p in
188
-
match String.Sub.is_empty last_seg with
189
-
| false -> r, true
190
-
| true -> _split_last_seg (String.Sub.tail ~rev:true dir), false
191
-
192
-
let seg_is_rel = function "." | ".." -> true | _ -> false
193
-
let sub_seg_is_rel seg =
194
String.Sub.(equal_bytes dot_sub seg || equal_bytes dotdot_sub seg)
195
196
(* File paths *)
197
198
type t = string (* N.B. a path is never "" or something is wrooong. *)
199
200
let of_string_windows p =
201
if p = "" then None else
···
203
match validate_and_collapse_seps p with
204
| None -> None
205
| Some p as some ->
206
-
if is_unc_path_windows p then parse_unc_windows p else
207
match String.find (Char.equal ':') p with
208
| None -> some
209
-
| Some i -> if i = String.length p - 1 then None else (Some p)
210
211
let of_string_posix p = if p = "" then None else validate_and_collapse_seps p
212
let of_string = if windows then of_string_windows else of_string_posix
···
218
let add_seg p seg =
219
if not (is_seg seg) then invalid_arg (err_invalid_seg seg);
220
let sep = if p.[String.length p - 1] = dir_sep_char then "" else dir_sep in
221
-
String.concat [p; sep; seg]
222
223
let append_posix p0 p1 =
224
if p1.[0] = dir_sep_char (* absolute *) then p1 else
225
let sep = if p0.[String.length p0 - 1] = dir_sep_char then "" else dir_sep in
226
-
String.concat [p0; sep; p1]
227
228
let append_windows p0 p1 =
229
-
if is_unc_path_windows p1 then p1 else
230
-
match String.find (Char.equal ':') p1 with
231
-
| Some _ (* drive *) -> p1
232
-
| None ->
233
-
if p1.[0] = dir_sep_char then (* absolute *) p1 else
234
-
let sep =
235
-
if p0.[String.length p0 - 1] = dir_sep_char then "" else dir_sep
236
-
in
237
-
String.concat [p0; sep; p1]
238
239
let append = if windows then append_windows else append_posix
240
···
242
let ( // ) = append
243
244
let split_volume_windows p =
245
-
let vol, path = sub_split_volume_windows p in
246
String.Sub.to_string vol, String.Sub.to_string path
247
248
let split_volume_posix p =
249
-
if String.is_prefix "//" p then dir_sep, String.with_range ~first:1 p else
250
-
"", p
251
252
let split_volume = if windows then split_volume_windows else split_volume_posix
253
254
let segs_windows p =
255
-
let _, path = sub_split_volume_windows p in
256
-
let path = String.Sub.to_string path in
257
-
String.cuts ~sep:dir_sep path
258
259
let segs_posix p =
260
-
let segs = String.cuts ~sep:dir_sep p in
261
-
if String.is_prefix "//" p then List.tl segs else segs
262
263
let segs = if windows then segs_windows else segs_posix
264
···
279
280
(* Base and parent paths *)
281
282
-
let split_base_windows p =
283
-
let vol, path = sub_split_volume_windows p in
284
-
if String.Sub.equal_bytes dir_sep_sub path then (* root *) p, dot_dir else
285
-
let dir, last_seg = _split_last_seg path in
286
match String.Sub.is_empty dir with
287
-
| true -> (* single seg *)
288
-
String.Sub.base_string (String.Sub.append vol dot_dir_sub),
289
-
String.Sub.to_string path
290
| false ->
291
match String.Sub.is_empty last_seg with
292
-
| false ->
293
-
String.Sub.base_string (String.Sub.append vol dir),
294
-
String.Sub.to_string last_seg
295
| true ->
296
let dir_file = String.Sub.tail ~rev:true dir in
297
let dir, dir_last_seg = _split_last_seg dir_file in
298
match String.Sub.is_empty dir with
299
-
| true ->
300
-
String.Sub.base_string (String.Sub.append vol dot_dir_sub),
301
-
String.Sub.to_string path
302
-
| false ->
303
-
String.Sub.base_string (String.Sub.append vol dir),
304
-
String.Sub.to_string (String.Sub.extend dir_last_seg)
305
306
let split_base_posix p =
307
-
if is_root_posix p then p, dot_dir else
308
-
let dir, last_seg = _split_last_seg (String.sub p) in
309
-
match String.Sub.is_empty dir with
310
-
| true -> (* single seg *) dot_dir, p
311
-
| false ->
312
-
match String.Sub.is_empty last_seg with
313
-
| false -> String.Sub.to_string dir, String.Sub.to_string last_seg
314
-
| true ->
315
-
let dir_file = String.Sub.tail ~rev:true dir in
316
-
let dir, dir_last_seg = _split_last_seg dir_file in
317
-
match String.Sub.is_empty dir with
318
-
| true -> dot_dir, p
319
-
| false ->
320
-
String.Sub.to_string dir,
321
-
String.Sub.to_string (String.Sub.extend dir_last_seg)
322
323
let split_base = if windows then split_base_windows else split_base_posix
324
325
let base p = snd (split_base p)
326
327
-
let basename_windows p =
328
-
let vol, path = sub_split_volume_windows p in
329
-
if String.Sub.equal_bytes dir_sep_sub path then (* root *) "" else
330
-
let basename =
331
-
let dir, last_seg = _split_last_seg path in
332
-
match String.Sub.is_empty dir with
333
-
| true -> (* single seg *) String.Sub.to_string path
334
-
| false ->
335
-
match String.Sub.is_empty last_seg with
336
-
| false -> String.Sub.to_string last_seg
337
-
| true ->
338
-
let dir_file = String.Sub.tail ~rev:true dir in
339
-
let _, dir_last_seg = _split_last_seg dir_file in
340
-
String.Sub.to_string dir_last_seg
341
-
in
342
-
match basename with "." | ".." -> "" | basename -> basename
343
344
-
let basename_posix p =
345
-
if p = dir_sep || p = "//" then (* root *) "" else
346
-
let basename =
347
-
let dir, last_seg = _split_last_seg (String.sub p) in
348
-
match String.Sub.is_empty dir with
349
-
| true -> (* single seg *) p
350
-
| false ->
351
-
match String.Sub.is_empty last_seg with
352
-
| false -> String.Sub.to_string last_seg
353
-
| true ->
354
-
let dir_file = String.Sub.tail ~rev:true dir in
355
-
let _, dir_last_seg = _split_last_seg dir_file in
356
-
String.Sub.to_string dir_last_seg
357
-
in
358
-
match basename with "." | ".." -> "" | basename -> basename
359
360
let basename p = if windows then basename_windows p else basename_posix p
361
362
-
(* The parent algorithm is not very smart. It tries not to preserve
363
-
the original path and avoids dealing with normalization. We simply
364
-
remove everyting (i.e. a potential "") after the last non-empty,
365
-
non-relative, path segment and if the resulting path is empty we
366
-
return "./". If the last non-empty segment is "." or ".." we then
367
-
simply postfix "../" *)
368
-
369
let _parent p =
370
let (dir, seg), is_last = _split_last_non_empty_seg p in
371
let dsep = if is_last then dir_sep_sub else String.Sub.empty in
372
-
match String.Sub.is_empty dir with
373
-
| true ->
374
-
if sub_seg_is_rel seg then [p; dsep; dotdot_dir_sub] else [dot_dir_sub]
375
-
| false ->
376
-
if sub_seg_is_rel seg then [p; dsep; dotdot_dir_sub] else [dir]
377
378
let parent_windows p =
379
-
let vol, path = sub_split_volume_windows p in
380
-
if String.Sub.equal_bytes dir_sep_sub path then (* root *) p else
381
String.Sub.(base_string @@ concat (vol :: _parent path))
382
383
let parent_posix p =
384
-
if is_root_posix p then p else
385
String.Sub.(base_string @@ concat (_parent (String.sub p)))
386
387
let parent = if windows then parent_windows else parent_posix
···
389
(* Normalization *)
390
391
let rem_empty_seg_windows p =
392
-
let vol, path = sub_split_volume_windows p in
393
-
if String.Sub.equal_bytes dir_sep_sub path then (* root *) p else
394
-
let dir, last_seg = _split_last_seg path in
395
-
if not (String.Sub.is_empty last_seg) then p else
396
-
let p = String.Sub.tail ~rev:true dir in
397
-
String.Sub.(base_string @@ concat [vol; p])
398
399
let rem_empty_seg_posix p = match String.length p with
400
| 1 -> p
···
410
let rem_empty_seg =
411
if windows then rem_empty_seg_windows else rem_empty_seg_posix
412
413
-
let normalize_rel_segs_rev segs =
414
let rec loop acc = function
415
| "." :: [] -> ("" :: acc) (* final "." remove but preserve directoryness. *)
416
| "." :: rest -> loop acc rest
···
426
| [] ->
427
match acc with
428
| ".." :: _ -> ("" :: acc) (* normalize final .. to ../ *)
429
| acc -> acc
430
in
431
-
loop [] segs
432
433
let normalize_segs = function
434
| "" :: segs -> (* absolute path *)
435
-
let rec rem_dotdots = function
436
-
| ".." :: segs -> rem_dotdots segs
437
-
| [] -> [""]
438
-
| segs -> segs
439
-
in
440
-
"" :: (rem_dotdots (List.rev (normalize_rel_segs_rev segs)))
441
| segs ->
442
-
match List.rev (normalize_rel_segs_rev segs) with
443
-
| [] | [""] -> ["."; ""]
444
| segs -> segs
445
446
let normalize_windows p =
447
-
let vol, path = sub_split_volume_windows p in
448
let path = String.Sub.to_string path in
449
-
let segs = normalize_segs (String.cuts ~sep:dir_sep path) in
450
-
let path = String.concat ~sep:dir_sep segs in
451
String.Sub.(to_string (concat [vol; String.sub path]))
452
453
let normalize_posix p =
454
-
let segs = String.cuts ~sep:dir_sep p in
455
-
let has_volume = String.is_prefix "//" p in
456
-
let segs = normalize_segs (if has_volume then List.tl segs else segs) in
457
let segs = if has_volume then "" :: segs else segs in
458
-
String.concat ~sep:dir_sep segs
459
460
let normalize = if windows then normalize_windows else normalize_posix
461
···
469
starts with a directory separator. *)
470
let suff_start = String.length prefix in
471
if prefix.[suff_start - 1] = dir_sep_char then true else
472
-
if suff_start = String.length p then true else
473
p.[suff_start] = dir_sep_char
474
475
-
let seg_prefix_last_index p0 p1 =
476
-
(* Warning doesn't care about volumes *)
477
let l0 = String.length p0 in
478
let l1 = String.length p1 in
479
let p0, p1, max = if l0 < l1 then p0, p1, l0 - 1 else p1, p0, l1 - 1 in
···
495
in
496
loop (-1) 0 p0 p1
497
498
-
let find_prefix_windows p0 p1 = match seg_prefix_last_index p0 p1 with
499
| None -> None
500
| Some i ->
501
-
let v0_len = String.Sub.length (fst (sub_split_volume_windows p0)) in
502
-
let v1_len = String.Sub.length (fst (sub_split_volume_windows p1)) in
503
-
let vmax = if v0_len > v1_len then v0_len else v1_len in
504
-
if i < vmax then None else
505
-
Some (String.with_index_range p0 ~last:i)
506
507
-
let find_prefix_posix p0 p1 = match seg_prefix_last_index p0 p1 with
508
| None -> None
509
-
| Some 0 when String.is_prefix "//" p0 || String.is_prefix "//" p1 -> None
510
| Some i -> Some (String.with_index_range p0 ~last:i)
511
512
let find_prefix = if windows then find_prefix_windows else find_prefix_posix
···
529
let prooted = normalize (append root p) in
530
if is_prefix nroot prooted then Some prooted else None
531
532
-
let relativize ~root p =
533
let root = (* root is always interpreted as a directory *)
534
let root = normalize root in
535
if root.[String.length root - 1] = dir_sep_char then root else
···
548
| [""], [""] ->
549
(* walk ends at the end of both path simultaneously, [p] is a
550
directory that matches exactly [root] expressed as a directory. *)
551
-
Some ["."; ""]
552
| root, p ->
553
(* walk ends here, either the next directory is different in
554
[root] and [p] or it is equal but it is the last one for [p]
···
559
from the current position we just use [p] so prepending
560
length root - 1 .. segments to [p] tells us how to go from
561
the remaining root to [p]. *)
562
-
Some (List.fold_left (fun acc _ -> dotdot :: acc) p (List.tl root))
563
in
564
match segs root, segs p with
565
| ("" :: _, s :: _)
···
568
None
569
| ["."; ""], p ->
570
(* p is relative and expressed w.r.t. "./", so it is itself. *)
571
-
Some p
572
| root, p ->
573
(* walk in the segments of root and p until a segment mismatches.
574
at that point express the remaining p relative to the remaining
···
577
final "" segment. *)
578
walk root p
579
580
-
let relativize ~root p = match relativize ~root p with
581
-
| None -> None
582
-
| Some segs -> Some (String.concat ~sep:dir_sep segs)
583
584
(* Predicates and comparison *)
585
586
let is_rel_posix p = p.[0] <> dir_sep_char
587
let is_rel_windows p =
588
-
if is_unc_path_windows p then false else
589
-
p.[windows_non_unc_path_start_index p] <> dir_sep_char
590
591
let is_rel = if windows then is_rel_windows else is_rel_posix
592
let is_abs p = not (is_rel p)
593
-
let is_root = if windows then is_root_windows else is_root_posix
594
595
let is_current_dir_posix p = String.equal p dot || String.equal p dot_dir
596
let is_current_dir_windows p =
597
-
if is_unc_path_windows p then false else
598
-
let start = windows_non_unc_path_start_index p in
599
match String.length p - start with
600
| 1 -> p.[start] = '.'
601
| 2 -> p.[start] = '.' && p.[start + 1] = dir_sep_char
···
639
if multi then multi_ext_sub seg else single_ext_sub seg
640
641
let get_ext ?multi p =
642
-
String.Sub.to_string (ext_sub ?multi (sub_last_seg p))
643
644
let has_ext e p =
645
-
let seg = String.Sub.drop ~sat:eq_ext_sep (sub_last_seg p) in
646
if not (String.Sub.is_suffix (String.sub e) seg) then false else
647
if not (String.is_empty e) && e.[0] = ext_sep_char then true else
648
(* check there's a dot before the suffix in [seg] *)
···
651
String.Sub.get seg dot_index = ext_sep_char
652
653
let ext_exists ?(multi = false) p =
654
-
let ext = ext_sub ~multi (sub_last_seg p) in
655
if not multi then not (String.Sub.is_empty ext) else
656
if String.Sub.is_empty ext then false else
657
match String.Sub.find ~rev:true eq_ext_sep ext with (* find another dot *)
···
25
let dir_sep_char = if windows then '\\' else '/'
26
let dir_sep = String.of_char dir_sep_char
27
let dir_sep_sub = String.sub dir_sep
28
+
let not_dir_sep c = c <> dir_sep_char
29
30
let dot = "."
31
let dot_sub = String.sub dot
···
36
let dotdot_dir = dotdot ^ dir_sep
37
let dotdot_dir_sub = String.sub dotdot_dir
38
39
+
(* Platform specific preliminaties *)
40
41
+
module Windows = struct
42
43
+
let is_unc_path p = String.is_prefix "\\\\" p
44
+
let has_drive p = String.exists (Char.equal ':') p
45
+
let non_unc_path_start p = match String.find (Char.equal ':') p with
46
| None -> 0
47
| Some i -> i + 1 (* exists by construction *)
48
49
+
let parse_unc s =
50
+
(* parses an UNC path, the \\ prefix was already parsed, adds a root path
51
+
if there's only a volume, UNC paths are always absolute. *)
52
+
let p = String.sub ~start:2 s in
53
+
let not_bslash c = c <> '\\' in
54
+
let parse_seg p = String.Sub.span ~min:1 ~sat:not_bslash p in
55
+
let ensure_root r = Some (if String.Sub.is_empty r then (s ^ "\\") else s)
56
+
in
57
+
match parse_seg p with
58
+
| (seg1, _) when String.Sub.is_empty seg1 -> None (* \\ or \\\ *)
59
+
| (seg1, rest) ->
60
+
let seg1_len = String.Sub.length seg1 in
61
+
match String.Sub.get_head ~rev:true seg1 with
62
+
| '.' when seg1_len = 1 -> (* \\.\device\ *)
63
+
begin match parse_seg (String.Sub.tail rest) with
64
+
| (seg, _) when String.Sub.is_empty seg -> None
65
+
| (_, rest) -> ensure_root rest
66
+
end
67
+
| '?' when seg1_len = 1 ->
68
+
begin match parse_seg (String.Sub.tail rest) with
69
+
| (seg2, _) when String.Sub.is_empty seg2 -> None
70
+
| (seg2, rest) ->
71
+
if (String.Sub.get_head ~rev:true seg2 = ':') (* \\?\drive:\ *)
72
+
then (ensure_root rest) else
73
+
if not (String.Sub.equal_bytes seg2 (String.sub "UNC"))
74
+
then begin (* \\?\server\share\ *)
75
+
match parse_seg (String.Sub.tail rest) with
76
+
| (seg, _) when String.Sub.is_empty seg -> None
77
+
| (_, rest) -> ensure_root rest
78
+
end else begin (* \\?\UNC\server\share\ *)
79
+
match parse_seg (String.Sub.tail rest) with
80
+
| (seg, _) when String.Sub.is_empty seg -> None
81
+
| (_, rest) ->
82
+
match parse_seg (String.Sub.tail rest) with
83
+
| (seg, _) when String.Sub.is_empty seg -> None
84
+
| (_, rest) -> ensure_root rest
85
+
end
86
+
end
87
+
| _ -> (* \\server\share\ *)
88
+
begin match parse_seg (String.Sub.tail rest) with
89
+
| (seg, _) when String.Sub.is_empty seg -> None
90
+
| (_, rest) -> ensure_root rest
91
+
end
92
93
+
let sub_split_volume p =
94
+
(* splits a windows path into its volume (or drive) and actual file
95
+
path. When called the path in [p] is guaranteed to be non empty
96
+
and if [p] is an UNC path it is guaranteed to the be parseable by
97
+
parse_unc_windows. *)
98
+
let split_before i = String.sub p ~stop:i, String.sub p ~start:i in
99
+
if not (is_unc_path p) then
100
+
begin match String.find (Char.equal ':') p with
101
+
| None -> String.Sub.empty, String.sub p
102
+
| Some i -> split_before (i + 1)
103
+
end
104
+
else
105
+
let bslash ~start = match String.find ~start (Char.equal '\\') p with
106
+
| None -> assert false | Some i -> i
107
+
in
108
+
let i = bslash ~start:2 in
109
+
let j = bslash ~start:(i + 1) in
110
+
match p.[i-1] with
111
+
| '.' when i = 3 -> split_before j
112
+
| '?' when i = 3 ->
113
+
if p.[j-1] = ':' then split_before j else
114
+
if (String.Sub.equal_bytes
115
+
(String.sub p ~start:(i + 1) ~stop:j)
116
+
(String.sub "UNC"))
117
+
then split_before (bslash ~start:((bslash ~start:(j + 1)) + 1))
118
else split_before (bslash ~start:(j + 1))
119
+
| _ -> split_before j
120
121
+
let is_root p =
122
+
let _, p = sub_split_volume p in
123
+
String.Sub.get_head p = dir_sep_char
124
+
end
125
+
126
+
module Posix = struct
127
+
let has_volume p = String.is_prefix "//" p
128
+
let is_root p = String.equal p dir_sep || String.equal p "//"
129
+
end
130
131
(* Segments *)
132
···
140
141
let is_seg = if windows then is_seg_windows else is_seg_posix
142
143
let _split_last_seg p = String.Sub.span ~rev:true ~sat:not_dir_sep p
144
let _sub_last_seg p = String.Sub.take ~rev:true ~sat:not_dir_sep p
145
+
let _sub_last_non_empty_seg p = (* returns empty on roots though *)
146
let dir, last = _split_last_seg p in
147
match String.Sub.is_empty last with
148
| false -> last
149
| true -> _sub_last_seg (String.Sub.tail ~rev:true dir)
150
151
+
let _split_last_non_empty_seg p =
152
+
let (dir, last_seg as r) = _split_last_seg p in
153
+
match String.Sub.is_empty last_seg with
154
+
| false -> r, true
155
+
| true -> _split_last_seg (String.Sub.tail ~rev:true dir), false
156
+
157
+
let sub_last_seg_windows p = _sub_last_seg (snd (Windows.sub_split_volume p))
158
+
let sub_last_seg_posix p = _sub_last_seg (String.sub p)
159
+
let sub_last_seg = if windows then sub_last_seg_windows else sub_last_seg_posix
160
+
161
let sub_last_non_empty_seg_windows p =
162
+
_sub_last_non_empty_seg (snd (Windows.sub_split_volume p))
163
164
let sub_last_non_empty_seg_posix p =
165
_sub_last_non_empty_seg (String.sub p)
···
168
if windows then sub_last_non_empty_seg_windows else
169
sub_last_non_empty_seg_posix
170
171
+
let is_rel_seg = function "." | ".." -> true | _ -> false
172
+
let sub_is_rel_seg seg =
173
String.Sub.(equal_bytes dot_sub seg || equal_bytes dotdot_sub seg)
174
175
+
let segs_of_path p = String.cuts ~sep:dir_sep p
176
+
let segs_to_path segs = String.concat ~sep:dir_sep segs
177
+
178
(* File paths *)
179
180
type t = string (* N.B. a path is never "" or something is wrooong. *)
181
+
182
+
let validate_and_collapse_seps p =
183
+
(* collapse non-initial sequences of [dir_sep] to a single one and checks
184
+
no null byte *)
185
+
let max_idx = String.length p - 1 in
186
+
let rec with_buf b last_sep k i = (* k is the write index in b *)
187
+
if i > max_idx then Some (Bytes.sub_string b 0 k) else
188
+
let c = string_unsafe_get p i in
189
+
if c = '\x00' then None else
190
+
if c <> dir_sep_char
191
+
then (bytes_unsafe_set b k c; with_buf b false (k + 1) (i + 1)) else
192
+
if not last_sep
193
+
then (bytes_unsafe_set b k c; with_buf b true (k + 1) (i + 1)) else
194
+
with_buf b true k (i + 1)
195
+
in
196
+
let rec try_no_alloc last_sep i =
197
+
if i > max_idx then Some p else
198
+
let c = string_unsafe_get p i in
199
+
if c = '\x00' then None else
200
+
if c <> dir_sep_char then try_no_alloc false (i + 1) else
201
+
if not last_sep then try_no_alloc true (i + 1) else
202
+
let b = Bytes.of_string p in (* copy and overwrite starting from i *)
203
+
with_buf b true i (i + 1)
204
+
in
205
+
let start = (* Allow initial double sep for POSIX and UNC paths *)
206
+
if max_idx > 0 then (if p.[0] = dir_sep_char then 1 else 0) else 0
207
+
in
208
+
try_no_alloc false start
209
210
let of_string_windows p =
211
if p = "" then None else
···
213
match validate_and_collapse_seps p with
214
| None -> None
215
| Some p as some ->
216
+
if Windows.is_unc_path p then Windows.parse_unc p else
217
match String.find (Char.equal ':') p with
218
| None -> some
219
+
| Some i when i = String.length p - 1 -> None (* path is empty *)
220
+
| Some _ -> Some p
221
222
let of_string_posix p = if p = "" then None else validate_and_collapse_seps p
223
let of_string = if windows then of_string_windows else of_string_posix
···
229
let add_seg p seg =
230
if not (is_seg seg) then invalid_arg (err_invalid_seg seg);
231
let sep = if p.[String.length p - 1] = dir_sep_char then "" else dir_sep in
232
+
String.concat ~sep [p; seg]
233
234
let append_posix p0 p1 =
235
if p1.[0] = dir_sep_char (* absolute *) then p1 else
236
let sep = if p0.[String.length p0 - 1] = dir_sep_char then "" else dir_sep in
237
+
String.concat ~sep [p0; p1]
238
239
let append_windows p0 p1 =
240
+
if Windows.is_unc_path p1 || Windows.has_drive p1 then p1 else
241
+
if p1.[0] = dir_sep_char then (* absolute *) p1 else
242
+
let sep = if p0.[String.length p0 - 1] = dir_sep_char then "" else dir_sep in
243
+
String.concat ~sep [p0; p1]
244
245
let append = if windows then append_windows else append_posix
246
···
248
let ( // ) = append
249
250
let split_volume_windows p =
251
+
let vol, path = Windows.sub_split_volume p in
252
String.Sub.to_string vol, String.Sub.to_string path
253
254
let split_volume_posix p =
255
+
if Posix.has_volume p then dir_sep, String.with_range ~first:1 p else "", p
256
257
let split_volume = if windows then split_volume_windows else split_volume_posix
258
259
let segs_windows p =
260
+
let _, path = Windows.sub_split_volume p in
261
+
segs_of_path (String.Sub.to_string path)
262
263
let segs_posix p =
264
+
let segs = segs_of_path p in
265
+
if Posix.has_volume p then List.tl segs else segs
266
267
let segs = if windows then segs_windows else segs_posix
268
···
283
284
(* Base and parent paths *)
285
286
+
let sub_is_root p = String.Sub.get_head p = dir_sep_char
287
+
288
+
let _split_base p =
289
+
let dir, last_seg = _split_last_seg p in
290
match String.Sub.is_empty dir with
291
+
| true -> (* single seg *) dot_dir_sub, String.Sub.to_string p
292
| false ->
293
match String.Sub.is_empty last_seg with
294
+
| false -> dir, String.Sub.to_string last_seg
295
| true ->
296
let dir_file = String.Sub.tail ~rev:true dir in
297
let dir, dir_last_seg = _split_last_seg dir_file in
298
match String.Sub.is_empty dir with
299
+
| true -> dot_dir_sub, String.Sub.to_string p
300
+
| false -> dir, String.Sub.(to_string (extend dir_last_seg))
301
+
302
+
let split_base_windows p =
303
+
let vol, path = Windows.sub_split_volume p in
304
+
if sub_is_root path then p, dot_dir else
305
+
let dir, b = _split_base path in
306
+
String.Sub.(base_string (append vol dir)), b
307
308
let split_base_posix p =
309
+
if Posix.is_root p then p, dot_dir else
310
+
let dir, b = _split_base (String.sub p) in
311
+
String.Sub.to_string dir, b
312
313
let split_base = if windows then split_base_windows else split_base_posix
314
315
let base p = snd (split_base p)
316
317
+
let _basename p = match String.Sub.to_string (_sub_last_non_empty_seg p) with
318
+
| "." | ".." -> ""
319
+
| basename -> basename
320
321
+
let basename_windows p =
322
+
let vol, path = Windows.sub_split_volume p in
323
+
if sub_is_root path then "" else _basename path
324
325
+
let basename_posix p = if Posix.is_root p then "" else _basename (String.sub p)
326
let basename p = if windows then basename_windows p else basename_posix p
327
328
let _parent p =
329
+
(* The parent algorithm is not very smart. It tries to preserve the
330
+
original path and avoids dealing with normalization. We simply
331
+
only keep everything before the last non-empty, non-relative,
332
+
path segment and if the resulting path is empty we return
333
+
"./". Otherwise if the last non-empty segment is "." or ".." we
334
+
simply postfix with "../" *)
335
let (dir, seg), is_last = _split_last_non_empty_seg p in
336
let dsep = if is_last then dir_sep_sub else String.Sub.empty in
337
+
if sub_is_rel_seg seg then [p; dsep; dotdot_dir_sub] else
338
+
if String.Sub.is_empty dir then [dot_dir_sub] else [dir]
339
340
let parent_windows p =
341
+
let vol, path = Windows.sub_split_volume p in
342
+
if sub_is_root path then p else
343
String.Sub.(base_string @@ concat (vol :: _parent path))
344
345
let parent_posix p =
346
+
if Posix.is_root p then p else
347
String.Sub.(base_string @@ concat (_parent (String.sub p)))
348
349
let parent = if windows then parent_windows else parent_posix
···
351
(* Normalization *)
352
353
let rem_empty_seg_windows p =
354
+
let vol, path = Windows.sub_split_volume p in
355
+
if sub_is_root path then p else
356
+
let max = String.Sub.length path - 1 in
357
+
if String.Sub.get path max <> dir_sep_char then p else
358
+
String.with_index_range p ~last:(max - 1)
359
360
let rem_empty_seg_posix p = match String.length p with
361
| 1 -> p
···
371
let rem_empty_seg =
372
if windows then rem_empty_seg_windows else rem_empty_seg_posix
373
374
+
let normalize_rel_segs segs = (* result is non empty but may be [""] *)
375
let rec loop acc = function
376
| "." :: [] -> ("" :: acc) (* final "." remove but preserve directoryness. *)
377
| "." :: rest -> loop acc rest
···
387
| [] ->
388
match acc with
389
| ".." :: _ -> ("" :: acc) (* normalize final .. to ../ *)
390
+
| [] -> [""]
391
| acc -> acc
392
in
393
+
List.rev (loop [] segs)
394
395
let normalize_segs = function
396
| "" :: segs -> (* absolute path *)
397
+
let rec rem_dotdots = function ".." :: ss -> rem_dotdots ss | ss -> ss in
398
+
"" :: (rem_dotdots @@ normalize_rel_segs segs)
399
| segs ->
400
+
match normalize_rel_segs segs with
401
+
| [""] -> ["."; ""]
402
| segs -> segs
403
404
let normalize_windows p =
405
+
let vol, path = Windows.sub_split_volume p in
406
let path = String.Sub.to_string path in
407
+
let path = segs_to_path @@ normalize_segs (segs_of_path path) in
408
String.Sub.(to_string (concat [vol; String.sub path]))
409
410
let normalize_posix p =
411
+
let has_volume = Posix.has_volume p in
412
+
let segs = segs_of_path p in
413
+
let segs = normalize_segs @@ if has_volume then List.tl segs else segs in
414
let segs = if has_volume then "" :: segs else segs in
415
+
segs_to_path segs
416
417
let normalize = if windows then normalize_windows else normalize_posix
418
···
426
starts with a directory separator. *)
427
let suff_start = String.length prefix in
428
if prefix.[suff_start - 1] = dir_sep_char then true else
429
+
if suff_start = String.length p then (* suffix empty *) true else
430
p.[suff_start] = dir_sep_char
431
432
+
let _prefix_last_index p0 p1 = (* last char index of segment-based prefix *)
433
let l0 = String.length p0 in
434
let l1 = String.length p1 in
435
let p0, p1, max = if l0 < l1 then p0, p1, l0 - 1 else p1, p0, l1 - 1 in
···
451
in
452
loop (-1) 0 p0 p1
453
454
+
let find_prefix_windows p0 p1 = match _prefix_last_index p0 p1 with
455
| None -> None
456
| Some i ->
457
+
let v0_len = String.Sub.length (fst (Windows.sub_split_volume p0)) in
458
+
let v1_len = String.Sub.length (fst (Windows.sub_split_volume p1)) in
459
+
let max_vlen = if v0_len > v1_len then v0_len else v1_len in
460
+
if i < max_vlen then None else Some (String.with_index_range p0 ~last:i)
461
462
+
let find_prefix_posix p0 p1 = match _prefix_last_index p0 p1 with
463
| None -> None
464
+
| Some 0 when Posix.has_volume p0 || Posix.has_volume p1 -> None
465
| Some i -> Some (String.with_index_range p0 ~last:i)
466
467
let find_prefix = if windows then find_prefix_windows else find_prefix_posix
···
484
let prooted = normalize (append root p) in
485
if is_prefix nroot prooted then Some prooted else None
486
487
+
let _relativize ~root p =
488
let root = (* root is always interpreted as a directory *)
489
let root = normalize root in
490
if root.[String.length root - 1] = dir_sep_char then root else
···
503
| [""], [""] ->
504
(* walk ends at the end of both path simultaneously, [p] is a
505
directory that matches exactly [root] expressed as a directory. *)
506
+
Some (segs_to_path ["."; ""])
507
| root, p ->
508
(* walk ends here, either the next directory is different in
509
[root] and [p] or it is equal but it is the last one for [p]
···
514
from the current position we just use [p] so prepending
515
length root - 1 .. segments to [p] tells us how to go from
516
the remaining root to [p]. *)
517
+
let segs = List.fold_left (fun acc _ -> dotdot :: acc) p (List.tl root) in
518
+
Some (segs_to_path segs)
519
in
520
match segs root, segs p with
521
| ("" :: _, s :: _)
···
524
None
525
| ["."; ""], p ->
526
(* p is relative and expressed w.r.t. "./", so it is itself. *)
527
+
Some (segs_to_path p)
528
| root, p ->
529
(* walk in the segments of root and p until a segment mismatches.
530
at that point express the remaining p relative to the remaining
···
533
final "" segment. *)
534
walk root p
535
536
+
let relativize_windows ~root p =
537
+
let rvol, root = Windows.sub_split_volume root in
538
+
let pvol, p = Windows.sub_split_volume p in
539
+
if not (String.Sub.equal_bytes rvol pvol) then None else
540
+
let root = String.Sub.to_string root in
541
+
let p = String.Sub.to_string p in
542
+
_relativize ~root p
543
+
544
+
let relativize_posix ~root p = _relativize ~root p
545
+
546
+
let relativize = if windows then relativize_windows else relativize_posix
547
548
(* Predicates and comparison *)
549
550
let is_rel_posix p = p.[0] <> dir_sep_char
551
let is_rel_windows p =
552
+
if Windows.is_unc_path p then false else
553
+
p.[Windows.non_unc_path_start p] <> dir_sep_char
554
555
let is_rel = if windows then is_rel_windows else is_rel_posix
556
let is_abs p = not (is_rel p)
557
+
let is_root = if windows then Windows.is_root else Posix.is_root
558
559
let is_current_dir_posix p = String.equal p dot || String.equal p dot_dir
560
let is_current_dir_windows p =
561
+
if Windows.is_unc_path p then false else
562
+
let start = Windows.non_unc_path_start p in
563
match String.length p - start with
564
| 1 -> p.[start] = '.'
565
| 2 -> p.[start] = '.' && p.[start + 1] = dir_sep_char
···
603
if multi then multi_ext_sub seg else single_ext_sub seg
604
605
let get_ext ?multi p =
606
+
String.Sub.to_string (ext_sub ?multi (sub_last_non_empty_seg p))
607
608
let has_ext e p =
609
+
let seg = String.Sub.drop ~sat:eq_ext_sep (sub_last_non_empty_seg p) in
610
if not (String.Sub.is_suffix (String.sub e) seg) then false else
611
if not (String.is_empty e) && e.[0] = ext_sep_char then true else
612
(* check there's a dot before the suffix in [seg] *)
···
615
String.Sub.get seg dot_index = ext_sep_char
616
617
let ext_exists ?(multi = false) p =
618
+
let ext = ext_sub ~multi (sub_last_non_empty_seg p) in
619
if not multi then not (String.Sub.is_empty ext) else
620
if String.Sub.is_empty ext then false else
621
match String.Sub.find ~rev:true eq_ext_sep ext with (* find another dot *)
+90
-87
src/fpath.mli
+90
-87
src/fpath.mli
···
19
distinguishes {e directory paths}
20
(["a/b/"]) from {e file paths} (["a/b"]).}}
21
22
Consult a few {{!tips}important tips}.
23
24
{b Note.} [Fpath] processes paths without accessing the file system.
···
34
["/"] on POSIX and ["\\"] on Windows. *)
35
36
val is_seg : string -> bool
37
-
(** [is_seg s] is [true] iff [s] does not contain {!dir_sep} or a
38
-
[0x00] byte. *)
39
40
val is_rel_seg : string -> bool
41
(** [is_rel_seg s] is true iff [s] is a relative segment, that is
···
50
(** [v s] is the string [s] as path.
51
52
@raise Invalid_argument if [s] is not a {{!of_string}valid path}. Use
53
-
{!of_string} to deal with foreign input and errors. *)
54
55
val add_seg : t -> string -> t
56
-
(** [add_seg p seg] adds [seg] at the end of [p]. If [seg] is [""]
57
-
it is only added if [p] has no final empty segment. {{!ex_add_seg}Examples}.
58
59
@raise Invalid_argument if {!is_seg}[ seg] is [false]. *)
60
···
66
{ul
67
{- If [p'] is absolute or has a non-empty {{!split_volume}volume} then
68
[p'] is returned.}
69
-
{- Otherwise appends [p'] to [p] using a {!dir_sep} if needed.}}
70
{{!ex_append}Examples}. *)
71
72
val ( // ) : t -> t -> t
···
105
{- [equal p (v @@ (fst @@ split_volume p) ^ (String.concat ~sep:dir_sep
106
(segs p)))]}} *)
107
108
-
(** {1:filedir File and directory paths} *)
109
110
val is_dir_path : t -> bool
111
-
(** [is_dir_path p] is [true] iff [p] represents a directory. This means
112
-
that [p]'s last segment is either [""], ["."] or [".."].
113
{{!ex_is_dir_path}Examples}. *)
114
115
val is_file_path : t -> bool
116
(** [is_file_path p] is [true] iff [p] represents a file. This is the
117
negation of {!is_dir_path}. This means that [p]'s last segment is
118
-
neither empty nor ["."], nor [".."]. {{!ex_is_file_path}Examples}. *)
119
120
val to_dir_path : t -> t
121
(** [to_dir_path p] is {!add_seg}[ p ""] it ensure that the result
122
-
represents a {{!is_dir_path}directory} (and, if converted to
123
-
a string, that it will end with a {!dir_sep}).
124
{{!ex_to_dir_path}Examples}. *)
125
126
val filename : t -> string
127
(** [filename p] is the file name of [p]. This is the last segment of
128
[p] if [p] is a {{!is_file_path}file path} and the empty string
129
-
otherwise. See also {!basename}. {{!ex_filename}Examples}. *)
130
131
(** {1:parentbase Base and parent paths} *)
132
···
141
{{!is_root}root path} there are no such segments and [b]
142
is ["./"].}
143
{- [d] is a {{!is_dir_path}directory} such that [d // b]
144
-
represents the same path as [p] (they may however differ
145
-
syntactically when converted to a string).}}
146
{{!ex_split_base}Examples}.
147
148
{b Note.} {{!normalize}Normalizing} [p] before using the function
149
-
ensures that [b] will be a {{!is_rel_seg}relative segment} iff [p] cannot
150
be named (like in ["."], ["../../"], ["/"], etc.). *)
151
152
val base : t -> t
153
(** [base p] is [snd (split_base p)]. *)
154
155
val basename : t -> string
156
-
(** [basename p] is [p]'s last non-empty empty segment if
157
-
{{!is_rel_seg}non-relative} or the empty string otherwise. The
158
-
latter occurs on {{!is_root}root paths} and on paths whose last
159
-
non-empty segment is relative. See also {!filename} and
160
{!base}. {{!ex_basename}Examples}.
161
162
{b Note.} {{!normalize}Normalizing} [p] before using the function
···
174
(** {1:norm Normalization} *)
175
176
val rem_empty_seg : t -> t
177
-
(** [rem_empty_seg p] removes the empty segment of [p] if it
178
-
exists and [p] is not a {{!is_root}root path}. This ensure that if
179
-
[p] is converted to a string it will not have a trailing
180
-
{!dir_sep} unless [p] is a root path. Note that this may affect
181
-
[p]'s {{!is_dir_path}directoryness}.
182
-
{{!ex_rem_empty_seg}Examples}. *)
183
184
val normalize : t -> t
185
(** [normalize p] is a path that represents the same path as [p],
···
197
198
(** {1:prefix Prefixes}
199
200
-
{b Warning.} The {{!is_prefix}prefix property} between paths does
201
-
not entail directory containement in general, as it is, by
202
-
definition, a syntactic test. For example [is_prefix (v "..") (v
203
-
"../..")] is [true], but the second path is not contained in the
204
-
first one or [is_prefix (v "..") (v ".")] is [false]. However, on
205
-
{{!normalize}normalized}, {{!is_abs}absolute} paths, the prefix relation
206
-
does entail directory containement. See also {!rooted}. *)
207
208
val is_prefix : t -> t -> bool
209
(** [is_prefix prefix p] is [true] if [prefix] is a prefix of
···
235
prefix [prefix] and preserves [p]'s
236
{{!is_dir_path}directoryness}. This means that [q] is a always
237
{{!is_rel}relative} and that the path [prefix // q] and [p] represent the
238
-
same paths (they may however differ syntactically when
239
-
converted to a string).}}
240
{{!ex_rem_prefix}Examples}. *)
241
242
(** {1 Roots and relativization} *)
···
246
{ul
247
{- [Some q] if there exists a {{!is_relative}relative} path [q] such
248
that [root // q] and [p] represent the same paths,
249
-
{{!is_dir_path}directoryness} included (they may however differ
250
-
syntactically when converted to a string).}
251
{- [None] otherwise}}
252
253
{{!ex_relativize}Examples.} *)
254
255
-
(*
256
-
257
-
val is_rooted : root:t -> t -> bool
258
-
(** [is_rooted root p] is [true] iff [p] is equal or contained in the
259
-
directory represented by [root] (if [root] is a {{!is_file_path}file path},
260
-
the path {!to_dir_path}[ root] is used instead).
261
-
{{!ex_is_rooted}Examples.} *)
262
-
263
-
val rooted_append : ?normalized:bool -> root:t -> t -> t option
264
-
(** [rooted_append ~root p] {{!appends}appends} [p] to [root] and
265
-
returns a result iff [is_rooted root (append root t)] is [true].
266
-
If [normalized] is [true] the result is normalized.
267
-
{{!ex_rooted_append}Examples.} *)
268
-
*)
269
-
270
-
(*
271
-
272
-
273
-
the path [p] is contained in path [root].
274
-
{ul
275
-
{- [None] if [prefix]
276
-
[is_prefix (normalize root) (normalize @@ append root p) = false].}
277
-
{- [Some (normalize @@ append root p)] otherwise.}}
278
-
In other words it ensures that an absolute path [p] or a relative
279
-
path [p] expressed w.r.t. [root] expresses a path that is
280
-
within the [root] file hierarchy. {{!ex_rooted}Examples}. *)
281
-
282
(** {1:predicates Predicates and comparison} *)
283
284
val is_rel : t -> bool
···
317
*)
318
319
val is_dotfile : t -> bool
320
-
(** [is_dotfile p] is [true] iff [p]'s last non-empty segment is not
321
-
["."] or [".."] and starts with a ['.']. {{!ex_is_dotfile}Examples}.
322
323
{b Warning.} By definition this is a syntactic test. For example it will
324
return [false] on [".ssh/."]. {{!normalize}Normalizing} the
···
345
(** [of_string s] is the string [s] as a path. [None] is returned if
346
{ul
347
{- [s] or the path following the {{!split_volume}volume} is empty ([""]),
348
-
expect on Windows UNC paths, see below.}
349
{- [s] has null byte (['\x00']).}
350
{- On Windows, [s] is an invalid UNC path (e.g. ["\\\\"] or ["\\\\a"])}}
351
The following transformations are performed on the string:
···
373
character. If there is no such occurence in the segment, the
374
extension is empty. With these definitions, ["."], [".."],
375
["..."] and dot files like [".ocamlinit"] or ["..ocamlinit"] have
376
-
no extension, but [".emacs.d"] and ["..emacs.d"] do have one. *)
377
378
type ext = string
379
(** The type for file extensions. *)
380
381
val get_ext : ?multi:bool -> t -> ext
382
-
(** [get_ext p] is [p]'s last non-empty segment file extension or the empty
383
-
string if there is no extension. If [multi] is [true] (defaults to
384
-
[false]), returns the multiple file extension. {{!ex_get_ext}Examples}. *)
385
386
val has_ext : ext -> t -> bool
387
(** [has_ext e p] is [true] iff [ext p = e || ext ~multi:true p = e].
···
389
the test. {{!ex_has_ext}Examples}. *)
390
391
val ext_exists : ?multi:bool -> t -> bool
392
-
(** [ext_exists ~multi p] is [true] iff [p]'s last segment has an
393
-
extension. If [multi] is [true] (default to [false]) returns
394
-
[true] iff [p] has {e more than one} extension.
395
{{!ex_ext_exists}Examples}. *)
396
397
val add_ext : ext -> t -> t
···
556
a path}. This usually means that we don't care whether the path
557
is a {{!is_file_path}file path} (e.g. ["a"]) or a
558
{{!is_dir_path}directory path} (e.g. ["a/"]).}
559
-
{- Windows accepts both ['\\'] and ['/'] as directory
560
-
separator. However [Fpath] on Windows converts ['/'] to ['\\'] on
561
-
the fly. Therefore you should either use ['/'] for defining
562
constant paths you inject with {!v} or better, construct them
563
-
directly with {!(/)}. {!to_string} will convert these paths
564
-
to strings using the platform's specific directory
565
-
separator {!dir_sep}.}
566
{- Avoid platform specific {{!split_volume}volumes} or hard-coding file
567
hierarchy conventions in your constants.}
568
{- Do not assume there is a single root path and that it is
569
-
[/]. On Windows each {{!split_volume}volume} can have a root path.
570
-
Use {!is_root} to detect root paths.}
571
{- Do not use {!to_string} to construct URIs, {!to_string} uses
572
{!dir_sep} to separate segments, on Windows this is ['\\'] which
573
-
is not what URIs expect. Access the path segments directly
574
-
with {!segs}, note that you will need to percent encode these.}}
575
576
{1:ex Examples}
577
···
926
927
{2:ex_get_ext {!get_ext}}
928
{ul
929
{- [get_ext (v "/a/b") = ""]}
930
-
{- [get_ext (v "a/.") = ""]}
931
-
{- [get_ext (v "a/..") = ""]}
932
{- [get_ext (v "a/.ocamlinit") = ""]}
933
{- [get_ext (v "/a/b.") = "."]}
934
{- [get_ext (v "/a/b.mli") = ".mli"]}
935
{- [get_ext (v "a.tar.gz") = ".gz"]}
936
{- [get_ext (v "a/.emacs.d") = ".d"]}
937
{- [get_ext ~multi:true (v "/a/b.mli") = ".mli"]}
938
{- [get_ext ~multi:true (v "a.tar.gz") = ".tar.gz"]}
939
-
{- [get_ext ~multi:true (v "a/.emacs.d") = ".d"]}}
940
941
{2:ex_has_ext {!has_ext}}
942
{ul
943
{- [has_ext ".mli" (v "a/b.mli") = true]}
944
{- [has_ext "mli" (v "a/b.mli") = true]}
945
{- [has_ext "mli" (v "a/bmli") = false]}
946
{- [has_ext ".tar.gz" (v "a/f.tar.gz") = true]}
947
{- [has_ext "tar.gz" (v "a/f.tar.gz") = true]}
···
953
{- [ext_exists (v "a/f.") = true]}
954
{- [ext_exists (v "a/f.gz") = true]}
955
{- [ext_exists (v "a/f.tar.gz") = true]}
956
{- [ext_exists (v ".emacs.d") = true]}
957
{- [ext_exists ~multi:true (v "a/f.gz") = false]}
958
{- [ext_exists ~multi:true (v "a/f.tar.gz") = true]}
959
{- [ext_exists ~multi:true (v ".emacs.d") = false]}}
···
19
distinguishes {e directory paths}
20
(["a/b/"]) from {e file paths} (["a/b"]).}}
21
22
+
The path segments ["."] and [".."] are {{!is_rel_seg}{e relative
23
+
path segments}} that respectively denote the current and parent
24
+
directory. The {{!basename}{e basename}} of a path is its last
25
+
non-empty segment if it is not a relative path segment and the empty
26
+
string otherwise.
27
+
28
Consult a few {{!tips}important tips}.
29
30
{b Note.} [Fpath] processes paths without accessing the file system.
···
40
["/"] on POSIX and ["\\"] on Windows. *)
41
42
val is_seg : string -> bool
43
+
(** [is_seg s] is [true] iff [s] does not contain {!dir_sep} or ['/'] or
44
+
a [0x00] byte. *)
45
46
val is_rel_seg : string -> bool
47
(** [is_rel_seg s] is true iff [s] is a relative segment, that is
···
56
(** [v s] is the string [s] as path.
57
58
@raise Invalid_argument if [s] is not a {{!of_string}valid path}. Use
59
+
{!of_string} to deal with untrusted input and errors. *)
60
61
val add_seg : t -> string -> t
62
+
(** [add_seg p seg] adds [seg] at the end of [p] if [p]'s last segment
63
+
is non-empty and replaces it otherwise. {{!ex_add_seg}Examples}.
64
65
@raise Invalid_argument if {!is_seg}[ seg] is [false]. *)
66
···
72
{ul
73
{- If [p'] is absolute or has a non-empty {{!split_volume}volume} then
74
[p'] is returned.}
75
+
{- Otherwise appends [p'] segments to [p] using {!add_seg}.}}
76
{{!ex_append}Examples}. *)
77
78
val ( // ) : t -> t -> t
···
111
{- [equal p (v @@ (fst @@ split_volume p) ^ (String.concat ~sep:dir_sep
112
(segs p)))]}} *)
113
114
+
(** {1:filedir File and directory paths}
115
+
116
+
{b Note.} The following properties are derived from the syntactic
117
+
semantics of paths which can be different from the one a file
118
+
system attributes to them. *)
119
120
val is_dir_path : t -> bool
121
+
(** [is_dir_path p] is [true] iff [p] represents a directory. This
122
+
means that [p]'s last segment is either [""], ["."] or [".."].
123
+
The property is invariant with respect to {{!normalize}normalization}.
124
{{!ex_is_dir_path}Examples}. *)
125
126
val is_file_path : t -> bool
127
(** [is_file_path p] is [true] iff [p] represents a file. This is the
128
negation of {!is_dir_path}. This means that [p]'s last segment is
129
+
neither empty nor ["."], nor [".."]. The property is invariant
130
+
with respect to {{!normalize}normalization}.
131
+
{{!ex_is_file_path}Examples}. *)
132
133
val to_dir_path : t -> t
134
(** [to_dir_path p] is {!add_seg}[ p ""] it ensure that the result
135
+
represents a {{!is_dir_path}directory} and, if converted to a
136
+
string, that it ends with a {!dir_sep}.
137
{{!ex_to_dir_path}Examples}. *)
138
139
val filename : t -> string
140
(** [filename p] is the file name of [p]. This is the last segment of
141
[p] if [p] is a {{!is_file_path}file path} and the empty string
142
+
otherwise. The result is invariant with respect to
143
+
{{!normalize}normalization}. See also
144
+
{!basename}. {{!ex_filename}Examples}. *)
145
146
(** {1:parentbase Base and parent paths} *)
147
···
156
{{!is_root}root path} there are no such segments and [b]
157
is ["./"].}
158
{- [d] is a {{!is_dir_path}directory} such that [d // b]
159
+
represents the same path as [p]. They may however differ
160
+
syntactically when converted to a string.}}
161
{{!ex_split_base}Examples}.
162
163
{b Note.} {{!normalize}Normalizing} [p] before using the function
164
+
ensures that [b] is a {{!is_rel_seg}relative segment} iff [p] cannot
165
be named (like in ["."], ["../../"], ["/"], etc.). *)
166
167
val base : t -> t
168
(** [base p] is [snd (split_base p)]. *)
169
170
val basename : t -> string
171
+
(** [basename p] is [p]'s last non-empty segment if non-relative or
172
+
the empty string otherwise. The latter occurs only on {{!is_root}root
173
+
paths} and on paths whose last non-empty segment is a
174
+
{{!is_rel_seg}relative segment}. See also {!filename} and
175
{!base}. {{!ex_basename}Examples}.
176
177
{b Note.} {{!normalize}Normalizing} [p] before using the function
···
189
(** {1:norm Normalization} *)
190
191
val rem_empty_seg : t -> t
192
+
(** [rem_empty_seg p] removes the empty segment of [p] if it exists
193
+
and [p] is not a {{!is_root}root path}. This ensure that if [p] is
194
+
converted to a string it will not have a trailing {!dir_sep}
195
+
unless [p] is a root path. Note that this may affect [p]'s
196
+
{{!is_dir_path}directoryness}. {{!ex_rem_empty_seg}Examples}. *)
197
198
val normalize : t -> t
199
(** [normalize p] is a path that represents the same path as [p],
···
211
212
(** {1:prefix Prefixes}
213
214
+
{b Warning.} The syntactic {{!is_prefix}prefix relation} between
215
+
paths does not, in general, entail directory containement. The following
216
+
examples show this:
217
+
{[
218
+
is_prefix (v "..") (v "../..") = true
219
+
is_prefix (v "..") (v ".") = false
220
+
]}
221
+
However, on {{!normalize}normalized}, {{!is_abs}absolute} paths,
222
+
the prefix relation does entail directory containement. See also
223
+
{!is_rooted}. *)
224
225
val is_prefix : t -> t -> bool
226
(** [is_prefix prefix p] is [true] if [prefix] is a prefix of
···
252
prefix [prefix] and preserves [p]'s
253
{{!is_dir_path}directoryness}. This means that [q] is a always
254
{{!is_rel}relative} and that the path [prefix // q] and [p] represent the
255
+
same paths. They may however differ syntactically when
256
+
converted to a string.}}
257
{{!ex_rem_prefix}Examples}. *)
258
259
(** {1 Roots and relativization} *)
···
263
{ul
264
{- [Some q] if there exists a {{!is_relative}relative} path [q] such
265
that [root // q] and [p] represent the same paths,
266
+
{{!is_dir_path}directoryness} included. They may however differ
267
+
syntactically when converted to a string.}
268
{- [None] otherwise}}
269
270
{{!ex_relativize}Examples.} *)
271
272
(** {1:predicates Predicates and comparison} *)
273
274
val is_rel : t -> bool
···
307
*)
308
309
val is_dotfile : t -> bool
310
+
(** [is_dotfile p] is [true] iff [p]'s {{!basename}basename} is non
311
+
empty and starts with a ['.'].
312
313
{b Warning.} By definition this is a syntactic test. For example it will
314
return [false] on [".ssh/."]. {{!normalize}Normalizing} the
···
335
(** [of_string s] is the string [s] as a path. [None] is returned if
336
{ul
337
{- [s] or the path following the {{!split_volume}volume} is empty ([""]),
338
+
except on Windows UNC paths, see below.}
339
{- [s] has null byte (['\x00']).}
340
{- On Windows, [s] is an invalid UNC path (e.g. ["\\\\"] or ["\\\\a"])}}
341
The following transformations are performed on the string:
···
363
character. If there is no such occurence in the segment, the
364
extension is empty. With these definitions, ["."], [".."],
365
["..."] and dot files like [".ocamlinit"] or ["..ocamlinit"] have
366
+
no extension, but [".emacs.d"] and ["..emacs.d"] do have one.
367
+
368
+
{b Warning.} The following functions act on paths whose
369
+
{{!basename}basename} is non empty and do nothing otherwise.
370
+
{{!normalize}Normalizing} [p] before using the functions ensures
371
+
that the functions do nothing iff [p] cannot be named (like in
372
+
["."], ["../../"], ["/"], etc.). *)
373
374
type ext = string
375
(** The type for file extensions. *)
376
377
val get_ext : ?multi:bool -> t -> ext
378
+
(** [get_ext p] is [p]'s {{!basename}basename} file extension or the
379
+
empty string if there is no extension. If [multi] is [true]
380
+
(defaults to [false]), returns the multiple file
381
+
extension. {{!ex_get_ext}Examples}. *)
382
383
val has_ext : ext -> t -> bool
384
(** [has_ext e p] is [true] iff [ext p = e || ext ~multi:true p = e].
···
386
the test. {{!ex_has_ext}Examples}. *)
387
388
val ext_exists : ?multi:bool -> t -> bool
389
+
(** [ext_exists ~multi p] is [true] iff [p]'s last non-empty
390
+
segment has an extension. If [multi] is [true] (default to [false])
391
+
returns [true] iff [p] has {e more than one} extension.
392
{{!ex_ext_exists}Examples}. *)
393
394
val add_ext : ext -> t -> t
···
553
a path}. This usually means that we don't care whether the path
554
is a {{!is_file_path}file path} (e.g. ["a"]) or a
555
{{!is_dir_path}directory path} (e.g. ["a/"]).}
556
+
{- Windows accepts both ['\\'] and ['/'] as directory separator.
557
+
However [Fpath] on Windows converts ['/'] to ['\\'] on the
558
+
fly. Therefore you should either use ['/'] for defining
559
constant paths you inject with {!v} or better, construct them
560
+
directly with {!(/)}. {!to_string} then converts paths to strings
561
+
using the platform's specific directory separator {!dir_sep}.}
562
{- Avoid platform specific {{!split_volume}volumes} or hard-coding file
563
hierarchy conventions in your constants.}
564
{- Do not assume there is a single root path and that it is
565
+
["/"]. On Windows each {{!split_volume}volume} can have a root path.
566
+
Use {!is_root} on {{!normalize}normalized} paths to detect roots.}
567
{- Do not use {!to_string} to construct URIs, {!to_string} uses
568
{!dir_sep} to separate segments, on Windows this is ['\\'] which
569
+
is not what URIs expect. Access path segments directly
570
+
with {!segs}; note that you will need to percent encode these.}}
571
572
{1:ex Examples}
573
···
922
923
{2:ex_get_ext {!get_ext}}
924
{ul
925
+
{- [get_ext (v "/") = ""]}
926
{- [get_ext (v "/a/b") = ""]}
927
+
{- [get_ext (v "a.mli/.") = ""]}
928
+
{- [get_ext (v "a.mli/..") = ""]}
929
{- [get_ext (v "a/.ocamlinit") = ""]}
930
+
{- [get_ext (v "a/.ocamlinit/") = ""]}
931
{- [get_ext (v "/a/b.") = "."]}
932
{- [get_ext (v "/a/b.mli") = ".mli"]}
933
{- [get_ext (v "a.tar.gz") = ".gz"]}
934
{- [get_ext (v "a/.emacs.d") = ".d"]}
935
+
{- [get_ext (v "a/.emacs.d/") = ".d"]}
936
{- [get_ext ~multi:true (v "/a/b.mli") = ".mli"]}
937
{- [get_ext ~multi:true (v "a.tar.gz") = ".tar.gz"]}
938
+
{- [get_ext ~multi:true (v "a/.emacs.d") = ".d"]}
939
+
{- [get_ext ~multi:true (v "a/.emacs.d/") = ".d/"]}}
940
941
{2:ex_has_ext {!has_ext}}
942
{ul
943
{- [has_ext ".mli" (v "a/b.mli") = true]}
944
{- [has_ext "mli" (v "a/b.mli") = true]}
945
+
{- [has_ext "mli" (v "a/b.mli/") = true]}
946
{- [has_ext "mli" (v "a/bmli") = false]}
947
{- [has_ext ".tar.gz" (v "a/f.tar.gz") = true]}
948
{- [has_ext "tar.gz" (v "a/f.tar.gz") = true]}
···
954
{- [ext_exists (v "a/f.") = true]}
955
{- [ext_exists (v "a/f.gz") = true]}
956
{- [ext_exists (v "a/f.tar.gz") = true]}
957
+
{- [ext_exists (v "a/f.tar.gz/") = true]}
958
{- [ext_exists (v ".emacs.d") = true]}
959
+
{- [ext_exists (v ".emacs.d/") = true]}
960
{- [ext_exists ~multi:true (v "a/f.gz") = false]}
961
{- [ext_exists ~multi:true (v "a/f.tar.gz") = true]}
962
{- [ext_exists ~multi:true (v ".emacs.d") = false]}}
+33
-3
test/test_path.ml
+33
-3
test/test_path.ml
···
507
eqp (Fpath.normalize @@ v "a/..b") (v "a/..b");
508
eqp (Fpath.normalize @@ v "./a") (v "a");
509
eqp (Fpath.normalize @@ v "../a") (v "../a");
510
eqp (Fpath.normalize @@ v "../../a") (v "../../a");
511
eqp (Fpath.normalize @@ v "./a/..") (v "./");
512
eqp (Fpath.normalize @@ v "/a/b/./..") (v "/a/");
···
729
relativize (v "../a") (v "../../b") (Some (v "../../b"));
730
relativize (v "a") (v "../../b") (Some (v "../../../b"));
731
relativize (v "a/c") (v "../../b") (Some (v "../../../../b"));
732
()
733
734
let is_abs_rel = test "Fpath.is_abs_rel" @@ fun () ->
···
828
()
829
830
let get_ext = test "Fpath.get_ext" @@ fun () ->
831
eq_str (Fpath.get_ext @@ v ".") "";
832
eq_str (Fpath.get_ext @@ v "..") "";
833
eq_str (Fpath.get_ext @@ v "...") "";
···
839
eq_str (Fpath.get_ext @@ v ".a...") ".";
840
eq_str (Fpath.get_ext @@ v ".a....") ".";
841
eq_str (Fpath.get_ext @@ v "a/...") "";
842
-
eq_str (Fpath.get_ext @@ v "a/.") "";
843
-
eq_str (Fpath.get_ext @@ v "a/..") "";
844
eq_str (Fpath.get_ext @@ v "a/.a") "";
845
eq_str (Fpath.get_ext @@ v "a/..b") "";
846
eq_str (Fpath.get_ext @@ v "a/..b.a") ".a";
847
eq_str (Fpath.get_ext @@ v "a/..b..ac") ".ac";
848
eq_str (Fpath.get_ext @@ v "/a/b") "";
849
eq_str (Fpath.get_ext @@ v "/a/b.") ".";
850
eq_str (Fpath.get_ext @@ v "a/.ocamlinit") "";
851
eq_str (Fpath.get_ext @@ v "a/.emacs.d") ".d";
852
eq_str (Fpath.get_ext @@ v "/a/b.mli") ".mli";
853
eq_str (Fpath.get_ext @@ v "a.tar.gz") ".gz";
854
eq_str (Fpath.get_ext @@ v "./a.") ".";
855
eq_str (Fpath.get_ext @@ v "./a..") ".";
856
eq_str (Fpath.get_ext @@ v "./.a.") ".";
857
-
eq_str (Fpath.get_ext @@ v "./.a..") ".";
858
eq_str (Fpath.get_ext ~multi:true @@ v ".") "";
859
eq_str (Fpath.get_ext ~multi:true @@ v "..") "";
860
eq_str (Fpath.get_ext ~multi:true @@ v "...") "";
···
862
eq_str (Fpath.get_ext ~multi:true @@ v ".....") "";
863
eq_str (Fpath.get_ext ~multi:true @@ v ".a") "";
864
eq_str (Fpath.get_ext ~multi:true @@ v ".a.") ".";
865
eq_str (Fpath.get_ext ~multi:true @@ v ".a..") "..";
866
eq_str (Fpath.get_ext ~multi:true @@ v ".a...") "...";
867
eq_str (Fpath.get_ext ~multi:true @@ v ".a....") "....";
···
870
eq_str (Fpath.get_ext ~multi:true @@ v "a/..") "";
871
eq_str (Fpath.get_ext ~multi:true @@ v "a/..b") "";
872
eq_str (Fpath.get_ext ~multi:true @@ v "a/..b.a") ".a";
873
eq_str (Fpath.get_ext ~multi:true @@ v "a/..b..ac") "..ac";
874
eq_str (Fpath.get_ext ~multi:true @@ v "a/.emacs.d") ".d";
875
eq_str (Fpath.get_ext ~multi:true @@ v "/a/b.mli") ".mli";
876
eq_str (Fpath.get_ext ~multi:true @@ v "a.tar.gz") ".tar.gz";
877
eq_str (Fpath.get_ext ~multi:true @@ v "./a.") ".";
878
eq_str (Fpath.get_ext ~multi:true @@ v "./a..") "..";
879
eq_str (Fpath.get_ext ~multi:true @@ v "./.a.") ".";
880
eq_str (Fpath.get_ext ~multi:true @@ v "./.a..") "..";
881
()
882
883
let has_ext = test "Fpath.has_ext" @@ fun () ->
···
905
eq_bool (Fpath.has_ext "..." @@ v "....") false;
906
eq_bool (Fpath.has_ext "..." @@ v ".a...") true;
907
eq_bool (Fpath.has_ext ".mli" @@ v "a/b.mli") true;
908
eq_bool (Fpath.has_ext "mli" @@ v "a/b.mli") true;
909
eq_bool (Fpath.has_ext "mli" @@ v "a/bmli") false;
910
eq_bool (Fpath.has_ext "mli" @@ v "a/.mli") false;
911
eq_bool (Fpath.has_ext ".tar.gz" @@ v "a/f.tar.gz") true;
912
eq_bool (Fpath.has_ext "tar.gz" @@ v "a/f.tar.gz") true;
913
eq_bool (Fpath.has_ext "tar.gz" @@ v "a/ftar.gz") false;
914
eq_bool (Fpath.has_ext "tar.gz" @@ v "a/tar.gz") false;
915
eq_bool (Fpath.has_ext "tar.gz" @@ v "a/.tar.gz") false;
916
eq_bool (Fpath.has_ext ".tar" @@ v "a/f.tar.gz") false;
917
eq_bool (Fpath.has_ext ".ocamlinit" @@ v ".ocamlinit") false;
918
eq_bool (Fpath.has_ext ".ocamlinit" @@ v "..ocamlinit") false;
919
eq_bool (Fpath.has_ext "..ocamlinit" @@ v "...ocamlinit") false;
920
eq_bool (Fpath.has_ext "..ocamlinit" @@ v ".a..ocamlinit") true;
···
507
eqp (Fpath.normalize @@ v "a/..b") (v "a/..b");
508
eqp (Fpath.normalize @@ v "./a") (v "a");
509
eqp (Fpath.normalize @@ v "../a") (v "../a");
510
+
eqp (Fpath.normalize @@ v "a/..") (v "./");
511
eqp (Fpath.normalize @@ v "../../a") (v "../../a");
512
eqp (Fpath.normalize @@ v "./a/..") (v "./");
513
eqp (Fpath.normalize @@ v "/a/b/./..") (v "/a/");
···
730
relativize (v "../a") (v "../../b") (Some (v "../../b"));
731
relativize (v "a") (v "../../b") (Some (v "../../../b"));
732
relativize (v "a/c") (v "../../b") (Some (v "../../../../b"));
733
+
if windows then begin
734
+
relativize (v "C:a\\c") (v "C:..\\..\\b") (Some (v "..\\..\\..\\..\\b"));
735
+
relativize (v "C:a\\c") (v "..\\..\\b") None;
736
+
relativize (v "\\\\?\\UNC\\server\\share\\a\\b\\c")
737
+
(v "\\\\?\\UNC\\server\\share\\d\\e\\f") (Some (v "../../../d/e/f"));
738
+
end;
739
()
740
741
let is_abs_rel = test "Fpath.is_abs_rel" @@ fun () ->
···
835
()
836
837
let get_ext = test "Fpath.get_ext" @@ fun () ->
838
+
eq_str (Fpath.get_ext @@ v "/") "";
839
eq_str (Fpath.get_ext @@ v ".") "";
840
eq_str (Fpath.get_ext @@ v "..") "";
841
eq_str (Fpath.get_ext @@ v "...") "";
···
847
eq_str (Fpath.get_ext @@ v ".a...") ".";
848
eq_str (Fpath.get_ext @@ v ".a....") ".";
849
eq_str (Fpath.get_ext @@ v "a/...") "";
850
+
eq_str (Fpath.get_ext @@ v "a.mli/.") "";
851
+
eq_str (Fpath.get_ext @@ v "a.mli/..") "";
852
eq_str (Fpath.get_ext @@ v "a/.a") "";
853
eq_str (Fpath.get_ext @@ v "a/..b") "";
854
eq_str (Fpath.get_ext @@ v "a/..b.a") ".a";
855
+
eq_str (Fpath.get_ext @@ v "a/..b.a/") ".a";
856
eq_str (Fpath.get_ext @@ v "a/..b..ac") ".ac";
857
+
eq_str (Fpath.get_ext @@ v "a/..b..ac/") ".ac";
858
eq_str (Fpath.get_ext @@ v "/a/b") "";
859
eq_str (Fpath.get_ext @@ v "/a/b.") ".";
860
+
eq_str (Fpath.get_ext @@ v "/a/b./") ".";
861
eq_str (Fpath.get_ext @@ v "a/.ocamlinit") "";
862
+
eq_str (Fpath.get_ext @@ v "a/.ocamlinit/") "";
863
eq_str (Fpath.get_ext @@ v "a/.emacs.d") ".d";
864
+
eq_str (Fpath.get_ext @@ v "a/.emacs.d/") ".d";
865
eq_str (Fpath.get_ext @@ v "/a/b.mli") ".mli";
866
+
eq_str (Fpath.get_ext @@ v "/a/b.mli/") ".mli";
867
eq_str (Fpath.get_ext @@ v "a.tar.gz") ".gz";
868
+
eq_str (Fpath.get_ext @@ v "a.tar.gz/") ".gz";
869
eq_str (Fpath.get_ext @@ v "./a.") ".";
870
+
eq_str (Fpath.get_ext @@ v "./a./") ".";
871
eq_str (Fpath.get_ext @@ v "./a..") ".";
872
+
eq_str (Fpath.get_ext @@ v "./a../") ".";
873
eq_str (Fpath.get_ext @@ v "./.a.") ".";
874
+
eq_str (Fpath.get_ext @@ v "./.a../") ".";
875
eq_str (Fpath.get_ext ~multi:true @@ v ".") "";
876
eq_str (Fpath.get_ext ~multi:true @@ v "..") "";
877
eq_str (Fpath.get_ext ~multi:true @@ v "...") "";
···
879
eq_str (Fpath.get_ext ~multi:true @@ v ".....") "";
880
eq_str (Fpath.get_ext ~multi:true @@ v ".a") "";
881
eq_str (Fpath.get_ext ~multi:true @@ v ".a.") ".";
882
+
eq_str (Fpath.get_ext ~multi:true @@ v ".a./") ".";
883
eq_str (Fpath.get_ext ~multi:true @@ v ".a..") "..";
884
eq_str (Fpath.get_ext ~multi:true @@ v ".a...") "...";
885
eq_str (Fpath.get_ext ~multi:true @@ v ".a....") "....";
···
888
eq_str (Fpath.get_ext ~multi:true @@ v "a/..") "";
889
eq_str (Fpath.get_ext ~multi:true @@ v "a/..b") "";
890
eq_str (Fpath.get_ext ~multi:true @@ v "a/..b.a") ".a";
891
+
eq_str (Fpath.get_ext ~multi:true @@ v "a/..b.a/") ".a";
892
eq_str (Fpath.get_ext ~multi:true @@ v "a/..b..ac") "..ac";
893
+
eq_str (Fpath.get_ext ~multi:true @@ v "a/..b..ac/") "..ac";
894
eq_str (Fpath.get_ext ~multi:true @@ v "a/.emacs.d") ".d";
895
+
eq_str (Fpath.get_ext ~multi:true @@ v "a/.emacs.d/") ".d";
896
eq_str (Fpath.get_ext ~multi:true @@ v "/a/b.mli") ".mli";
897
+
eq_str (Fpath.get_ext ~multi:true @@ v "/a/b.mli/") ".mli";
898
eq_str (Fpath.get_ext ~multi:true @@ v "a.tar.gz") ".tar.gz";
899
+
eq_str (Fpath.get_ext ~multi:true @@ v "a.tar.gz/") ".tar.gz";
900
eq_str (Fpath.get_ext ~multi:true @@ v "./a.") ".";
901
+
eq_str (Fpath.get_ext ~multi:true @@ v "./a./") ".";
902
eq_str (Fpath.get_ext ~multi:true @@ v "./a..") "..";
903
+
eq_str (Fpath.get_ext ~multi:true @@ v "./a../") "..";
904
eq_str (Fpath.get_ext ~multi:true @@ v "./.a.") ".";
905
+
eq_str (Fpath.get_ext ~multi:true @@ v "./.a./") ".";
906
eq_str (Fpath.get_ext ~multi:true @@ v "./.a..") "..";
907
+
eq_str (Fpath.get_ext ~multi:true @@ v "./.a../") "..";
908
()
909
910
let has_ext = test "Fpath.has_ext" @@ fun () ->
···
932
eq_bool (Fpath.has_ext "..." @@ v "....") false;
933
eq_bool (Fpath.has_ext "..." @@ v ".a...") true;
934
eq_bool (Fpath.has_ext ".mli" @@ v "a/b.mli") true;
935
+
eq_bool (Fpath.has_ext ".mli" @@ v "a/b.mli/") true;
936
eq_bool (Fpath.has_ext "mli" @@ v "a/b.mli") true;
937
eq_bool (Fpath.has_ext "mli" @@ v "a/bmli") false;
938
eq_bool (Fpath.has_ext "mli" @@ v "a/.mli") false;
939
eq_bool (Fpath.has_ext ".tar.gz" @@ v "a/f.tar.gz") true;
940
eq_bool (Fpath.has_ext "tar.gz" @@ v "a/f.tar.gz") true;
941
+
eq_bool (Fpath.has_ext "tar.gz" @@ v "a/f.tar.gz/") true;
942
eq_bool (Fpath.has_ext "tar.gz" @@ v "a/ftar.gz") false;
943
eq_bool (Fpath.has_ext "tar.gz" @@ v "a/tar.gz") false;
944
eq_bool (Fpath.has_ext "tar.gz" @@ v "a/.tar.gz") false;
945
eq_bool (Fpath.has_ext ".tar" @@ v "a/f.tar.gz") false;
946
eq_bool (Fpath.has_ext ".ocamlinit" @@ v ".ocamlinit") false;
947
+
eq_bool (Fpath.has_ext ".ocamlinit/" @@ v ".ocamlinit") false;
948
eq_bool (Fpath.has_ext ".ocamlinit" @@ v "..ocamlinit") false;
949
eq_bool (Fpath.has_ext "..ocamlinit" @@ v "...ocamlinit") false;
950
eq_bool (Fpath.has_ext "..ocamlinit" @@ v ".a..ocamlinit") true;