jon.recoil.org
Odoc docs
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 the plain [byte]/[native] archives first, then the [ppx_driver]
28 variants. ppx derivers such as [ppxlib.traverse] and [ppxlib.metaquot]
29 declare their archive only under the [ppx_driver] predicate; without
30 this they'd be dropped here and later re-discovered by the no-META
31 fallback, which names a library after its [.cma] file (e.g.
32 [ppxlib_traverse] instead of [ppxlib.traverse]). *)
33 let lookup preds =
34 try Some (Fl_metascanner.lookup "archive" preds pkg_defs)
35 with _ -> None
36 in
37 List.find_map lookup
38 [ [ "byte" ]; [ "native" ]; [ "byte"; "ppx_driver" ];
39 [ "native"; "ppx_driver" ] ]
40 in
41
42 let deps =
43 try
44 let deps_str = Fl_metascanner.lookup "requires" [] pkg_defs in
45 (* The deps_str is a string of space-separated package names, e.g. "a b c" *)
46 (* We use Astring to split the string into a list of package names *)
47 Astring.String.fields ~empty:false deps_str
48 with _ -> []
49 in
50
51 let dir =
52 List.find_opt (fun d -> d.Fl_metascanner.def_var = "directory") pkg_defs
53 in
54 let dir = Option.map (fun d -> d.Fl_metascanner.def_value) dir in
55 let archive_name =
56 Option.bind archive_filename (fun a ->
57 let file_name_len = String.length a in
58 if file_name_len > 0 then Some (Filename.chop_extension a) else None)
59 in
60 [ { name = library_name; archive_name; dir; deps } ]
61 with Not_found -> []
62
63let process_meta_file file =
64 let () = Format.eprintf "process_meta_file: %s\n%!" (Fpath.to_string file) in
65 let meta_dir = Fpath.parent file in
66 let meta =
67 OS.File.with_ic file (fun ic () -> Fl_metascanner.parse ic) ()
68 |> Result.get_ok
69 in
70 let base_library_name =
71 if Fpath.basename file = "META" then Fpath.parent file |> Fpath.basename
72 else Fpath.get_ext file
73 in
74 let rec extract_name_and_archive ~prefix
75 ((name, pkg_expr) : string * Fl_metascanner.pkg_expr) =
76 let library_name = prefix ^ "." ^ name in
77 let libraries =
78 read_libraries_from_pkg_defs ~library_name pkg_expr.pkg_defs
79 in
80 let child_libraries =
81 pkg_expr.pkg_children
82 |> List.map (extract_name_and_archive ~prefix:library_name)
83 |> List.flatten
84 in
85 libraries @ child_libraries
86 in
87 let libraries =
88 read_libraries_from_pkg_defs ~library_name:base_library_name meta.pkg_defs
89 in
90 let is_not_private (lib : library) =
91 not
92 (String.split_on_char '.' lib.name
93 |> List.exists (fun x -> x = "__private__"))
94 in
95 let libraries =
96 libraries
97 @ (meta.pkg_children
98 |> List.map (extract_name_and_archive ~prefix:base_library_name)
99 |> List.flatten)
100 |> List.filter is_not_private
101 in
102 { meta_dir; libraries }
103
104let libname_of_archive v =
105 let { meta_dir; libraries } = v in
106 List.fold_left
107 (fun acc (x : library) ->
108 match x.archive_name with
109 | None -> acc
110 | Some archive_name ->
111 let dir =
112 match x.dir with
113 | None -> meta_dir
114 | Some x -> Fpath.(meta_dir // v x)
115 in
116 Fpath.Map.update
117 Fpath.(dir / archive_name)
118 (function
119 | None -> Some x.name
120 | Some y ->
121 Logs.err (fun m ->
122 m "Multiple libraries for archive %s: %s and %s."
123 archive_name x.name y);
124 Some y)
125 acc)
126 Fpath.Map.empty libraries
127
128let directories v =
129 let { meta_dir; libraries } = v in
130 List.fold_left
131 (fun acc x ->
132 match x.dir with
133 | None | Some "" -> Fpath.Set.add meta_dir acc
134 | Some x -> (
135 let dir = Fpath.(meta_dir // v x) in
136 (* NB. topkg installs a META file that points to a ../topkg-care directory
137 that is installed by the topkg-care package. We filter that out here,
138 though I've not thought of a good way to sort out the `topkg-care` package *)
139 match OS.Dir.exists dir with
140 | Ok true -> Fpath.Set.add dir acc
141 | _ -> acc))
142 Fpath.Set.empty libraries