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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
open Fugue
open Filepath
type t =
| Autogen
| Dot
| Target of Target.Name.t
let to_string = function
| Autogen -> "autogen"
| Dot -> "dot"
| Target n -> "target(" ^ Target.Name.to_string n ^ ")"
let to_filename = function
| Target tn -> Target.Name.to_dirname tn
| Dot -> fn "dot"
| Autogen -> fn "autogen"
exception DistNotADirectory
exception MissingDestinationDirectory of t
exception DistNotFound
exception DistFileNotFound of string
let path = ref (fp "dist")
let set_path p = path := p
let get_path () = !path
let setup_path = get_path () </> fn "setup"
let configure_path = get_path () </> fn "configure"
let build_path = get_path () </> fn "build"
let check_exn f =
if Filesystem.exists (get_path ()) then
if Sys.is_directory $ fp_to_string (get_path ()) then
()
else
raise DistNotADirectory
else
f ()
let exist () = check_exn (fun () -> raise DistNotFound)
let create_maybe () =
check_exn (fun () ->
let _ = Filesystem.mkdir_safe (get_path ()) 0o755 in
())
let get_build () = get_path () </> fn "build"
let get_build_path buildtype = get_build () </> to_filename buildtype
let get_build_exn buildtype =
let dist = get_build_path buildtype in
if not (Filesystem.is_dir dist) then
raise (MissingDestinationDirectory buildtype)
else
dist
let create_build buildtype =
let _ = Filesystem.mkdir_safe (get_build ()) 0o755 in
let dest = get_build_path buildtype in
let _ = Filesystem.mkdir_safe dest 0o755 in
dest
let read_dist_file path =
try
let content = Filesystem.read_file path in
hashtbl_from_list
(List.map (fun l -> second (default "") $ Utils.toKV l) $ String_utils.split '\n' content)
with Sys_error _ | Unix.Unix_error _ -> raise (DistFileNotFound (fp_to_string path))
let read_setup () = read_dist_file setup_path
let read_configure () = read_dist_file configure_path
let write_setup setup =
let kv (k, v) = k ^ ": " ^ v in
Filesystem.write_file setup_path (String.concat "\n" $ List.map kv (hashtbl_to_list setup))
let remove_dead_links () =
let files = Sys.readdir "." in
let build_path = fp_to_string (get_build ()) in
Array.iter
(fun fn ->
try
let l = Unix.readlink fn in
if String_utils.startswith build_path l then
Sys.remove fn
with Unix.Unix_error _ | Sys_error _ -> ())
files
|
