prefetch: paths

3 files changed, 39 insertions, 43 deletions

diff --git a/lib/error.ml b/lib/error.ml
index d98c1ee..1fd2aa6 100644
--- a/lib/error.ml
+++ b/lib/error.ml
@@ -30,6 +30,7 @@ type prefetch_method = [
 
 type prefetch_error = [
 	| `Empty_output of prefetch_method
+	| `Bad_output of prefetch_method * string
 	| `JSON_parsing of prefetch_method * string
 	| `Darcs_context of string
 	| `RunException of prefetch_method * exn * string
diff --git a/lib/input_foreman.ml b/lib/input_foreman.ml
index 10ae67a..9c83684 100644
--- a/lib/input_foreman.ml
+++ b/lib/input_foreman.ml
@@ -253,13 +253,14 @@ let prefetch ~env ~proc_mgr ~name () : (unit, error) result =
 		Ok (String.trim (Buffer.contents stdout_buf))
 	in
 	let models = Input.jg_models2 input in
-	let prefetch_file (f : File.t) : (Input.t * string option, Error.prefetch_error) result =
+	let prefetch_file (f : File.t) : (Input.t * string, Error.prefetch_error) result =
 		let method' = `URL
 		and url = Uri.of_string (Input.Template.fill f.url ~models)
 		in
 		let cmd = [
 			"nix-prefetch-url";
 			Uri.to_string url;
+			"--print-path";
 			"--type";
 			hash_algo_type_val;
 		]
@@ -271,29 +272,25 @@ let prefetch ~env ~proc_mgr ~name () : (unit, error) result =
 		| Ok stdout ->
 			begin
 				Logs.debug (fun m -> m "Command output: %s" stdout);
-				let last_nonempty_line =
-					String.split_on_char '\n' stdout
-					|> List.rev
-					|> List.find_opt (fun line -> line <> "")
-				in
-				match last_nonempty_line with
-				| None -> Error (`Empty_output method')
-				| value ->
-					Ok
-						(
-							{input with hash = {input.hash with value}},
-							None
-						)
+				match String.split_on_char '\n' (String.trim stdout) with
+				| hash :: path :: _ when Option.is_some (Eio.Path.native (Eio.Path.(Eio.Stdenv.fs env / path))) ->
+					Ok (
+						{input with hash = {input.hash with value = Some hash}},
+						path
+					)
+				| _ ->
+					Error (`Bad_output (method', stdout))
 			end
 		| Error err -> Error err
 
-	and prefetch_archive (a : Archive.t) : (Input.t * string option, Error.prefetch_error) result =
+	and prefetch_archive (a : Archive.t) : (Input.t * string, Error.prefetch_error) result =
 		let method' = `URL
 		and url = Uri.of_string (Input.Template.fill a.url ~models)
 		in
 		let cmd = [
 			"nix-prefetch-url";
 			Uri.to_string url;
+			"--print-path";
 			"--unpack";
 			"--type";
 			hash_algo_type_val;
@@ -306,22 +303,18 @@ let prefetch ~env ~proc_mgr ~name () : (unit, error) result =
 		| Ok stdout ->
 			begin
 				Logs.debug (fun m -> m "Command output: %s" stdout);
-				let last_nonempty_line =
-					String.split_on_char '\n' stdout
-					|> List.rev
-					|> List.find_opt (fun line -> line <> "")
-				in
-				match last_nonempty_line with
-				| None -> Error (`Empty_output method')
-				| value ->
+				match String.split_on_char '\n' (String.trim stdout) with
+				| hash :: path :: _ when Option.is_some (Eio.Path.native (Eio.Path.(Eio.Stdenv.fs env / path))) ->
 					Ok (
-						{input with hash = {input.hash with value}},
-						None
+						{input with hash = {input.hash with value = Some hash}},
+						path
 					)
+				| _ ->
+					Error (`Bad_output (method', stdout))
 			end
 		| Error err -> Error err
 
-	and prefetch_git (g : Git.t) : (Input.t * string option, Error.prefetch_error) result =
+	and prefetch_git (g : Git.t) : (Input.t * string, Error.prefetch_error) result =
 		let method' = `Git
 		and repository = Uri.of_string (Input.Template.fill g.repository ~models)
 		in
@@ -368,12 +361,12 @@ let prefetch ~env ~proc_mgr ~name () : (unit, error) result =
 							value = Some data.hash.value;
 						};
 					},
-					Some data.path
+					data.path
 				)
 			end
 		| Error err -> Error err
 
-	and prefetch_darcs (d : Darcs.t) : (Input.t * string option, Error.prefetch_error) result =
+	and prefetch_darcs (d : Darcs.t) : (Input.t * string, Error.prefetch_error) result =
 		let method' = `Darcs
 		and repository = Input.Template.fill d.repository ~models
 		in
@@ -421,12 +414,12 @@ let prefetch ~env ~proc_mgr ~name () : (unit, error) result =
 							value = Some data.hash.value;
 						};
 					},
-					Some data.path
+					data.path
 				)
 			end
 		| Error err -> Error err
 
-	and prefetch_pijul (p : Pijul.t) : (Input.t * string option, Error.prefetch_error) result =
+	and prefetch_pijul (p : Pijul.t) : (Input.t * string, Error.prefetch_error) result =
 		let method' = `Pijul
 		and cmd = [
 			"nix-prefetch-pijul";
@@ -464,12 +457,12 @@ let prefetch ~env ~proc_mgr ~name () : (unit, error) result =
 							value = Some data.hash.value;
 						};
 					},
