WIP: Add local repo support

bin/commandStatus.ml

@@ -12,10 +12,8 @@ let status () =
   [%derive.show: string list] (SatysfiDirs.runtime_dirs ()) |> print_endline;
   printf "SATySFi user directory: ";
   [%derive.show: string option] (SatysfiDirs.user_dir ()) |> print_endline;
-  env.opam_reg |> Option.iter ~f:(
-    printf !"Selected SATySFi runtime distribution: %{sexp:OpamSatysfiRegistry.t}\n");
-  env.dist_library_dir |> Option.iter ~f:(
-    printf "Selected SATySFi runtime distribution: %s\n")
+  printf !"Selected OPAM SATySFi library registry: %{sexp:OpamSatysfiRegistry.t option}\n" env.opam_reg ;
+  printf !"Selected SATySFi runtime distribution: %{sexp: string option}\n" env.dist_library_dir
 
 
 let status_command =

bin/setup.ml

@@ -8,17 +8,14 @@ let home_dir = match SatysfiDirs.home_dir () with
   | Some(d) -> d
   | None -> failwith "Cannot find home directory"
 
-let reg_opam =
-  SatysfiDirs.opam_share_dir ~outf:Format.std_formatter
-  |> Option.bind ~f:(fun opam_share_dir ->
-      OpamSatysfiRegistry.read (Filename.concat opam_share_dir "satysfi"))
-
 let default_target_dir =
   Sys.getenv "SATYSFI_RUNTIME"
   |> Option.value ~default:(Filename.concat home_dir ".satysfi")
   |> (fun dir -> Filename.concat dir "dist")
 
 let read_environment () =
-  let dist_library_dir = SatysfiDirs.satysfi_dist_dir ~outf:Format.std_formatter in
-  Environment.{ opam_reg = reg_opam; dist_library_dir }
+  let outf = Format.std_formatter in
+  let env = EnvironmentStatus.read_opam_environment () in
+  Format.(fprintf std_formatter !"env: %{sexp: Environment.t}\n" env);
+  SatysfiDirs.read_satysfi_env ~outf env
 

src/command/build.ml

@@ -2,6 +2,7 @@ open Core
 open Satyrographos
 
 module P = Shexp_process
+module OW = Satyrographos.OpamWrapper
 
 let read_module ~outf ~verbose ~build_module ~buildscript_path =
   let src_dir = Filename.dirname buildscript_path in
@@ -122,7 +123,9 @@ let opam_pin_project ~(buildscript: BuildScript.t) ~buildscript_path =
             Lint.get_opam_name ~opam ~opam_path
           in
           P.run "opam" ["pin"; "add"; "--no-action"; "--yes"; opam_name; "file://" ^ workdir cwd]
-          >> P.run "opam" ["reinstall"; "--verbose"; "--yes"; workdir cwd]
+          >> P.set_env "OPAMSOLVERTIMEOUT" "0" (
+            P.run "opam" ["reinstall"; "--verbose"; "--yes"; "--"; workdir cwd]
+          )
         )
     )
 

src/command/lockdown.ml

@@ -21,9 +21,11 @@ let save_lockdown ~verbose ~buildscript_path =
     (lockdown_file_path ~buildscript_path)
     lockdown
 
+let restore_lockdown_result ~verbose ~buildscript_path =
+  Satyrographos_lockdown.LockdownFile.load_file_result
+    (lockdown_file_path ~buildscript_path)
+  |> Result.map (Satyrographos_lockdown.Lockdown.restore_lockdown ~verbose)
+
 let restore_lockdown ~verbose ~buildscript_path =
-  let lockdown =
-    Satyrographos_lockdown.LockdownFile.load_file_exn
-      (lockdown_file_path ~buildscript_path);
-  in
-  Satyrographos_lockdown.Lockdown.restore_lockdown ~verbose lockdown;
+  restore_lockdown_result ~verbose ~buildscript_path
+  |> Result.get_ok

src/command/runSatysfi.ml

@@ -3,6 +3,7 @@ open Satyrographos
 
 module Process = Shexp_process
 module P = Process
+module OW = Satyrographos.OpamWrapper
 
 module StringMap = Map.Make(String)
 

src/dune

@@ -3,7 +3,16 @@
  (synopsis "Internal Satyrographos Library, do not use!")
  (inline_tests)
  (preprocess (staged_pps ppx_deriving.std ppx_jane))
