(*─────────────────────────────────────────────────────────────────────────────┐
│ 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 *)
					Ok (stdout_buf, stderr_buf)
				with
					| exn -> Error (Printexc.to_string exn)
			end
		| {prog; args}, next :: rest ->
			begin
				let pipe_in, pipe_out = Eio.Process.pipe ~sw proc_mgr in
				let stderr_buf = Buffer.create 512 in
				let 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: pipe_out ~stderr: stderr_sink cmd;
					Eio.Resource.close pipe_out;
					(* close writer after child is spawned *)
					build_pipeline ~stdin: pipe_in (next, rest)
				with
					| exn -> Error (Printexc.to_string exn)
			end
	in
	build_pipeline cmds

let get_latest ~sw ~proc_mgr input : (string option, error) result =
	match Input.latest_cmd input with
	| None ->
		Ok None
	| Some cmds ->
		let name = input.name
		and models = Input.jg_models2 input
		in
		match run_pipeline ~sw ~proc_mgr ~models cmds with
		| Error err -> Error (`Latest_cmd_fail (name, err))
		| Ok (stdout_buf, stderr_buf) ->
			let stderr_str = String.trim @@ Buffer.contents stderr_buf in
			(* & shame on you for putting non-errors in the stderr *)
			if stderr_str <> "" then
				Error (`Latest_cmd_stderr (name, stderr_str))
			else
				let latest_str = String.trim @@ Buffer.contents stdout_buf in
				if latest_str = "" then
					Error (`Latest_cmd_empty name)
				else
					Ok (Some latest_str)

type latest_result = [
	| `LacksCmd
	| `AlreadyLatest
	| `NewLatestValue of string
]
[@@deriving show]