-					Some data.path
+					data.path
 				)
 			end
 		| Error err -> Error err
 	in
-	let* (new_input, new_silo_link_opt) : Input.t * string option =
+	let* (new_input, new_silo_link) : Input.t * string =
 		Result.map_error (fun err -> `Prefetch (input.name, err)) @@ begin
 			match input.kind with
 			| `File f -> prefetch_file f
@@ -480,11 +473,7 @@ let prefetch ~env ~proc_mgr ~name () : (unit, error) result =
 		end
 	in
 	Logs.app (fun m -> m "Prefetched %a." Name.pp input.name);
-	Option.iter
-		(fun link_to ->
-			Working_directory.make_silo_link ~name: (Name.take name) ~link_to
-		)
-		new_silo_link_opt;
+	Working_directory.make_silo_link ~name: (Name.take name) ~link_to: new_silo_link;
 	set name new_input
 
 let run_pipeline ~sw ~proc_mgr ~(models : Input.jg_models2) cmds =
diff --git a/lib/prefetch.ml b/lib/prefetch.ml
index d5351e9..3cc4c2f 100644
--- a/lib/prefetch.ml
+++ b/lib/prefetch.ml
@@ -30,6 +30,7 @@ end
 module Git = struct
 	type t = {
 		datetime: string option;
+		path: string;
 		rev: string;
 		hash: Hash.t;
 	}
@@ -39,10 +40,11 @@ module Git = struct
 		let open Jsont in
 		Object.map
 			~kind: "Prefetch_Git"
-			(fun datetime rev blake3 sha256 sha512 ->
+			(fun path datetime rev blake3 sha256 sha512 ->
 				let hash = Hash.make_from_opts blake3 sha256 sha512 in
-				make ?datetime ~rev ~hash ()
+				make ~path ?datetime ~rev ~hash ()
 			)
+		|> Object.mem "path" string ~enc: (fun i -> i.path)
 		|> Object.opt_mem "date" string ~enc: (fun i -> i.datetime)
 		|> Object.mem "rev" string ~enc: (fun i -> i.rev)
 		|> Hash.add_jsont_case
@@ -51,6 +53,7 @@ end
 
 module Darcs = struct
 	type t = {
+		path: string;
 		datetime: string option;
 		context: string;
 		weak_hash: string;
@@ -62,10 +65,11 @@ module Darcs = struct
 		let open Jsont in
 		Object.map
 			~kind: "Prefetch_Darcs"
-			(fun datetime context weak_hash blake3 sha256 sha512 ->
+			(fun path datetime context weak_hash blake3 sha256 sha512 ->
 				let hash = Hash.make_from_opts blake3 sha256 sha512 in
-				make ?datetime ~context ~weak_hash ~hash ()
+				make ~path ?datetime ~context ~weak_hash ~hash ()
 			)
+		|> Object.mem "path" string ~enc: (fun i -> i.path)
 		|> Object.opt_mem "date" string ~enc: (fun i -> i.datetime)
 		|> Object.mem "context" string ~enc: (fun i -> i.context)
 		|> Object.mem "weak-hash" string ~enc: (fun i -> i.weak_hash)
@@ -75,6 +79,7 @@ end
 
 module Pijul = struct
 	type t = {
+		path: string;
 		datetime: string option;
 		state: string;
 		hash: Hash.t
@@ -85,10 +90,11 @@ module Pijul = struct
 		let open Jsont in
 		Object.map
 			~kind: "Prefetch_Pijul"
-			(fun datetime state blake3 sha256 sha512 ->
+			(fun path datetime state blake3 sha256 sha512 ->
 				let hash = Hash.make_from_opts blake3 sha256 sha512 in
-				make ?datetime ~state ~hash ()
+				make ~path ?datetime ~state ~hash ()
 			)
+		|> Object.mem "path" string ~enc: (fun i -> i.path)
 		|> Object.opt_mem "date" string ~enc: (fun i -> i.datetime)
 		|> Object.mem "state" string ~enc: (fun i -> i.state)
 		|> Hash.add_jsont_case