package drom_lib

  1. Overview
  2. Docs

Source file misc.ml

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
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
(**************************************************************************)
(*                                                                        *)
(*    Copyright 2020 OCamlPro & Origin Labs                               *)
(*                                                                        *)
(*  All rights reserved. This file is distributed under the terms of the  *)
(*  GNU Lesser General Public License version 2.1, with the special       *)
(*  exception on linking described in the file LICENSE.                   *)
(*                                                                        *)
(**************************************************************************)

open EzFile.OP
open EzCompat

module EzString = struct
  include EzString

  let chop_prefix s ~prefix =
    if EzString.starts_with s ~prefix then
      let prefix_len = String.length prefix in
      let len = String.length s in
      Some (String.sub s prefix_len (len - prefix_len))
    else
      None

  let chop_suffix s ~suffix =
    if EzString.ends_with s ~suffix then
      let suffix_len = String.length suffix in
      let len = String.length s in
      Some (String.sub s 0 (len - suffix_len))
    else
      None
end

let option_value o ~default =
  match o with
  | None -> default
  | Some v -> v

let verbose i = !Globals.verbosity >= i

let call ?(stdout = Unix.stdout) args =
  if verbose 1 then
    Printf.eprintf "Calling %s\n%!" (String.concat " " (Array.to_list args));
  let pid = Unix.create_process args.(0) args Unix.stdin stdout Unix.stderr in
  let rec iter () =
    match Unix.waitpid [] pid with
    | exception Unix.Unix_error (EINTR, _, _) -> iter ()
    | _pid, status -> (
      match status with
      | WEXITED 0 -> ()
      | _ ->
        Error.raise "Command '%s' exited with error code %s"
          (String.concat " " (Array.to_list args))
          ( match status with
          | WEXITED n -> string_of_int n
          | WSIGNALED n -> Printf.sprintf "SIGNAL %d" n
          | WSTOPPED n -> Printf.sprintf "STOPPED %d" n ) )
  in
  iter ()

(** run a cmd and return the first line of output *)
let call_get_fst_line cmd =
  let chan = Unix.open_process_in cmd in
  try
    let output = input_line chan in
    match Unix.close_process_in chan with
    | WEXITED 0 -> Some output
    | _err ->
      Error.raise "Command '%s' exited with error code %s" cmd
        ( match _err with
        | WEXITED n -> string_of_int n
        | WSIGNALED n -> Printf.sprintf "SIGNAL %d" n
        | WSTOPPED n -> Printf.sprintf "STOPPED %d" n )
  with
  | End_of_file -> None
  | e -> raise e

(* Return a tm with correct year and month *)
let date () =
  let time = Unix.gettimeofday () in
  let tm = Unix.gmtime time in
  { tm with tm_year = 1900 + tm.tm_year; tm_mon = tm.tm_mon + 1 }

open Types

let homepage p =
  match p.homepage with
  | Some s -> Some s
  | None -> (
    match p.github_organization with
    | Some organization ->
      Some
        (Printf.sprintf "https://%s.github.io/%s" organization p.package.name)
    | None -> None )

let sphinx_target p =
  option_value p.sphinx_target ~default:"sphinx"

let odoc_target p =
  option_value p.odoc_target ~default:"doc"

let doc_api p =
  match p.doc_api with
  | Some s -> Some s
  | None -> (
    match p.github_organization with
    | Some organization ->
      Some
        (Printf.sprintf "https://%s.github.io/%s/%s" organization
           p.package.name (odoc_target p))
    | None -> None )

let doc_gen p =
  match p.doc_gen with
  | Some s -> Some s
  | None ->
      match p.github_organization with
      | Some organization ->
          Some
            (Printf.sprintf "https://%s.github.io/%s/%s" organization
               p.package.name (sphinx_target p))
      | None -> None

let p_dependencies package =
  package.p_dependencies @ package.project.dependencies

let p_mode package =
  match package.p_mode with
  | Some deps -> deps
  | None -> package.project.mode

let p_pack_modules package =
  match package.p_pack_modules with
  | Some deps -> deps
  | None -> package.project.pack_modules

let p_version package =
  match package.p_version with
  | Some deps -> deps
  | None -> package.project.version

let p_tools package = package.p_tools @ package.project.tools

let p_synopsis package =
  match package.p_synopsis with
  | Some deps -> deps
  | None -> package.project.synopsis

let p_description package =
  match package.p_description with
  | Some deps -> deps
  | None -> package.project.description

let p_authors package =
  match package.p_authors with
  | Some deps -> deps
  | None -> package.project.authors

