ocaml onset

14 files changed, 3808 insertions, 0 deletions

diff --git a/lib/dune b/lib/dune
new file mode 100644
index 0000000..bd587da
--- /dev/null
+++ b/lib/dune
@@ -0,0 +1,11 @@
+(library
+ (public_name nixtamal)
+ (name nixtamal)
+ (libraries eio eio_main jingoo jsont jsont.bytesrw kdl logs saturn uri)
+ (preprocess
+  (pps
+   ppx_deriving.enum
+   ppx_deriving.eq
+   ppx_deriving.ord
+   ppx_deriving.make
+   ppx_deriving.show)))
diff --git a/lib/editor.ml b/lib/editor.ml
new file mode 100644
index 0000000..a0a6752
--- /dev/null
+++ b/lib/editor.ml
@@ -0,0 +1,19 @@
+(*─────────────────────────────────────────────────────────────────────────────┐
+│ SPDX-FileCopyrightText: 2025 toastal <https://toast.al/contact/>             │
+│ SPDX-License-Identifier: LGPL-2.1-or-later WITH OCaml-LGPL-linking-exception │
+└─────────────────────────────────────────────────────────────────────────────*)
+
+let find () =
+	match Sys.getenv_opt "VISUAL" with
+	| Some v -> v
+	| None ->
+		match Sys.getenv_opt "EDITOR" with
+		| Some e -> e
+		| None -> "vi"
+
+let run_on file =
+	match find () with
+	| ed when String.contains ed ' ' ->
+		Unix.execvp "/bin/sh" [|"/bin/sh"; "-c"; ed ^ " " ^ file|]
+	| ed ->
+		Unix.execvp ed [|ed; file|]
diff --git a/lib/error.ml b/lib/error.ml
new file mode 100644
index 0000000..4255c79
--- /dev/null
+++ b/lib/error.ml
@@ -0,0 +1,77 @@
+(*─────────────────────────────────────────────────────────────────────────────┐
+│ SPDX-FileCopyrightText: 2025 toastal <https://toast.al/contact/>             │
+│ SPDX-License-Identifier: LGPL-2.1-or-later WITH OCaml-LGPL-linking-exception │
+└─────────────────────────────────────────────────────────────────────────────*)
+open Name
+
+type manifest_error = [
+	| `Parsing of Util.KDL.Valid.err list
+	| `Not_set_up
+	| `File_already_exists
+]
+[@@deriving show]
+
+type lockfile_error = [
+	| `Parsing of string
+	| `Serializing of string
+]
+[@@deriving show]
+
+type prefetch_method = [
+	| `URL
+	| `Git
+	| `Darcs
+	| `Pijul
+]
+[@@deriving show]
+
+type prefetch_error = [
+	| `Empty_output of prefetch_method
+	| `Stderr of prefetch_method * string
+	| `JSON_parsing of prefetch_method * string
+	| `Darcs_context of string
+	| `Exception of prefetch_method * string
+]
+[@@deriving show]
+
+type input_foreman_error = [
+	| `Could_not_add of Name.t
+	| `Could_not_drop of Name.t
+	| `Could_not_get of Name.t
+	| `Could_not_set of Name.t
+	| `Latest_cmd_empty of Name.t
+	| `Latest_cmd_fail of Name.t * string
+	| `Latest_cmd_stderr of Name.t * string
+	| `Prefetch of Name.t * prefetch_error
+	| `Pool_exception of string
+	(* FIXME: string list *)
+	| `Many_errors of string list
+]
+[@@deriving show]
+
+type error = [
+	| `Manifest of manifest_error
+	| `Lockfile of lockfile_error
+	| `Version_mismatch of string * string
+	| `Input_foreman of input_foreman_error
+]
+[@@deriving show]
+
+let [@inline]tag_manifest (res : ('a, manifest_error) result) =
+	Result.map_error (fun err -> `Manifest err) res
+
+let [@inline]tag_lockfile (res : ('a, lockfile_error) result) =
+	Result.map_error (fun err -> `Lockfile err) res
+
+let [@inline]tag_input_foreman res =
+	Result.map_error (fun err -> `Input_foreman err) res
+
+let pp ppf = function
+	| `Manifest err ->
+		Fmt.(pf ppf "%a" pp_manifest_error err)
+	| `Lockfile err ->
+		Fmt.(pf ppf "%a" pp_lockfile_error err)
+	| `Version_mismatch (mnfst, lock) ->
+		Fmt.pf ppf "Version mismatch: Manifest@@%s & Lockfile@@%s" mnfst lock
+	| `Input_foreman (`CouldNotAdd name) ->
+		Fmt.pf ppf "Could not set %a" Name.pp name
diff --git a/lib/input.ml b/lib/input.ml
new file mode 100644
index 0000000..6ff5e6e
--- /dev/null
+++ b/lib/input.ml
@@ -0,0 +1,362 @@
+(*─────────────────────────────────────────────────────────────────────────────┐
+│ SPDX-FileCopyrightText: 2025 toastal <https://toast.al/contact/>             │
+│ SPDX-License-Identifier: LGPL-2.1-or-later WITH OCaml-LGPL-linking-exception │
+└─────────────────────────────────────────────────────────────────────────────*)
+open Name
+
+type jg_models2 = string -> Jingoo.Jg_types.tvalue
+
+module Template = struct
+	type t =
+		Template of string
+	[@@unboxed]
+	[@@deriving show]
+
+	let [@inline]make t = Template t
+	let [@inline]take (Template t) = t
+	let [@inline]fill ~(models : jg_models2) tpl =
+		Jingoo.Jg_template2.from_string ~models (take tpl)
+end
+
+module Latest = struct
+	module Cmd = struct
+		type 'a non_empty_list =
+				('a * 'a list)
+		[@@deriving show]
+
+		type cmd = {
+			prog: Template.t;
+			args: Template.t list;
+		}
+		[@@deriving show, make]
+
+		type t = cmd non_empty_list
+		[@@deriving show]
+
+		let (~$) x = (x, [])
+		let (|:) (x, xs) x' = (x, x' :: xs)
+		let (@) (x, xs) (y, ys) = (x, xs @ y :: ys)
+	end
+
+	type t = {
+		cmd: Cmd.t option;
+		value: string option;
+	}
+	[@@deriving show, make]
+end
+
+(* KINDS **********************************************************************)
+
+module File = struct
+	type t = {
+		url: Template.t;
+		mirrors: Template.t list;
+	}
+	[@@deriving show, make]
+end
+
+module Archive = struct
+	type t = {
+		url: Template.t;
+		mirrors: Template.t list;
+	}
+	[@@deriving show, make]
+end
+
+module Git = struct
+	module Reference = struct
+		type t = [
+			| `Branch of string
+			| `Ref of string
+		]
+		[@@deriving show]
+	end
+
+	type t = {
+		repository: Template.t;
+		mirrors: Template.t list;
+		reference: Reference.t;
+		datetime: string option; (* ISO 8601 RFC 3339 *)
+		submodules: bool; [@default false]
+		lfs: bool; [@default false]
+		latest_revision: string option;
+	}
+	[@@deriving show, make]
+
+	let default_latest_cmd git : Latest.Cmd.t =
+		let open Latest.Cmd in
+		let git_ls_remote flag value : t =
+			let m = Latest.Cmd.make_cmd in
+			let t = Template.make in
+			~$(m ~prog: (t "git") ~args: [t "ls-remote"; t flag; git.repository; t "--refs"; t value] ())
+			|: (m ~prog: (t "cut") ~args: [t "-f1"] ())
+		in
+		match git.reference with
+		| `Branch b -> git_ls_remote "--branches" b
+		| `Ref r -> git_ls_remote "--heads" r
+end
+
+module Darcs = struct
+	module Reference = struct
+		type t = [
+			| `Context of [`Assumed of string option | `Stated of string]
+			| `Tag of string
+		]
+		[@@deriving show]
+	end
+
+	type t = {
+		repository: Template.t;
+		mirrors: Template.t list;
+		reference: Reference.t;
+		datetime: string option; (* ISO 8601 RFC 3339 *)
+		latest_weak_hash: string option;
+	}
+	[@@deriving show, make]
+
+	let pp fmt t = Fmt.pf fmt "%s" (show t)
+end
+
+module Pijul = struct
+	module Reference = struct
+		type t = [
+			| `Channel of string
+			| `State of string
+			| `Change of string
+		]
+		[@@deriving show]
+	end
+
+	type t = {
+		remote: Template.t;
+		mirrors: Template.t list;
+		reference: Reference.t;
+		datetime: string option; (* ISO 8601 RFC 3339 *)
+		latest_state: string option;
+	}
+	[@@deriving show, make]
+end
+
+module Hash = struct
+	type algorithm =
+		| SHA256
+		| SHA512
+		| BLAKE3
+	[@@deriving enum, eq, ord, show]
+
+	let algorithm_to_string = function
+		| SHA256 -> "SHA256"
+		| SHA512 -> "SHA512"
+		| BLAKE3 -> "BLAKE3"
+
+	let algorithm_to_string_lower =
+		Fun.compose String.lowercase_ascii algorithm_to_string
+
+	let algorithm_of_string = function
+		| "SHA256" | "sha256" -> Some SHA256
+		| "SHA512" | "sha512" -> Some SHA512
+		| "BLAKE3" | "blake3" -> Some BLAKE3
+		| _ -> None
+
+	(* many of the builtin fetchers may only work with SHA256 *)
+	let default_algorithm = SHA256
+
+	type t = {
+		algorithm: algorithm;
+			[@default default_algorithm]
+		(* None is for not yet calculated *)
+		value: string option;
+		(* used to assert in fetching for manually-updated pins *)
+		expected: string option;
+	}
+	[@@deriving show, make]
+end
+
+(* INPUT *******************************************************************)
+
+module Kind = struct
+	type t = [
+		| `File of File.t
+		| `Archive of Archive.t
+		| `Git of Git.t
+		| `Darcs of Darcs.t
+		| `Pijul of Pijul.t
+	]
+	[@@deriving show]
+end
+
+let make_kind_file ~url ?mirrors () =
+	`File (File.make ~url ?mirrors ())
+
+let make_kind_archive ~url ?mirrors () =
+	`Archive (Archive.make ~url ?mirrors ())
+
+let make_kind_darcs ~repository ?mirrors ~reference ?latest_weak_hash () =
+	`Darcs (Darcs.make ~repository ?mirrors ~reference ?latest_weak_hash ())
+
+let make_kind_pijul ~remote ?mirrors ~reference ?latest_state () =
+	`Pijul (Pijul.make ~remote ?mirrors ~reference ?latest_state ())
+
+let make_kind_git ~repository ?mirrors ~reference ?latest_revision ?submodules ?lfs () =
+	`Git (Git.make ~repository ?mirrors ~reference ?latest_revision ?submodules ?lfs ())
+
+type t = {
+	name: Name.t;
+	kind: Kind.t;
+	(* This is use to override or provide a command to get the latest change or
+		revision or timestamp or whatever. *)
+	latest: Latest.t; [@default Latest.make ()]
+	hash: Hash.t; [@default Hash.make ()]
+	frozen: bool; [@default false]
+}
+[@@deriving show, make]
+
+let latest_cmd (input : t) : Latest.Cmd.t option =
+	match input.latest.cmd with
+	| None ->
+		(
+			match input.kind with
+			| `Git g -> Some (Git.default_latest_cmd g)
+			(* Would be nice if other tools did a better job letting you query the
+			remote repository directly, but that isn’t where we are *)
+			| _ -> None
+		)
+	| Some cmd -> Some cmd
+
+(* JINGOO MODELS **************************************************************)
+
+let jg_models2 (input : t) (needle : string) : Jingoo.Jg_types.tvalue =
+	let open Jingoo.Jg_types in
+	let opt_count = Option.fold ~none: 0 ~some: (Fun.const 1) in
+	(* presupplied with global values *)
+	let make_hashtbl (further_size : int) : (string, tvalue) Hashtbl.t =
+		let size = 1 + opt_count input.latest.value in
+		let htbl = Hashtbl.create (size + further_size) in
+		Hashtbl.add htbl "name" (Tstr (Name.take input.name));
+		Option.iter (fun v -> Hashtbl.add htbl "cmd_value" (Tstr v)) input.latest.value;
+		htbl
+	in
+	let hashtbl =
+		match input.kind with
+		| `File _ ->
+			make_hashtbl 0
+		| `Archive _ ->
+			make_hashtbl 0
+		| `Git g ->
+			begin
+				let htbl = make_hashtbl 5 in
+				(
+					match g.reference with
+					| `Branch b -> Hashtbl.add htbl "branch" (Tstr b)
+					| `Ref r -> Hashtbl.add htbl "ref" (Tstr r)
+				);
+				Option.iter (fun d -> Hashtbl.add htbl "datetime" (Tstr d)) g.datetime;
+				Hashtbl.add htbl "lfs" (Tbool g.lfs);
+				Hashtbl.add htbl "submodules" (Tbool g.submodules);
+				Option.iter
+					(fun r ->
+						List.iter (fun key -> Hashtbl.add htbl key (Tstr r)) ["rev"; "revision"]
+					)
+					g.latest_revision;
+				htbl
+			end
+		| `Darcs d ->
+			begin
+				let htbl = make_hashtbl 2 in
+				(
+					match d.reference with
+					| `Context (`Stated sc) ->
+						Hashtbl.add htbl "context" (Tstr sc)
+					| `Context (`Assumed ac) ->
+						Option.iter (fun c -> Hashtbl.add htbl "context" (Tstr c)) ac
+					| `Tag t ->
+						Hashtbl.add htbl "tag" (Tstr t)
+				);
+				Option.iter (fun d -> Hashtbl.add htbl "datetime" (Tstr d)) d.datetime;
+				Option.iter (fun w -> Hashtbl.add htbl "weak_hash" (Tstr w)) d.latest_weak_hash;
+				htbl
+			end
+		| `Pijul p ->
+			begin
+				let htbl = make_hashtbl 2 in
+				(
+					match p.reference with
+					| `Channel c -> Hashtbl.add htbl "channel" (Tstr c)
+					| `State s -> Hashtbl.add htbl "state" (Tstr s)
+					| `Change c -> Hashtbl.add htbl "change" (Tstr c)
+				);
+				Option.iter (fun d -> Hashtbl.add htbl "datetime" (Tstr d)) p.datetime;
+				Option.iter (fun s -> Hashtbl.add htbl "state" (Tstr s)) p.latest_state;
+				htbl
+			end
+	in
+	try Hashtbl.find hashtbl needle with Not_found -> Tnull
+
+(* NIXPKGS ********************************************************************)
+
+(* Nixpkgs is so critical & valuable to the Nix ecosystem that it gets its own
+	special treatment; it is also *required* to get access to many of the
+	fetchers *)
+module Nixpkgs = struct
+	let name = Name.make "nixpkgs"
+
+	let default_git_repository = Template.make "https://github.com/NixOS/nixpkgs.git"
+
+	(* NOTE: "refs/heads/nixpkgs-unstable" is probably good enough for your
+ 		project, but defaulting to nixos-unstable since it is ‘safer’, requiring
+ 		that all the NixOS tests pass *)
+	let default_ref = "refs/heads/nixos-unstable"
+
+	let default_hash = Hash.make ~algorithm: Hash.SHA256 ()
+
+	let known_git_mirrors : Template.t list =
+		List.map Template.make [
+			"https://mirrors.tuna.tsinghua.edu.cn/git/nixpkgs.git"
+		]
+
+	let mk_latest ~reference ?latest_value () : Latest.t =
+		let mk_latest_cmd ~flag ~arg : Latest.Cmd.t =
+			let open Latest.Cmd in
+			let m = Latest.Cmd.make_cmd in
+			let t = Template.make in
+			~$(m ~prog: (t "git") ~args: [t "ls-remote"; t flag; default_git_repository; t "--refs"; t arg] ())
+			|: (m ~prog: (t "cut") ~args: [t "-f1"] ())
+		in
+		{
+			cmd = begin
+				match reference with
+				| `Ref r -> Some (mk_latest_cmd ~flag: "--heads" ~arg: r);
+				| `Branch b -> Some (mk_latest_cmd ~flag: "--branches" ~arg: b);
+			end;
+			value = latest_value;
+		}
+
+	let make_archive ?(reference = `Ref default_ref) ?latest_value () =
+		let latest = mk_latest ~reference ?latest_value () in
+		let url =
+			Template.make "https://github.com/NixOS/nixpkgs/archive/{{cmd_value}}.tar.gz"
+		in
+		let kind = make_kind_archive ~url () in
+		make ~name ~kind ~latest ~hash: default_hash ()
+
+	(* The TUNA mirror is a Git mirror, so normalize on Git *)
+	let make_git_with_known_mirrors
+			?(extra_mirrors = [])
+			?(reference = `Ref default_ref)
+			?latest_revision
+			?submodules
+			?lfs
+			()
+		=
+		let kind =
+			make_kind_git
+				~repository: default_git_repository
+				~mirrors: (known_git_mirrors @ extra_mirrors)
+				~reference
+				?latest_revision
+				?submodules
+				?lfs
+				()
+		in
+		make ~name ~kind ~hash: default_hash ()
+end
diff --git a/lib/input_foreman.ml b/lib/input_foreman.ml
new file mode 100644
index 0000000..4808d6d
--- /dev/null
+++ b/lib/input_foreman.ml
@@ -0,0 +1,722 @@
+(*─────────────────────────────────────────────────────────────────────────────┐
+│ SPDX-FileCopyrightText: 2025 toastal <https://toast.al/contact/>             │
+│ SPDX-License-Identifier: LGPL-2.1-or-later WITH OCaml-LGPL-linking-exception │
+└─────────────────────────────────────────────────────────────────────────────*)
+open Name
+
+type error = Error.input_foreman_error
+
+module Htbl = Saturn.Htbl
+
+type t = (Name.t, Input.t) Htbl.t
+
+let inputs : t =
+	Htbl.create
+		~hashed_type: (module struct
+			type t = Name.t
+			let equal = Name.equal
+			let hash n = Hashtbl.hash (Name.take n)
+		end)
+		~min_buckets: 8
+		~max_buckets: 1024
+		()
+
+let pp fmt inputs' =
+	let name_map : Input.t NameMap.t =
+		Htbl.to_seq inputs'
+		|> Seq.fold_left
+				(fun acc (name, input) -> NameMap.add name input acc)
+				NameMap.empty
+	in
+	Fmt.pf fmt "%a" (NameMap.pp Input.pp) name_map
+
+(* Ugly, but *shrug* *)
+let pp_for_earthlings pff =
+	let hp_k_v ppf' (k, v) = Fmt.pf ppf' "\t%s: %s" k v in
+	let hp_betupled_input ppf' (name, kind, data) =
+		Fmt.pf ppf' "%s: (%s)@;" (Name.take name) kind;
+		Fmt.pf ppf' "%a" (Fmt.list ~sep: (Fmt.any "@.") hp_k_v) data;
+	and betuple (input : Input.t) : Name.t * string * (string * string) list =
+		let models = Input.jg_models2 input in
+		let fill = Input.Template.fill ~models in
+		let kind_name, kind_tuples =
+			match input.kind with
+			| `File f ->
+				"file",
+				("url", fill f.url) :: List.map (fun m -> "mirror", fill m) f.mirrors
+			| `Archive a ->
+				"archive",
+				("url", fill a.url) :: List.map (fun m -> "mirror", fill m) a.mirrors
+			| `Git g ->
+				"git",
+				List.concat [
+					["repository", fill g.repository];
+					(List.map (fun m -> "mirror", fill m) g.mirrors);
+					(
+						match g.reference with
+						| `Branch b -> ["branch", b]
+						| `Ref r -> ["ref", r]
+					);
+					Option.fold ~none: [] ~some: (fun d -> ["datetime", d]) g.datetime;
+					["submodules", Fmt.str "%a" Fmt.bool g.submodules;
+					"lfs", Fmt.str "%a" Fmt.bool g.lfs;
+					];
+					Option.fold ~none: [] ~some: (fun r -> ["latest-revision", r]) g.latest_revision;
+				]
+			| `Darcs d ->
+				"darcs",
+				List.concat [
+					["repository", fill d.repository];
+					(List.map (fun m -> ("mirror", fill m)) d.mirrors);
+					(
+						match d.reference with
+						| `Context (`Assumed None) -> []
+						| `Context (`Assumed (Some ac)) -> ["context (assumed)", ac]
+						| `Context (`Stated sc) -> ["context (stated)", sc]
+						| `Tag t -> [("tag", t)]
+					);
+					Option.fold ~none: [] ~some: (fun d -> ["datetime", d]) d.datetime;
+					Option.fold ~none: [] ~some: (fun w -> ["latest-weak-hash", w]) d.latest_weak_hash;
+				]
+			| `Pijul p ->
+				"pijul",
+				List.concat [
+					[("remote", fill p.remote)];
+					(List.map (fun m -> "mirror", fill m) p.mirrors);
+					(
+						match p.reference with
+						| `Channel c -> ["channel", c]
+						| `State s -> ["state", s]
+						| `Change c -> ["change", c]
+					);
+					Option.fold ~none: [] ~some: (fun d -> ["datetime", d]) p.datetime;
+					Option.fold ~none: [] ~some: (fun s -> ["latest-state", s]) p.latest_state;
+				]
+		in
+		let data_tuples : (string * string) list =
+			List.concat [
+				kind_tuples;
+				(
+					match input.latest.cmd with
+					| None -> []
+					| Some (cmd, cmds) ->
+						let cmd_str_filled ({prog; args}: Input.Latest.Cmd.cmd) =
+							List.map fill (prog :: args)
+						in
+						let cmds' =
+							List.map cmd_str_filled (cmd :: cmds)
+						and formatter =
+							Fmt.list ~sep: (Fmt.any " ") (Fmt.list ~sep: (Fmt.any " ") Fmt.string)
+						in
+							[("latest-cmd", Fmt.str "$ %a" formatter cmds')]
+				);
+				Option.fold ~none: [] ~some: (fun v -> ["latest-value", v]) input.latest.value;
+				["hash-algorithm", Input.Hash.algorithm_to_string input.hash.algorithm];
+				Option.fold ~none: [] ~some: (fun r -> ["hash-value", r]) input.hash.value;
+				Option.fold ~none: [] ~some: (fun r -> ["hash-expected", r]) input.hash.expected;
+				["frozen", Fmt.str "%a" Fmt.bool input.frozen];
+			]
+		in
+			(input.name, kind_name, data_tuples)
+	in
+	Htbl.to_seq inputs
+	|> Seq.fold_left (fun acc ((Name.Name name), input) -> (Name.Name name, betuple input) :: acc) []
+	|> List.stable_sort (fun (name_a, _) (name_b, _) -> Name.compare name_a name_b)
+	|> List.map (fun (_, s) -> s)
+	|> Fmt.pf pff "%a" (Fmt.list ~sep: (Fmt.any "@.@.") hp_betupled_input)
+
+let get name : (Input.t, error) result =
+	Logs.debug (fun m -> m "Get input %a" Name.pp name);
+	match Htbl.find_opt inputs name with
+	| Some s -> Ok s
+	| None -> Error (`Could_not_get name)
+
+let set name input : (unit, error) result =
+	Logs.debug (fun m -> m "Set input ⟨%a, %a⟩" Name.pp name Input.pp input);
+	if Htbl.try_set inputs name input then
+		Ok ()
+	else
+		Error (`Could_not_set name)
+
+let add name input : (unit, error) result =
+	Logs.debug (fun m -> m "Add input ⟨%a, %a⟩" Name.pp name Input.pp input);
+	if Htbl.try_add inputs name input then
+		Ok ()
+	else
+		Error (`Could_not_add name)
+
+let drop name : (unit, error) result =
+	Logs.debug (fun m -> m "Drop input %a" Name.pp name);
+	if Htbl.try_remove inputs name then
+		Ok ()
+	else
+		Error (`Could_not_drop name)
+
+let to_manifest mk =
+	Htbl.to_seq inputs
+	|> Seq.fold_left (fun acc (name, input) -> (name, mk input) :: acc) []
+	|> List.stable_sort (fun (name_a, _) (name_b, _) -> Name.compare name_a name_b)
+	|> List.concat_map (fun (_, manifest_node) -> manifest_node)
+
+let to_lockfile mk =
+	Htbl.to_seq inputs
+	|> Seq.fold_left
+			(fun acc (name, input) -> NameMap.add name (mk input) acc)
+			NameMap.empty
+
+let cp_darcs_context ~env ~(name : Name.t) ~context =
+	let (let*) = Result.bind in
+	let original_path =
+		if String.starts_with ~prefix: "/" context then
+			Eio.Path.(Eio.Stdenv.fs env / context)
+		else
+			Eio.Path.(Working_directory.get () / context)
+	in
+	let* () = Working_directory.set_up_darcs_context_if_needed () in
+	let path =
+		Eio.Path.(
+			Working_directory.(get () / darcs_context_dir / (Fmt.str "%s.txt" (Name.take name)))
+		)
+	in
+	Logs.app (fun m ->
+		m
+			"Copying Darcs context file for %a from %a to %a …"
+			Name.pp
+			name
+			Eio.Path.pp
+			original_path
+			Eio.Path.pp
+			path
+	);
+	let () =
+		Eio.Path.with_open_in original_path @@ fun input ->
+		Eio.Path.with_open_out ~create: (`Or_truncate 0o644) path @@ fun output ->
+		Eio.Flow.copy input output
+	in
+	Ok (Fmt.str "./%s/%s.txt" Working_directory.darcs_context_dir (Name.take name))
+
+exception Proc_error of string
+
+let prefetch ~env ~proc_mgr ~name () : (unit, error) result =
+	Logs.app (fun m -> m "Prefetching input %a … (this may take a while)" Name.pp name);
+	let open Input in
+	let (let*) = Result.bind in
+	let* input = get name in
+	let hash_algo_type_val = Input.Hash.algorithm_to_string_lower input.hash.algorithm in
+	let proc_env =
+		let unix_env = Unix.environment () in
+		Array.append unix_env [|"NIX_HASH_ALGO=" ^ hash_algo_type_val|]
+	in
+	let stdout_buf = Buffer.create 1024
+	and stderr_buf = Buffer.create 1024
+	in
+	let stdout_sink = Eio.Flow.buffer_sink stdout_buf
+	and stderr_sink = Eio.Flow.buffer_sink stderr_buf
+	and models = Input.jg_models2 input
+	in
+	let prefetch_file (f : File.t) : (Input.t, 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;
+			"--type";
+			hash_algo_type_val;
+		]
+		in
+		Logs.debug (fun m -> m "Running file cmd: %a" (Fmt.list ~sep: Fmt.sp Fmt.string) cmd);
+		try
+			let () =
+				Eio.Process.run
+					proc_mgr
+					~env: proc_env
+					~stdout: stdout_sink
+					~stderr: stderr_sink
+					cmd
+			in
+			let stderr_str = String.trim @@ Buffer.contents stderr_buf in
+			(* Fkin’ A… why use stderr for *not* errors, Nix‽ *)
+			if stderr_str <> "" && not (String.starts_with ~prefix: "path is" stderr_str) then
+				Error (`Stderr (method', stderr_str))
+			else
+				let stdin_str = String.trim @@ Buffer.contents stdout_buf in
+				Logs.debug (fun m -> m "Command output: %s" stdin_str);
+				let last_nonempty_line =
+					String.split_on_char '\n' stdin_str
+					|> 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}}
+		with
+			| exn -> Error (`Exception (method', Printexc.to_string exn))
+
+	and prefetch_archive (a : Archive.t) : (Input.t, 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;
+			"--unpack";
+			"--type";
+			hash_algo_type_val;
+		]
+		in
+		Logs.debug (fun m -> m "Running archive cmd: %a" (Fmt.list ~sep: Fmt.sp Fmt.string) cmd);
+		try
+			let () =
+				Eio.Process.run
+					proc_mgr
+					~env: proc_env
+					~stdout: stdout_sink
+					~stderr: stderr_sink
+					cmd
+			in
+			let stderr_str = String.trim @@ Buffer.contents stderr_buf in
+			(* Fkin’ A… why use stderr for *not* errors, Nix‽ *)
+			if stderr_str <> "" && not (String.starts_with ~prefix: "path is" stderr_str) then
+				Error (`Stderr (method', stderr_str))
+			else
+				let stdin_str = String.trim @@ Buffer.contents stdout_buf in
+				Logs.debug (fun m -> m "Command output: %s" stdin_str);
+				let last_nonempty_line =
+					String.split_on_char '\n' stdin_str
+					|> 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}}
+		with
+			| exn -> Error (`Exception (method', Printexc.to_string exn))
+
+	and prefetch_git (g : Git.t) : (Input.t, Error.prefetch_error) result =
+		let method' = `Git
+		and repository = Uri.of_string (Input.Template.fill g.repository ~models)
+		in
+		let cmd = [
+			"nix-prefetch-git";
+			"--no-deepClone";
+			"--quiet";
+			"--url";
+			Uri.to_string repository;
+		]
+		in
+		Logs.debug (fun m -> m "Running Git cmd: %a" (Fmt.list ~sep: Fmt.sp Fmt.string) cmd);
+		let cmd =
+			List.concat [
+				cmd;
+				(
+					match g.reference with
+					| `Branch b -> ["--branch-name"; b]
+					| `Ref r -> ["--rev"; r]
+				);
+				if g.submodules then ["--fetch-submodules"] else [];
+				if g.lfs then ["--fetch-lfs"] else [];
+			];
+		in
+		try
+			let () =
+				Eio.Process.run
+					proc_mgr
+					~env: proc_env
+					~stdout: stdout_sink
+					~stderr: stderr_sink
+					cmd
+			in
+			let stderr_str = String.trim @@ Buffer.contents stderr_buf in
+			if stderr_str <> "" then
+				Error (`Stderr (method', stderr_str))
+			else
+				let stdin_str = Buffer.contents stdout_buf in
+				Logs.debug (fun m -> m "Command output: %s" stdin_str);
+				let* data =
+					if stdin_str = "" then
+						Error (`Empty_output method')
+					else
+						Jsont_bytesrw.decode_string Prefetch.Git.jsont stdin_str
+						|> Result.map_error (fun err -> `JSON_parsing (method', err))
+				in
+				Ok {input with
+					kind =
+					`Git {g with
+						latest_revision = Some data.rev;
+						datetime = data.datetime;
+					};
+					hash = {input.hash with
+						algorithm = data.hash.algorithm;
+						value = Some data.hash.value;
+					};
+				}
+		with
+			| exn -> Error (`Exception (method', Printexc.to_string exn))
+
+	and prefetch_darcs (d : Darcs.t) : (Input.t, Error.prefetch_error) result =
+		let method' = `Darcs
+		and repository = Input.Template.fill d.repository ~models
+		in
+		let cmd = ["nix-prefetch-darcs"] in
+		(* formatter looks ugly so doing cmd = cmd @ […] *)
+		let cmd =
+			match d.reference with
+			| `Context (`Assumed _) -> cmd
+			| `Context (`Stated sc) -> cmd @ ["--context"; sc]
+			| `Tag t -> cmd @ ["--tag"; t]
+		in
+		let cmd = cmd @ [repository] in
+		Logs.debug (fun m -> m "Running Darcs cmd: %a" (Fmt.list ~sep: Fmt.sp Fmt.string) cmd);
+		try
+			let () =
+				Eio.Process.run
+					proc_mgr
+					~env: proc_env
+					~stdout: stdout_sink
+					~stderr: stderr_sink
+					cmd
+			in
+			let stderr_str = String.trim @@ Buffer.contents stderr_buf in
+			if stderr_str <> "" then
+				Error (`Stderr (method', stderr_str))
+			else
+				let stdin_str = Buffer.contents stdout_buf in
+				Logs.debug (fun m -> m "Command output: %s" stdin_str);
+				let* data =
+					if stdin_str = "" then
+						Error (`Empty_output method')
+					else
+						Jsont_bytesrw.decode_string Prefetch.Darcs.jsont stdin_str
+						|> Result.map_error (fun err -> `JSON_parsing (method', err))
+				in
+				let* reference =
+					match d.reference with
+					| `Context (`Assumed _) ->
+						(* TODO: copy file *)
+						let* new_ctx =
+							cp_darcs_context ~env ~name ~context: data.context
+							|> Result.map_error (fun err -> `Darcs_context err)
+						in
+						Ok (`Context (`Assumed (Some new_ctx)))
+					| _ ->
+						Ok d.reference
+				in
+				Ok {input with
+					kind =
+					`Darcs {d with
+						reference;
+						datetime = data.datetime;
+						latest_weak_hash = Some data.weak_hash;
+					};
+					hash = {input.hash with
+						algorithm = data.hash.algorithm;
+						value = Some data.hash.value;
+					};
+				}
+		with
+			| exn -> Error (`Exception (method', Printexc.to_string exn))
+
+	and prefetch_pijul (p : Pijul.t) : (Input.t, Error.prefetch_error) result =
+		let method' = `Pijul
+		and cmd = [
+			"nix-prefetch-pijul";
+			"--remote";
+			Input.Template.fill p.remote ~models;
+		]
+		in
+		let cmd =
+			cmd @
+				match p.reference with
+				| `Change c -> ["--change"; c]
+				| `Channel c -> ["--channel"; c]
+				| `State s -> ["--state"; s]
+		in
+		Logs.debug (fun m -> m "Running Pijul cmd: %a" (Fmt.list ~sep: Fmt.sp Fmt.string) cmd);
+		try
+			let () =
+				Eio.Process.run
+					proc_mgr
+					~env: proc_env
+					~stdout: stdout_sink
+					~stderr: stderr_sink
+					cmd
+			in
+			let stderr_str = String.trim @@ Buffer.contents stderr_buf in
+			if stderr_str <> "" then
+				Error (`Stderr (method', stderr_str))
+			else
+				let stdin_str = Buffer.contents stdout_buf in
+				Logs.debug (fun m -> m "Command output: %s" stdin_str);
+				let* data =
+					if stdin_str = "" then
+						Error (`Empty_output method')
+					else
+						Jsont_bytesrw.decode_string Prefetch.Pijul.jsont stdin_str
+						|> Result.map_error (fun err -> `JSON_parsing (method', err))
+				in
+				Ok {input with
+					kind =
+					`Pijul {p with
+						datetime = data.datetime;
+						latest_state = Some data.state;
+					};
+					hash = {input.hash with
+						algorithm = data.hash.algorithm;
+						value = Some data.hash.value;
+					};
+				}
+		with
+			| exn -> Error (`Exception (method', Printexc.to_string exn))
+	in
+	let* new_input : Input.t =
+		Result.map_error (fun err -> `Prefetch (input.name, err)) @@ begin
+			match input.kind with
+			| `File f -> prefetch_file f
+			| `Archive a -> prefetch_archive a
+			| `Git g -> prefetch_git g
+			| `Darcs d -> prefetch_darcs d
+			| `Pijul p -> prefetch_pijul p
+		end
+	in
+	Logs.app (fun m -> m "Prefetched %a." Name.pp input.name);
+	set name new_input
+
+let run_pipeline ~sw ~proc_mgr ~(models : Input.jg_models2) cmds =
+	let open Input.Latest.Cmd in
+	let rec build_pipeline ?stdin = function
+		| {prog; args}, [] ->
+			begin
+				let stdout_buf = Buffer.create 512
+				and stderr_buf = Buffer.create 512
+				in
+				let stdout_sink = Eio.Flow.buffer_sink stdout_buf
+				and stderr_sink = Eio.Flow.buffer_sink stderr_buf
+				and cmd = List.map (Input.Template.fill ~models) (prog :: args)
+				in
+				try
+					Eio.Process.run proc_mgr ?stdin ~stdout: stdout_sink ~stderr: stderr_sink cmd;
+					Option.iter Eio.Resource.close stdin;
+					(* close pipe input after last process *)
+