- (libraries core fileutils json-derivers opam-format shexp.process uri uri-sexp yojson))
+ (libraries
+   core
+   fileutils
+   json-derivers
+   opam-format
+   opam-state
+   shexp.process
+   uri
+   uri-sexp
+   yojson))
 
 (ocamllex
  (modules glob_lexer)

src/environment.ml

@@ -1,15 +1,31 @@
+open Core
+
+module OpamSwitch = struct
+  include OpamSwitch
+
+  let sexp_of_t v =
+    OpamSwitch.to_string v
+    |> [%sexp_of: string]
+
+  let t_of_sexp sexp =
+    [%of_sexp: string] sexp
+    |> OpamSwitch.of_string
+end
+
 type t = {
+  opam_switch: OpamSwitch.t option;
   opam_reg: OpamSatysfiRegistry.t option;
   dist_library_dir: string option;
 }
+[@@deriving sexp]
+
 
 let empty = {
+  opam_switch=None;
   opam_reg=None;
   dist_library_dir=None;
 }
 
-open Core
-
 type project_env = {
   buildscript_path: string;
   satysfi_runtime_dir: string;

src/environment.mli

@@ -1,12 +1,16 @@
 (** A type represents runtime environment. *)
 type t = {
+  opam_switch: OpamSwitch.t option;
+  (** OPAM Switch. E.g., 4.10.0 *)
+
   opam_reg: OpamSatysfiRegistry.t option;
-  (** OPAM Registry. I.e., ~/.satyrograpos *)
+  (** OPAM Registry. E.g., ~/.opam/4.10.0/share/satysfi *)
 
   dist_library_dir: string option;
   (** A directory with SATySFi dist for the current SATySFi compiler.
       Typically, this points a directory under OPAM reg or /usr/local/share/satysfi/dist. *)
 }
+[@@deriving sexp]
 
 (** An empty runtime environment. *)
 val empty: t

src/environmentStatus.ml

@@ -0,0 +1,21 @@
+open Core
+
+(*
+let satysfi_opam_registry () =
+  OpamWrapper.get_satysfi_opam_registry None
+  |> Option.map ~f:OpamFilename.Dir.to_string
+*)
+
+let read_opam_environment ?opam_switch () =
+  let satysfi_opam_registry () =
+    OpamWrapper.get_satysfi_opam_registry opam_switch
+    |> Option.map ~f:OpamFilename.Dir.to_string
+  in
+
+  let reg = satysfi_opam_registry () in
+  Format.(printf !"reg: %{sexp: string option}\n" reg);
+
+  let opam_reg =
+    OpamSatysfiRegistry.read (reg |> Option.value_exn ~message:"Failed to read OPAM repo")
+  in
+  Environment.{ empty with opam_reg; opam_switch; }

src/lockdown/lockdownFile.ml

@@ -20,10 +20,17 @@ type opam_package = {
 }
 [@@deriving equal, sexp, yojson]
 
+type opam_repo = {
+  name: string;
+  url: string;
+}
+[@@deriving equal, sexp, yojson]
+
 let x =
   opam_package_of_yojson
 type opam_dependencies = {
   packages: opam_package list;
+  repos: opam_repo list;
 }
 [@@deriving equal, sexp, yojson]
 
@@ -75,10 +82,13 @@ let save_file_exn f ld =
       |> Out_channel.output_string oc
     )
 
-let load_file_exn f =
+let load_file_result f =
   In_channel.read_all f
   |> Yaml.yaml_of_string
   |> error_msg_to_invalid_arg
   |> YamlYojson.yojson_of_yaml
   |> of_yojson
+
+let load_file_exn f =
+  load_file_result f
   |> Result.ok_or_failwith

src/lockdown/opamDependencies.ml

@@ -2,61 +2,101 @@ open Core
 
 open LockdownFile
 module P = Shexp_process
+module OpamWrapper = Satyrographos.OpamWrapper
 
-let opam_installed_transitive_dependencies_com ~verbose:_ packages =
-  let open P.Infix in
-  let cmd =
-    P.run "opam" [
-      "list";
-      "-i";
-      "--color=never";
-      "--columns";
-      "name,installed-version";
-      "--separator=,";
-      "--recursive";
-      "--required-by"; String.concat ~sep:"," packages]
-    |> P.capture_unit [P.Std_io.Stdout]
-    >>| String.split_lines
-    >>| List.filter ~f:(fun l -> String.is_prefix ~prefix:"#" l |> not)
-    >>| List.filter_map ~f:(fun l ->
-        match String.split_on_chars ~on:[','] l with
-        | [name; version] -> Some {
-            name = String.strip name;
-            version = String.strip version;
-          }
-        | [""] | [] -> None
-        | _ ->
-          failwithf
-            "BUG: Unrecognizable package information from OPAM: %S"
-            l
-            ()
-      )
-  in
-  P.echo "Gathering OPAM package information..."
-  >> cmd
+let get_opam_repositories ~gt ~rt () =
+  OpamGlobalState.repos_list gt
+  |> List.map ~f:(OpamRepositoryState.get_repo rt)
 
 let get_opam_dependencies ~verbose packages =
-  let packages =
-    opam_installed_transitive_dependencies_com ~verbose packages
+  OpamGlobalState.with_ `Lock_none @@ fun gt ->
+  OpamRepositoryState.with_ `Lock_none gt @@ fun rt ->
+  let package_and_repos =
+    OpamWrapper.opam_installed_transitive_dependencies_com ~verbose packages
     |> P.eval
   in
-  { packages; }
+  let packages =
+    package_and_repos
+    |> List.map ~f:(fun {name; version; _} -> {name; version;})
+  in
+  let used_repos =
+    package_and_repos
+    |> List.map ~f:(fun {repo; _} -> repo)
+    |> Set.of_list (module String)
+  in
+  used_repos
+  |> Set.to_list
+  |> Printf.printf !"Used repos: %{sexp: string list}\n";
+  let all_repos = get_opam_repositories ~gt ~rt () in
+  let repo_map =
+    all_repos
+    |> List.filter_map ~f:(fun r ->
+        let name = OpamRepositoryName.to_string r.repo_name in
+        if Set.mem used_repos name
+        then Some (name, r)
+        else begin
+          OpamRepositoryBackend.to_string r |> Printf.printf "Not used: %s\n";
+          None
+        end
+      )
+    |> Map.of_alist_exn (module String)
+  in
+  let repos =
+    all_repos
+    |> List.filter ~f:(fun r ->
+       let name = OpamRepositoryName.to_string r.repo_name in
+       Set.mem used_repos name
+      )
+    |> List.map ~f:(fun r ->
+        { name = OpamRepositoryName.to_string r.repo_name;
+          url = OpamUrl.to_string r.repo_url;
+        }
+      )
+  in
+  let unsafe_repos =
+    repo_map
+    |> Map.filter ~f:(fun r ->
+        OpamUrl.to_string r.repo_url
+        |> Set.mem OpamWrapper.safe_repo_list
+        |> not)
+  in
+  if Map.is_empty unsafe_repos |> not
+  then begin
+    unsafe_repos
+    |> Map.to_alist
+    |> List.map ~f:snd
+    |> List.map ~f:OpamRepositoryBackend.to_string
+    |> List.map ~f:(fun s -> "  " ^ s)
+    |> String.concat ~sep:"\n"
+    |> Printf.printf "[WARNING] The following repos are unsafe:\n%s\n";
+    package_and_repos
+    |> List.filter_map ~f:(fun {name; repo; _} ->
+        if Map.mem unsafe_repos repo
+        then Some (Printf.sprintf "  %s at %s" name repo)
+        else None)
+    |> String.concat ~sep:"\n"
+    |> Printf.printf "Used by:\n%s\n";
+  end;
+  { packages; repos; }
 
 let restore_opam_dependencies_com ~verbose (dependencies : opam_dependencies) =
   let packages =
     dependencies.packages
     |> List.map ~f:(fun {name; version;} ->
-        sprintf "%s.%s" name version)
-  in
-  [
-    ["install"; "--yes";];
-    if verbose
-    then ["--verbose";]
-    else [];
-    packages;
-  ]
-  |> List.concat
-  |> P.run "opam"
+        name, version)
+  in
+  let install_com =
+    OpamWrapper.opam_install_com ~verbose packages
+  in
+  let repos =
+    dependencies.repos
+    |> List.map ~f:(fun {name; url} -> name, url)
+  in
+  let open P.Infix in
+  OpamWrapper.opam_clean_up_local_switch_com ()
+  >> OpamWrapper.opam_set_up_local_switch_com ~repos ~version:None ()
+  >> install_com
+
 
 let restore_opam_dependencies ~verbose (dependencies : opam_dependencies) =
   restore_opam_dependencies_com ~verbose dependencies