`opam pin scan'

master_changes.md

@@ -23,7 +23,9 @@ New option/command/subcommand are prefixed with ◈.
   * Support -n as an alias of --no-action (to match opam-pin) [#4324 @dra27]
 
 ## Pin
-  *
+  * ◈ Add `pin scan` subcommand to list available pins [#4285 @rjbou]
+  * ◈ Add `--normalise` option to print a normalised list when scanning, that can be taken by `opam pin add` [#4285 @rjbou]
+  * `OpamCommand.pin` refactor, including adding `OpamClient.PIN.pin_url_list` to pin a list of package with url  [#4285 @rjbou]
 
 ## List
   * <field> form no longer advertised as valid for --columns [#4322 @dra27]
@@ -67,13 +69,12 @@ New option/command/subcommand are prefixed with ◈.
 ## Opam installer
   *
 
-## Opam file
-  *
 
 ## Solver
   * Don't penalise packages with more recent 'hidden-versions' [#4312 @AltGr]
 
 ## Internal
+  * Process: don't display status line if not verbose, and status line disabled [#4285 @rjbou]
   * Optimise package name comparison [#4328 @AltGr - fix #4245]
 
 ## Test

src/client/opamClient.ml

@@ -1478,6 +1478,33 @@ module PIN = struct
     | OpamPinCommand.Aborted -> OpamStd.Sys.exit_because `Aborted
     | OpamPinCommand.Nothing_to_do -> st
 
+  let url_pins st ?edit ?(action=true) ?(pre=fun _ -> ()) pins =
+    let names = List.map (fun (n,_,_,_) -> n) pins in
+    (match names with
+    | _::_::_ ->
+      if not (OpamConsole.confirm
+                "This will pin the following packages: %s. Continue?"
+                (OpamStd.List.concat_map ", " OpamPackage.Name.to_string names))
+      then
+        OpamStd.Sys.exit_because `Aborted
+    | _ -> ());
+    let pinned = st.pinned in
+    let st =
+      List.fold_left (fun st (name, version, url, subpath as pin) ->
+          pre pin;
+          try
+            OpamPinCommand.source_pin st name ?version
+              ?edit ?subpath (Some url)
+          with
+          | OpamPinCommand.Aborted -> OpamStd.Sys.exit_because `Aborted
+          | OpamPinCommand.Nothing_to_do -> st)
+        st pins
+    in
+    if action then
+      (OpamConsole.msg "\n";
+       post_pin_action st pinned names)
+    else st
+
   let edit st ?(action=true) ?version name =
     let pinned = st.pinned in
     let st =

src/client/opamClient.mli

@@ -126,6 +126,12 @@ module PIN: sig
     rw switch_state -> ?action:bool -> ?version:version -> OpamPackage.Name.t ->
     rw switch_state
 
+  val url_pins:
+    rw switch_state ->  ?edit:bool -> ?action:bool ->
+    ?pre:((name * version option * url * string option) -> unit) ->
+    (name * version option * url * string option) list ->
+    rw switch_state
+
   val unpin:
     rw switch_state ->
     ?action:bool -> OpamPackage.Name.t list -> rw switch_state

src/client/opamCommands.ml

