fix(pkg): remove External_copy

Make it the same as file://. Both of these constructors mean the same
thing, so let's keep one of them.

Signed-off-by: Rudi Grinberg <[email protected]>

<!-- ps-id: cc26aabc-5ed3-42c9-90db-53efae6ec9da -->

src/dune_pkg/opam_solver.ml

@@ -569,7 +569,7 @@ let opam_package_to_lock_file_pkg
           (* opam discards the later checksums, so we only take the first one *)
           | checksum :: _ -> Some (Loc.none, Checksum.of_opam_hash checksum)
         in
-        Source.Fetch { Source.url; checksum } ))
+        { Source.url; checksum } ))
   in
   let info =
     let url = OpamFile.OPAM.url opam_file in
@@ -581,7 +581,7 @@ let opam_package_to_lock_file_pkg
           |> Option.map ~f:(fun hash -> Loc.none, Checksum.of_opam_hash hash)
         in
         let url = Loc.none, OpamFile.URL.url url in
-        Source.Fetch { url; checksum })
+        { Source.url; checksum })
     in
     let dev =
       Package_name.Set.mem pinned_package_names name

src/dune_pkg/source.ml

@@ -1,48 +1,34 @@
 open Import
 
-type fetch =
+type t =
   { url : Loc.t * OpamUrl.t
   ; checksum : (Loc.t * Checksum.t) option
   }
 
-type t =
-  | External_copy of Loc.t * Path.External.t
-  | Fetch of fetch
-
-let remove_locs = function
-  | External_copy (_loc, path) -> External_copy (Loc.none, path)
-  | Fetch { url = _loc, url; checksum } ->
-    Fetch
-      { url = Loc.none, url
-      ; checksum = Option.map checksum ~f:(fun (_loc, checksum) -> Loc.none, checksum)
-      }
+let remove_locs { url = _loc, url; checksum } =
+  { url = Loc.none, url
+  ; checksum = Option.map checksum ~f:(fun (_loc, checksum) -> Loc.none, checksum)
+  }
 ;;
 
-let equal a b =
-  match a, b with
-  | External_copy (loc, path), External_copy (other_loc, other_path) ->
-    Loc.equal loc other_loc && Path.External.equal path other_path
-  | ( Fetch { url = loc, url; checksum }
-    , Fetch { url = other_loc, other_url; checksum = other_checksum } ) ->
-    Loc.equal loc other_loc
-    && OpamUrl.equal url other_url
-    && Option.equal
-         (fun (loc, checksum) (other_loc, other_checksum) ->
-           Loc.equal loc other_loc && Checksum.equal checksum other_checksum)
-         checksum
-         other_checksum
-  | _ -> false
+let equal
+  { url = loc, url; checksum }
+  { url = other_loc, other_url; checksum = other_checksum }
+  =
+  Loc.equal loc other_loc
+  && OpamUrl.equal url other_url
+  && Option.equal
+       (fun (loc, checksum) (other_loc, other_checksum) ->
+         Loc.equal loc other_loc && Checksum.equal checksum other_checksum)
+       checksum
+       other_checksum
 ;;
 
-let to_dyn = function
-  | External_copy (_loc, path) ->
-    Dyn.variant "External_copy" [ Path.External.to_dyn path ]
-  | Fetch { url = _loc, url; checksum } ->
-    Dyn.variant
-      "Fetch"
-      [ Dyn.string (OpamUrl.to_string url)
-      ; Dyn.option (fun (_loc, checksum) -> Checksum.to_dyn checksum) checksum
-      ]
+let to_dyn { url = _loc, url; checksum } =
+  Dyn.record
+    [ "url", Dyn.string (OpamUrl.to_string url)
+    ; "checksum", Dyn.option (fun (_loc, checksum) -> Checksum.to_dyn checksum) checksum
+    ]
 ;;
 
 let fetch_and_hash_archive_cached =
@@ -68,7 +54,7 @@ let fetch_and_hash_archive_cached =
       None
 ;;
 
-let compute_missing_checksum_of_fetch
+let compute_missing_checksum
   ({ url = url_loc, url; checksum } as fetch)
   package_name
   ~pinned
