Recursive & subpath pinning: update and add test

master_changes.md

@@ -38,6 +38,7 @@ users)
 
 ## Actions
   *  Add a `'Fetch` action with several packages: one node to download once and prepare source once for packages that share same archive [#4893 @rjbou - fix #3741]
+  * Add subpath on actions listing urls [#4876 @rjbou]
 
 ## Install
   * Make the status of pinned packages more explicit during installation [#4987 @kit-ty-kate - fix #4925]
@@ -63,6 +64,9 @@ users)
   * Switch the default version when undefined from ~dev to dev [#4949 @kit-ty-kate]
   * ◈ New option `opam pin --current` to fix a package in its current state (avoiding pending reinstallations or removals from the repository) [#4973 @AltGr - fix #4970]
   * [BUG] Fix using `--working-dir` with non pinned packages: it was not downloading sources as they were remove from package that need sources [#5082 @rjbou - fix #5060]
+  * [NEW] Reactivate subpath and recursive pinning `--recursive` and `--subpath` [#4876 @rjbou]
+  * scan: show subpaths [#4876 @rjbou]
+  * Fix windows path for subpath, by introducing their own type in `OpamFilename` [#4876 @rjbou]
 
 ## List
   * Some optimisations to 'opam list --installable' queries combined with other filters [#4882 @altgr - fix #4311]
@@ -140,6 +144,7 @@ users)
   * Pass --depth=1 to git-fetch in the Git repo backend [#4442 @dra27]
   * Use 4.08's unnamed functor arguments to silence warning 67 [#4775 @dra27]
   * git: disable colored output [#4884 @rjbou]
+  * Check if a source is up to date with subpath [#4876 @rjbou]
 
 ## Build
   * Bump src_exts and fix build compat with Dune 2.9.0 [#4752 @dra27]
@@ -339,6 +344,7 @@ users)
   * New download functions for shared source, old ones kept [#4893 @rjbou]
   * `OpamClient.filter_unpinned_locally` now display a warning of skipped packages instead of debug log [#5083 @rjbou]
   * `OpamSolution.parallel_apply`: fix sources_needed package set, now integrate requested but not locally pinned packages [#5082 @rjbou]
+  * Add `?subpath` to `OpamRepository.fetch_dev_packages`, `OpamVCS.is_up_to_date` and vcs specific functions in `OpamDarcs`, `OpamHG`, and `OpamGit` [#4876 @rjbou]
 
 ## opam-state
   * `OpamSwitchState.universe`: `requested` argument moved from `name_package_set` to `package_set`, to precise installed packages with `--best-effort` [#4796 @LasseBlaauwbroek]
@@ -382,3 +388,4 @@ users)
   * `OpamSystem.copy_dir`: two-pass `rsync` copy for `MSYS2`, to handle symlinks [#4817 @jonahbeckford]
   * `OpamSHA`: use now only `sha`, some function removed (`shaxxx`, `shaxxx_bytes`, etc.) [#5042 @kit-ty-kate]
   * `OpamCoreConfig.r`: remove openssl related config: `use_openssl` parameter & config field, and `OPAMUSEOPENSSL` environment variable [#5042 @kit-ty-kate]
+  * `OpamFilename`: add a `SubPath` submodule to handle multi-platform subpath specifications. It has an effect on a lot of functions signatures [#4876 @rjbou]

src/client/opamAction.ml

@@ -617,7 +617,7 @@ let make_command st opam ?dir ?text_command (cmd, args) =
           let rev = OpamProcess.Job.run (OpamRepository.revision src u) in
           Printf.sprintf "pinned(%s%s%s)"
             (OpamUrl.to_string u)
-            (OpamStd.Option.to_string (fun s -> "("^s^")")
+            (OpamStd.Option.to_string OpamFilename.SubPath.pretty_string
                (OpamFile.URL.subpath url))
             (OpamStd.Option.to_string
                (fun r -> "#"^OpamPackage.Version.to_string r) rev)

src/client/opamArg.ml

@@ -703,8 +703,12 @@ let existing_filename_dirname_or_dash =
   in
   parse, print
 
-let _subpath_conv =
-  (fun str -> `Ok (OpamStd.String.remove_prefix ~prefix:"./" str)), pr_str
+let subpath_conv =
+  let parse str =
+    `Ok (OpamFilename.SubPath.of_string str)
+  in
+  let print ppf sb = pr_str ppf (OpamFilename.SubPath.to_string sb) in
+  parse, print
 
 let package_name =
   let parse str =
@@ -1438,22 +1442,20 @@ let assume_built cli =
 (* Options common to all path based/related commands, e.g. (un)pin, upgrade,
    remove, (re)install.
    Disabled *)
-let recurse _cli = Term.const false
+(* let recurse _cli = Term.const false *)
 
-(*
+let recurse cli =
   mk_flag ~cli (cli_from cli2_2) ["recursive"]
     "Allow recursive lookups of (b,*.opam) files. Cf. $(i,--subpath) also."
-*)
 
-let subpath _cli = Term.const None
-(*
+(* let subpath _cli = Term.const None *)
+let subpath cli =
   mk_opt ~cli (cli_from cli2_2) ["subpath"] "PATH"
     "$(b,*.opam) files are retrieved from the given sub directory instead of \
       top directory. Sources are then taken from the targeted sub directory, \
       internally only this subdirectory is copied/fetched.  It can be combined \
       with $(i,--recursive) to have a recursive lookup on the subpath."
     Arg.(some subpath_conv) None
-*)
 
 let package_selection_section = "PACKAGE SELECTION OPTIONS"
 

src/client/opamArg.mli

@@ -197,7 +197,7 @@ val assume_built: OpamCLIVersion.Sourced.t -> bool Term.t
    remove, (re)install
    Disabled *)
 val recurse: OpamCLIVersion.Sourced.t -> bool Term.t
-val subpath: OpamCLIVersion.Sourced.t -> string option Term.t
+val subpath: OpamCLIVersion.Sourced.t -> subpath option Term.t
 
 (** Applly build options *)
 val apply_build_options: OpamCLIVersion.Sourced.t -> build_options -> unit

src/client/opamAuxCommands.ml

@@ -88,62 +88,43 @@ let url_with_local_branch = function
      | None -> url)
   | url -> url
 
-let opams_of_dir ?recurse ?subpath d =
-  let files = OpamPinned.files_in_source ?recurse ?subpath d in
-  List.fold_left (fun acc (n, f, subp) ->
+let opams_of_dir_t files_in_source get set dir =
+  let files = files_in_source dir in
+  List.fold_left (fun acc x ->
+      let n, f = get x in
       let name =
         let open OpamStd.Option.Op in
         n >>+ fun () ->
         OpamFile.OPAM.(name_opt (safe_read f))
         >>+ fun () ->
         match files with
         | [] | _::_::_ -> None
-        | [_] -> name_from_project_dirname d
+        | [_] -> name_from_project_dirname dir
       in
       match name with
-      | Some n -> (n, f, subp) :: acc
+      | Some n -> set n x :: acc
       | None ->
         OpamConsole.warning
           "Ignoring file at %s: could not infer package name"
           (OpamFile.to_string f);
         acc)
     [] files
 
-let opams_of_dir_w_target ?(recurse=false) ?subpath
+
+let opams_of_dir ?recurse ?subpath dir =
+  opams_of_dir_t (OpamPinned.files_in_source ?recurse ?subpath)
+    (fun (n, f, _) -> n, f)
+    (fun n (_, f, s)-> n, f, s)
+    dir
+
+let opams_of_dir_w_target ?recurse ?subpath
     ?(same_kind=fun _ -> OpamClientConfig.(!r.pin_kind_auto)) url dir =
-  OpamStd.List.filter_map (fun (name, file, subp) ->
-      let url =
-        match url.OpamUrl.backend with
-        | #OpamUrl.version_control as vc ->
-          let module VCS =
-            (val match vc with
-               | `git -> (module OpamGit.VCS: OpamVCS.VCS)
-               | `hg -> (module OpamHg.VCS: OpamVCS.VCS)
-               | `darcs -> (module OpamDarcs.VCS: OpamVCS.VCS)
-               : OpamVCS.VCS)
-          in
-          let open OpamProcess.Job.Op in
-          let versioned_files =
-            OpamProcess.Job.run @@
-            VCS.versioned_files dir @@| fun files -> files
-          in
-          let opamfile =
-            OpamFilename.remove_prefix dir (OpamFile.filename file)
-          in
-          if List.mem opamfile versioned_files
-          || not (OpamStd.String.contains opamfile ~sub:Filename.dir_sep) then
-            url
-          else
-            { url with
-              transport = "file";
-              hash = None;
-              backend = `rsync }
-        | _ -> url
-      in
-      if same_kind url then
-        Some (name, file, url, subp)
-      else None)
-    (opams_of_dir ~recurse ?subpath dir)
+  opams_of_dir_t
+    (OpamPinned.files_in_source_w_target
+       ?recurse ?subpath ~same_kind url)
+    (fun (n, f, _, _) -> n, f)
+    (fun n (_, f, u, s)-> n, f, u, s)
+    dir
 
 let name_and_dir_of_opam_file f =
   let srcdir = OpamFilename.dirname f in
@@ -169,7 +150,7 @@ let resolve_locals_pinned st ?(recurse=false) ?subpath atom_or_local_list =
          let open OpamStd.Option.Op in
          match subpath with
          | Some sp ->
-           let dir_sp = OpamFilename.Op.(dir / sp) in
+           let dir_sp = OpamFilename.SubPath.(dir / sp) in
            let url_sp_dir =
              OpamSwitchState.primary_url_with_subpath st nv >>= OpamUrl.local_dir
            in
@@ -264,10 +245,7 @@ let autopin_aux st ?quiet ?(for_view=false) ?recurse ?subpath atom_or_local_list
   else
   let pinning_dirs =
     OpamStd.List.filter_map (function
-        | `Dirname d ->
-          (match subpath with
-           | Some s -> Some OpamFilename.Op.(d/s)
-           | None -> Some d)
+        | `Dirname d -> Some OpamFilename.SubPath.(d /? subpath)
         | _ -> None)
       atom_or_local_list
   in
@@ -276,7 +254,8 @@ let autopin_aux st ?quiet ?(for_view=false) ?recurse ?subpath atom_or_local_list
          Printf.sprintf "%s => %s%s"
            (OpamPackage.Name.to_string name)
            (OpamUrl.to_string target)
-           (match subpath with None -> "" | Some s -> " ("^s^")")))
+           (OpamStd.Option.to_string
+              OpamFilename.SubPath.pretty_string subpath)))
     to_pin;
   let obsolete_pins =
     (* Packages not current but pinned to the same dirs *)

src/client/opamAuxCommands.mli

@@ -36,36 +36,37 @@ val name_and_dir_of_opam_file: filename -> name option * dirname
 (** From a directory, retrieve its opam files and returns packages name, opam
     file and subpath option *)
 val opams_of_dir:
-  ?recurse:bool -> ?subpath:string ->
-  OpamFilename.Dir.t -> (name * OpamFile.OPAM.t OpamFile.t * string option) list
+  ?recurse:bool -> ?subpath:subpath ->
+  OpamFilename.Dir.t -> (name * OpamFile.OPAM.t OpamFile.t * subpath option) list
 
 (** Like [opam_of_dirs], but changes the pinning_url if needed. If given [url]
     is local dir with vcs backend, and opam files not versioned, its pinning url
     is changed to rsync path-pin. If [ame_kind the_new_url] returns true,
     package information (name, opam file, new_url, subpath) are added to the
     returned list, otherwise it is discarded. *)
 val opams_of_dir_w_target:
-  ?recurse:bool -> ?subpath:string ->
+  ?recurse:bool -> ?subpath:subpath ->
   ?same_kind:(OpamUrl.t -> bool) -> OpamUrl.t -> OpamFilename.Dir.t ->
-  (name * OpamFile.OPAM.t OpamFile.t * OpamUrl.t * string option) list
+  (name * OpamFile.OPAM.t OpamFile.t * OpamUrl.t * subpath option) list
 
 (** Resolves the opam files and directories in the list to package name and
     location, and returns the corresponding pinnings and atoms. May fail and
     exit if package names for provided [`Filename] could not be inferred, or if
     the same package name appears multiple times.
 *)
 val resolve_locals:
-  ?quiet:bool -> ?recurse:bool -> ?subpath:string ->
+  ?quiet:bool -> ?recurse:bool -> ?subpath:subpath ->
   [ `Atom of atom | `Filename of filename | `Dirname of dirname ] list ->
-  (name * OpamUrl.t * string option * OpamFile.OPAM.t OpamFile.t) list * atom list
+  (name * OpamUrl.t * subpath option * OpamFile.OPAM.t OpamFile.t) list
+  * atom list
 
 (** Resolves the opam files and directories in the list to package name and
     location, according to what is currently pinned, and returns the
     corresponding list of atoms. Prints warnings for directories where nothing
     is pinned, or opam files corresponding to no pinned package.
 *)
 val resolve_locals_pinned:
-  'a switch_state -> ?recurse:bool -> ?subpath:string ->
+  'a switch_state -> ?recurse:bool -> ?subpath:subpath ->
   [ `Atom of atom | `Dirname of dirname ] list ->
   atom list
 
@@ -85,7 +86,7 @@ val autopin:
   ?simulate:bool ->
   ?quiet:bool ->
   ?recurse:bool ->
-  ?subpath:string ->
+  ?subpath:subpath ->
   [ `Atom of atom | `Filename of filename | `Dirname of dirname ] list ->
   rw switch_state * atom list
 
@@ -100,7 +101,7 @@ val simulate_autopin:
   ?quiet:bool ->
   ?for_view:bool ->
   ?recurse:bool ->
-  ?subpath:string ->
+  ?subpath:subpath ->
   [ `Atom of atom | `Filename of filename | `Dirname of dirname ] list ->
   'a switch_state * atom list
 

src/client/opamClient.mli

@@ -127,7 +127,7 @@ module PIN: sig
   val pin:
     rw switch_state ->
     OpamPackage.Name.t ->
-    ?edit:bool -> ?version:version -> ?action:bool -> ?subpath:string ->
+    ?edit:bool -> ?version:version -> ?action:bool -> ?subpath:subpath ->
     ?locked:bool ->
     [< `Source of url | `Version of version | `Dev_upstream
     | `Source_version of version * version
@@ -143,9 +143,9 @@ module PIN: sig
 
   val url_pins:
     rw switch_state -> ?edit:bool -> ?action:bool -> ?locked:bool ->
-    ?pre:((name * version option * OpamFile.OPAM.t option * url * string option)
+    ?pre:((name * version option * OpamFile.OPAM.t option * url * subpath option)
           -> unit) ->
-    (name * version option * OpamFile.OPAM.t option * url * string option) list ->
+    (name * version option * OpamFile.OPAM.t option * url * subpath option) list ->
     rw switch_state
 
   val unpin:

src/client/opamCommands.ml

@@ -3224,8 +3224,10 @@ let pin ?(unpin_only=false) cli =
                        | Some sp, true ->
                          (match spu with
                           | Some spp ->
-                            OpamUrl.Op.(OpamStd.String.starts_with
-                                          ~prefix:(url / sp).path (u / spp).path)
+                            let open OpamUrl.Op in
+                            OpamStd.String.starts_with
+                              ~prefix:(url / OpamFilename.SubPath.to_string sp).path
+                              (u / OpamFilename.SubPath.to_string spp).path
                           | None -> false)
                        | None, true ->
                          u.path = url.path
@@ -3454,7 +3456,7 @@ let source cli =
          in
          OpamProcess.Job.run job;
          if OpamPinned.find_opam_file_in_source nv.name
-             (OpamStd.Option.map_default (fun sp -> Op.(dir / sp)) dir subpath)
+             OpamFilename.SubPath.(dir /? subpath)
             = None
          then
            let f =