+3 -3

README.md

··· 2 2 ------------------------------------------------------------------------------- 3 3 v%%VERSION%% 4 4 5 5 - Fpath is an OCaml module for handling file system paths on POSIX and 6 6 - Windows operating systems. Fpath processes paths without accessing the 7 7 - file system and is independent from any system library. 5 5 + Fpath is an OCaml module for handling file system paths with POSIX or 6 6 + Windows conventions. Fpath processes paths without accessing the file 7 7 + system and is independent from any system library. 8 8 9 9 Fpath depends on [Astring][astring] and is distributed under the ISC 10 10 license.

+230 -266

src/fpath.ml

··· 25 25 let dir_sep_char = if windows then '\\' else '/' 26 26 let dir_sep = String.of_char dir_sep_char 27 27 let dir_sep_sub = String.sub dir_sep 28 28 + let not_dir_sep c = c <> dir_sep_char 28 29 29 30 let dot = "." 30 31 let dot_sub = String.sub dot ··· 35 36 let dotdot_dir = dotdot ^ dir_sep 36 37 let dotdot_dir_sub = String.sub dotdot_dir 37 38 38 38 - (* Structural preliminaries *) 39 39 + (* Platform specific preliminaties *) 39 40 40 40 - let validate_and_collapse_seps p = 41 41 - (* collapse non-initial sequences of [dir_sep] to a single one and checks 42 42 - no null byte *) 43 43 - let max_idx = String.length p - 1 in 44 44 - let rec with_buf b last_sep k i = (* k is the write index in b *) 45 45 - if i > max_idx then Some (Bytes.sub_string b 0 k) else 46 46 - let c = string_unsafe_get p i in 47 47 - if c = '\x00' then None else 48 48 - if c <> dir_sep_char 49 49 - then (bytes_unsafe_set b k c; with_buf b false (k + 1) (i + 1)) else 50 50 - if not last_sep 51 51 - then (bytes_unsafe_set b k c; with_buf b true (k + 1) (i + 1)) else 52 52 - with_buf b true k (i + 1) 53 53 - in 54 54 - let rec try_no_alloc last_sep i = 55 55 - if i > max_idx then Some p else 56 56 - let c = string_unsafe_get p i in 57 57 - if c = '\x00' then None else 58 58 - if c <> dir_sep_char then try_no_alloc false (i + 1) else 59 59 - if not last_sep then try_no_alloc true (i + 1) else 60 60 - let b = Bytes.of_string p in (* copy and overwrite starting from i *) 61 61 - with_buf b true i (i + 1) 62 62 - in 63 63 - let start = (* Allow initial double sep *) 64 64 - if max_idx > 0 then (if p.[0] = dir_sep_char then 1 else 0) else 0 65 65 - in 66 66 - try_no_alloc false start 41 41 + module Windows = struct 67 42 68 68 - let is_unc_path_windows p = String.is_prefix "\\\\" p 69 69 - let windows_non_unc_path_start_index p = 70 70 - match String.find (Char.equal ':') p with 43 43 + let is_unc_path p = String.is_prefix "\\\\" p 44 44 + let has_drive p = String.exists (Char.equal ':') p 45 45 + let non_unc_path_start p = match String.find (Char.equal ':') p with 71 46 | None -> 0 72 47 | Some i -> i + 1 (* exists by construction *) 73 48 74 74 - let parse_unc_windows s = 75 75 - (* parses an UNC path, the \\ prefix was already parsed, adds a root path 76 76 - if there's only a volume, UNC paths are always absolute. *) 77 77 - let p = String.sub ~start:2 s in 78 78 - let not_bslash c = c <> '\\' in 79 79 - let parse_seg p = String.Sub.span ~min:1 ~sat:not_bslash p in 80 80 - let ensure_root r = Some (if String.Sub.is_empty r then (s ^ "\\") else s) in 81 81 - match parse_seg p with 82 82 - | (seg1, _) when String.Sub.is_empty seg1 -> None (* \\ or \\\ *) 83 83 - | (seg1, rest) -> 84 84 - let seg1_len = String.Sub.length seg1 in 85 85 - match String.Sub.get_head ~rev:true seg1 with 86 86 - | '.' when seg1_len = 1 -> (* \\.\device\ *) 87 87 - begin match parse_seg (String.Sub.tail rest) with 88 88 - | (seg, _) when String.Sub.is_empty seg -> None 89 89 - | (_, rest) -> ensure_root rest 90 90 - end 91 91 - | '?' when seg1_len = 1 -> 92 92 - begin match parse_seg (String.Sub.tail rest) with 93 93 - | (seg2, _) when String.Sub.is_empty seg2 -> None 94 94 - | (seg2, rest) -> 95 95 - if (String.Sub.get_head ~rev:true seg2 = ':') (* \\?\drive:\ *) 96 96 - then (ensure_root rest) else 97 97 - if not (String.Sub.equal_bytes seg2 (String.sub "UNC")) 98 98 - then begin (* \\?\server\share\ *) 99 99 - match parse_seg (String.Sub.tail rest) with 100 100 - | (seg, _) when String.Sub.is_empty seg -> None 101 101 - | (_, rest) -> ensure_root rest 102 102 - end else begin (* \\?\UNC\server\share\ *) 103 103 - match parse_seg (String.Sub.tail rest) with 104 104 - | (seg, _) when String.Sub.is_empty seg -> None 105 105 - | (_, rest) -> 106 106 - match parse_seg (String.Sub.tail rest) with 107 107 - | (seg, _) when String.Sub.is_empty seg -> None 108 108 - | (_, rest) -> ensure_root rest 109 109 - end 110 110 - end 111 111 - | _ -> (* \\server\share\ *) 112 112 - begin match parse_seg (String.Sub.tail rest) with 113 113 - | (seg, _) when String.Sub.is_empty seg -> None 114 114 - | (_, rest) -> ensure_root rest 115 115 - end 49 49 + let parse_unc s = 50 50 + (* parses an UNC path, the \\ prefix was already parsed, adds a root path 51 51 + if there's only a volume, UNC paths are always absolute. *) 52 52 + let p = String.sub ~start:2 s in 53 53 + let not_bslash c = c <> '\\' in 54 54 + let parse_seg p = String.Sub.span ~min:1 ~sat:not_bslash p in 55 55 + let ensure_root r = Some (if String.Sub.is_empty r then (s ^ "\\") else s) 56 56 + in 57 57 + match parse_seg p with 58 58 + | (seg1, _) when String.Sub.is_empty seg1 -> None (* \\ or \\\ *) 59 59 + | (seg1, rest) -> 60 60 + let seg1_len = String.Sub.length seg1 in 61 61 + match String.Sub.get_head ~rev:true seg1 with 62 62 + | '.' when seg1_len = 1 -> (* \\.\device\ *) 63 63 + begin match parse_seg (String.Sub.tail rest) with 64 64 + | (seg, _) when String.Sub.is_empty seg -> None 65 65 + | (_, rest) -> ensure_root rest 66 66 + end 67 67 + | '?' when seg1_len = 1 -> 68 68 + begin match parse_seg (String.Sub.tail rest) with 69 69 + | (seg2, _) when String.Sub.is_empty seg2 -> None 70 70 + | (seg2, rest) -> 71 71 + if (String.Sub.get_head ~rev:true seg2 = ':') (* \\?\drive:\ *) 72 72 + then (ensure_root rest) else 73 73 + if not (String.Sub.equal_bytes seg2 (String.sub "UNC")) 74 74 + then begin (* \\?\server\share\ *) 75 75 + match parse_seg (String.Sub.tail rest) with 76 76 + | (seg, _) when String.Sub.is_empty seg -> None 77 77 + | (_, rest) -> ensure_root rest 78 78 + end else begin (* \\?\UNC\server\share\ *) 79 79 + match parse_seg (String.Sub.tail rest) with 80 80 + | (seg, _) when String.Sub.is_empty seg -> None 81 81 + | (_, rest) -> 82 82 + match parse_seg (String.Sub.tail rest) with 83 83 + | (seg, _) when String.Sub.is_empty seg -> None 84 84 + | (_, rest) -> ensure_root rest 85 85 + end 86 86 + end 87 87 + | _ -> (* \\server\share\ *) 88 88 + begin match parse_seg (String.Sub.tail rest) with 89 89 + | (seg, _) when String.Sub.is_empty seg -> None 90 90 + | (_, rest) -> ensure_root rest 91 91 + end 116 92 117 117 - let sub_split_volume_windows p = 118 118 - (* splits a windows path into its volume (or drive) and actual file 119 119 - path. When called the path in [p] is guaranteed to be non empty 120 120 - and if [p] is an UNC path it is guaranteed to the be parseable by 121 121 - parse_unc_windows. *) 122 122 - let split_before i = String.sub p ~stop:i, String.sub p ~start:i in 123 123 - if not (is_unc_path_windows p) then 124 124 - begin match String.find (Char.equal ':') p with 125 125 - | None -> String.Sub.empty, String.sub p 126 126 - | Some i -> split_before (i + 1) 127 127 - end 128 128 - else 129 129 - let bslash ~start = match String.find ~start (Char.equal '\\') p with 130 130 - | None -> assert false | Some i -> i 131 131 - in 132 132 - let i = bslash ~start:2 in 133 133 - let j = bslash ~start:(i + 1) in 134 134 - match p.[i-1] with 135 135 - | '.' when i = 3 -> split_before j 136 136 - | '?' when i = 3 -> 137 137 - if p.[j-1] = ':' then split_before j else 138 138 - if (String.Sub.equal_bytes 139 139 - (String.sub p ~start:(i + 1) ~stop:j) 140 140 - (String.sub "UNC")) 141 141 - then split_before (bslash ~start:((bslash ~start:(j + 1)) + 1)) 93 93 + let sub_split_volume p = 94 94 + (* splits a windows path into its volume (or drive) and actual file 95 95 + path. When called the path in [p] is guaranteed to be non empty 96 96 + and if [p] is an UNC path it is guaranteed to the be parseable by 97 97 + parse_unc_windows. *) 98 98 + let split_before i = String.sub p ~stop:i, String.sub p ~start:i in 99 99 + if not (is_unc_path p) then 100 100 + begin match String.find (Char.equal ':') p with 101 101 + | None -> String.Sub.empty, String.sub p 102 102 + | Some i -> split_before (i + 1) 103 103 + end 104 104 + else 105 105 + let bslash ~start = match String.find ~start (Char.equal '\\') p with 106 106 + | None -> assert false | Some i -> i 107 107 + in 108 108 + let i = bslash ~start:2 in 109 109 + let j = bslash ~start:(i + 1) in 110 110 + match p.[i-1] with 111 111 + | '.' when i = 3 -> split_before j 112 112 + | '?' when i = 3 -> 113 113 + if p.[j-1] = ':' then split_before j else 114 114 + if (String.Sub.equal_bytes 115 115 + (String.sub p ~start:(i + 1) ~stop:j) 116 116 + (String.sub "UNC")) 117 117 + then split_before (bslash ~start:((bslash ~start:(j + 1)) + 1)) 142 118 else split_before (bslash ~start:(j + 1)) 143 143 - | _ -> split_before j 119 119 + | _ -> split_before j 144 120 145 145 - let is_root_posix p = String.equal p dir_sep || String.equal p "//" 146 146 - let is_root_windows p = 147 147 - let _, p = sub_split_volume_windows p in 148 148 - String.Sub.equal_bytes dir_sep_sub p 121 121 + let is_root p = 122 122 + let _, p = sub_split_volume p in 123 123 + String.Sub.get_head p = dir_sep_char 124 124 + end 125 125 + 126 126 + module Posix = struct 127 127 + let has_volume p = String.is_prefix "//" p 128 128 + let is_root p = String.equal p dir_sep || String.equal p "//" 129 129 + end 149 130 150 131 (* Segments *) 151 132 ··· 159 140 160 141 let is_seg = if windows then is_seg_windows else is_seg_posix 161 142 162 162 - let not_dir_sep c = c <> dir_sep_char 163 163 - 164 143 let _split_last_seg p = String.Sub.span ~rev:true ~sat:not_dir_sep p 165 144 let _sub_last_seg p = String.Sub.take ~rev:true ~sat:not_dir_sep p 166 166 - let sub_last_seg_windows p = _sub_last_seg (snd (sub_split_volume_windows p)) 167 167 - let sub_last_seg_posix p = _sub_last_seg (String.sub p) 168 168 - let sub_last_seg = if windows then sub_last_seg_windows else sub_last_seg_posix 169 169 - 170 170 - let _sub_last_non_empty_seg p = (* result is empty only roots *) 145 145 + let _sub_last_non_empty_seg p = (* returns empty on roots though *) 171 146 let dir, last = _split_last_seg p in 172 147 match String.Sub.is_empty last with 173 148 | false -> last 174 149 | true -> _sub_last_seg (String.Sub.tail ~rev:true dir) 175 150 151 151 + let _split_last_non_empty_seg p = 152 152 + let (dir, last_seg as r) = _split_last_seg p in 153 153 + match String.Sub.is_empty last_seg with 154 154 + | false -> r, true 155 155 + | true -> _split_last_seg (String.Sub.tail ~rev:true dir), false 156 156 + 157 157 + let sub_last_seg_windows p = _sub_last_seg (snd (Windows.sub_split_volume p)) 158 158 + let sub_last_seg_posix p = _sub_last_seg (String.sub p) 159 159 + let sub_last_seg = if windows then sub_last_seg_windows else sub_last_seg_posix 160 160 + 176 161 let sub_last_non_empty_seg_windows p = 177 177 - _sub_last_non_empty_seg (snd (sub_split_volume_windows p)) 162 162 + _sub_last_non_empty_seg (snd (Windows.sub_split_volume p)) 178 163 179 164 let sub_last_non_empty_seg_posix p = 180 165 _sub_last_non_empty_seg (String.sub p) ··· 183 168 if windows then sub_last_non_empty_seg_windows else 184 169 sub_last_non_empty_seg_posix 185 170 186 186 - let _split_last_non_empty_seg p = 187 187 - let (dir, last_seg as r) = _split_last_seg p in 188 188 - match String.Sub.is_empty last_seg with 189 189 - | false -> r, true 190 190 - | true -> _split_last_seg (String.Sub.tail ~rev:true dir), false 191 191 - 192 192 - let seg_is_rel = function "." | ".." -> true | _ -> false 193 193 - let sub_seg_is_rel seg = 171 171 + let is_rel_seg = function "." | ".." -> true | _ -> false 172 172 + let sub_is_rel_seg seg = 194 173 String.Sub.(equal_bytes dot_sub seg || equal_bytes dotdot_sub seg) 195 174 175 175 + let segs_of_path p = String.cuts ~sep:dir_sep p 176 176 + let segs_to_path segs = String.concat ~sep:dir_sep segs 177 177 + 196 178 (* File paths *) 197 179 198 180 type t = string (* N.B. a path is never "" or something is wrooong. *) 181 181 + 182 182 + let validate_and_collapse_seps p = 183 183 + (* collapse non-initial sequences of [dir_sep] to a single one and checks 184 184 + no null byte *) 185 185 + let max_idx = String.length p - 1 in 186 186 + let rec with_buf b last_sep k i = (* k is the write index in b *) 187 187 + if i > max_idx then Some (Bytes.sub_string b 0 k) else 188 188 + let c = string_unsafe_get p i in 189 189 + if c = '\x00' then None else 190 190 + if c <> dir_sep_char 191 191 + then (bytes_unsafe_set b k c; with_buf b false (k + 1) (i + 1)) else 192 192 + if not last_sep 193 193 + then (bytes_unsafe_set b k c; with_buf b true (k + 1) (i + 1)) else 194 194 + with_buf b true k (i + 1) 195 195 + in 196 196 + let rec try_no_alloc last_sep i = 197 197 + if i > max_idx then Some p else 198 198 + let c = string_unsafe_get p i in 199 199 + if c = '\x00' then None else 200 200 + if c <> dir_sep_char then try_no_alloc false (i + 1) else 201 201 + if not last_sep then try_no_alloc true (i + 1) else 202 202 + let b = Bytes.of_string p in (* copy and overwrite starting from i *) 203 203 + with_buf b true i (i + 1) 204 204 + in 205 205 + let start = (* Allow initial double sep for POSIX and UNC paths *) 206 206 + if max_idx > 0 then (if p.[0] = dir_sep_char then 1 else 0) else 0 207 207 + in 208 208 + try_no_alloc false start 199 209 200 210 let of_string_windows p = 201 211 if p = "" then None else ··· 203 213 match validate_and_collapse_seps p with 204 214 | None -> None 205 215 | Some p as some -> 206 206 - if is_unc_path_windows p then parse_unc_windows p else 216 216 + if Windows.is_unc_path p then Windows.parse_unc p else 207 217 match String.find (Char.equal ':') p with 208 218 | None -> some 209 209 - | Some i -> if i = String.length p - 1 then None else (Some p) 219 219 + | Some i when i = String.length p - 1 -> None (* path is empty *) 220 220 + | Some _ -> Some p 210 221 211 222 let of_string_posix p = if p = "" then None else validate_and_collapse_seps p 212 223 let of_string = if windows then of_string_windows else of_string_posix ··· 218 229 let add_seg p seg = 219 230 if not (is_seg seg) then invalid_arg (err_invalid_seg seg); 220 231 let sep = if p.[String.length p - 1] = dir_sep_char then "" else dir_sep in 221 221 - String.concat [p; sep; seg] 232 232 + String.concat ~sep [p; seg] 222 233 223 234 let append_posix p0 p1 = 224 235 if p1.[0] = dir_sep_char (* absolute *) then p1 else 225 236 let sep = if p0.[String.length p0 - 1] = dir_sep_char then "" else dir_sep in 226 226 - String.concat [p0; sep; p1] 237 237 + String.concat ~sep [p0; p1] 227 238 228 239 let append_windows p0 p1 = 229 229 - if is_unc_path_windows p1 then p1 else 230 230 - match String.find (Char.equal ':') p1 with 231 231 - | Some _ (* drive *) -> p1 232 232 - | None -> 233 233 - if p1.[0] = dir_sep_char then (* absolute *) p1 else 234 234 - let sep = 235 235 - if p0.[String.length p0 - 1] = dir_sep_char then "" else dir_sep 236 236 - in 237 237 - String.concat [p0; sep; p1] 240 240 + if Windows.is_unc_path p1 || Windows.has_drive p1 then p1 else 241 241 + if p1.[0] = dir_sep_char then (* absolute *) p1 else 242 242 + let sep = if p0.[String.length p0 - 1] = dir_sep_char then "" else dir_sep in 243 243 + String.concat ~sep [p0; p1] 238 244 239 245 let append = if windows then append_windows else append_posix 240 246 ··· 242 248 let ( // ) = append 243 249 244 250 let split_volume_windows p = 245 245 - let vol, path = sub_split_volume_windows p in 251 251 + let vol, path = Windows.sub_split_volume p in 246 252 String.Sub.to_string vol, String.Sub.to_string path 247 253 248 254 let split_volume_posix p = 249 249 - if String.is_prefix "//" p then dir_sep, String.with_range ~first:1 p else 250 250 - "", p 255 255 + if Posix.has_volume p then dir_sep, String.with_range ~first:1 p else "", p 251 256 252 257 let split_volume = if windows then split_volume_windows else split_volume_posix 253 258 254 259 let segs_windows p = 255 255 - let _, path = sub_split_volume_windows p in 256 256 - let path = String.Sub.to_string path in 257 257 - String.cuts ~sep:dir_sep path 260 260 + let _, path = Windows.sub_split_volume p in 261 261 + segs_of_path (String.Sub.to_string path) 258 262 259 263 let segs_posix p = 260 260 - let segs = String.cuts ~sep:dir_sep p in 261 261 - if String.is_prefix "//" p then List.tl segs else segs 264 264 + let segs = segs_of_path p in 265 265 + if Posix.has_volume p then List.tl segs else segs 262 266 263 267 let segs = if windows then segs_windows else segs_posix 264 268 ··· 279 283 280 284 (* Base and parent paths *) 281 285 282 282 - let split_base_windows p = 283 283 - let vol, path = sub_split_volume_windows p in 284 284 - if String.Sub.equal_bytes dir_sep_sub path then (* root *) p, dot_dir else 285 285 - let dir, last_seg = _split_last_seg path in 286 286 + let sub_is_root p = String.Sub.get_head p = dir_sep_char 287 287 + 288 288 + let _split_base p = 289 289 + let dir, last_seg = _split_last_seg p in 286 290 match String.Sub.is_empty dir with 287 287 - | true -> (* single seg *) 288 288 - String.Sub.base_string (String.Sub.append vol dot_dir_sub), 289 289 - String.Sub.to_string path 291 291 + | true -> (* single seg *) dot_dir_sub, String.Sub.to_string p 290 292 | false -> 291 293 match String.Sub.is_empty last_seg with 292 292 - | false -> 293 293 - String.Sub.base_string (String.Sub.append vol dir), 294 294 - String.Sub.to_string last_seg 294 294 + | false -> dir, String.Sub.to_string last_seg 295 295 | true -> 296 296 let dir_file = String.Sub.tail ~rev:true dir in 297 297 let dir, dir_last_seg = _split_last_seg dir_file in 298 298 match String.Sub.is_empty dir with 299 299 - | true -> 300 300 - String.Sub.base_string (String.Sub.append vol dot_dir_sub), 301 301 - String.Sub.to_string path 302 302 - | false -> 303 303 - String.Sub.base_string (String.Sub.append vol dir), 304 304 - String.Sub.to_string (String.Sub.extend dir_last_seg) 299 299 + | true -> dot_dir_sub, String.Sub.to_string p 300 300 + | false -> dir, String.Sub.(to_string (extend dir_last_seg)) 301 301 + 302 302 + let split_base_windows p = 303 303 + let vol, path = Windows.sub_split_volume p in 304 304 + if sub_is_root path then p, dot_dir else 305 305 + let dir, b = _split_base path in 306 306 + String.Sub.(base_string (append vol dir)), b 305 307 306 308 let split_base_posix p = 307 307 - if is_root_posix p then p, dot_dir else 308 308 - let dir, last_seg = _split_last_seg (String.sub p) in 309 309 - match String.Sub.is_empty dir with 310 310 - | true -> (* single seg *) dot_dir, p 311 311 - | false -> 312 312 - match String.Sub.is_empty last_seg with 313 313 - | false -> String.Sub.to_string dir, String.Sub.to_string last_seg 314 314 - | true -> 315 315 - let dir_file = String.Sub.tail ~rev:true dir in 316 316 - let dir, dir_last_seg = _split_last_seg dir_file in 317 317 - match String.Sub.is_empty dir with 318 318 - | true -> dot_dir, p 319 319 - | false -> 320 320 - String.Sub.to_string dir, 321 321 - String.Sub.to_string (String.Sub.extend dir_last_seg) 309 309 + if Posix.is_root p then p, dot_dir else 310 310 + let dir, b = _split_base (String.sub p) in 311 311 + String.Sub.to_string dir, b 322 312 323 313 let split_base = if windows then split_base_windows else split_base_posix 324 314 325 315 let base p = snd (split_base p) 326 316 327 327 - let basename_windows p = 328 328 - let vol, path = sub_split_volume_windows p in 329 329 - if String.Sub.equal_bytes dir_sep_sub path then (* root *) "" else 330 330 - let basename = 331 331 - let dir, last_seg = _split_last_seg path in 332 332 - match String.Sub.is_empty dir with 333 333 - | true -> (* single seg *) String.Sub.to_string path 334 334 - | false -> 335 335 - match String.Sub.is_empty last_seg with 336 336 - | false -> String.Sub.to_string last_seg 337 337 - | true -> 338 338 - let dir_file = String.Sub.tail ~rev:true dir in 339 339 - let _, dir_last_seg = _split_last_seg dir_file in 340 340 - String.Sub.to_string dir_last_seg 341 341 - in 342 342 - match basename with "." | ".." -> "" | basename -> basename 317 317 + let _basename p = match String.Sub.to_string (_sub_last_non_empty_seg p) with 318 318 + | "." | ".." -> "" 319 319 + | basename -> basename 343 320 344 344 - let basename_posix p = 345 345 - if p = dir_sep || p = "//" then (* root *) "" else 346 346 - let basename = 347 347 - let dir, last_seg = _split_last_seg (String.sub p) in 348 348 - match String.Sub.is_empty dir with 349 349 - | true -> (* single seg *) p 350 350 - | false -> 351 351 - match String.Sub.is_empty last_seg with 352 352 - | false -> String.Sub.to_string last_seg 353 353 - | true -> 354 354 - let dir_file = String.Sub.tail ~rev:true dir in 355 355 - let _, dir_last_seg = _split_last_seg dir_file in 356 356 - String.Sub.to_string dir_last_seg 357 357 - in 358 358 - match basename with "." | ".." -> "" | basename -> basename 321 321 + let basename_windows p = 322 322 + let vol, path = Windows.sub_split_volume p in 323 323 + if sub_is_root path then "" else _basename path 359 324 325 325 + let basename_posix p = if Posix.is_root p then "" else _basename (String.sub p) 360 326 let basename p = if windows then basename_windows p else basename_posix p 361 327 362 362 - (* The parent algorithm is not very smart. It tries not to preserve 363 363 - the original path and avoids dealing with normalization. We simply 364 364 - remove everyting (i.e. a potential "") after the last non-empty, 365 365 - non-relative, path segment and if the resulting path is empty we 366 366 - return "./". If the last non-empty segment is "." or ".." we then 367 367 - simply postfix "../" *) 368 368 - 369 328 let _parent p = 329 329 + (* The parent algorithm is not very smart. It tries to preserve the 330 330 + original path and avoids dealing with normalization. We simply 331 331 + only keep everything before the last non-empty, non-relative, 332 332 + path segment and if the resulting path is empty we return 333 333 + "./". Otherwise if the last non-empty segment is "." or ".." we 334 334 + simply postfix with "../" *) 370 335 let (dir, seg), is_last = _split_last_non_empty_seg p in 371 336 let dsep = if is_last then dir_sep_sub else String.Sub.empty in 372 372 - match String.Sub.is_empty dir with 373 373 - | true -> 374 374 - if sub_seg_is_rel seg then [p; dsep; dotdot_dir_sub] else [dot_dir_sub] 375 375 - | false -> 376 376 - if sub_seg_is_rel seg then [p; dsep; dotdot_dir_sub] else [dir] 337 337 + if sub_is_rel_seg seg then [p; dsep; dotdot_dir_sub] else 338 338 + if String.Sub.is_empty dir then [dot_dir_sub] else [dir] 377 339 378 340 let parent_windows p = 379 379 - let vol, path = sub_split_volume_windows p in 380 380 - if String.Sub.equal_bytes dir_sep_sub path then (* root *) p else 341 341 + let vol, path = Windows.sub_split_volume p in 342 342 + if sub_is_root path then p else 381 343 String.Sub.(base_string @@ concat (vol :: _parent path)) 382 344 383 345 let parent_posix p = 384 384 - if is_root_posix p then p else 346 346 + if Posix.is_root p then p else 385 347 String.Sub.(base_string @@ concat (_parent (String.sub p))) 386 348 387 349 let parent = if windows then parent_windows else parent_posix ··· 389 351 (* Normalization *) 390 352 391 353 let rem_empty_seg_windows p = 392 392 - let vol, path = sub_split_volume_windows p in 393 393 - if String.Sub.equal_bytes dir_sep_sub path then (* root *) p else 394 394 - let dir, last_seg = _split_last_seg path in 395 395 - if not (String.Sub.is_empty last_seg) then p else 396 396 - let p = String.Sub.tail ~rev:true dir in 397 397 - String.Sub.(base_string @@ concat [vol; p]) 354 354 + let vol, path = Windows.sub_split_volume p in 355 355 + if sub_is_root path then p else 356 356 + let max = String.Sub.length path - 1 in 357 357 + if String.Sub.get path max <> dir_sep_char then p else 358 358 + String.with_index_range p ~last:(max - 1) 398 359 399 360 let rem_empty_seg_posix p = match String.length p with 400 361 | 1 -> p ··· 410 371 let rem_empty_seg = 411 372 if windows then rem_empty_seg_windows else rem_empty_seg_posix 412 373 413 413 - let normalize_rel_segs_rev segs = 374 374 + let normalize_rel_segs segs = (* result is non empty but may be [""] *) 414 375 let rec loop acc = function 415 376 | "." :: [] -> ("" :: acc) (* final "." remove but preserve directoryness. *) 416 377 | "." :: rest -> loop acc rest ··· 426 387 | [] -> 427 388 match acc with 428 389 | ".." :: _ -> ("" :: acc) (* normalize final .. to ../ *) 390 390 + | [] -> [""] 429 391 | acc -> acc 430 392 in 431 431 - loop [] segs 393 393 + List.rev (loop [] segs) 432 394 433 395 let normalize_segs = function 434 396 | "" :: segs -> (* absolute path *) 435 435 - let rec rem_dotdots = function 436 436 - | ".." :: segs -> rem_dotdots segs 437 437 - | [] -> [""] 438 438 - | segs -> segs 439 439 - in 440 440 - "" :: (rem_dotdots (List.rev (normalize_rel_segs_rev segs))) 397 397 + let rec rem_dotdots = function ".." :: ss -> rem_dotdots ss | ss -> ss in 398 398 + "" :: (rem_dotdots @@ normalize_rel_segs segs) 441 399 | segs -> 442 442 - match List.rev (normalize_rel_segs_rev segs) with 443 443 - | [] | [""] -> ["."; ""] 400 400 + match normalize_rel_segs segs with 401 401 + | [""] -> ["."; ""] 444 402 | segs -> segs 445 403 446 404 let normalize_windows p = 447 447 - let vol, path = sub_split_volume_windows p in 405 405 + let vol, path = Windows.sub_split_volume p in 448 406 let path = String.Sub.to_string path in 449 449 - let segs = normalize_segs (String.cuts ~sep:dir_sep path) in 450 450 - let path = String.concat ~sep:dir_sep segs in 407 407 + let path = segs_to_path @@ normalize_segs (segs_of_path path) in 451 408 String.Sub.(to_string (concat [vol; String.sub path])) 452 409 453 410 let normalize_posix p = 454 454 - let segs = String.cuts ~sep:dir_sep p in 455 455 - let has_volume = String.is_prefix "//" p in 456 456 - let segs = normalize_segs (if has_volume then List.tl segs else segs) in 411 411 + let has_volume = Posix.has_volume p in 412 412 + let segs = segs_of_path p in 413 413 + let segs = normalize_segs @@ if has_volume then List.tl segs else segs in 457 414 let segs = if has_volume then "" :: segs else segs in 458 458 - String.concat ~sep:dir_sep segs 415 415 + segs_to_path segs 459 416 460 417 let normalize = if windows then normalize_windows else normalize_posix 461 418 ··· 469 426 starts with a directory separator. *) 470 427 let suff_start = String.length prefix in 471 428 if prefix.[suff_start - 1] = dir_sep_char then true else 472 472 - if suff_start = String.length p then true else 429 429 + if suff_start = String.length p then (* suffix empty *) true else 473 430 p.[suff_start] = dir_sep_char 474 431 475 475 - let seg_prefix_last_index p0 p1 = 476 476 - (* Warning doesn't care about volumes *) 432 432 + let _prefix_last_index p0 p1 = (* last char index of segment-based prefix *) 477 433 let l0 = String.length p0 in 478 434 let l1 = String.length p1 in 479 435 let p0, p1, max = if l0 < l1 then p0, p1, l0 - 1 else p1, p0, l1 - 1 in ··· 495 451 in 496 452 loop (-1) 0 p0 p1 497 453 498 498 - let find_prefix_windows p0 p1 = match seg_prefix_last_index p0 p1 with 454 454 + let find_prefix_windows p0 p1 = match _prefix_last_index p0 p1 with 499 455 | None -> None 500 456 | Some i -> 501 501 - let v0_len = String.Sub.length (fst (sub_split_volume_windows p0)) in 502 502 - let v1_len = String.Sub.length (fst (sub_split_volume_windows p1)) in 503 503 - let vmax = if v0_len > v1_len then v0_len else v1_len in 504 504 - if i < vmax then None else 505 505 - Some (String.with_index_range p0 ~last:i) 457 457 + let v0_len = String.Sub.length (fst (Windows.sub_split_volume p0)) in 458 458 + let v1_len = String.Sub.length (fst (Windows.sub_split_volume p1)) in 459 459 + let max_vlen = if v0_len > v1_len then v0_len else v1_len in 460 460 + if i < max_vlen then None else Some (String.with_index_range p0 ~last:i) 506 461 507 507 - let find_prefix_posix p0 p1 = match seg_prefix_last_index p0 p1 with 462 462 + let find_prefix_posix p0 p1 = match _prefix_last_index p0 p1 with 508 463 | None -> None 509 509 - | Some 0 when String.is_prefix "//" p0 || String.is_prefix "//" p1 -> None 464 464 + | Some 0 when Posix.has_volume p0 || Posix.has_volume p1 -> None 510 465 | Some i -> Some (String.with_index_range p0 ~last:i) 511 466 512 467 let find_prefix = if windows then find_prefix_windows else find_prefix_posix ··· 529 484 let prooted = normalize (append root p) in 530 485 if is_prefix nroot prooted then Some prooted else None 531 486 532 532 - let relativize ~root p = 487 487 + let _relativize ~root p = 533 488 let root = (* root is always interpreted as a directory *) 534 489 let root = normalize root in 535 490 if root.[String.length root - 1] = dir_sep_char then root else ··· 548 503 | [""], [""] -> 549 504 (* walk ends at the end of both path simultaneously, [p] is a 550 505 directory that matches exactly [root] expressed as a directory. *) 551 551 - Some ["."; ""] 506 506 + Some (segs_to_path ["."; ""]) 552 507 | root, p -> 553 508 (* walk ends here, either the next directory is different in 554 509 [root] and [p] or it is equal but it is the last one for [p] ··· 559 514 from the current position we just use [p] so prepending 560 515 length root - 1 .. segments to [p] tells us how to go from 561 516 the remaining root to [p]. *) 562 562 - Some (List.fold_left (fun acc _ -> dotdot :: acc) p (List.tl root)) 517 517 + let segs = List.fold_left (fun acc _ -> dotdot :: acc) p (List.tl root) in 518 518 + Some (segs_to_path segs) 563 519 in 564 520 match segs root, segs p with 565 521 | ("" :: _, s :: _) ··· 568 524 None 569 525 | ["."; ""], p -> 570 526 (* p is relative and expressed w.r.t. "./", so it is itself. *) 571 571 - Some p 527 527 + Some (segs_to_path p) 572 528 | root, p -> 573 529 (* walk in the segments of root and p until a segment mismatches. 574 530 at that point express the remaining p relative to the remaining ··· 577 533 final "" segment. *) 578 534 walk root p 579 535 580 580 - let relativize ~root p = match relativize ~root p with 581 581 - | None -> None 582 582 - | Some segs -> Some (String.concat ~sep:dir_sep segs) 536 536 + let relativize_windows ~root p = 537 537 + let rvol, root = Windows.sub_split_volume root in 538 538 + let pvol, p = Windows.sub_split_volume p in 539 539 + if not (String.Sub.equal_bytes rvol pvol) then None else 540 540 + let root = String.Sub.to_string root in 541 541 + let p = String.Sub.to_string p in 542 542 + _relativize ~root p 543 543 + 544 544 + let relativize_posix ~root p = _relativize ~root p 545 545 + 546 546 + let relativize = if windows then relativize_windows else relativize_posix 583 547 584 548 (* Predicates and comparison *) 585 549 586 550 let is_rel_posix p = p.[0] <> dir_sep_char 587 551 let is_rel_windows p = 588 588 - if is_unc_path_windows p then false else 589 589 - p.[windows_non_unc_path_start_index p] <> dir_sep_char 552 552 + if Windows.is_unc_path p then false else 553 553 + p.[Windows.non_unc_path_start p] <> dir_sep_char 590 554 591 555 let is_rel = if windows then is_rel_windows else is_rel_posix 592 556 let is_abs p = not (is_rel p) 593 593 - let is_root = if windows then is_root_windows else is_root_posix 557 557 + let is_root = if windows then Windows.is_root else Posix.is_root 594 558 595 559 let is_current_dir_posix p = String.equal p dot || String.equal p dot_dir 596 560 let is_current_dir_windows p = 597 597 - if is_unc_path_windows p then false else 598 598 - let start = windows_non_unc_path_start_index p in 561 561 + if Windows.is_unc_path p then false else 562 562 + let start = Windows.non_unc_path_start p in 599 563 match String.length p - start with 600 564 | 1 -> p.[start] = '.' 601 565 | 2 -> p.[start] = '.' && p.[start + 1] = dir_sep_char ··· 639 603 if multi then multi_ext_sub seg else single_ext_sub seg 640 604 641 605 let get_ext ?multi p = 642 642 - String.Sub.to_string (ext_sub ?multi (sub_last_seg p)) 606 606 + String.Sub.to_string (ext_sub ?multi (sub_last_non_empty_seg p)) 643 607 644 608 let has_ext e p = 645 645 - let seg = String.Sub.drop ~sat:eq_ext_sep (sub_last_seg p) in 609 609 + let seg = String.Sub.drop ~sat:eq_ext_sep (sub_last_non_empty_seg p) in 646 610 if not (String.Sub.is_suffix (String.sub e) seg) then false else 647 611 if not (String.is_empty e) && e.[0] = ext_sep_char then true else 648 612 (* check there's a dot before the suffix in [seg] *) ··· 651 615 String.Sub.get seg dot_index = ext_sep_char 652 616 653 617 let ext_exists ?(multi = false) p = 654 654 - let ext = ext_sub ~multi (sub_last_seg p) in 618 618 + let ext = ext_sub ~multi (sub_last_non_empty_seg p) in 655 619 if not multi then not (String.Sub.is_empty ext) else 656 620 if String.Sub.is_empty ext then false else 657 621 match String.Sub.find ~rev:true eq_ext_sep ext with (* find another dot *)

+90 -87

src/fpath.mli

··· 19 19 distinguishes {e directory paths} 20 20 (["a/b/"]) from {e file paths} (["a/b"]).}} 21 21 22 22 + The path segments ["."] and [".."] are {{!is_rel_seg}{e relative 23 23 + path segments}} that respectively denote the current and parent 24 24 + directory. The {{!basename}{e basename}} of a path is its last 25 25 + non-empty segment if it is not a relative path segment and the empty 26 26 + string otherwise. 27 27 + 22 28 Consult a few {{!tips}important tips}. 23 29 24 30 {b Note.} [Fpath] processes paths without accessing the file system. ··· 34 40 ["/"] on POSIX and ["\\"] on Windows. *) 35 41 36 42 val is_seg : string -> bool 37 37 - (** [is_seg s] is [true] iff [s] does not contain {!dir_sep} or a 38 38 - [0x00] byte. *) 43 43 + (** [is_seg s] is [true] iff [s] does not contain {!dir_sep} or ['/'] or 44 44 + a [0x00] byte. *) 39 45 40 46 val is_rel_seg : string -> bool 41 47 (** [is_rel_seg s] is true iff [s] is a relative segment, that is ··· 50 56 (** [v s] is the string [s] as path. 51 57 52 58 @raise Invalid_argument if [s] is not a {{!of_string}valid path}. Use 53 53 - {!of_string} to deal with foreign input and errors. *) 59 59 + {!of_string} to deal with untrusted input and errors. *) 54 60 55 61 val add_seg : t -> string -> t 56 56 - (** [add_seg p seg] adds [seg] at the end of [p]. If [seg] is [""] 57 57 - it is only added if [p] has no final empty segment. {{!ex_add_seg}Examples}. 62 62 + (** [add_seg p seg] adds [seg] at the end of [p] if [p]'s last segment 63 63 + is non-empty and replaces it otherwise. {{!ex_add_seg}Examples}. 58 64 59 65 @raise Invalid_argument if {!is_seg}[ seg] is [false]. *) 60 66 ··· 66 72 {ul 67 73 {- If [p'] is absolute or has a non-empty {{!split_volume}volume} then 68 74 [p'] is returned.} 69 69 - {- Otherwise appends [p'] to [p] using a {!dir_sep} if needed.}} 75 75 + {- Otherwise appends [p'] segments to [p] using {!add_seg}.}} 70 76 {{!ex_append}Examples}. *) 71 77 72 78 val ( // ) : t -> t -> t ··· 105 111 {- [equal p (v @@ (fst @@ split_volume p) ^ (String.concat ~sep:dir_sep 106 112 (segs p)))]}} *) 107 113 108 108 - (** {1:filedir File and directory paths} *) 114 114 + (** {1:filedir File and directory paths} 115 115 + 116 116 + {b Note.} The following properties are derived from the syntactic 117 117 + semantics of paths which can be different from the one a file 118 118 + system attributes to them. *) 109 119 110 120 val is_dir_path : t -> bool 111 111 - (** [is_dir_path p] is [true] iff [p] represents a directory. This means 112 112 - that [p]'s last segment is either [""], ["."] or [".."]. 121 121 + (** [is_dir_path p] is [true] iff [p] represents a directory. This 122 122 + means that [p]'s last segment is either [""], ["."] or [".."]. 123 123 + The property is invariant with respect to {{!normalize}normalization}. 113 124 {{!ex_is_dir_path}Examples}. *) 114 125 115 126 val is_file_path : t -> bool 116 127 (** [is_file_path p] is [true] iff [p] represents a file. This is the 117 128 negation of {!is_dir_path}. This means that [p]'s last segment is 118 118 - neither empty nor ["."], nor [".."]. {{!ex_is_file_path}Examples}. *) 129 129 + neither empty nor ["."], nor [".."]. The property is invariant 130 130 + with respect to {{!normalize}normalization}. 131 131 + {{!ex_is_file_path}Examples}. *) 119 132 120 133 val to_dir_path : t -> t 121 134 (** [to_dir_path p] is {!add_seg}[ p ""] it ensure that the result 122 122 - represents a {{!is_dir_path}directory} (and, if converted to 123 123 - a string, that it will end with a {!dir_sep}). 135 135 + represents a {{!is_dir_path}directory} and, if converted to a 136 136 + string, that it ends with a {!dir_sep}. 124 137 {{!ex_to_dir_path}Examples}. *) 125 138 126 139 val filename : t -> string 127 140 (** [filename p] is the file name of [p]. This is the last segment of 128 141 [p] if [p] is a {{!is_file_path}file path} and the empty string 129 129 - otherwise. See also {!basename}. {{!ex_filename}Examples}. *) 142 142 + otherwise. The result is invariant with respect to 143 143 + {{!normalize}normalization}. See also 144 144 + {!basename}. {{!ex_filename}Examples}. *) 130 145 131 146 (** {1:parentbase Base and parent paths} *) 132 147 ··· 141 156 {{!is_root}root path} there are no such segments and [b] 142 157 is ["./"].} 143 158 {- [d] is a {{!is_dir_path}directory} such that [d // b] 144 144 - represents the same path as [p] (they may however differ 145 145 - syntactically when converted to a string).}} 159 159 + represents the same path as [p]. They may however differ 160 160 + syntactically when converted to a string.}} 146 161 {{!ex_split_base}Examples}. 147 162 148 163 {b Note.} {{!normalize}Normalizing} [p] before using the function 149 149 - ensures that [b] will be a {{!is_rel_seg}relative segment} iff [p] cannot 164 164 + ensures that [b] is a {{!is_rel_seg}relative segment} iff [p] cannot 150 165 be named (like in ["."], ["../../"], ["/"], etc.). *) 151 166 152 167 val base : t -> t 153 168 (** [base p] is [snd (split_base p)]. *) 154 169 155 170 val basename : t -> string 156 156 - (** [basename p] is [p]'s last non-empty empty segment if 157 157 - {{!is_rel_seg}non-relative} or the empty string otherwise. The 158 158 - latter occurs on {{!is_root}root paths} and on paths whose last 159 159 - non-empty segment is relative. See also {!filename} and 171 171 + (** [basename p] is [p]'s last non-empty segment if non-relative or 172 172 + the empty string otherwise. The latter occurs only on {{!is_root}root 173 173 + paths} and on paths whose last non-empty segment is a 174 174 + {{!is_rel_seg}relative segment}. See also {!filename} and 160 175 {!base}. {{!ex_basename}Examples}. 161 176 162 177 {b Note.} {{!normalize}Normalizing} [p] before using the function ··· 174 189 (** {1:norm Normalization} *) 175 190 176 191 val rem_empty_seg : t -> t 177 177 - (** [rem_empty_seg p] removes the empty segment of [p] if it 178 178 - exists and [p] is not a {{!is_root}root path}. This ensure that if 179 179 - [p] is converted to a string it will not have a trailing 180 180 - {!dir_sep} unless [p] is a root path. Note that this may affect 181 181 - [p]'s {{!is_dir_path}directoryness}. 182 182 - {{!ex_rem_empty_seg}Examples}. *) 192 192 + (** [rem_empty_seg p] removes the empty segment of [p] if it exists 193 193 + and [p] is not a {{!is_root}root path}. This ensure that if [p] is 194 194 + converted to a string it will not have a trailing {!dir_sep} 195 195 + unless [p] is a root path. Note that this may affect [p]'s 196 196 + {{!is_dir_path}directoryness}. {{!ex_rem_empty_seg}Examples}. *) 183 197 184 198 val normalize : t -> t 185 199 (** [normalize p] is a path that represents the same path as [p], ··· 197 211 198 212 (** {1:prefix Prefixes} 199 213 200 200 - {b Warning.} The {{!is_prefix}prefix property} between paths does 201 201 - not entail directory containement in general, as it is, by 202 202 - definition, a syntactic test. For example [is_prefix (v "..") (v 203 203 - "../..")] is [true], but the second path is not contained in the 204 204 - first one or [is_prefix (v "..") (v ".")] is [false]. However, on 205 205 - {{!normalize}normalized}, {{!is_abs}absolute} paths, the prefix relation 206 206 - does entail directory containement. See also {!rooted}. *) 214 214 + {b Warning.} The syntactic {{!is_prefix}prefix relation} between 215 215 + paths does not, in general, entail directory containement. The following 216 216 + examples show this: 217 217 + {[ 218 218 + is_prefix (v "..") (v "../..") = true 219 219 + is_prefix (v "..") (v ".") = false 220 220 + ]} 221 221 + However, on {{!normalize}normalized}, {{!is_abs}absolute} paths, 222 222 + the prefix relation does entail directory containement. See also 223 223 + {!is_rooted}. *) 207 224 208 225 val is_prefix : t -> t -> bool 209 226 (** [is_prefix prefix p] is [true] if [prefix] is a prefix of ··· 235 252 prefix [prefix] and preserves [p]'s 236 253 {{!is_dir_path}directoryness}. This means that [q] is a always 237 254 {{!is_rel}relative} and that the path [prefix // q] and [p] represent the 238 238 - same paths (they may however differ syntactically when 239 239 - converted to a string).}} 255 255 + same paths. They may however differ syntactically when 256 256 + converted to a string.}} 240 257 {{!ex_rem_prefix}Examples}. *) 241 258 242 259 (** {1 Roots and relativization} *) ··· 246 263 {ul 247 264 {- [Some q] if there exists a {{!is_relative}relative} path [q] such 248 265 that [root // q] and [p] represent the same paths, 249 249 - {{!is_dir_path}directoryness} included (they may however differ 250 250 - syntactically when converted to a string).} 266 266 + {{!is_dir_path}directoryness} included. They may however differ 267 267 + syntactically when converted to a string.} 251 268 {- [None] otherwise}} 252 269 253 270 {{!ex_relativize}Examples.} *) 254 271 255 255 - (* 256 256 - 257 257 - val is_rooted : root:t -> t -> bool 258 258 - (** [is_rooted root p] is [true] iff [p] is equal or contained in the 259 259 - directory represented by [root] (if [root] is a {{!is_file_path}file path}, 260 260 - the path {!to_dir_path}[ root] is used instead). 261 261 - {{!ex_is_rooted}Examples.} *) 262 262 - 263 263 - val rooted_append : ?normalized:bool -> root:t -> t -> t option 264 264 - (** [rooted_append ~root p] {{!appends}appends} [p] to [root] and 265 265 - returns a result iff [is_rooted root (append root t)] is [true]. 266 266 - If [normalized] is [true] the result is normalized. 267 267 - {{!ex_rooted_append}Examples.} *) 268 268 - *) 269 269 - 270 270 - (* 271 271 - 272 272 - 273 273 - the path [p] is contained in path [root]. 274 274 - {ul 275 275 - {- [None] if [prefix] 276 276 - [is_prefix (normalize root) (normalize @@ append root p) = false].} 277 277 - {- [Some (normalize @@ append root p)] otherwise.}} 278 278 - In other words it ensures that an absolute path [p] or a relative 279 279 - path [p] expressed w.r.t. [root] expresses a path that is 280 280 - within the [root] file hierarchy. {{!ex_rooted}Examples}. *) 281 281 - 282 272 (** {1:predicates Predicates and comparison} *) 283 273 284 274 val is_rel : t -> bool ··· 317 307 *) 318 308 319 309 val is_dotfile : t -> bool 320 320 - (** [is_dotfile p] is [true] iff [p]'s last non-empty segment is not 321 321 - ["."] or [".."] and starts with a ['.']. {{!ex_is_dotfile}Examples}. 310 310 + (** [is_dotfile p] is [true] iff [p]'s {{!basename}basename} is non 311 311 + empty and starts with a ['.']. 322 312 323 313 {b Warning.} By definition this is a syntactic test. For example it will 324 314 return [false] on [".ssh/."]. {{!normalize}Normalizing} the ··· 345 335 (** [of_string s] is the string [s] as a path. [None] is returned if 346 336 {ul 347 337 {- [s] or the path following the {{!split_volume}volume} is empty ([""]), 348 348 - expect on Windows UNC paths, see below.} 338 338 + except on Windows UNC paths, see below.} 349 339 {- [s] has null byte (['\x00']).} 350 340 {- On Windows, [s] is an invalid UNC path (e.g. ["\\\\"] or ["\\\\a"])}} 351 341 The following transformations are performed on the string: ··· 373 363 character. If there is no such occurence in the segment, the 374 364 extension is empty. With these definitions, ["."], [".."], 375 365 ["..."] and dot files like [".ocamlinit"] or ["..ocamlinit"] have 376 376 - no extension, but [".emacs.d"] and ["..emacs.d"] do have one. *) 366 366 + no extension, but [".emacs.d"] and ["..emacs.d"] do have one. 367 367 + 368 368 + {b Warning.} The following functions act on paths whose 369 369 + {{!basename}basename} is non empty and do nothing otherwise. 370 370 + {{!normalize}Normalizing} [p] before using the functions ensures 371 371 + that the functions do nothing iff [p] cannot be named (like in 372 372 + ["."], ["../../"], ["/"], etc.). *) 377 373 378 374 type ext = string 379 375 (** The type for file extensions. *) 380 376 381 377 val get_ext : ?multi:bool -> t -> ext 382 382 - (** [get_ext p] is [p]'s last non-empty segment file extension or the empty 383 383 - string if there is no extension. If [multi] is [true] (defaults to 384 384 - [false]), returns the multiple file extension. {{!ex_get_ext}Examples}. *) 378 378 + (** [get_ext p] is [p]'s {{!basename}basename} file extension or the 379 379 + empty string if there is no extension. If [multi] is [true] 380 380 + (defaults to [false]), returns the multiple file 381 381 + extension. {{!ex_get_ext}Examples}. *) 385 382 386 383 val has_ext : ext -> t -> bool 387 384 (** [has_ext e p] is [true] iff [ext p = e || ext ~multi:true p = e]. ··· 389 386 the test. {{!ex_has_ext}Examples}. *) 390 387 391 388 val ext_exists : ?multi:bool -> t -> bool 392 392 - (** [ext_exists ~multi p] is [true] iff [p]'s last segment has an 393 393 - extension. If [multi] is [true] (default to [false]) returns 394 394 - [true] iff [p] has {e more than one} extension. 389 389 + (** [ext_exists ~multi p] is [true] iff [p]'s last non-empty 390 390 + segment has an extension. If [multi] is [true] (default to [false]) 391 391 + returns [true] iff [p] has {e more than one} extension. 395 392 {{!ex_ext_exists}Examples}. *) 396 393 397 394 val add_ext : ext -> t -> t ··· 556 553 a path}. This usually means that we don't care whether the path 557 554 is a {{!is_file_path}file path} (e.g. ["a"]) or a 558 555 {{!is_dir_path}directory path} (e.g. ["a/"]).} 559 559 - {- Windows accepts both ['\\'] and ['/'] as directory 560 560 - separator. However [Fpath] on Windows converts ['/'] to ['\\'] on 561 561 - the fly. Therefore you should either use ['/'] for defining 556 556 + {- Windows accepts both ['\\'] and ['/'] as directory separator. 557 557 + However [Fpath] on Windows converts ['/'] to ['\\'] on the 558 558 + fly. Therefore you should either use ['/'] for defining 562 559 constant paths you inject with {!v} or better, construct them 563 563 - directly with {!(/)}. {!to_string} will convert these paths 564 564 - to strings using the platform's specific directory 565 565 - separator {!dir_sep}.} 560 560 + directly with {!(/)}. {!to_string} then converts paths to strings 561 561 + using the platform's specific directory separator {!dir_sep}.} 566 562 {- Avoid platform specific {{!split_volume}volumes} or hard-coding file 567 563 hierarchy conventions in your constants.} 568 564 {- Do not assume there is a single root path and that it is 569 569 - [/]. On Windows each {{!split_volume}volume} can have a root path. 570 570 - Use {!is_root} to detect root paths.} 565 565 + ["/"]. On Windows each {{!split_volume}volume} can have a root path. 566 566 + Use {!is_root} on {{!normalize}normalized} paths to detect roots.} 571 567 {- Do not use {!to_string} to construct URIs, {!to_string} uses 572 568 {!dir_sep} to separate segments, on Windows this is ['\\'] which 573 573 - is not what URIs expect. Access the path segments directly 574 574 - with {!segs}, note that you will need to percent encode these.}} 569 569 + is not what URIs expect. Access path segments directly 570 570 + with {!segs}; note that you will need to percent encode these.}} 575 571 576 572 {1:ex Examples} 577 573 ··· 926 922 927 923 {2:ex_get_ext {!get_ext}} 928 924 {ul 925 925 + {- [get_ext (v "/") = ""]} 929 926 {- [get_ext (v "/a/b") = ""]} 930 930 - {- [get_ext (v "a/.") = ""]} 931 931 - {- [get_ext (v "a/..") = ""]} 927 927 + {- [get_ext (v "a.mli/.") = ""]} 928 928 + {- [get_ext (v "a.mli/..") = ""]} 932 929 {- [get_ext (v "a/.ocamlinit") = ""]} 930 930 + {- [get_ext (v "a/.ocamlinit/") = ""]} 933 931 {- [get_ext (v "/a/b.") = "."]} 934 932 {- [get_ext (v "/a/b.mli") = ".mli"]} 935 933 {- [get_ext (v "a.tar.gz") = ".gz"]} 936 934 {- [get_ext (v "a/.emacs.d") = ".d"]} 935 935 + {- [get_ext (v "a/.emacs.d/") = ".d"]} 937 936 {- [get_ext ~multi:true (v "/a/b.mli") = ".mli"]} 938 937 {- [get_ext ~multi:true (v "a.tar.gz") = ".tar.gz"]} 939 939 - {- [get_ext ~multi:true (v "a/.emacs.d") = ".d"]}} 938 938 + {- [get_ext ~multi:true (v "a/.emacs.d") = ".d"]} 939 939 + {- [get_ext ~multi:true (v "a/.emacs.d/") = ".d/"]}} 940 940 941 941 {2:ex_has_ext {!has_ext}} 942 942 {ul 943 943 {- [has_ext ".mli" (v "a/b.mli") = true]} 944 944 {- [has_ext "mli" (v "a/b.mli") = true]} 945 945 + {- [has_ext "mli" (v "a/b.mli/") = true]} 945 946 {- [has_ext "mli" (v "a/bmli") = false]} 946 947 {- [has_ext ".tar.gz" (v "a/f.tar.gz") = true]} 947 948 {- [has_ext "tar.gz" (v "a/f.tar.gz") = true]} ··· 953 954 {- [ext_exists (v "a/f.") = true]} 954 955 {- [ext_exists (v "a/f.gz") = true]} 955 956 {- [ext_exists (v "a/f.tar.gz") = true]} 957 957 + {- [ext_exists (v "a/f.tar.gz/") = true]} 956 958 {- [ext_exists (v ".emacs.d") = true]} 959 959 + {- [ext_exists (v ".emacs.d/") = true]} 957 960 {- [ext_exists ~multi:true (v "a/f.gz") = false]} 958 961 {- [ext_exists ~multi:true (v "a/f.tar.gz") = true]} 959 962 {- [ext_exists ~multi:true (v ".emacs.d") = false]}}

+33 -3

test/test_path.ml

··· 507 507 eqp (Fpath.normalize @@ v "a/..b") (v "a/..b"); 508 508 eqp (Fpath.normalize @@ v "./a") (v "a"); 509 509 eqp (Fpath.normalize @@ v "../a") (v "../a"); 510 510 + eqp (Fpath.normalize @@ v "a/..") (v "./"); 510 511 eqp (Fpath.normalize @@ v "../../a") (v "../../a"); 511 512 eqp (Fpath.normalize @@ v "./a/..") (v "./"); 512 513 eqp (Fpath.normalize @@ v "/a/b/./..") (v "/a/"); ··· 729 730 relativize (v "../a") (v "../../b") (Some (v "../../b")); 730 731 relativize (v "a") (v "../../b") (Some (v "../../../b")); 731 732 relativize (v "a/c") (v "../../b") (Some (v "../../../../b")); 733 733 + if windows then begin 734 734 + relativize (v "C:a\\c") (v "C:..\\..\\b") (Some (v "..\\..\\..\\..\\b")); 735 735 + relativize (v "C:a\\c") (v "..\\..\\b") None; 736 736 + relativize (v "\\\\?\\UNC\\server\\share\\a\\b\\c") 737 737 + (v "\\\\?\\UNC\\server\\share\\d\\e\\f") (Some (v "../../../d/e/f")); 738 738 + end; 732 739 () 733 740 734 741 let is_abs_rel = test "Fpath.is_abs_rel" @@ fun () -> ··· 828 835 () 829 836 830 837 let get_ext = test "Fpath.get_ext" @@ fun () -> 838 838 + eq_str (Fpath.get_ext @@ v "/") ""; 831 839 eq_str (Fpath.get_ext @@ v ".") ""; 832 840 eq_str (Fpath.get_ext @@ v "..") ""; 833 841 eq_str (Fpath.get_ext @@ v "...") ""; ··· 839 847 eq_str (Fpath.get_ext @@ v ".a...") "."; 840 848 eq_str (Fpath.get_ext @@ v ".a....") "."; 841 849 eq_str (Fpath.get_ext @@ v "a/...") ""; 842 842 - eq_str (Fpath.get_ext @@ v "a/.") ""; 843 843 - eq_str (Fpath.get_ext @@ v "a/..") ""; 850 850 + eq_str (Fpath.get_ext @@ v "a.mli/.") ""; 851 851 + eq_str (Fpath.get_ext @@ v "a.mli/..") ""; 844 852 eq_str (Fpath.get_ext @@ v "a/.a") ""; 845 853 eq_str (Fpath.get_ext @@ v "a/..b") ""; 846 854 eq_str (Fpath.get_ext @@ v "a/..b.a") ".a"; 855 855 + eq_str (Fpath.get_ext @@ v "a/..b.a/") ".a"; 847 856 eq_str (Fpath.get_ext @@ v "a/..b..ac") ".ac"; 857 857 + eq_str (Fpath.get_ext @@ v "a/..b..ac/") ".ac"; 848 858 eq_str (Fpath.get_ext @@ v "/a/b") ""; 849 859 eq_str (Fpath.get_ext @@ v "/a/b.") "."; 860 860 + eq_str (Fpath.get_ext @@ v "/a/b./") "."; 850 861 eq_str (Fpath.get_ext @@ v "a/.ocamlinit") ""; 862 862 + eq_str (Fpath.get_ext @@ v "a/.ocamlinit/") ""; 851 863 eq_str (Fpath.get_ext @@ v "a/.emacs.d") ".d"; 864 864 + eq_str (Fpath.get_ext @@ v "a/.emacs.d/") ".d"; 852 865 eq_str (Fpath.get_ext @@ v "/a/b.mli") ".mli"; 866 866 + eq_str (Fpath.get_ext @@ v "/a/b.mli/") ".mli"; 853 867 eq_str (Fpath.get_ext @@ v "a.tar.gz") ".gz"; 868 868 + eq_str (Fpath.get_ext @@ v "a.tar.gz/") ".gz"; 854 869 eq_str (Fpath.get_ext @@ v "./a.") "."; 870 870 + eq_str (Fpath.get_ext @@ v "./a./") "."; 855 871 eq_str (Fpath.get_ext @@ v "./a..") "."; 872 872 + eq_str (Fpath.get_ext @@ v "./a../") "."; 856 873 eq_str (Fpath.get_ext @@ v "./.a.") "."; 857 857 - eq_str (Fpath.get_ext @@ v "./.a..") "."; 874 874 + eq_str (Fpath.get_ext @@ v "./.a../") "."; 858 875 eq_str (Fpath.get_ext ~multi:true @@ v ".") ""; 859 876 eq_str (Fpath.get_ext ~multi:true @@ v "..") ""; 860 877 eq_str (Fpath.get_ext ~multi:true @@ v "...") ""; ··· 862 879 eq_str (Fpath.get_ext ~multi:true @@ v ".....") ""; 863 880 eq_str (Fpath.get_ext ~multi:true @@ v ".a") ""; 864 881 eq_str (Fpath.get_ext ~multi:true @@ v ".a.") "."; 882 882 + eq_str (Fpath.get_ext ~multi:true @@ v ".a./") "."; 865 883 eq_str (Fpath.get_ext ~multi:true @@ v ".a..") ".."; 866 884 eq_str (Fpath.get_ext ~multi:true @@ v ".a...") "..."; 867 885 eq_str (Fpath.get_ext ~multi:true @@ v ".a....") "...."; ··· 870 888 eq_str (Fpath.get_ext ~multi:true @@ v "a/..") ""; 871 889 eq_str (Fpath.get_ext ~multi:true @@ v "a/..b") ""; 872 890 eq_str (Fpath.get_ext ~multi:true @@ v "a/..b.a") ".a"; 891 891 + eq_str (Fpath.get_ext ~multi:true @@ v "a/..b.a/") ".a"; 873 892 eq_str (Fpath.get_ext ~multi:true @@ v "a/..b..ac") "..ac"; 893 893 + eq_str (Fpath.get_ext ~multi:true @@ v "a/..b..ac/") "..ac"; 874 894 eq_str (Fpath.get_ext ~multi:true @@ v "a/.emacs.d") ".d"; 895 895 + eq_str (Fpath.get_ext ~multi:true @@ v "a/.emacs.d/") ".d"; 875 896 eq_str (Fpath.get_ext ~multi:true @@ v "/a/b.mli") ".mli"; 897 897 + eq_str (Fpath.get_ext ~multi:true @@ v "/a/b.mli/") ".mli"; 876 898 eq_str (Fpath.get_ext ~multi:true @@ v "a.tar.gz") ".tar.gz"; 899 899 + eq_str (Fpath.get_ext ~multi:true @@ v "a.tar.gz/") ".tar.gz"; 877 900 eq_str (Fpath.get_ext ~multi:true @@ v "./a.") "."; 901 901 + eq_str (Fpath.get_ext ~multi:true @@ v "./a./") "."; 878 902 eq_str (Fpath.get_ext ~multi:true @@ v "./a..") ".."; 903 903 + eq_str (Fpath.get_ext ~multi:true @@ v "./a../") ".."; 879 904 eq_str (Fpath.get_ext ~multi:true @@ v "./.a.") "."; 905 905 + eq_str (Fpath.get_ext ~multi:true @@ v "./.a./") "."; 880 906 eq_str (Fpath.get_ext ~multi:true @@ v "./.a..") ".."; 907 907 + eq_str (Fpath.get_ext ~multi:true @@ v "./.a../") ".."; 881 908 () 882 909 883 910 let has_ext = test "Fpath.has_ext" @@ fun () -> ··· 905 932 eq_bool (Fpath.has_ext "..." @@ v "....") false; 906 933 eq_bool (Fpath.has_ext "..." @@ v ".a...") true; 907 934 eq_bool (Fpath.has_ext ".mli" @@ v "a/b.mli") true; 935 935 + eq_bool (Fpath.has_ext ".mli" @@ v "a/b.mli/") true; 908 936 eq_bool (Fpath.has_ext "mli" @@ v "a/b.mli") true; 909 937 eq_bool (Fpath.has_ext "mli" @@ v "a/bmli") false; 910 938 eq_bool (Fpath.has_ext "mli" @@ v "a/.mli") false; 911 939 eq_bool (Fpath.has_ext ".tar.gz" @@ v "a/f.tar.gz") true; 912 940 eq_bool (Fpath.has_ext "tar.gz" @@ v "a/f.tar.gz") true; 941 941 + eq_bool (Fpath.has_ext "tar.gz" @@ v "a/f.tar.gz/") true; 913 942 eq_bool (Fpath.has_ext "tar.gz" @@ v "a/ftar.gz") false; 914 943 eq_bool (Fpath.has_ext "tar.gz" @@ v "a/tar.gz") false; 915 944 eq_bool (Fpath.has_ext "tar.gz" @@ v "a/.tar.gz") false; 916 945 eq_bool (Fpath.has_ext ".tar" @@ v "a/f.tar.gz") false; 917 946 eq_bool (Fpath.has_ext ".ocamlinit" @@ v ".ocamlinit") false; 947 947 + eq_bool (Fpath.has_ext ".ocamlinit/" @@ v ".ocamlinit") false; 918 948 eq_bool (Fpath.has_ext ".ocamlinit" @@ v "..ocamlinit") false; 919 949 eq_bool (Fpath.has_ext "..ocamlinit" @@ v "...ocamlinit") false; 920 950 eq_bool (Fpath.has_ext "..ocamlinit" @@ v ".a..ocamlinit") true;