Source file `library_names.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
(** To extract the library names for a given package, without using dune, we

    1. parse the META file of the package with ocamlfind to see which libraries
    exist and what their archive name (.cma filename) is.

    2. use ocamlobjinfo to get a list of all modules within the archives. EDIT:
    it seems this step is now skipped.

    This code assumes that the META file lists for every library an archive
    [archive_name], and that for this cma archive exists a corresponsing
    [archive_name].ocamlobjinfo file. *)

type library = {
  name : string;
  archive_name : string option;
  dir : string option;
  deps : string list;
}

type t = { meta_dir : Fpath.t; libraries : library list }

let read_libraries_from_pkg_defs ~library_name pkg_defs =
  try
    let archive_filename =
      try Some (Fl_metascanner.lookup "archive" [ "byte" ] pkg_defs)
      with _ -> (
        try Some (Fl_metascanner.lookup "archive" [ "native" ] pkg_defs)
        with _ -> None)
    in

    let deps_str = Fl_metascanner.lookup "requires" [] pkg_defs in
    let deps = Astring.String.fields ~empty:false deps_str in
    let dir =
      List.find_opt (fun d -> d.Fl_metascanner.def_var = "directory") pkg_defs
    in
    let dir = Option.map (fun d -> d.Fl_metascanner.def_value) dir in
    let archive_name =
      Option.bind archive_filename (fun a ->
          let file_name_len = String.length a in
          if file_name_len > 0 then Some (Filename.chop_extension a) else None)
    in
    [ { name = library_name; archive_name; dir; deps } ]
  with Not_found -> []

let process_meta_file file =
  let () = Format.eprintf "process_meta_file: %s\n%!" (Fpath.to_string file) in
  let ic = open_in (Fpath.to_string file) in
  let meta_dir = Fpath.parent file in
  let meta = Fl_metascanner.parse ic in
  let base_library_name =
    if Fpath.basename file = "META" then Fpath.parent file |> Fpath.basename
    else Fpath.get_ext file
  in
  let rec extract_name_and_archive ~prefix
      ((name, pkg_expr) : string * Fl_metascanner.pkg_expr) =
    let library_name = prefix ^ "." ^ name in
    let libraries =
      read_libraries_from_pkg_defs ~library_name pkg_expr.pkg_defs
    in
    let child_libraries =
      pkg_expr.pkg_children
      |> List.map (extract_name_and_archive ~prefix:library_name)
      |> List.flatten
    in
    libraries @ child_libraries
  in
  let libraries =
    read_libraries_from_pkg_defs ~library_name:base_library_name meta.pkg_defs
  in
  let is_not_private (lib : library) =
    not
      (String.split_on_char '.' lib.name
      |> List.exists (fun x -> x = "__private__"))
  in
  let libraries =
    libraries
    @ (meta.pkg_children
      |> List.map (extract_name_and_archive ~prefix:base_library_name)
      |> List.flatten)
    |> List.filter is_not_private
  in
  { meta_dir; libraries }

let libname_of_archive v =
  let { meta_dir; libraries } = v in
  List.fold_left
    (fun acc (x : library) ->
      match x.archive_name with
      | None -> acc
      | Some archive_name ->
          let dir =
            match x.dir with
            | None -> meta_dir
            | Some x -> Fpath.(meta_dir // v x)
          in
          Fpath.Map.update
            Fpath.(dir / archive_name)
            (function
              | None -> Some x.name
              | Some y ->
                  Logs.err (fun m ->
                      m "Multiple libraries for archive %s: %s and %s."
                        archive_name x.name y);
                  Some y)
            acc)
    Fpath.Map.empty libraries

let directories v =
  let { meta_dir; libraries } = v in
  List.fold_left
    (fun acc x ->
      match x.dir with
      | None | Some "" -> Fpath.Set.add meta_dir acc
      | Some x -> (
          let dir = Fpath.(meta_dir // v x) in
          (* NB. topkg installs a META file that points to a ../topkg-care directory
              that is installed by the topkg-care package. We filter that out here,
              though I've not thought of a good way to sort out the `topkg-care` package *)
          match Bos.OS.Dir.exists dir with
          | Ok true -> Fpath.Set.add dir acc
          | _ -> acc))
    Fpath.Set.empty libraries