@@ -98,15 +84,6 @@ let compute_missing_checksum_of_fetch
     >>| Option.value ~default:fetch
 ;;
 
-let compute_missing_checksum t package_name ~pinned =
-  let open Fiber.O in
-  match t with
-  | External_copy _ -> Fiber.return t
-  | Fetch fetch ->
-    let+ fetch = compute_missing_checksum_of_fetch fetch package_name ~pinned in
-    Fetch fetch
-;;
-
 module Fields = struct
   let copy = "copy"
   let fetch = "fetch"
@@ -128,20 +105,27 @@ let decode_fetch =
   { url = url_loc, url; checksum }
 ;;
 
+let external_copy (loc, path) =
+  let path = Path.External.to_string path in
+  let url : OpamUrl.t = { transport = "file"; path; hash = None; backend = `rsync } in
+  { url = loc, url; checksum = None }
+;;
+
 let decode =
   let open Decoder in
   sum
     [ ( Fields.copy
       , located string
         >>| fun (loc, source) path ->
-        External_copy
-          ( loc
-          , if Filename.is_relative source
-            then Path.External.relative path source
-            else Path.External.of_string source ) )
+        let path =
+          if Filename.is_relative source
+          then Path.External.relative path source
+          else Path.External.of_string source
+        in
+        external_copy (loc, path) )
     ; ( Fields.fetch
       , let+ fetch = fields decode_fetch in
-        fun _ -> Fetch fetch )
+        fun _ -> fetch )
     ]
 ;;
 
@@ -154,7 +138,12 @@ let encode_fetch_field { url = _loc, url; checksum } =
 
 let encode t =
   let open Encoder in
-  match t with
-  | External_copy (_loc, path) -> constr Fields.copy string (Path.External.to_string path)
-  | Fetch fetch -> named_record_fields Fields.fetch (encode_fetch_field fetch)
+  named_record_fields Fields.fetch (encode_fetch_field t)
+;;
+
+let kind t =
+  let _, url = t.url in
+  if OpamUrl0.is_local url && url.backend = `rsync
+  then `Directory_or_archive (Path.External.of_string url.path)
+  else `Fetch
 ;;

src/dune_pkg/source.mli

@@ -1,17 +1,15 @@
 open Import
 
-type fetch =
+type t =
   { url : Loc.t * OpamUrl.t
   ; checksum : (Loc.t * Checksum.t) option
   }
 
-type t =
-  | External_copy of Loc.t * Path.External.t
-  | Fetch of fetch
-
 val equal : t -> t -> bool
 val decode : (Path.External.t -> t) Dune_sexp.Decoder.t
 val encode : t -> Dune_sexp.t
 val to_dyn : t -> Dyn.t
 val remove_locs : t -> t
 val compute_missing_checksum : t -> Package_name.t -> pinned:bool -> t Fiber.t
+val external_copy : Loc.t * Path.External.t -> t
+val kind : t -> [ `Directory_or_archive of Path.External.t | `Fetch ]

src/dune_rules/fetch_rules.ml

@@ -8,6 +8,7 @@ include struct
   module Rev_store = Rev_store
   module Pkg = Lock_dir.Pkg
   module OpamUrl = OpamUrl
+  module Source = Source
 end
 
 let context_name = Context_name.of_string "_fetch"
@@ -152,16 +153,15 @@ let extract_checksums_and_urls (lockdir : Dune_pkg.Lock_dir.t) =
         | None -> sources
         | Some source -> source :: sources
       in
-      List.fold_left
-        sources
-        ~init:acc
-        ~f:(fun (checksums, urls) (source : Dune_pkg.Source.t) ->
-          match source with
-          | Fetch { url; checksum = Some ((_, checksum) as checksum_with_loc) } ->
-            Checksum.Map.set checksums checksum (url, checksum_with_loc), urls
-          | Fetch { url; checksum = None } ->
-            checksums, Digest.Map.set urls (digest_of_url (snd url)) url
-          | _ -> checksums, urls))
+      List.fold_left sources ~init:acc ~f:(fun (checksums, urls) (source : Source.t) ->
+        match Source.kind source with
+        | `Directory_or_archive _ -> checksums, urls
+        | `Fetch ->
+          let url = source.url in
+          (match source.checksum with
+           | Some ((_, checksum) as checksum_with_loc) ->
+             Checksum.Map.set checksums checksum (url, checksum_with_loc), urls
+           | None -> checksums, Digest.Map.set urls (digest_of_url (snd url)) url)))
 ;;
 
 let find_checksum, find_url =
