Source file ocamlfind.ml

let init =
  let initialized = ref false in
  fun () ->
    if !initialized then ()
    else
      let prefix = Opam.prefix () in
      let env_camllib = Fpath.(v prefix / "lib" / "ocaml" |> to_string) in
      let config = Fpath.(v prefix / "lib" / "findlib.conf" |> to_string) in
      Findlib.init ~config ~env_camllib ()

let all () =
  init ();
  Fl_package_base.list_packages ()

let get_dir lib =
  try
    init ();
    Fl_package_base.query lib |> fun x ->
    Ok Fpath.(v x.package_dir |> to_dir_path)
  with e ->
    Logs.err (fun m -> m "Error: %s\n" (Printexc.to_string e));
    Error (`Msg "Error getting directory")

let archives pkg =
  init ();
  let package = Fl_package_base.query pkg in
  let get_1 preds =
    try
      [
        Fl_metascanner.lookup "archive" preds
          package.Fl_package_base.package_defs;
      ]
    with _ -> []
  in
  match pkg with
  | "stdlib" -> [ "stdlib.cma"; "stdlib.cmxa" ]
  | _ ->
      get_1 [ "native" ] @ get_1 [ "byte" ]
      @ get_1 [ "native"; "ppx_driver" ]
      @ get_1 [ "byte"; "ppx_driver" ]
      |> List.filter (fun x -> String.length x > 0)
      |> List.sort_uniq String.compare

let sub_libraries top =
  init ();
  let packages = Fl_package_base.list_packages () in
  List.fold_left
    (fun acc lib ->
      let package = String.split_on_char '.' lib |> List.hd in
      if package = top then Util.StringSet.add lib acc else acc)
    Util.StringSet.empty packages

(* Returns deep dependencies for the given package *)
let rec dep =
  let memo = ref Util.StringMap.empty in
  fun pkg ->
    init ();
    try Util.StringMap.find pkg !memo
    with Not_found -> (
      try
        let deps = Fl_package_base.requires ~preds:[ "ppx_driver" ] pkg in
        let result =
          List.fold_left
            (fun acc x ->
              match dep x with
              | Ok dep_deps -> Util.StringSet.(union acc (add x dep_deps))
              | Error _ -> acc)
            Util.StringSet.empty deps
        in
        memo := Util.StringMap.add pkg (Ok result) !memo;
        Ok result
      with e ->
        let result = Error (`Msg (Printexc.to_string e)) in
        memo := Util.StringMap.add pkg result !memo;
        result)

let deps pkgs =
  let results = List.map dep pkgs in
  Ok
    (List.fold_left Util.StringSet.union
       (Util.StringSet.singleton "stdlib")
       (List.map (Result.value ~default:Util.StringSet.empty) results))

module Db = struct
  type t = {
    all_libs : Util.StringSet.t;
    all_lib_deps : Util.StringSet.t Util.StringMap.t;
    lib_dirs_and_archives : (string * Fpath.t * Util.StringSet.t) list;
    archives_by_dir : Util.StringSet.t Fpath.map;
    libname_of_archive : string Fpath.map;
    cmi_only_libs : (Fpath.t * string) list;
  }

  let create libs =
    let _ = Opam.prefix () in
    let libs = Util.StringSet.to_seq libs |> List.of_seq in

    (* First, find the complete set of libraries - that is, including all of
       the dependencies of the libraries supplied on the commandline *)
    let all_libs_deps =
      match deps libs with
      | Error (`Msg msg) ->
          Logs.err (fun m -> m "Error finding dependencies: %s" msg);
          Util.StringSet.empty
      | Ok libs -> Util.StringSet.add "stdlib" libs
    in

    let all_libs_set =
      Util.StringSet.union all_libs_deps (Util.StringSet.of_list libs)
    in
    let all_libs = Util.StringSet.elements all_libs_set in

    (* Now we need the dependency tree of those libraries *)
    let all_lib_deps =
      List.fold_right
        (fun lib_name acc ->
          match deps [ lib_name ] with
          | Ok deps -> Util.StringMap.add lib_name deps acc
          | Error (`Msg msg) ->
              Logs.err (fun m ->
                  m
                    "Error finding dependencies of library '%s' through \
                     ocamlfind: %s"
                    lib_name msg);
              acc)
        all_libs Util.StringMap.empty
    in

    (* We also need to find, for each library, the library directory and
       the list of archives for that library *)
    let lib_dirs_and_archives =
      List.filter_map
        (fun lib ->
          match get_dir lib with
          | Error _ ->
              Logs.err (fun m -> m "No dir for library %s" lib);
              None
          | Ok p ->
              let archives = archives lib in
              let archives =
                List.map
                  (fun x ->
                    try Filename.chop_extension x
                    with e ->
                      Logs.err (fun m -> m "Can't chop extension from %s" x);
                      raise e)
                  archives
              in
              let archives = Util.StringSet.(of_list archives) in
              Some (lib, p, archives))
        all_libs
    in

    (* An individual directory may contain multiple libraries, each with
       zero or more archives. We need to know which directories contain
       which archives *)
    let archives_by_dir =
      List.fold_left
        (fun set (_lib, p, archives) ->
          Fpath.Map.update p
            (function
              | Some set -> Some (Util.StringSet.union set archives)
              | None -> Some archives)
            set)
        Fpath.Map.empty lib_dirs_and_archives
    in

    (* Compute the mapping between full path of an archive to the
       name of the libary *)
    let libname_of_archive =
      List.fold_left
        (fun map (lib, dir, archives) ->
          match Util.StringSet.elements archives with
          | [] -> map
          | [ archive ] ->
              Fpath.Map.update
                Fpath.(dir / archive)
                (function
                  | None -> Some lib
                  | Some x ->
                      Logs.info (fun m ->
                          m
                            "Multiple libraries for archive %s: %s and %s. \
                             Arbitrarily picking the latter."
                            archive x lib);
                      Some lib)
                map
          | xs ->
              Logs.err (fun m ->
                  m "multiple archives detected: [%a]"
                    Fmt.(list ~sep:sp string)
                    xs);
              assert false)
        Fpath.Map.empty lib_dirs_and_archives
    in

    (* We also need to know about libraries that have no archives at all
       (these are virtual libraries usually) *)
    let cmi_only_libs =
      List.fold_left
        (fun map (lib, dir, archives) ->
          match Util.StringSet.elements archives with
          | [] -> (dir, lib) :: map
          | _ -> map)
        [] lib_dirs_and_archives
    in
    {
      all_libs = all_libs_set;
      all_lib_deps;
      lib_dirs_and_archives;
      archives_by_dir;
      libname_of_archive;
      cmi_only_libs;
    }
end