Use the opam library (for read_only operations)

dune-project

@@ -36,4 +36,5 @@
   base64
   astring
   bos
-  ppxlib))
+  (opam-state
+   (>= 2.1.2))))

platform.opam

@@ -28,7 +28,7 @@ depends: [
   "base64"
   "astring"
   "bos"
-  "ppxlib"
+  "opam-state" {>= "2.1.2"}
   "odoc" {with-doc}
 ]
 build: [

src/bin/main.ml

@@ -142,4 +142,6 @@ let main () =
   in
   Stdlib.exit @@ Cmd.eval' (Cmd.v info term)
 
-let () = main ()
+let () =
+  Platform.Opam.Queries.init ();
+  main ()

src/lib/binary_package.ml

@@ -6,9 +6,9 @@ open Bos
 type t = { name : string; ver : string }
 
 (** Name and version of the binary package corresponding to a given package. *)
-let binary_name ~ocaml_version ~name ~ver ~pure_binary =
+let binary_name ~ocaml ~name ~ver ~pure_binary =
   let name = if pure_binary then name else name ^ "+bin+platform" in
-  let ocaml_version = Ocaml_version.to_string ocaml_version in
+  let ocaml_version = Opam.Conversions.version_of_pkg ocaml in
   { name; ver = ver ^ "-ocaml" ^ ocaml_version }
 
 let name_to_string { name; ver } = name ^ "." ^ ver
@@ -17,33 +17,41 @@ let name { name; ver = _ } = name
 let has_binary_package repo { name; ver } =
   Repo.has_pkg (Binary_repo.repo repo) ~pkg:name ~ver
 
-let generate_opam_file original_name pure_binary archive_path ocaml_version =
+let generate_opam_file original_name pure_binary archive_path ocaml =
   let conflicts = if pure_binary then None else Some [ original_name ] in
   Repo.Opam_file.v
     ~install:[ [ "cp"; "-pPR"; "."; "%{prefix}%" ] ]
-    ~depends:[ ("ocaml", Some ("=", Ocaml_version.to_string ocaml_version)) ]
+    ~depends:[ ("ocaml", Some ("=", Opam.Conversions.version_of_pkg ocaml)) ]
     ?conflicts ~url:archive_path
 
 let should_remove = Fpath.(is_prefix (v "lib"))
 
 let process_path prefix path =
-  let+ ex = Bos.OS.File.exists path in
-  if not ex then None
-  else
-    match Fpath.rem_prefix prefix path with
-    | None -> None
-    | Some path ->
-        if should_remove path then None else Some Fpath.(base prefix // path)
+  match Fpath.of_string path with
+  | Error (`Msg s) -> Error (`Msg s)
+  | Ok path -> (
+      let+ ex = Bos.OS.File.exists path in
+      if not ex then None
+      else
+        match Fpath.rem_prefix prefix path with
+        | None -> None
+        | Some path ->
+            if should_remove path then None
+            else Some Fpath.(base prefix // path))
 
 (** Binary is already in the sandbox. Add this binary as a package in the local
     repo *)
-let make_binary_package opam_opts ~ocaml_version sandbox repo
-    ({ name; ver } as bname) ~name:query_name ~pure_binary =
+let make_binary_package opam_opts ~ocaml sandbox repo ({ name; ver } as bname)
+    ~name:query_name ~pure_binary =
   let prefix = Sandbox_switch.switch_path_prefix sandbox in
   let archive_path =
     Binary_repo.archive_path repo ~unique_name:(name_to_string bname ^ ".tar.gz")
   in
-  Sandbox_switch.list_files opam_opts sandbox ~pkg:query_name >>= fun paths ->
+  Opam.Queries.(
+    with_switch_state
+      ~dir_name:(Sandbox_switch.get_sandbox_root sandbox)
+      (files_installed_by_pkg query_name))
+  >>= fun paths ->
   let* paths =
     paths
     |> Result.List.filter_map (process_path prefix)
@@ -61,7 +69,5 @@ let make_binary_package opam_opts ~ocaml_version sandbox repo
   if not archive_created then
     Error (`Msg "Couldn't generate the package archive for unknown reason.")
   else
-    let opam =
-      generate_opam_file query_name pure_binary archive_path ocaml_version
-    in
+    let opam = generate_opam_file query_name pure_binary archive_path ocaml in
     Repo.add_package opam_opts (Binary_repo.repo repo) ~pkg:name ~ver opam

src/lib/binary_package.mli

@@ -6,11 +6,7 @@ open! Import
 type t
 
 val binary_name :
-  ocaml_version:Ocaml_version.t ->
-  name:string ->
-  ver:string ->
-  pure_binary:bool ->
-  t
+  ocaml:OpamPackage.t -> name:string -> ver:string -> pure_binary:bool -> t
 
 val name_to_string : t -> string
 val name : t -> string
@@ -20,7 +16,7 @@ val has_binary_package : Binary_repo.t -> t -> bool
 
 val make_binary_package :
   Opam.GlobalOpts.t ->
-  ocaml_version:Ocaml_version.t ->
+  ocaml:OpamPackage.t ->
   Sandbox_switch.t ->
   Binary_repo.t ->
   t ->

src/lib/dune

@@ -1,3 +1,3 @@
 (library
  (name platform)
- (libraries astring angstrom ocaml-version bos.setup))
+ (libraries astring angstrom ocaml-version bos.setup opam-state))

src/lib/opam.ml

@@ -136,59 +136,102 @@ module Repository = struct
       Bos.Cmd.(v "repository" % "--this-switch" % "remove" % name)
 end
 
-module Show = struct
-  let list_files opam_opts pkg_name =
-    Cmd.run_l opam_opts Bos.Cmd.(v "show" % "--list-files" % pkg_name)
-
-  let available_versions opam_opts pkg_name =
-    let open Result.Syntax in
-    let+ output =
-      Cmd.run_s opam_opts
-        Bos.Cmd.(v "show" % "-f" % "available-versions" % pkg_name)
+module Queries = struct
+  let init () =
+    OpamFormatConfig.init ();
+    let root = OpamStateConfig.opamroot () in
+    OpamStateConfig.load_defaults root |> ignore;
+    OpamStateConfig.init ~root_dir:root ()
+
+  let latest_version ~metadata_universe ~pkg_universe ~ocaml package =
+    let package = OpamPackage.Name.of_string package in
+    let compatible_ones =
+      OpamPackage.Set.filter
+        (fun pkg ->
+          OpamPackage.Name.equal (OpamPackage.name pkg) package
+          &&
+          let pkg_opam_file = OpamPackage.Map.find pkg metadata_universe in
+          let dependencies = OpamFile.OPAM.depends pkg_opam_file in
+          let env _ = None in
+          OpamFormula.verifies
+            (OpamPackageVar.filter_depends_formula ~env dependencies)
+            ocaml)
+        pkg_universe
     in
-    Astring.String.cuts ~sep:"  " output |> List.rev
-
-  let installed_version opam_opts pkg_name =
-    match
-      Cmd.run_s opam_opts
-        Bos.Cmd.(
-          v "show" % pkg_name % "-f" % "installed-version" % "--normalise")
-    with
-    | Ok "--" -> Ok None
-    | Ok s -> Ok (Some s)
-    | Error e -> Error e
-
-  let installed_versions opam_opts pkg_names =
-    let parse =
-      let open Angstrom in
-      let is_whitespace = function
-        | '\x20' | '\x0a' | '\x0d' | '\x09' -> true
-        | _ -> false
-      in
-      let whitespace = take_while is_whitespace in
-      let word = whitespace *> take_till is_whitespace in
-      let field f = whitespace *> string f *> word in
-      let parse_double_line = both (field "name") (field "installed-version") in
-      let parse = many parse_double_line in
-      fun s ->
-        match parse_string ~consume:Consume.All parse s with
-        | Ok e -> Ok e
-        | Error e -> Result.errorf "Error in parsing installed versions: %s" e
+    try Some (OpamPackage.max_version compatible_ones package)
+    with Not_found -> None
+
+  let installed_versions pkg_names
+      (sel : OpamTypes.switch_selections) =
+    let installed_pkgs = sel.sel_installed in
+    List.map
+      (fun name ->
+        let version =
+          OpamPackage.package_of_name_opt installed_pkgs
+          @@ OpamPackage.Name.of_string name
+        in
+        (name, version))
+      pkg_names
+
+  let files_installed_by_pkg pkg_name
+      (switch_state : 'lock OpamStateTypes.switch_state) =
+    let changes_f =
+      OpamPath.Switch.changes switch_state.switch_global.root
+        switch_state.switch
+        (OpamPackage.Name.of_string pkg_name)
     in
-    let* res =
-      Cmd.run_s opam_opts
-        Bos.Cmd.(
-          v "show" %% of_list pkg_names % "-f" % "name,installed-version"
-          % "--normalise")
-    in
-    let+ res = parse res in
-    List.map (function a, "--" -> (a, None) | a, s -> (a, Some s)) res
-
-  let depends opam_opts pkg_name =
-    Cmd.run_l opam_opts Bos.Cmd.(v "show" % "-f" % "depends:" % pkg_name)
+    match OpamFile.Changes.read_opt changes_f with
+    | None ->
+        Result.errorf
+          "Something went wrong looking for the files installed by %s" pkg_name
+    | Some changes ->
+        Ok
+          (OpamDirTrack.check
+             (OpamPath.Switch.root switch_state.switch_global.root
+                switch_state.switch)
+             changes
+          |> List.fold_left
+               (fun acc file ->
+                 match file with
+                 | filename, _ -> OpamFilename.to_string filename :: acc)
+               [])
+
+  let get_pkg_universe (switch_state : 'lock OpamStateTypes.switch_state) =
+    switch_state.available_packages
+
+  let get_metadata_universe (switch_state : 'lock OpamStateTypes.switch_state) =
+    switch_state.opams
+
+let get_switch = function
+      | None -> OpamStateConfig.get_switch ()
+      | Some dir ->
+          OpamSwitch.of_dirname
+            (Fpath.to_string dir |> OpamFilename.Dir.of_string)
+
+  let with_switch_state ?dir_name f =
+    let switch = get_switch dir_name in
+    OpamGlobalState.with_ `Lock_read (fun global_state ->
+        OpamSwitchState.with_ `Lock_read global_state ~switch
+          (fun switch_state -> f switch_state))
+
+  let with_switch_state_sel ?dir_name f =
+    let switch = get_switch dir_name in
+    OpamGlobalState.with_ `Lock_read (fun global_state ->
+      let sel = OpamSwitchState.load_selections ~lock_kind:`Lock_read global_state switch in
+    f sel)
+
+  let with_virtual_state f =
+    OpamGlobalState.with_ `Lock_read (fun global_state ->
+        OpamRepositoryState.with_ `Lock_read global_state (fun repo_state ->
+            let virtual_state =
+              OpamSwitchState.load_virtual global_state repo_state
+            in
+            f virtual_state))
+end
 
-  let version opam_opts pkg_name =
-    Cmd.run_l opam_opts Bos.Cmd.(v "show" % "-f" % "version" % pkg_name)
+module Conversions = struct
+  let version_of_pkg pkg =
+    OpamPackage.version pkg |> OpamPackage.Version.to_string
 end
 
 let install opam_opts pkgs =

src/lib/opam.mli

@@ -51,26 +51,46 @@ module Repository : sig
   val remove : GlobalOpts.t -> string -> (unit, [> `Msg of string ]) result
 end
 
-module Show : sig
-  val list_files :
-    GlobalOpts.t -> string -> (string list, [> `Msg of string ]) result
+module Queries : sig
+  val init : unit -> unit
 
-  val available_versions :
-    GlobalOpts.t -> string -> (string list, [> `Msg of string ]) result
+  val files_installed_by_pkg :
+    string ->
+    'lock OpamStateTypes.switch_state ->
+    (string list, [> `Msg of string ]) result
+
+  val get_pkg_universe :
+    'lock OpamStateTypes.switch_state -> OpamTypes.package_set lazy_t
 
-  val installed_version :
-    GlobalOpts.t -> string -> (string option, [> `Msg of string ]) result
+  val get_metadata_universe :
+    'lock OpamStateTypes.switch_state -> OpamFile.OPAM.t OpamTypes.package_map
+
+  val latest_version :
+    metadata_universe:OpamFile.OPAM.t OpamTypes.package_map ->
+    pkg_universe:OpamTypes.package_set ->
+    ocaml:OpamPackage.t ->
+    string ->
+    OpamPackage.t option
 
   val installed_versions :
-    GlobalOpts.t ->
-    string list ->
-    ((string * string option) list, 'a) Result.or_msg
+  string list ->
+    OpamTypes.switch_selections -> (string * OpamPackage.t option) list
+
+  val with_switch_state :
+    ?dir_name:Fpath.t ->
+    ([< OpamStateTypes.unlocked > `Lock_read `Lock_write ]
+     OpamStateTypes.switch_state ->
+    'a) ->
+    'a
 
-  val depends :
-    GlobalOpts.t -> string -> (string list, [> `Msg of string ]) result
+  val with_switch_state_sel :  ?dir_name:Fpath.t -> (OpamTypes.switch_selections -> 'a) -> 'a
+
+  val with_virtual_state :
+    (OpamStateTypes.unlocked OpamStateTypes.switch_state -> 'a) -> 'a
+end
 
-  val version :
-    GlobalOpts.t -> string -> (string list, [> `Msg of string ]) result
+module Conversions : sig
+  val version_of_pkg : OpamPackage.t -> string
 end
 
 val install : GlobalOpts.t -> string list -> (unit, [> `Msg of string ]) result

src/lib/sandbox_switch.ml

@@ -15,6 +15,8 @@ type t = {
           [init] and removed during [deinit]. *)
 }
 
+let get_sandbox_root sb = sb.sandbox_root
+
 let compiler_tools =
   [
     "ocaml";
@@ -88,8 +90,8 @@ let with_var_sys_ocaml_version opam_opts ~ocaml_version f =
   let* () = Opam.Config.Var.set opam_opts ~global var ocaml_version in
   Fun.protect ~finally:restore_var f
 
-let init opam_opts ~ocaml_version =
-  let ocaml_version = Ocaml_version.to_string ocaml_version in
+let init opam_opts ~ocaml =
+  let ocaml_version = Opam.Conversions.version_of_pkg ocaml in
   (* Directory in which to create the switch. *)
   let* sandbox_root = OS.Dir.tmp "ocaml-platform-sandbox-%s" in
   let* compiler_path =
@@ -129,14 +131,10 @@ let install _opam_opts t ~pkg =
   let pkg = pkg_to_string pkg in
   Opam.install t.sandbox_opts [ pkg ]
 
-let list_files _opam_opts t ~pkg =
-  let+ files = Opam.Show.list_files t.sandbox_opts pkg in
-  List.map Fpath.v files
-
 let switch_path_prefix t = t.prefix
 
-let with_sandbox_switch opam_opts ~ocaml_version f =
-  let* sandbox = init opam_opts ~ocaml_version in
+let with_sandbox_switch opam_opts ~ocaml f =
+  let* sandbox = init opam_opts ~ocaml in
   Fun.protect
     ~finally:(fun () -> deinit opam_opts sandbox)
     (fun () -> f sandbox)