@@ -2757,6 +2757,7 @@ let pin ?(unpin_only=false) () =
   let doc = pin_doc in
   let commands = [
     "list", `list, [], "Lists pinned packages.";
+    "scan", `scan, ["DIR"], "Lists available packages to pin in directory.";
     "add", `add, ["PACKAGE"; "TARGET"],
     "Pins package $(i,PACKAGE) to $(i,TARGET), which may be a version, a path, \
      or a URL.\n\
@@ -2860,6 +2861,15 @@ let pin ?(unpin_only=false) () =
     mk_flag ["dev-repo"] "Pin to the upstream package source for the latest \
                           development version"
   in
+  let normalise =
+    mk_flag ["normalise"]
+      (Printf.sprintf
+         "Print list of available package to pin in format \
+          `name.version%curl`, that is comprehensible by `opam pin \
+          add`. Available only with the scan subcommand. An example of use is \
+          `opam pin scan . --normalise | grep foo | xargs opam pin add`"
+         OpamPinCommand.scan_sep)
+  in
   let guess_names kind ~recurse ?subpath url k =
     let found, cleanup =
       match OpamUrl.local_dir url with
@@ -2955,17 +2965,53 @@ let pin ?(unpin_only=false) () =
   in
   let pin
       global_options build_options
-      kind edit no_act dev_repo print_short recurse subpath command params =
+      kind edit no_act dev_repo print_short recurse subpath normalise
+      command params =
     apply_global_options global_options;
     apply_build_options build_options;
     let action = not no_act in
-    match command, params with
-    | Some `list, [] | None, [] ->
+    let get_command = function
+      | Some `list, [] | None, [] ->
+        `list
+      | Some `scan, [url] ->
+        `scan url
+      | Some `remove, (_::_ as arg) ->
+        `remove arg
+      | Some `edit, [nv]  ->
+        `edit nv
+      | Some `add, pins when OpamPinCommand.looks_like_normalised pins ->
+        `add_normalised pins
+      | Some `default p, pins when
+          OpamPinCommand.looks_like_normalised (p::pins) ->
+        `add_normalised (p::pins)
+      | Some `add, [nv] | Some `default nv, [] when dev_repo ->
+        `add_dev nv
+      | Some `add, [arg] | Some `default arg, [] ->
+        `add_url arg
+      | Some `add, [n; target] | Some `default n, [target] ->
+        `add_wtarget (n,target)
+      | _ -> `incorrect
+    in
+    match get_command (command, params) with
+    | `list ->
       OpamGlobalState.with_ `Lock_none @@ fun gt ->
       OpamSwitchState.with_ `Lock_none gt @@ fun st ->
       OpamClient.PIN.list st ~short:print_short;
       `Ok ()
-    | Some `remove, (_::_ as arg) ->
+    | `scan url ->
+      let backend, handle_suffix =
+        match kind with
+        | Some (#OpamUrl.backend as k) -> Some k, None
+        | Some `auto -> OpamUrl.guess_version_control url, Some true
+        | None when OpamClientConfig.(!r.pin_kind_auto) ->
+          OpamUrl.guess_version_control url, Some true
+        | _ -> None, None
+      in
+      OpamUrl.parse ?backend ?handle_suffix url
+      |> OpamAuxCommands.url_with_local_branch
+      |> OpamPinCommand.scan ~normalise ~recurse ?subpath;
+      `Ok ()
+    | `remove arg ->
       OpamGlobalState.with_ `Lock_none @@ fun gt ->
       OpamSwitchState.with_ `Lock_write gt @@ fun st ->
       let err, to_unpin =
@@ -3018,15 +3064,22 @@ let pin ?(unpin_only=false) () =
       else
         (OpamSwitchState.drop @@ OpamClient.PIN.unpin st ~action to_unpin;
          `Ok ())
-    | Some `edit, [nv]  ->
+    | `edit nv  ->
       (match (fst package) nv with
        | `Ok (name, version) ->
          OpamGlobalState.with_ `Lock_none @@ fun gt ->
          OpamSwitchState.with_ `Lock_write gt @@ fun st ->
          OpamSwitchState.drop @@ OpamClient.PIN.edit st ~action ?version name;
          `Ok ()
        | `Error e -> `Error (false, e))
-    | Some `add, [nv] | Some `default nv, [] when dev_repo ->
+    | `add_normalised pins ->
+      let pins = OpamPinCommand.parse_pins pins in
+      OpamGlobalState.with_ `Lock_none @@ fun gt ->
+      OpamSwitchState.with_ `Lock_write gt @@ fun st ->
+      OpamSwitchState.drop @@
+      OpamClient.PIN.url_pins st ~edit ~action pins;
+      `Ok ()
+    | `add_dev nv ->
       (match (fst package) nv with
        | `Ok (name,version) ->
          OpamGlobalState.with_ `Lock_none @@ fun gt ->
@@ -3038,7 +3091,7 @@ let pin ?(unpin_only=false) () =
        | `Error e ->
          if command = Some `add then `Error (false, e)
          else bad_subcommand commands ("pin", command, params))
