list-stale command

4 files changed, 77 insertions, 0 deletions

diff --git a/bin/cmd.ml b/bin/cmd.ml
index 6a2966d..a411f43 100644
--- a/bin/cmd.ml
+++ b/bin/cmd.ml
@@ -301,6 +301,28 @@ module Lock = struct
 	let cmd ~env = Cmdliner.Cmd.v info (term ~env)
 end
 
+module List_stale = struct
+	let info =
+		Cmdliner.Cmd.info
+			"list-stale"
+			~doc: "List stale inputs with latest-cmd, without refreshing"
+			~man: common_man
+
+	let run ~env ~domain_count : unit =
+		match Nixtamal.list_stale ~env ~domain_count with
+		| Ok() -> ()
+		| Error err -> failwith (Fmt.str "%a" Nixtamal.Error.pp_error err)
+
+	let term ~env =
+		let open Cmdliner in
+		Term.(
+			const (fun glb -> Global.run ~env glb @@ run)
+			$ Global.args
+		)
+
+	let cmd ~env = Cmdliner.Cmd.v info (term ~env)
+end
+
 module Refresh = struct
 	let info =
 		Cmdliner.Cmd.info
diff --git a/bin/main.ml b/bin/main.ml
index 618b9db..bdb25e7 100644
--- a/bin/main.ml
+++ b/bin/main.ml
@@ -25,6 +25,7 @@ let cmd ~env =
 		Cmd.Tweak.cmd ~env;
 		Cmd.Show.cmd ~env;
 		Cmd.Lock.cmd ~env;
+		Cmd.List_stale.cmd ~env;
 		Cmd.Refresh.cmd ~env;
 	]
 	in
diff --git a/lib/input_foreman.ml b/lib/input_foreman.ml
index 8f0cffe..4873e80 100644
--- a/lib/input_foreman.ml
+++ b/lib/input_foreman.ml
@@ -593,6 +593,51 @@ let lock ~env ~sw ~proc_mgr ~domain_count ?(force = false) ?names () : (unit, er
 	| Some names ->
 		lock_many ~env ~sw ~proc_mgr ~domain_count ~force ~names
 
+let list_stale ~env ~sw ~proc_mgr ~domain_count ~names : (unit, error) result =
+	Logs.info (fun m -> m "Listing stale …");
+	let (let*) = Result.bind in
+	let dm = Eio.Stdenv.domain_mgr env in
+	let pool = Eio.Executor_pool.create ~sw ~domain_count dm in
+	let any_succeed, stale, errors =
+		names
+		|> List.map
+				(fun name ->
+					Eio.Executor_pool.submit ~weight: 1.0 pool (fun () ->
+						let* input = get name in
+						match get_latest ~sw ~proc_mgr input with
+						| Error err -> Error err
+						| Ok None -> Ok None
+						| Ok (Some new_value) -> Ok (Some (name, new_value))
+					)
+				)
+		|> List.fold_left
+				(fun (suc, sacc, errs) ->
+					function
+						| Ok (Ok None) -> true, sacc, errs
+						| Ok (Ok (Some stale)) -> true, stale :: sacc, errs
+						| Ok (Error err) -> suc, sacc, err :: errs
+						| Error exn -> suc, sacc, (`Pool_exception exn) :: errs
+				)
+				(false, [], [])
+	in
+	match any_succeed, errors with
+	| true, errs ->
+		begin
+			let warn err =
+				Logs.warn (fun m -> m "Couldn’t refresh: %a" Error.pp_input_foreman_error err)
+			and prnt (name, latest_value) =
+				Logs.app (fun m -> m "%a: %s" Fmt.(styled `Green string) (Name.take name) latest_value)
+			in
+			List.iter warn errs;
+			List.iter prnt stale;
+			Ok ()
+		end
+	| 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_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
diff --git a/lib/nixtamal.ml b/lib/nixtamal.ml
index f8b9203..8cd371b 100644
--- a/lib/nixtamal.ml
+++ b/lib/nixtamal.ml
@@ -174,6 +174,15 @@ let lock ~env ~domain_count ?(force = false) ?names () : (unit, error) result =
 	Lock_loader.write ();
 	Ok ()
 
+let list_stale ~env ~domain_count : (unit, error) result =
+	Eio.Switch.run @@ fun sw ->
+	let (let*) = Result.bind in
+	let proc_mgr = Eio.Stdenv.process_mgr env in
+	let* all_names = read_manifest_and_lockfile () in
+	Error.tag_input_foreman @@ begin
+		Input_foreman.list_stale ~env ~sw ~proc_mgr ~domain_count ~names: all_names
+	end
+
 let refresh ~env ~domain_count ?names () : (unit, error) result =
 	Eio.Switch.run @@ fun sw ->
 	let (let*) = Result.bind in