1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
|
open Fugue
exception EmptyFilename
exception InvalidFilename of string
type filepath = {
absolute : bool;
filepath : string list;
}
type filename = { filename : string }
let is_absolute fp = fp.absolute
let empty_fn = { filename = "" }
let current_dir = { absolute = false; filepath = [] }
let fp_to_string x =
match (x.filepath, x.absolute) with
| [], true -> "/"
| [], false -> "./"
| l, true -> "/" ^ String.concat Filename.dir_sep l
| l, false -> String.concat Filename.dir_sep l
let fn_to_string x = x.filename
(** [got_dirsep s] returns [true] if [s] contains [Filename.dir_sep], i.e. "/" on Unix. *)
let got_dirsep x =
let gotDirsep = ref false in
let dirsepLen = String.length Filename.dir_sep in
for i = 0 to String.length x - dirsepLen - 1 do
if String.sub x i dirsepLen = Filename.dir_sep then
gotDirsep := true
done;
!gotDirsep
(* this only strip the last / if it exists *)
let fp x =
(* TODO fix it properly, however separator is always a single char *)
match String_utils.split Filename.dir_sep.[0] x with
| "" :: p -> { absolute = true; filepath = List.filter (fun x -> x <> "." && x <> "") p }
| p -> { absolute = false; filepath = List.filter (fun x -> x <> "." && x <> "") p }
let fn = function
| "" | "." | ".." -> raise EmptyFilename
| filename when got_dirsep filename -> raise (InvalidFilename filename)
| filename -> { filename }
let valid_fn x =
try
let _ = fn x in
true
with EmptyFilename | InvalidFilename _ -> false
let ( <//> ) (afp : filepath) (bfp : filepath) =
match (afp.absolute, bfp.absolute) with
| _, true -> failwith "the second argument cannot be an absolute path"
| _ -> { absolute = afp.absolute; filepath = afp.filepath @ bfp.filepath }
let ( </> ) (afp : filepath) (bfp : filename) =
{ absolute = afp.absolute; filepath = afp.filepath @ [ bfp.filename ] }
let ( <.> ) (afp : filename) ext = fn (afp.filename ^ "." ^ ext)
let path_length path = List.length path.filepath
let path_dirname path = { path with filepath = list_init path.filepath }
let path_basename path = fn (list_last path.filepath)
let in_current_dir (x : filename) = fp x.filename
let chop_extension (x : filename) = fn (Filename.chop_extension (fn_to_string x))
|