-    | Some `add, [arg] | Some `default arg, [] ->
+    | `add_url arg ->
       (match pin_target kind arg with
        | `None | `Version _ ->
          let msg =
@@ -3048,42 +3101,30 @@ let pin ?(unpin_only=false) () =
          `Error (true, msg)
        | `Source url ->
          guess_names kind ~recurse ?subpath url @@ fun names ->
-         let names = match names with
-           | _::_::_ ->
-             if OpamConsole.confirm
-                 "This will pin the following packages: %s. Continue?"
-                 (OpamStd.List.concat_map ", "
-                    (fun (n, _, _, _) -> OpamPackage.Name.to_string n)
-                    names)
-             then names
-             else OpamStd.Sys.exit_because `Aborted
-           | _ -> names
-         in
          OpamGlobalState.with_ `Lock_none @@ fun gt ->
          OpamSwitchState.with_ `Lock_write gt @@ fun st ->
-         let pinned = st.pinned in
-         let st =
-           List.fold_left (fun st (name, opam_opt, subpath,  url) ->
-               OpamStd.Option.iter (fun opam ->
-                   let opam_localf =
-                     OpamPath.Switch.Overlay.tmp_opam
-                       st.switch_global.root st.switch name
-                   in
-                   if not (OpamFilename.exists (OpamFile.filename opam_localf))
-                   then OpamFile.OPAM.write opam_localf opam)
-                 opam_opt;
-               try OpamPinCommand.source_pin st name ~edit ?subpath (Some url) with
-               | OpamPinCommand.Aborted -> OpamStd.Sys.exit_because `Aborted
-               | OpamPinCommand.Nothing_to_do -> st)
-             st names
+         let pins, opams =
+           List.fold_left (fun (pins, opams) (name, opam_opt, subpath, url) ->
+               (name, None, url, subpath)::pins,
+               match opam_opt with
+               | None -> opams
+               | Some opam -> OpamPackage.Name.Map.add name opam opams)
+             ([], OpamPackage.Name.Map.empty) names
          in
-         if action then
-           (OpamSwitchState.drop @@
-            OpamClient.PIN.post_pin_action st pinned
-              (List.map (fun (n,_,_,_) -> n) names);
-            `Ok ())
-         else `Ok ())
-    | Some `add, [n; target] | Some `default n, [target] ->
+         let pre (name, _, _, _) =
+           OpamPackage.Name.Map.find_opt name opams
+           |> OpamStd.Option.iter (fun opam ->
+               let opam_localf =
+                 OpamPath.Switch.Overlay.tmp_opam
+                   st.switch_global.root st.switch name
+               in
+               if not (OpamFilename.exists (OpamFile.filename opam_localf))
+               then OpamFile.OPAM.write opam_localf opam)
+         in
+         OpamSwitchState.drop @@
+         OpamClient.PIN.url_pins st ~edit ~action ~pre (List.rev pins);
+         `Ok ())
+    | `add_wtarget (n, target) ->
       (match (fst package) n with
        | `Ok (name,version) ->
          let pin = pin_target kind target in
@@ -3093,12 +3134,13 @@ let pin ?(unpin_only=false) () =
          OpamClient.PIN.pin st name ?version ~edit ~action ?subpath pin;
          `Ok ()
        | `Error e -> `Error (false, e))
-    | command, params -> bad_subcommand commands ("pin", command, params)
+    | `incorrect -> bad_subcommand commands ("pin", command, params)
   in
   Term.ret
     Term.(const pin
           $global_options $build_options
           $kind $edit $no_act $dev_repo $print_short_flag $recurse $subpath
+          $normalise
           $command $params),
   term_info "pin" ~doc ~man
 

src/client/opamPinCommand.ml

@@ -702,3 +702,115 @@ let list st ~short =
   in
   let table = List.map lines (OpamPackage.Set.elements st.pinned) in
   OpamConsole.print_table stdout ~sep:"  " (OpamStd.Format.align_table table)