let lock_one ~env ~sw ~proc_mgr ~force ~name : (unit, error) result =
	Logs.info (fun m ->
		if force then m "Locking input %a …" Name.pp name
		else m "Locking input %a if needed …" Name.pp name
	);
	let (let*) = Result.bind in
	let* input = get name in
	let* () =
		match input.latest.cmd, input.latest.value, force with
		(* Only if we have a command, but no value or forced *)
		| Some _, None, _ | Some _, _, true ->
			Logs.app (fun m -> m "Fetching latest value for %a …" Name.pp name);
			begin
				match get_latest ~sw ~proc_mgr input with
				| Error err -> Error err
				| Ok None -> Ok ()
				| Ok (Some new_value) ->
					Logs.info (fun m -> m "New latest value: %a" Fmt.string new_value);
					let latest = {input.latest with value = Some new_value} in
					set name {input with latest}
			end
		| _, _, _ -> Ok ()
	in
	let needs_prefetch : bool =
		force
		|| if Option.is_none input.hash.value then
			true
		else
			match input.kind with
			| `File _ -> false
			| `Archive _ -> false
			| `Git g -> Option.is_none g.latest_revision
			| `Darcs d -> Option.is_none d.latest_weak_hash
			| `Pijul p -> Option.is_none p.latest_state
	in
	if needs_prefetch then
		prefetch ~env ~proc_mgr ~name ()
	else
		Ok ()

let lock_many ~env ~sw ~proc_mgr ~domain_count ~force ~(names : Name.t list) : (unit, error) result =
	Logs.debug (fun m -> m "Locking many: %a" Fmt.(brackets (list ~sep: semi Name.pp)) names);
	let dm = Eio.Stdenv.domain_mgr env in
	let pool = Eio.Executor_pool.create ~sw ~domain_count dm in
	let any_succeed, errors =
		names
		|> List.map
				(fun name ->
					Eio.Executor_pool.submit ~weight: 1.0 pool (fun () ->
						lock_one ~env ~sw ~proc_mgr ~force ~name
					)
				)
		|> List.fold_left
				(fun (suc, errs) ->
					function
						| Ok (Ok()) ->
							true, errs
						| Ok (Error err) ->
							suc, err :: errs
						| Error exn ->
							suc, (`Pool_exception (Printexc.to_string exn)) :: errs
				)
				(false, [])
	in
	match any_succeed, errors with
	| true, errs ->
		let warn err =
			Logs.warn (fun m -> m "Couldn’t lock: %a" Error.pp_input_foreman_error err)
		in
		List.iter warn errs;
		Ok ()
	| false, [err] ->
		Error err
	| false, errs ->
		let err_str = List.map (fun err -> Fmt.str "%a" Error.pp_input_foreman_error err) errs in
		Error (`Many_errors err_str)

let lock ~env ~sw ~proc_mgr ~domain_count ?(force = false) ?names () : (unit, error) result =
	match names with
	| None | Some [] ->
		let all_names =
			Htbl.to_seq inputs
			|> Seq.fold_left (fun acc (name, _) -> name :: acc) []
		in
		lock_many ~env ~sw ~proc_mgr ~domain_count ~force ~names: all_names
	| Some [name] ->
		lock_one ~env ~sw ~proc_mgr ~force ~name
	| Some names ->
		lock_many ~env ~sw ~proc_mgr ~domain_count ~force ~names

let refresh_one ~env ~sw ~proc_mgr ~name : (unit, error) result =
	Logs.app (fun m -> m "Refreshing input %a …" Name.pp name);
	let (let*) = Result.bind in
	let* input = get name in
	let* latest_result : latest_result =
		match get_latest ~sw ~proc_mgr input with
		| Error err -> Error err
		| Ok None -> Ok `LacksCmd
		| Ok (Some(new_value : string)) ->
			Logs.info (fun m -> m "Old latest value: %a" (Fmt.option ~none: (Fmt.const Fmt.string "∅") Fmt.string) input.latest.value);
			Logs.info (fun m -> m "New latest value: %a" Fmt.string new_value);
			let is_outdated : string option -> bool =
				Option.fold ~none: true ~some: (Fun.compose not (String.equal new_value))
			in
			if is_outdated input.latest.value then
				Ok (`NewLatestValue new_value)
			else
				Ok `AlreadyLatest
	in
	match latest_result with
	| `LacksCmd ->
		Logs.warn (fun m -> m "No “latest-cmd” set for %a or a default for its kind … fetching from scratch (probably wastefully)." Name.pp input.name);
		prefetch ~env ~proc_mgr ~name ()
	| `AlreadyLatest ->
		Logs.app (fun m -> m "%a already at latest; moving on." Name.pp input.name);
		Ok ()
	| `NewLatestValue new_value ->
		let latest = {input.latest with value = Some new_value} in
		let* () = set name {input with latest} in
		(* If we had a new version, then it is time to prefetch *)
		prefetch ~env ~proc_mgr ~name ()

let refresh_many ~env ~sw ~proc_mgr ~domain_count ~(names : Name.t list) : (unit, error) result =
	Logs.debug (fun m -> m "Refreshing many: %a" Fmt.(brackets (list ~sep: semi Name.pp)) names);
	let dm = Eio.Stdenv.domain_mgr env in
	let pool = Eio.Executor_pool.create ~sw ~domain_count dm in
	let any_succeed, errors =
		names
		|> List.map
				(fun name ->
					Eio.Executor_pool.submit ~weight: 1.0 pool (fun () ->
						refresh_one ~env ~sw ~proc_mgr ~name
					)
				)
		|> List.fold_left
				(fun (suc, errs) ->
					function
						| Ok (Ok()) ->
							true, errs
						| Ok (Error err) ->
							suc, err :: errs
						| Error exn ->
							suc, (`Pool_exception (Printexc.to_string exn)) :: errs
				)
				(false, [])
	in
	match any_succeed, errors with
	| true, errs ->
		let warn err =
			Logs.warn (fun m -> m "Couldn’t refresh: %a" Error.pp_input_foreman_error err)
		in
		List.iter warn errs;
		Ok ()
	| false, [err] ->
		Error err
	| false, errs ->
		let err_str = List.map (fun err -> Fmt.str "%a" Error.pp_input_foreman_error err) errs in
		Error (`Many_errors err_str)

let refresh ~env ~sw ~proc_mgr ~domain_count ?names () : (unit, error) result =
	match names with
	| None | Some [] ->
		let all_names =
			Htbl.to_seq inputs
			|> Seq.fold_left (fun acc (name, _) -> name :: acc) []
		in
		refresh_many ~env ~sw ~proc_mgr ~domain_count ~names: all_names
	| Some [name] ->
		refresh_one ~env ~sw ~proc_mgr ~name
	| Some names ->
		refresh_many ~env ~sw ~proc_mgr ~domain_count ~names