From 8c07df1de4f9783f3b8bc8e1ce7419c67bb9fa92 Mon Sep 17 00:00:00 2001 From: swrup Date: Mon, 3 Nov 2025 08:46:29 +0100 Subject: [PATCH] JJ: Description from the destination commit: change to let*? JJ: Description from source commit: . --- unikernel/unikernel.ml | 65 +++++++++++++++++++++++------------------- 1 file changed, 36 insertions(+), 29 deletions(-) diff --git a/unikernel/unikernel.ml b/unikernel/unikernel.ml index a9624814..5a00b37b 100644 --- a/unikernel/unikernel.ml +++ b/unikernel/unikernel.ml @@ -44,28 +44,17 @@ struct module Assets = struct module Assets_ro = Keys_ro - let ( let*$ ) = Lwt_result.bind + let ( let*? ) = Lwt_result.bind + let ( let+? ) x f = Lwt_result.map f x let map_err_to_string = map_err_to_string Assets_ro.pp_error - let get_dir l name = - l - |> List.find_opt (fun (k, t) -> - Mirage_kv.Key.(equal (v name) k) && t = `Dictionary) - |> Option.map fst - |> Option.to_result ~none:(`Msg (Fmt.str "missing `%s` directory" name)) - |> Lwt_result.lift - let get_subdirs ro k = - let*$ keys = Assets_ro.list ro k |> map_err_to_string in - List.filter (fun (_, t) -> t = `Dictionary) keys - |> List.map fst - |> Lwt_result.return + let+? keys = Assets_ro.list ro k |> map_err_to_string in + List.filter (fun (_, t) -> t = `Dictionary) keys |> List.map fst let get_values ro k = - let*$ keys = Assets_ro.list ro k |> map_err_to_string in - List.filter (fun (_, t) -> t = `Value) keys - |> List.map fst - |> Lwt_result.return + let+? keys = Assets_ro.list ro k |> map_err_to_string in + List.filter (fun (_, t) -> t = `Value) keys |> List.map fst let find keys name = keys @@ -73,19 +62,37 @@ struct |> Option.to_result ~none:(`Msg (Fmt.str "missing `%s` directory" name)) |> Lwt_result.lift + let lwt_list_get_ok l = + let open Lwt.Syntax in + let+ l = l in + let err = ref None in + try + l + |> List.map (function + | Error _e as e -> + err := Some e; + raise Exit + | Ok v -> v) + |> Result.ok + with Exit -> ( match !err with None -> assert false | Some v -> v) + + let get ro s = + let*? base_dir = get_subdirs ro Mirage_kv.Key.empty in + let*? dir = find base_dir s in + let*? subdirs = get_subdirs ro dir in + let+? l = + subdirs + |> Lwt_list.map_s (fun lang_dir -> + let+? files = get_values ro lang_dir in + (lang_dir, files)) + |> lwt_list_get_ok + in + l + let assets ro = - let*$ base_dir = get_subdirs ro Mirage_kv.Key.empty in - let*$ terms_dir = find base_dir "terms" in - let*$ privacy_dir = find base_dir "privacy" in - let*$ terms_subdirs = get_subdirs ro terms_dir in - let*$ privacy_subdirs = get_subdirs ro privacy_dir in - let*$ _terms_files = - terms_subdirs |> Lwt_list.map_s (get_values ro) |> Lwt_result.ok - in - let*$ _privacy_files = - privacy_subdirs |> Lwt_list.map_s (get_values ro) |> Lwt_result.ok - in - Lwt_result.return () + let*? terms_assoc = get ro "terms" in + let+? privacy_assoc = get ro "privacy" in + (terms_assoc, privacy_assoc) end let tls certificate_ro key_ro =