let wget ~url ~output =
  let dirname = Filename.dirname output in
  if not (Sys.file_exists dirname) then EzFile.make_dir ~p:true dirname;
  call
    [| "curl";
       "-f";
       "--write-out";
       "%{http_code}\\n";
       "--retry";
       "3";
       "--retry-delay";
       "2";
       "--user-agent";
       "opam-bin/2.0.5";
       "-L";
       "-o";
       output;
       url
    |]

let bug_reports p =
  match p.bug_reports with
  | Some s -> Some s
  | None -> (
    match p.github_organization with
    | Some organization ->
      Some
        (Printf.sprintf "https://github.com/%s/%s/issues" organization
           p.package.name)
    | None -> None )

let subst s f =
  let b = Buffer.create (2 * String.length s) in
  Buffer.add_substitute b f s;
  Buffer.contents b

let list_opam_packages dir =
  let packages = ref [] in
  let files =
    match Sys.readdir dir with
    | exception _ -> [||]
    | files -> files
  in
  Array.iter
    (fun file ->
      if Filename.check_suffix file ".opam" then
        let package = Filename.chop_suffix file ".opam" in
        packages := package :: !packages)
    files;
  !packages

let semantic_version version =
  match EzString.split version '.' with
  | [ major; minor; fix ] -> (
    try Some (int_of_string major, int_of_string minor, int_of_string fix)
    with Failure _ -> None )
  | _ -> None

let underscorify s =
  let b = Bytes.of_string s in
  for i = 1 to String.length s - 2 do
    let c = s.[i] in
    match c with
    | 'a' .. 'z'
    | 'A' .. 'Z'
    | '0' .. '9' ->
      ()
    | _ -> Bytes.set b i '_'
  done;
  Bytes.to_string b

let library_name p =
  match p.p_pack with
  | Some name -> String.uncapitalize name
  | None -> underscorify p.name

let package_lib package = underscorify package.name ^ "_lib"

let deps_package p =
  let packages = ref StringSet.empty in
  List.iter
    (fun package -> packages := StringSet.add package.name !packages)
    p.packages;
  let p_dependencies =
    List.flatten (List.map (fun pk -> pk.p_dependencies) p.packages)
  in
  let p_tools = List.flatten (List.map (fun pk -> pk.p_tools) p.packages) in
  let p_dependencies =
    List.filter
      (fun (name, _d) -> not (StringSet.mem name !packages))
      p_dependencies
  in
  let p_tools =
    List.filter (fun (name, _d) -> not (StringSet.mem name !packages)) p_tools
  in
  { p.package with
    name = p.package.name ^ "-deps";
    p_synopsis = Some (p.synopsis ^ " (all deps)");
    p_dependencies;
    p_tools
  }

let modules package =
  let files = try Sys.readdir package.dir with _ -> [||] in
  let set = ref StringSet.empty in
  let add_module file =
    let m = String.capitalize file in
    set := StringSet.add m !set
  in
  Array.iter
    (fun file ->
      match EzString.chop_suffix file ~suffix:".ml" with
      | Some file -> add_module file
      | None -> (
        match EzString.chop_suffix file ~suffix:".mll" with
        | Some file -> add_module file
        | None -> (
          match EzString.chop_suffix file ~suffix:".mly" with
          | Some file -> add_module file
          | None -> () ) ))
    files;
  StringSet.to_list !set

let add_skip name list =
  List.map
    (fun (file, content) -> (file, Printf.sprintf "!{%s:skip}%s" name content))
    list

let dev_repo p =
  match p.dev_repo with
  | Some s -> Some s
  | None -> (
    match p.github_organization with
    | Some organization ->
      Some
        (Printf.sprintf "https://github.com/%s/%s" organization p.package.name)
    | None -> None )

let vendor_packages () =
  let vendors_dir = "vendors" in
  (try Sys.readdir vendors_dir with _ -> [||])
  |> Array.map (fun dir ->
         let dir = vendors_dir // dir in
         (try Sys.readdir dir with Not_found -> [||])
         |> Array.map (fun file ->
                if Filename.check_suffix file ".opam" then
                  Some (dir // file)
                else
                  None)
         |> Array.to_list
         |> List.filter (function
              | None -> false
              | Some _file -> true)
         |> List.map (function
              | None -> assert false
              | Some file -> file))
  |> Array.to_list |> List.flatten

let library_module p =
  match p.p_pack with
  | Some name -> name
  | None -> String.capitalize (underscorify p.name)
OCaml

Innovation. Community. Security.