diff --git a/src/lib_embedded_protocol_alpha/src/storage_functors.ml b/src/lib_embedded_protocol_alpha/src/storage_functors.ml index 7f1842c03..cc7a7ee6c 100644 --- a/src/lib_embedded_protocol_alpha/src/storage_functors.ml +++ b/src/lib_embedded_protocol_alpha/src/storage_functors.ml @@ -35,10 +35,6 @@ let map_key f = function | `Key k -> `Key (f k) | `Dir k -> `Dir (f k) -let map_option f = function - | None -> None - | Some x -> Some (f x) - module Make_subcontext (C : Raw_context.T) (N : NAME) : Raw_context.T with type t = C.t = struct type t = C.t @@ -94,7 +90,7 @@ module Make_single_data_storage (C : Raw_context.T) (N : NAME) (V : VALUE) C.init_set t N.name (V.to_bytes v) >>= fun t -> Lwt.return (C.project t) let set_option t v = - C.set_option t N.name (map_option V.to_bytes v) >>= fun t -> + C.set_option t N.name (Option.map ~f:V.to_bytes v) >>= fun t -> Lwt.return (C.project t) let remove t = C.remove t N.name >>= fun t -> @@ -203,7 +199,7 @@ module Make_indexed_data_storage C.init_set s (I.to_path i []) (V.to_bytes v) >>= fun t -> Lwt.return (C.project t) let set_option s i v = - C.set_option s (I.to_path i []) (map_option V.to_bytes v) >>= fun t -> + C.set_option s (I.to_path i []) (Option.map ~f:V.to_bytes v) >>= fun t -> Lwt.return (C.project t) let remove s i = C.remove s (I.to_path i []) >>= fun t -> @@ -411,7 +407,7 @@ module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) Lwt.return (C.project s) let set_option s i v = Raw_context.set_option (s,i) - N.name (map_option V.to_bytes v) >>= fun (s, _) -> + N.name (Option.map ~f:V.to_bytes v) >>= fun (s, _) -> Lwt.return (C.project s) let remove s i = Raw_context.remove (s,i) N.name >>= fun (s, _) -> diff --git a/src/lib_node_updater/tezos_protocol_environment.ml b/src/lib_node_updater/tezos_protocol_environment.ml index 854cbef72..08b83304f 100644 --- a/src/lib_node_updater/tezos_protocol_environment.ml +++ b/src/lib_node_updater/tezos_protocol_environment.ml @@ -109,4 +109,6 @@ module Make(Param : sig val name: string end)() = struct | Ok _ as ok -> ok | Error errors -> Error [Ecoproto_error errors] + module Option = Option + end diff --git a/src/lib_protocol_environment_sigs/jbuild b/src/lib_protocol_environment_sigs/jbuild index adf1c6960..710815932 100644 --- a/src/lib_protocol_environment_sigs/jbuild +++ b/src/lib_protocol_environment_sigs/jbuild @@ -30,6 +30,7 @@ v1/error_monad.mli v1/logging.mli v1/time.mli + v1/option.mli v1/RPC_arg.mli v1/RPC_path.mli diff --git a/src/lib_protocol_environment_sigs/v1/option.mli b/src/lib_protocol_environment_sigs/v1/option.mli new file mode 100644 index 000000000..b4cce5734 --- /dev/null +++ b/src/lib_protocol_environment_sigs/v1/option.mli @@ -0,0 +1,24 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2017. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +val map: f:('a -> 'b) -> 'a option -> 'b option + +val apply: f:('a -> 'b option) -> 'a option -> 'b option + +val iter: f:('a -> unit) -> 'a option -> unit + +val unopt: default:'a -> 'a option -> 'a + +val unopt_map: f:('a -> 'b) -> default:'b -> 'a option -> 'b + +val first_some: 'a option -> 'a option -> 'a option + +val try_with : (unit -> 'a) -> 'a option + +val some : 'a -> 'a option diff --git a/src/lib_stdlib/option.ml b/src/lib_stdlib/option.ml index 3e0b5e76c..eb546f2fc 100644 --- a/src/lib_stdlib/option.ml +++ b/src/lib_stdlib/option.ml @@ -34,3 +34,5 @@ let first_some a b = match a, b with let try_with f = try Some (f ()) with _ -> None + +let some x = Some x diff --git a/src/lib_stdlib/option.mli b/src/lib_stdlib/option.mli index c14400fb9..720c34f5f 100644 --- a/src/lib_stdlib/option.mli +++ b/src/lib_stdlib/option.mli @@ -27,3 +27,6 @@ val first_some: 'a option -> 'a option -> 'a option (** [Some (f ())] if [f] does not raise, [None] otherwise *) val try_with : (unit -> 'a) -> 'a option + +(** Make an option of a value *) +val some : 'a -> 'a option