+
+(* Must not be contained in a package name, version, nor url *)
+let scan_sep = '^'
+
+let scan ~normalise ~recurse ?subpath url =
+  let open OpamStd.Option.Op in
+  let pins_of_dir dir =
+    OpamPinned.files_in_source ~recurse ?subpath dir
+    |> OpamStd.List.filter_map (fun (nf, opamf, sb) ->
+        let opam = OpamFile.OPAM.safe_read opamf in
+        match (nf ++ OpamFile.OPAM.name_opt opam) with
+        | Some name ->
+          Some (name, (OpamFile.OPAM.version_opt opam), sb)
+        | None ->
+          OpamConsole.warning "Can not retrieve a package name from %s"
+            (OpamFilename.to_string (OpamFile.filename opamf));
+          None)
+  in
+  let pins, cleanup =
+    match OpamUrl.local_dir url with
+    | Some dir -> pins_of_dir dir, None
+    | None ->
+      let pin_cache_dir = OpamRepositoryPath.pin_cache url in
+      let cleanup = fun () ->
+        OpamFilename.rmdir @@ OpamRepositoryPath.pin_cache_dir ()
+      in
+      let basename =
+        match OpamStd.String.split (OpamUrl.basename url) '.' with
+        | [] ->
+          OpamConsole.error_and_exit `Bad_arguments
+            "Can not retrieve a path from '%s'"
+            (OpamUrl.to_string url)
+        | b::_ -> b
+      in
+      try
+        let open OpamProcess.Job.Op in
+        OpamProcess.Job.run @@
+        OpamRepository.pull_tree
+          ~cache_dir:(OpamRepositoryPath.download_cache
+                        OpamStateConfig.(!r.root_dir))
+          basename pin_cache_dir [] [url] @@| function
+        | Not_available (_,u) ->
+          OpamConsole.error_and_exit `Sync_error
+            "Could not retrieve %s" u
+        | Result _ | Up_to_date _ ->
+          pins_of_dir pin_cache_dir, Some cleanup
+      with e -> OpamStd.Exn.finalise e cleanup
+  in
+  let finalise = OpamStd.Option.default (fun () -> ()) cleanup in
+  OpamStd.Exn.finally finalise @@ fun () ->
+  if normalise then
+    OpamConsole.msg "%s"
+      (OpamStd.List.concat_map "\n"
+         (fun (name, version, sb) ->
+            Printf.sprintf "%s%s%c%s%s"
+              (OpamPackage.Name.to_string name)
+              (OpamStd.Option.to_string
+                 (fun v -> "." ^OpamPackage.Version.to_string v) version)
+              scan_sep
+              (OpamUrl.to_string url)
+              (OpamStd.Option.to_string (fun sb ->
+                   (String.make 1 scan_sep) ^ sb) sb))
+         pins)
+  else
+    ["# Name"; "# Version"; "# Url" (*; "# Subpath"*)] ::
+    List.map (fun (name, version, _sb) ->
+        [ OpamPackage.Name.to_string name;
+          (version >>| OpamPackage.Version.to_string) +! "-";
+          OpamUrl.to_string url;
+          (*sb +! "-"*) ]) pins
+    |> OpamStd.Format.align_table
+    |> OpamConsole.print_table stdout ~sep:"  "
+
+let looks_like_normalised args =
+    List.for_all (fun s -> OpamStd.String.contains_char s scan_sep) args
+
+let parse_pins pins =
+  let separator = Re.char scan_sep in
+  let re =
+    Re.(compile @@ whole_string @@ seq [
+        (* package name *)
+        group @@
+        rep1 @@ alt [ alnum; diff punct (alt [char '.'; char scan_sep]) ];
+        (* optional version *)
+        opt @@ seq [ char '.';
+                     group @@
+                     rep1 @@ alt [ alnum; diff punct separator ]];
+        separator;
+        (* url *)
+        group @@ rep1 @@ diff any separator;
+        (* optional subpath *)
+        opt @@ seq [ separator; group @@ rep1 any ];
+      ])
+  in
+  let get s =
+    try
+      let groups = Re.exec re s in
+      Some ( Re.Group.(
+          OpamPackage.Name.of_string @@ get groups 1,
+          OpamStd.Option.map OpamPackage.Version.of_string
+          @@ OpamStd.Option.of_Not_found (get groups) 2,
+          OpamUrl.parse @@ get groups 3,
+          OpamStd.Option.of_Not_found (get groups) 4)
+        )
+    with Not_found | Failure _ -> None
+  in
+  OpamStd.List.filter_map (fun str ->
+      let pin = get str in
+      if pin = None then
+        (OpamConsole.warning "Argument %S is not correct" str;
+         None)
+      else pin) pins