@@ -316,14 +316,18 @@ module Copy = struct
   ;;
 end
 
-let fetch ~target kind url checksum =
+let fetch ~target kind (source : Source.t) =
+  let source_kind = Source.kind source in
   let src =
-    let url_or_checksum =
-      match checksum with
-      | Some (_, checksum) -> `Checksum checksum
-      | None -> `Url (snd url)
-    in
-    Path.build (make_target ~kind url_or_checksum)
+    match source_kind with
+    | `Directory_or_archive p -> Path.external_ p
+    | `Fetch ->
+      let url_or_checksum =
+        match source.checksum with
+        | Some (_, checksum) -> `Checksum checksum
+        | None -> `Url (snd source.url)
+      in
+      Path.build (make_target ~kind url_or_checksum)
   in
   let open Action_builder.With_targets.O in
   (* [Action_builder.copy] already adds this dependency for us,
@@ -335,8 +339,15 @@ let fetch ~target kind url checksum =
   match kind with
   | `File -> Action_builder.copy ~src ~dst:target
   | `Directory ->
-    Copy.action ~src_dir:src ~dst_dir:target
-    |> Action.Full.make
+    let action =
+      match source_kind with
+      | `Fetch -> Copy.action ~src_dir:src ~dst_dir:target
+      | `Directory_or_archive _ ->
+        (* For local sources, we don't need an intermediate step copying to the
+           .fetch context. This would just add pointless additional overhead. *)
+        action ~url:source.url ~checksum:source.checksum ~target ~kind
+    in
+    Action.Full.make action
     |> Action_builder.With_targets.return
     |> Action_builder.With_targets.add_directories ~directory_targets:[ target ]
 ;;

src/dune_rules/fetch_rules.mli

@@ -8,8 +8,7 @@ val context : Build_context.t
 val fetch
   :  target:Path.Build.t
   -> [ `File | `Directory ]
-  -> Loc.t * OpamUrl.t
-  -> (Loc.t * Dune_pkg.Checksum.t) option
+  -> Dune_pkg.Source.t
   -> Action.Full.t With_targets.t
 
 val gen_rules

src/dune_rules/lock_dir.ml

@@ -149,3 +149,32 @@ let lock_dir_active ctx =
     | None -> Memo.return false
     | Some path -> Fs_memo.dir_exists (In_source_dir path)
 ;;
+
+let source_kind (source : Dune_pkg.Source.t) =
+  let loc, url = source.url in
+  if OpamUrl.is_local url && url.backend = `rsync
+  then (
+    let path = Path.External.of_string url.path in
+    Fs_memo.path_kind (External path)
+    >>| function
+    | Error (ENOENT, _, _) ->
+      User_error.raise
+        ~loc
+        [ Pp.textf "%s does not exist" (Path.External.to_string_maybe_quoted path) ]
+    | Error exn ->
+      User_error.raise
+        ~loc
+        [ Pp.textf "unable to read %s" (Path.External.to_string_maybe_quoted path)
+        ; Unix_error.Detailed.pp exn
+        ]
+    | Ok S_REG -> `Local (`File, path)
+    | Ok S_DIR -> `Local (`Directory, path)
+    | Ok _kind ->
+      User_error.raise
+        ~loc
+        [ Pp.textf
+            "path %s is not a directory or a file"
+            (Path.External.to_string_maybe_quoted path)
+        ])
+  else Memo.return `Fetch
+;;

src/dune_rules/lock_dir.mli

@@ -19,3 +19,7 @@ module Sys_vars : sig
 
   val poll : t
 end
+
+val source_kind
+  :  Dune_pkg.Source.t
+  -> [ `Local of [ `Directory | `File ] * Path.External.t | `Fetch ] Memo.t