jon.recoil.org
this repo has no description
1open Bos
2
3(** To extract the library names for a given package, without using dune, we
4
5 1. parse the META file of the package with ocamlfind to see which libraries
6 exist and what their archive name (.cma filename) is.
7
8 2. use ocamlobjinfo to get a list of all modules within the archives. EDIT:
9 it seems this step is now skipped.
10
11 This code assumes that the META file lists for every library an archive
12 [archive_name], and that for this cma archive exists a corresponsing
13 [archive_name].ocamlobjinfo file. *)
14
15type library = {
16 name : string;
17 archive_name : string option;
18 dir : string option;
19 deps : string list;
20}
21
22type t = { meta_dir : Fpath.t; libraries : library list }
23
24let read_libraries_from_pkg_defs ~library_name pkg_defs =
25 try
26 let archive_filename =
27 try Some (Fl_metascanner.lookup "archive" [ "byte" ] pkg_defs)
28 with _ -> (
29 try Some (Fl_metascanner.lookup "archive" [ "native" ] pkg_defs)
30 with _ -> None)
31 in
32
33 let deps =
34 try
35 let deps_str = Fl_metascanner.lookup "requires" [] pkg_defs in
36 (* The deps_str is a string of space-separated package names, e.g. "a b c" *)
37 (* We use Astring to split the string into a list of package names *)
38 Astring.String.fields ~empty:false deps_str
39 with _ -> []
40 in
41
42 let dir =
43 List.find_opt (fun d -> d.Fl_metascanner.def_var = "directory") pkg_defs
44 in
45 let dir = Option.map (fun d -> d.Fl_metascanner.def_value) dir in
46 let archive_name =
47 Option.bind archive_filename (fun a ->
48 let file_name_len = String.length a in
49 if file_name_len > 0 then Some (Filename.chop_extension a) else None)
50 in
51 [ { name = library_name; archive_name; dir; deps } ]
52 with Not_found -> []
53
54let process_meta_file file =
55 let () = Format.eprintf "process_meta_file: %s\n%!" (Fpath.to_string file) in
56 let meta_dir = Fpath.parent file in
57 let meta =
58 OS.File.with_ic file (fun ic () -> Fl_metascanner.parse ic) ()
59 |> Result.get_ok
60 in
61 let base_library_name =
62 if Fpath.basename file = "META" then Fpath.parent file |> Fpath.basename
63 else Fpath.get_ext file
64 in
65 let rec extract_name_and_archive ~prefix
66 ((name, pkg_expr) : string * Fl_metascanner.pkg_expr) =
67 let library_name = prefix ^ "." ^ name in
68 let libraries =
69 read_libraries_from_pkg_defs ~library_name pkg_expr.pkg_defs
70 in
71 let child_libraries =
72 pkg_expr.pkg_children
73 |> List.map (extract_name_and_archive ~prefix:library_name)
74 |> List.flatten
75 in
76 libraries @ child_libraries
77 in
78 let libraries =
79 read_libraries_from_pkg_defs ~library_name:base_library_name meta.pkg_defs
80 in
81 let is_not_private (lib : library) =
82 not
83 (String.split_on_char '.' lib.name
84 |> List.exists (fun x -> x = "__private__"))
85 in
86 let libraries =
87 libraries
88 @ (meta.pkg_children
89 |> List.map (extract_name_and_archive ~prefix:base_library_name)
90 |> List.flatten)
91 |> List.filter is_not_private
92 in
93 { meta_dir; libraries }
94
95let libname_of_archive v =
96 let { meta_dir; libraries } = v in
97 List.fold_left
98 (fun acc (x : library) ->
99 match x.archive_name with
100 | None -> acc
101 | Some archive_name ->
102 let dir =
103 match x.dir with
104 | None -> meta_dir
105 | Some x -> Fpath.(meta_dir // v x)
106 in
107 Fpath.Map.update
108 Fpath.(dir / archive_name)
109 (function
110 | None -> Some x.name
111 | Some y ->
112 Logs.err (fun m ->
113 m "Multiple libraries for archive %s: %s and %s."
114 archive_name x.name y);
115 Some y)
116 acc)
117 Fpath.Map.empty libraries
118
119let directories v =
120 let { meta_dir; libraries } = v in
121 List.fold_left
122 (fun acc x ->
123 match x.dir with
124 | None | Some "" -> Fpath.Set.add meta_dir acc
125 | Some x -> (
126 let dir = Fpath.(meta_dir // v x) in
127 (* NB. topkg installs a META file that points to a ../topkg-care directory
128 that is installed by the topkg-care package. We filter that out here,
129 though I've not thought of a good way to sort out the `topkg-care` package *)
130 match OS.Dir.exists dir with
131 | Ok true -> Fpath.Set.add dir acc
132 | _ -> acc))
133 Fpath.Set.empty libraries