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
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
(** [dir_exists path] checks if the file at [path] exists and is a directory *)
let dir_exists path =
match Sys.file_exists path with
| false ->
false
| true ->
Sys.is_directory path
let create_folder ?(perm = 0o700) ~on_error folder =
let to_path_string = folder in
match Sys.file_exists to_path_string with
| true ->
Ok to_path_string
| false ->
let r =
match Sys.mkdir to_path_string perm with
| exception _ ->
Error on_error
| () ->
Ok folder
in
r
let create_file ?(on_file = ignore) ~on_error file =
try
let () = ignore @@ Out_channel.with_open_bin file on_file in
Ok file
with _exn -> Error on_error
let split_path s =
let regex = Re.(compile @@ str Filename.dir_sep) in
Re.split regex s
let rec rmrf path =
match Sys.is_directory path with
| true -> (
let () =
Array.iter
(fun name -> rmrf (Filename.concat path name))
(Sys.readdir path)
in
let stats = Unix.lstat path in
match stats.st_kind with
| Unix.S_DIR ->
Unix.rmdir path
| S_REG | S_LNK | S_CHR | S_SOCK | S_FIFO ->
Unix.unlink path
| S_BLK ->
()
)
| false ->
Sys.remove path
| exception e ->
raise e
(** [mkdirp root componenent] creates directories which start at [root] and
recursively [componenent] *)
let rec mkdirp root componenent =
let ( let* ) = Result.bind in
let ok = Result.ok in
let err = Result.error in
match componenent with
| [] ->
ok root
| t :: q ->
let path = Filename.concat root t in
let* () =
match dir_exists path with
| true ->
ok ()
| false -> (
match Sys.mkdir path 0o755 with
| () ->
ok ()
| exception _ ->
err path
)
in
mkdirp path q
let mkfilep ?outchan root componenent file =
let ( let* ) = Result.bind in
let* dir = mkdirp root componenent in
let path = Filename.concat dir file in
try
let chan = Out_channel.open_text path in
let () = Option.iter (( |> ) chan) outchan in
let () = close_out_noerr chan in
Ok path
with _ -> Error path
let mk ~file ?outchan path =
let s = split_path path in
let root = Filename.dir_sep in
match file with
| false ->
mkdirp root s
| true -> (
let spath, file = ListUtil.remove_last s in
match file with
| None ->
Result.error path
| Some file ->
mkfilep ?outchan root spath file
)
let read_chan chan =
let buffer = Buffer.create 4_096 in
let size = 1024 in
let bytes = Bytes.create size in
let continue = ref true in
let () =
while !continue do
let read = input chan bytes 0 size in
let () = Buffer.add_subbytes buffer bytes 0 read in
continue := read = size
done
in
Buffer.contents buffer
let read_all_chan ch = really_input_string ch (in_channel_length ch)
let read_all string = In_channel.with_open_bin string read_all_chan
let rec remove_prefix prefix path =
match (prefix, path) with
| [], [] | _ :: _, [] ->
String.empty
| [], (_ :: _ as s) ->
String.concat Filename.dir_sep s
| t1 :: q1, (t2 :: q2 as s) ->
if String.equal t1 t2 then
remove_prefix q1 q2
else
String.concat Filename.dir_sep s
let remove_prefix prefix path =
let prefix = Unix.realpath prefix in
let path = Unix.realpath path in
let prefix = split_path prefix in
let path = split_path path in
remove_prefix prefix path
let cp_rm src dst =
let created =
mk ~file:true
~outchan:(fun oc ->
let content = read_all src in
output_string oc content
)
dst
in
Result.map (fun _ -> rmrf src) created
(** [move strategy src dst] *)
let move strategy src dst =
match strategy with
| `Move -> (
try Ok (Unix.rename src dst)
with Unix.Unix_error (EXDEV, _, _) -> cp_rm src dst
)
| `Copy ->
let content = read_all src in
let () =
Out_channel.with_open_bin dst (fun oc -> output_string oc content)
in
Ok ()