diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 3657c9b413ffef7029358fbb2055110199f2b191..391713c9c5600165d04c0f1b203cacb60a631942 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -888,6 +888,11 @@ opam:tezos-lmdb: variables: package: tezos-lmdb +opam:tezos-lwt-result-stdlib: + <<: *opam_definition + variables: + package: tezos-lwt-result-stdlib + opam:tezos-mempool-006-PsCARTHA: <<: *opam_definition variables: diff --git a/src/lib_lwt_result_stdlib/.ocamlformat b/src/lib_lwt_result_stdlib/.ocamlformat new file mode 100644 index 0000000000000000000000000000000000000000..8278a132e3d6f6c868be4c6e0a012089319d0bbc --- /dev/null +++ b/src/lib_lwt_result_stdlib/.ocamlformat @@ -0,0 +1,12 @@ +version=0.10 +wrap-fun-args=false +let-binding-spacing=compact +field-space=loose +break-separators=after-and-docked +sequence-style=separator +doc-comments=before +margin=80 +module-item-spacing=sparse +parens-tuple=always +parens-tuple-patterns=always +break-string-literals=newlines-and-wrap diff --git a/src/lib_lwt_result_stdlib/dune b/src/lib_lwt_result_stdlib/dune new file mode 100644 index 0000000000000000000000000000000000000000..bf5ef425ad8342c93ddc115febb0dcf59a48b577 --- /dev/null +++ b/src/lib_lwt_result_stdlib/dune @@ -0,0 +1,14 @@ +(library + (name tezos_lwt_result_stdlib) + (public_name tezos-lwt-result-stdlib) + (flags (:standard -open Tezos_error_monad)) + (libraries tezos-error-monad + lwt + tezos-lwt-result-stdlib.sigs + tezos-lwt-result-stdlib.functors + tezos-lwt-result-stdlib.lib)) + +(alias + (name runtest_lint) + (deps (glob_files *.ml{,i})) + (action (run %{lib:tezos-tooling:lint.sh} %{deps}))) diff --git a/src/lib_lwt_result_stdlib/dune-project b/src/lib_lwt_result_stdlib/dune-project new file mode 100644 index 0000000000000000000000000000000000000000..f139b54d60939c562f4af88783f2af1fbba04c64 --- /dev/null +++ b/src/lib_lwt_result_stdlib/dune-project @@ -0,0 +1,2 @@ +(lang dune 1.11) +(name tezos-lwt-result-stdlib) diff --git a/src/lib_lwt_result_stdlib/functors/.ocamlformat b/src/lib_lwt_result_stdlib/functors/.ocamlformat new file mode 100644 index 0000000000000000000000000000000000000000..8278a132e3d6f6c868be4c6e0a012089319d0bbc --- /dev/null +++ b/src/lib_lwt_result_stdlib/functors/.ocamlformat @@ -0,0 +1,12 @@ +version=0.10 +wrap-fun-args=false +let-binding-spacing=compact +field-space=loose +break-separators=after-and-docked +sequence-style=separator +doc-comments=before +margin=80 +module-item-spacing=sparse +parens-tuple=always +parens-tuple-patterns=always +break-string-literals=newlines-and-wrap diff --git a/src/lib_lwt_result_stdlib/functors/dune b/src/lib_lwt_result_stdlib/functors/dune new file mode 100644 index 0000000000000000000000000000000000000000..43330b85f435b34197da9a389ac8433e751ef7b2 --- /dev/null +++ b/src/lib_lwt_result_stdlib/functors/dune @@ -0,0 +1,10 @@ +(library + (name functors) + (public_name tezos-lwt-result-stdlib.functors) + (flags (:standard)) + (libraries lwt tezos-lwt-result-stdlib.sigs)) + +(alias + (name runtest_lint) + (deps (glob_files *.ml{,i})) + (action (run %{lib:tezos-tooling:lint.sh} %{deps}))) diff --git a/src/lib_lwt_result_stdlib/functors/map.ml b/src/lib_lwt_result_stdlib/functors/map.ml new file mode 100644 index 0000000000000000000000000000000000000000..d5e43e1d51c5976014aa5f3ab0563106f0f035e6 --- /dev/null +++ b/src/lib_lwt_result_stdlib/functors/map.ml @@ -0,0 +1,64 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module Make (Seq : Sigs.Seq.S) = struct + module type S = Sigs.Map.S with type error := Seq.Monad.out_error + + module Make (Ord : Stdlib.Map.OrderedType) : S with type key = Ord.t = struct + open Seq + include Stdlib.Map.Make (Ord) + + let iter_e f t = iter_e (fun (k, v) -> f k v) (to_seq t) + + let iter_s f t = iter_s (fun (k, v) -> f k v) (to_seq t) + + let iter_es f t = iter_es (fun (k, v) -> f k v) (to_seq t) + + let iter_p f t = iter_p (fun (k, v) -> f k v) (to_seq t) + + let iter_ep f t = iter_ep (fun (k, v) -> f k v) (to_seq t) + + let fold_e f t init = + fold_left_e (fun acc (k, v) -> f k v acc) init (to_seq t) + + let fold_s f t init = + fold_left_s (fun acc (k, v) -> f k v acc) init (to_seq t) + + let fold_es f t init = + fold_left_es (fun acc (k, v) -> f k v acc) init (to_seq t) + + let min_binding = min_binding_opt + + let max_binding = max_binding_opt + + let choose = choose_opt + + let find = find_opt + + let find_first = find_first_opt + + let find_last = find_last_opt + end +end diff --git a/src/lib_lwt_result_stdlib/functors/map.mli b/src/lib_lwt_result_stdlib/functors/map.mli new file mode 100644 index 0000000000000000000000000000000000000000..423803dae6f124cc06290fd95e173bc269bfbdd0 --- /dev/null +++ b/src/lib_lwt_result_stdlib/functors/map.mli @@ -0,0 +1,30 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module Make (Seq : Sigs.Seq.S) : sig + module type S = Sigs.Map.S with type error := Seq.Monad.out_error + + module Make (Ord : Stdlib.Map.OrderedType) : S with type key = Ord.t +end diff --git a/src/lib_lwt_result_stdlib/functors/seq.ml b/src/lib_lwt_result_stdlib/functors/seq.ml new file mode 100644 index 0000000000000000000000000000000000000000..c0ea1c04b5a27699917fe5630178d32c8f0c5026 --- /dev/null +++ b/src/lib_lwt_result_stdlib/functors/seq.ml @@ -0,0 +1,245 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module Make (Monad : Sigs.Monad.S) : Sigs.Seq.S with module Monad = Monad = +struct + module Monad = Monad + open Lwt.Infix + open Monad + include Stdlib.Seq + + let ok_nil = Ok Nil + + let return_nil = Lwt.return ok_nil + + let ok_empty = Ok empty + + let return_empty = Lwt.return ok_empty + + let lwt_empty = Lwt.return empty + + let rec fold_left_e f acc seq = + match seq () with + | Nil -> + Ok acc + | Cons (item, seq) -> + f acc item >>? fun acc -> fold_left_e f acc seq + + let rec fold_left_s f acc seq = + match seq () with + | Nil -> + Lwt.return acc + | Cons (item, seq) -> + f acc item >>= fun acc -> fold_left_s f acc seq + + let rec fold_left_es f acc seq = + match seq () with + | Nil -> + Monad.return acc + | Cons (item, seq) -> + f acc item >>=? fun acc -> fold_left_es f acc seq + + let rec iter_e f seq = + match seq () with + | Nil -> + ok_unit + | Cons (item, seq) -> + f item >>? fun () -> iter_e f seq + + let rec iter_s f seq = + match seq () with + | Nil -> + Lwt.return_unit + | Cons (item, seq) -> + f item >>= fun () -> iter_s f seq + + let rec iter_es f seq = + match seq () with + | Nil -> + return_unit + | Cons (item, seq) -> + f item >>=? fun () -> iter_es f seq + + let iter_p f seq = + let rec iter_p f seq acc = + match seq () with + | Nil -> + join_p acc + | Cons (item, seq) -> + iter_p f seq (f item :: acc) + in + iter_p f seq [] + + let iter_ep f seq = + let rec iter_ep f seq acc = + match seq () with + | Nil -> + join_ep acc + | Cons (item, seq) -> + iter_ep f seq (f item :: acc) + in + iter_ep f seq [] + + let rec map_e f seq = + match seq () with + | Nil -> + ok_empty + | Cons (item, seq) -> + f item + >>? fun item -> + map_e f seq >>? fun seq -> ok (fun () -> Cons (item, seq)) + + let rec map_s f seq = + match seq () with + | Nil -> + lwt_empty + | Cons (item, seq) -> + f item + >>= fun item -> + map_s f seq >>= fun seq -> Lwt.return (fun () -> Cons (item, seq)) + + let rec map_es f seq = + match seq () with + | Nil -> + return_empty + | Cons (item, seq) -> + f item + >>=? fun item -> + map_es f seq >>=? fun seq -> Monad.return (fun () -> Cons (item, seq)) + + let map_p f seq = + all_p (fold_left (fun acc x -> f x :: acc) [] seq) >|= List.to_seq + + let map_ep f seq = + all_ep (fold_left (fun acc x -> f x :: acc) [] seq) >|=? List.to_seq + + let rec filter_e f seq = + match seq () with + | Nil -> + ok_empty + | Cons (item, seq) -> ( + f item + >>? function + | false -> + filter_e f seq + | true -> + filter_e f seq >>? fun seq -> ok (fun () -> Cons (item, seq)) ) + + let rec filter_s f seq = + match seq () with + | Nil -> + lwt_empty + | Cons (item, seq) -> ( + f item + >>= function + | false -> + filter_s f seq + | true -> + filter_s f seq + >>= fun seq -> Lwt.return (fun () -> Cons (item, seq)) ) + + let rec filter_es f seq = + match seq () with + | Nil -> + return_empty + | Cons (item, seq) -> ( + f item + >>=? function + | false -> + filter_es f seq + | true -> + filter_es f seq + >>=? fun seq -> Monad.return (fun () -> Cons (item, seq)) ) + + let rec filter_map_e f seq = + match seq () with + | Nil -> + ok_empty + | Cons (item, seq) -> ( + f item + >>? function + | None -> + filter_map_e f seq + | Some item -> + filter_map_e f seq >>? fun seq -> ok (fun () -> Cons (item, seq)) ) + + let rec filter_map_s f seq = + match seq () with + | Nil -> + lwt_empty + | Cons (item, seq) -> ( + f item + >>= function + | None -> + filter_map_s f seq + | Some item -> + filter_map_s f seq + >>= fun seq -> Lwt.return (fun () -> Cons (item, seq)) ) + + let rec filter_map_es f seq = + match seq () with + | Nil -> + return_empty + | Cons (item, seq) -> ( + f item + >>=? function + | None -> + filter_map_es f seq + | Some item -> + filter_map_es f seq + >>=? fun seq -> Monad.return (fun () -> Cons (item, seq)) ) + + let rec find_first f seq = + match seq () with + | Nil -> + None + | Cons (item, seq) -> + if f item then Some item else find_first f seq + + let rec find_first_e f seq = + match seq () with + | Nil -> + ok_none + | Cons (item, seq) -> ( + f item + >>? function true -> ok_some item | false -> find_first_e f seq ) + + let rec find_first_s f seq = + match seq () with + | Nil -> + Lwt.return_none + | Cons (item, seq) -> ( + f item + >>= function + | true -> Lwt.return_some item | false -> find_first_s f seq ) + + let rec find_first_es f seq = + match seq () with + | Nil -> + return_none + | Cons (item, seq) -> ( + f item + >>=? function true -> return_some item | false -> find_first_es f seq ) +end diff --git a/src/lib_lwt_result_stdlib/functors/seq.mli b/src/lib_lwt_result_stdlib/functors/seq.mli new file mode 100644 index 0000000000000000000000000000000000000000..4e0911c165e3f7219bd8b66b3f6b4280f77035de --- /dev/null +++ b/src/lib_lwt_result_stdlib/functors/seq.mli @@ -0,0 +1,26 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module Make (Monad : Sigs.Monad.S) : Sigs.Seq.S with module Monad = Monad diff --git a/src/lib_lwt_result_stdlib/functors/set.ml b/src/lib_lwt_result_stdlib/functors/set.ml new file mode 100644 index 0000000000000000000000000000000000000000..5a10e59eb9ba145931f1961ec283b75050bc24e8 --- /dev/null +++ b/src/lib_lwt_result_stdlib/functors/set.ml @@ -0,0 +1,61 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module Make (Seq : Sigs.Seq.S) = struct + module type S = Sigs.Set.S with type error := Seq.Monad.out_error + + module Make (Ord : Stdlib.Map.OrderedType) : S with type elt = Ord.t = struct + open Seq + include Stdlib.Set.Make (Ord) + + let iter_e f t = iter_e f (to_seq t) + + let iter_s f t = iter_s f (to_seq t) + + let iter_p f t = iter_p f (to_seq t) + + let iter_es f t = iter_es f (to_seq t) + + let iter_ep f t = iter_ep f (to_seq t) + + let fold_e f t init = fold_left_e (fun acc e -> f e acc) init (to_seq t) + + let fold_s f t init = fold_left_s (fun acc e -> f e acc) init (to_seq t) + + let fold_es f t init = fold_left_es (fun acc e -> f e acc) init (to_seq t) + + let min_elt = min_elt_opt + + let max_elt = max_elt_opt + + let choose = choose_opt + + let find = find_opt + + let find_first = find_first_opt + + let find_last = find_last_opt + end +end diff --git a/src/lib_lwt_result_stdlib/functors/set.mli b/src/lib_lwt_result_stdlib/functors/set.mli new file mode 100644 index 0000000000000000000000000000000000000000..27f62475a57ce3eb971ab0d431e12ef4fb50a6ca --- /dev/null +++ b/src/lib_lwt_result_stdlib/functors/set.mli @@ -0,0 +1,30 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module Make (Seq : Sigs.Seq.S) : sig + module type S = Sigs.Set.S with type error := Seq.Monad.out_error + + module Make (Ord : Stdlib.Map.OrderedType) : S with type elt = Ord.t +end diff --git a/src/lib_lwt_result_stdlib/lib/.ocamlformat b/src/lib_lwt_result_stdlib/lib/.ocamlformat new file mode 100644 index 0000000000000000000000000000000000000000..8278a132e3d6f6c868be4c6e0a012089319d0bbc --- /dev/null +++ b/src/lib_lwt_result_stdlib/lib/.ocamlformat @@ -0,0 +1,12 @@ +version=0.10 +wrap-fun-args=false +let-binding-spacing=compact +field-space=loose +break-separators=after-and-docked +sequence-style=separator +doc-comments=before +margin=80 +module-item-spacing=sparse +parens-tuple=always +parens-tuple-patterns=always +break-string-literals=newlines-and-wrap diff --git a/src/lib_lwt_result_stdlib/lib/dune b/src/lib_lwt_result_stdlib/lib/dune new file mode 100644 index 0000000000000000000000000000000000000000..989575c402caf06ae8282e4162c3213c43d641e4 --- /dev/null +++ b/src/lib_lwt_result_stdlib/lib/dune @@ -0,0 +1,13 @@ +(library + (name lib) + (public_name tezos-lwt-result-stdlib.lib) + (flags (:standard -open Tezos_error_monad)) + (libraries tezos-error-monad + lwt + tezos-lwt-result-stdlib.sigs + tezos-lwt-result-stdlib.functors)) + +(alias + (name runtest_lint) + (deps (glob_files *.ml{,i})) + (action (run %{lib:tezos-tooling:lint.sh} %{deps}))) diff --git a/src/lib_lwt_result_stdlib/lib/map.ml b/src/lib_lwt_result_stdlib/lib/map.ml new file mode 100644 index 0000000000000000000000000000000000000000..634fa4b2dc02df4c963f43ecfc6590cb998ed976 --- /dev/null +++ b/src/lib_lwt_result_stdlib/lib/map.ml @@ -0,0 +1,26 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +include Functors.Map.Make (Seq) diff --git a/src/lib_lwt_result_stdlib/lib/map.mli b/src/lib_lwt_result_stdlib/lib/map.mli new file mode 100644 index 0000000000000000000000000000000000000000..a6a303cfd6642aed7eea1ea96d664a44134ab1c1 --- /dev/null +++ b/src/lib_lwt_result_stdlib/lib/map.mli @@ -0,0 +1,28 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module type S = Sigs.Map.S with type error := Error_monad.error list + +module Make (Ord : Stdlib.Map.OrderedType) : S with type key = Ord.t diff --git a/src/lib_lwt_result_stdlib/lib/seq.ml b/src/lib_lwt_result_stdlib/lib/seq.ml new file mode 100644 index 0000000000000000000000000000000000000000..a0cabf0b48c2c62864dc5ba61f1b3b18663b8c78 --- /dev/null +++ b/src/lib_lwt_result_stdlib/lib/seq.ml @@ -0,0 +1,32 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +include Functors.Seq.Make (struct + type in_error = Error_monad.error + + type out_error = Error_monad.error list + + include Tezos_error_monad.Monad +end) diff --git a/src/lib_lwt_result_stdlib/lib/seq.mli b/src/lib_lwt_result_stdlib/lib/seq.mli new file mode 100644 index 0000000000000000000000000000000000000000..0376a707e72fbcf50c2bf2c73d803739a3d29819 --- /dev/null +++ b/src/lib_lwt_result_stdlib/lib/seq.mli @@ -0,0 +1,29 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +include + Sigs.Seq.S + with type Monad.in_error = Error_monad.error + and type Monad.out_error = Error_monad.error list diff --git a/src/lib_lwt_result_stdlib/lib/set.ml b/src/lib_lwt_result_stdlib/lib/set.ml new file mode 100644 index 0000000000000000000000000000000000000000..81203765bec47ca6ee64b57b8b7164a995eb75fe --- /dev/null +++ b/src/lib_lwt_result_stdlib/lib/set.ml @@ -0,0 +1,26 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +include Functors.Set.Make (Seq) diff --git a/src/lib_lwt_result_stdlib/lib/set.mli b/src/lib_lwt_result_stdlib/lib/set.mli new file mode 100644 index 0000000000000000000000000000000000000000..a9fae50ff21757fc499e8eaea06e4094b569cb61 --- /dev/null +++ b/src/lib_lwt_result_stdlib/lib/set.mli @@ -0,0 +1,28 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module type S = Sigs.Set.S with type error := Error_monad.error list + +module Make (Ord : Stdlib.Map.OrderedType) : S with type elt = Ord.t diff --git a/src/lib_lwt_result_stdlib/lwtreslib.ml b/src/lib_lwt_result_stdlib/lwtreslib.ml new file mode 100644 index 0000000000000000000000000000000000000000..7d29527fa2278349239975c3dc8fee172d545ff8 --- /dev/null +++ b/src/lib_lwt_result_stdlib/lwtreslib.ml @@ -0,0 +1,28 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module Seq = Lib.Seq +module Set = Lib.Set +module Map = Lib.Map diff --git a/src/lib_lwt_result_stdlib/lwtreslib.mli b/src/lib_lwt_result_stdlib/lwtreslib.mli new file mode 100644 index 0000000000000000000000000000000000000000..bc57a9b6e44b7031a8708393b57e953ac5df23c6 --- /dev/null +++ b/src/lib_lwt_result_stdlib/lwtreslib.mli @@ -0,0 +1,52 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** [Error_monad]-aware replacements for parts of the Stdlib. + + This library aims to provide replacements to some parts of the Stdlib that: + + - do not raise exceptions (e.g., it shadows [Map.find] with [Map.find_opt]), + - include traversal functions for Lwt (think [Lwt_list] for [List]), + [tzresult], and the combined [tzresult]-Lwt monad (think the + list-traversal functions from [Error_monad]. + + The aim is to allow the use of the standard OCaml data-structures within the + context of Lwt and the Error monad. This is already somewhat available for + [List] through the combination of {!Stdlib.List} (for basic functionality), + {!Lwt_list} (for the Lwt-aware traversals), and {!Error_monad} (for the + error-aware and combined-error-lwt-aware traversal). + + More and more modules will be added to this Library. In particular [List] + (to avoid splitting the functionality from three distinct libraries and to + provide more consistent coverage), [Array], and [Option] will be made + available. + +*) + +module Seq : module type of Lib.Seq + +module Set : module type of Lib.Set + +module Map : module type of Lib.Map diff --git a/src/lib_lwt_result_stdlib/sigs/.ocamlformat b/src/lib_lwt_result_stdlib/sigs/.ocamlformat new file mode 100644 index 0000000000000000000000000000000000000000..8278a132e3d6f6c868be4c6e0a012089319d0bbc --- /dev/null +++ b/src/lib_lwt_result_stdlib/sigs/.ocamlformat @@ -0,0 +1,12 @@ +version=0.10 +wrap-fun-args=false +let-binding-spacing=compact +field-space=loose +break-separators=after-and-docked +sequence-style=separator +doc-comments=before +margin=80 +module-item-spacing=sparse +parens-tuple=always +parens-tuple-patterns=always +break-string-literals=newlines-and-wrap diff --git a/src/lib_lwt_result_stdlib/sigs/dune b/src/lib_lwt_result_stdlib/sigs/dune new file mode 100644 index 0000000000000000000000000000000000000000..b7c0d48a5e7d0860b316c321aad6b3b42b3a2e81 --- /dev/null +++ b/src/lib_lwt_result_stdlib/sigs/dune @@ -0,0 +1,10 @@ +(library + (name sigs) + (public_name tezos-lwt-result-stdlib.sigs) + (flags (:standard)) + (libraries lwt)) + +(alias + (name runtest_lint) + (deps (glob_files *.ml{,i})) + (action (run %{lib:tezos-tooling:lint.sh} %{deps}))) diff --git a/src/lib_lwt_result_stdlib/sigs/map.ml b/src/lib_lwt_result_stdlib/sigs/map.ml new file mode 100644 index 0000000000000000000000000000000000000000..3e73e329237446319a33e67bbd775b351ce78871 --- /dev/null +++ b/src/lib_lwt_result_stdlib/sigs/map.ml @@ -0,0 +1,145 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module type S = sig + type error (* for substitution/constraint *) + + type key + + type +'a t + + val empty : 'a t + + val is_empty : 'a t -> bool + + val mem : key -> 'a t -> bool + + val add : key -> 'a -> 'a t -> 'a t + + val update : key -> ('a option -> 'a option) -> 'a t -> 'a t + + val singleton : key -> 'a -> 'a t + + val remove : key -> 'a t -> 'a t + + val merge : + (key -> 'a option -> 'b option -> 'c option) -> 'a t -> 'b t -> 'c t + + val union : (key -> 'a -> 'a -> 'a option) -> 'a t -> 'a t -> 'a t + + val compare : ('a -> 'a -> int) -> 'a t -> 'a t -> int + + val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool + + val iter : (key -> 'a -> unit) -> 'a t -> unit + + (** [iter_e f m] applies [f] to the bindings of [m] one by one in an + unspecified order. If all the applications result in [Ok ()], then the + result of the iteration is [Ok ()]. If any of the applications results in + [Error e] then the iteration stops and the result of the iteration is + [Error e]. *) + val iter_e : + (key -> 'a -> (unit, error) result) -> 'a t -> (unit, error) result + + val iter_s : (key -> 'a -> unit Lwt.t) -> 'a t -> unit Lwt.t + + val iter_p : (key -> 'a -> unit Lwt.t) -> 'a t -> unit Lwt.t + + (** [iter_es f m] applies [f] to the bindings of [m] in an unspecified order, + one after the other as the promises resolve. If all the applications + result in [Ok ()], then the result of the iteration is [Ok ()]. If any of + the applications results in [Error e] then the iteration stops and the + result of the iteration is [Error e]. *) + val iter_es : + (key -> 'a -> (unit, error) result Lwt.t) -> + 'a t -> + (unit, error) result Lwt.t + + (** [iter_ep f m] applies [f] to the bindings of [m]. All the applications are + done concurrently. If all the applications result in [Ok ()], then the + result of the iteration is [Ok ()]. If any of the applications results in + [Error e] then the result of the iteration is [Error e]. *) + val iter_ep : + (key -> 'a -> (unit, error) result Lwt.t) -> + 'a t -> + (unit, error) result Lwt.t + + val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b + + (** [fold_e f m init] is + [f k1 d1 init >>? fun acc -> f k2 d2 acc >>? fun acc -> …] where [kN] is + the key bound to [dN] in [m]. *) + val fold_e : + (key -> 'a -> 'b -> ('b, error) result) -> 'a t -> 'b -> ('b, error) result + + val fold_s : (key -> 'a -> 'b -> 'b Lwt.t) -> 'a t -> 'b -> 'b Lwt.t + + (** [fold_es f m init] is + [f k1 d1 init >>=? fun acc -> f k2 d2 acc >>=? fun acc -> …] where [kN] is + the key bound to [dN] in [m]. *) + val fold_es : + (key -> 'a -> 'b -> ('b, error) result Lwt.t) -> + 'a t -> + 'b -> + ('b, error) result Lwt.t + + val for_all : (key -> 'a -> bool) -> 'a t -> bool + + val exists : (key -> 'a -> bool) -> 'a t -> bool + + val filter : (key -> 'a -> bool) -> 'a t -> 'a t + + val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t + + val cardinal : 'a t -> int + + val bindings : 'a t -> (key * 'a) list + + val min_binding : 'a t -> (key * 'a) option + + val max_binding : 'a t -> (key * 'a) option + + val choose : 'a t -> (key * 'a) option + + val split : key -> 'a t -> 'a t * 'a option * 'a t + + val find : key -> 'a t -> 'a option + + val find_first : (key -> bool) -> 'a t -> (key * 'a) option + + val find_last : (key -> bool) -> 'a t -> (key * 'a) option + + val map : ('a -> 'b) -> 'a t -> 'b t + + val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t + + val to_seq : 'a t -> (key * 'a) Stdlib.Seq.t + + val to_seq_from : key -> 'a t -> (key * 'a) Stdlib.Seq.t + + val add_seq : (key * 'a) Stdlib.Seq.t -> 'a t -> 'a t + + val of_seq : (key * 'a) Stdlib.Seq.t -> 'a t +end diff --git a/src/lib_lwt_result_stdlib/sigs/monad.ml b/src/lib_lwt_result_stdlib/sigs/monad.ml new file mode 100644 index 0000000000000000000000000000000000000000..6920de28e07017ad5b646f5ea82051107cf4f020 --- /dev/null +++ b/src/lib_lwt_result_stdlib/sigs/monad.ml @@ -0,0 +1,146 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** Modules with the [S] signature are used to instantiate the other modules of + this library. [S] describes a generic Lwt-Result combined monad, the rest of + this library builds upon. *) +module type S = sig + (** [in_error] are the errors as injected into the monad. In other words, + [in_error] is the type of values that are used in primitives that "raise" + an error. *) + type in_error + + (** [out_error] are the errors as received from the monad. In other words, + [out_error] is the type of values that are seen when matching on [Error _] + to, say, recover. + + The types [in_error] and [out_error] are kept separate (although they can + be equal) to support cases such as the following: + - [out_error] are richer than [in_error], such as by including a + timestamp, a filename, or some other such metadata. + - [out_error] is slightly different and [private] and [in_error] is simply + the type of argument to the functions that construct the private + [out_error]. + - [out_error] is a collection of [in_error] and additional functions (not + required by this library) allow additional manipulation. E.g., in the + case of Tezos: errors are built into traces that can be grown. + *) + type out_error + + (** result monad *) + + val ok : 'a -> ('a, out_error) result + + val ok_unit : (unit, out_error) result + + val ok_none : ('a option, out_error) result + + val ok_some : 'a -> ('a option, out_error) result + + val ok_nil : ('a list, out_error) result + + val ok_true : (bool, out_error) result + + val ok_false : (bool, out_error) result + + val error : in_error -> ('a, out_error) result + + val ( >>? ) : + ('a, out_error) result -> + ('a -> ('b, out_error) result) -> + ('b, out_error) result + + val ( >|? ) : ('a, out_error) result -> ('a -> 'b) -> ('b, out_error) result + + (** lwt-result combined monad *) + + val return : 'a -> ('a, out_error) result Lwt.t + + val return_unit : (unit, out_error) result Lwt.t + + val return_none : ('a option, out_error) result Lwt.t + + val return_some : 'a -> ('a option, out_error) result Lwt.t + + val return_nil : ('a list, out_error) result Lwt.t + + val return_true : (bool, out_error) result Lwt.t + + val return_false : (bool, out_error) result Lwt.t + + val fail : in_error -> ('a, out_error) result Lwt.t + + val ( >>=? ) : + ('a, out_error) result Lwt.t -> + ('a -> ('b, out_error) result Lwt.t) -> + ('b, out_error) result Lwt.t + + val ( >|=? ) : + ('a, out_error) result Lwt.t -> ('a -> 'b) -> ('b, out_error) result Lwt.t + + (** Mixing operators *) + + (** All operators follow this naming convention: + - the first character is [>] + - the second character is [>] for [bind] and [|] for [map] + - the next character is [=] for Lwt or [?] for Error + - the next character (if present) is [=] for Lwt or [?] for Error, it is + only used for operator that are within both monads. *) + + val ( >>?= ) : + ('a, out_error) result -> + ('a -> ('b, out_error) result Lwt.t) -> + ('b, out_error) result Lwt.t + + val ( >|?= ) : + ('a, out_error) result -> ('a -> 'b Lwt.t) -> ('b, out_error) result Lwt.t + + (** joins *) + val join_e : (unit, out_error) result list -> (unit, out_error) result + + val all_e : ('a, out_error) result list -> ('a list, out_error) result + + val both_e : + ('a, out_error) result -> + ('b, out_error) result -> + ('a * 'b, out_error) result + + val join_p : unit Lwt.t list -> unit Lwt.t + + val all_p : 'a Lwt.t list -> 'a list Lwt.t + + val both_p : 'a Lwt.t -> 'b Lwt.t -> ('a * 'b) Lwt.t + + val join_ep : + (unit, out_error) result Lwt.t list -> (unit, out_error) result Lwt.t + + val all_ep : + ('a, out_error) result Lwt.t list -> ('a list, out_error) result Lwt.t + + val both_ep : + ('a, out_error) result Lwt.t -> + ('b, out_error) result Lwt.t -> + ('a * 'b, out_error) result Lwt.t +end diff --git a/src/lib_lwt_result_stdlib/sigs/seq.ml b/src/lib_lwt_result_stdlib/sigs/seq.ml new file mode 100644 index 0000000000000000000000000000000000000000..fc3e842f7cafe662dbe4f1bb0d1d8c4b2478069c --- /dev/null +++ b/src/lib_lwt_result_stdlib/sigs/seq.ml @@ -0,0 +1,276 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +(** A wrapper around {!Stdlib.Seq} that includes lwt-, error- and + lwt-error-aware traversal functions. + + All traversal functions that are suffixed with [_e] are within the error + monad. Note that this functions have a “fail-early” behaviour: the traversal + is interrupted as when any of the intermediate application fails (i.e., + returns an [Error _]). + + All traversal functions that are suffixed with [_s] are within Lwt. These + functions traverse the elements sequentially: the promise for a given step + of the traversal is only initiated when the promise for the previous step is + resolved. Note that these functions have a fail-early behaviour: the + traversal is interrupted if any of the intermediate promise is rejected. + + All the traversal functions that are suffixed with [_p] are within Lwt. + These functions traverse the elements concurrently: the promise for all the + steps are created immediately. The suffix [_p] is chosen for similarity with + the {!Lwt_list} functions even though, as with {!Lwt_list}'s functions there + is no parallelism involved, only concurrency. Note that these functions have + a “best-effort” behaviour: the whole-traversal promise (i.e., the promise + returned by the [_p]-suffixed function) only resolves once each of the step + promises have resolved. Even if one of the step promise is rejected, the + whole-traversal promise is only rejected once all the other step promises + have resolved. + + All the traversal functions that are suffixed with [_es] are within the + combined error-and-Lwt monad. These function traverse the elements + sequentially with a fail-early behaviour for both rejection (as an Lwt + promise) and failure (as a result). + + All the traversal functions that are suffixed with [_ep] are within the + combined error-and-Lwt monad. These function traverse the elements + concurrently with a best-effort behaviour. +*) +module type S = sig + module Monad : Monad.S + + open Monad (* for [error] *) + + (** including the OCaml's {!Stdlib.Seq} module to share the {!Seq.t} type + (including concrete definition) and to bring the existing functions. *) + include + module type of Stdlib.Seq + with type 'a t = 'a Stdlib.Seq.t + and type 'a node = 'a Stdlib.Seq.node + + (** in-monad, preallocated empty/nil *) + + val ok_empty : ('a t, out_error) result + + val return_empty : ('a t, out_error) result Lwt.t + + val ok_nil : ('a node, out_error) result + + val return_nil : ('a node, out_error) result Lwt.t + + (** Similar to {!fold_left} but wraps the traversal in {!result}. The + traversal is interrupted if one of the step returns an [Error _]. *) + val fold_left_e : + ('a -> 'b -> ('a, out_error) result) -> + 'a -> + 'b t -> + ('a, out_error) result + + (** Similar to {!fold_left} but wraps the traversing in {!Lwt}. Each step of + the traversal is started after the previous one has resolved. The + traversal is interrupted if one of the promise is rejected. *) + val fold_left_s : ('a -> 'b -> 'a Lwt.t) -> 'a -> 'b t -> 'a Lwt.t + + (** Similar to {!fold_left} but wraps the traversing in [result Lwt.t]. + Each step of the traversal is started after the previous one resolved. The + traversal is interrupted if one of the step is rejected or is fulfilled + with [Error _]. *) + val fold_left_es : + ('a -> 'b -> ('a, out_error) result Lwt.t) -> + 'a -> + 'b t -> + ('a, out_error) result Lwt.t + + (** Similar to {!iter} but wraps the iteration in {!result}. The iteration + is interrupted if one of the step returns an [Error _]. *) + val iter_e : + ('a -> (unit, out_error) result) -> 'a t -> (unit, out_error) result + + (** Similar to {!iter} but wraps the iteration in {!Lwt}. Each step + of the iteration is started after the previous one resolved. The iteration + is interrupted if one of the promise is rejected. *) + val iter_s : ('a -> unit Lwt.t) -> 'a t -> unit Lwt.t + + (** Similar to {!iter} but wraps the iteration in [result Lwt.t]. Each step + of the iteration is started after the previous one resolved. The iteration + is interrupted if one of the promise is rejected of fulfilled with an + [Error _]. *) + val iter_es : + ('a -> (unit, out_error) result Lwt.t) -> + 'a t -> + (unit, out_error) result Lwt.t + + (** Similar to {!iter} but wraps the iteration in {!Lwt}. All the + steps of the iteration are started concurrently. The promise [iter_p f s] + is resolved only once all the promises of the iteration are. At this point + it is either fulfilled if all promises are, or rejected if at least one of + them is. *) + val iter_p : ('a -> unit Lwt.t) -> 'a t -> unit Lwt.t + + (** Similar to {!iter} but wraps the iteration in [result Lwt.t]. All the + steps of the iteration are started concurrently. The promise [iter_ep] + resolves once all the promises of the traversal resolve. At this point it + either: + - is rejected if at least one of the promises is, otherwise + - is fulfilled with [Error _] if at least one of the promises is, + otherwise + - is fulfilled with [Ok ()] if all the promises are. *) + val iter_ep : + ('a -> (unit, out_error) result Lwt.t) -> + 'a t -> + (unit, out_error) result Lwt.t + + (** Similar to {!map} but wraps the transformation in {!result}. The + traversal is interrupted if any of the application returns an [Error _]. + + Note that, unlike {!map}, [map_e] is not lazy: it applies the + transformation immediately to all the elements of the sequence (unless it + is interrupted by an [Error _]) and does not terminate on infinite + sequences (again, unless interrupted). Moreover [map_e] is not + tail-recursive. *) + val map_e : + ('a -> ('b, out_error) result) -> 'a t -> ('b t, out_error) result + + (** Similar to {!map} but wraps the transformation in {!Lwt}. Each + transformation is done sequentially, only starting once the previous + one has resolved. The traversal is interrupted if any of the promise is + rejected. + + Note that, unlike {!map}, [map_s] is not lazy: it applies the + transformation eagerly to all the elements of the sequence (unless + interrupted by a rejection) and does not terminate on infinite sequences + (again, unless interrupted). Moreover [map_s] is not tail-recursive. *) + val map_s : ('a -> 'b Lwt.t) -> 'a t -> 'b t Lwt.t + + (** Similar to {!map} but wraps the transformation in [result Lwt.t]. Each + transformation is done sequentially, only starting once the previous + one has resolved. The traversal is interrupted if any of the promise is + rejected or fulfilled with an [Error _]. + + Note that, unlike {!map}, [map_es] is not lazy: it applies the + transformation eagerly to all the elements of the sequence (unless + interrupted by rejection or an [Error _]) and does not terminate on + infinite sequences (again, unless interrupted). Moreover [map_es] is not + tail-recursive. *) + val map_es : + ('a -> ('b, out_error) result Lwt.t) -> + 'a t -> + ('b t, out_error) result Lwt.t + + (** Similar to {!map} but wraps the transformation in {!Lwt}. All the + transformations are done concurrently. The promise [map_p f s] resolves + once all the promises of the traversal resolve. At this point it is + fulfilled if all the promises are, and it is rejected if any of them are. + + Note that, unlike {!map}, [map_p] is not lazy: it applies the + transformation eagerly to all the elements of the sequence and does not + terminate on infinite sequences. Moreover [map_p] is not tail-recursive. + *) + val map_p : ('a -> 'b Lwt.t) -> 'a t -> 'b t Lwt.t + + (** Similar to {!map} but wraps the transformation in [result Lwt]. All the + transformations are done concurrently. The promise [map_p f s] resolves + once all the promises of the traversal resolve. At this point it is + rejected if any of the promises are, and otherwise it is resolved with + [Error _] if any of the promises are, and otherwise it is fulfilled (if + all the promises are). + + Note that, unlike {!map}, [map_ep] is not lazy: it applies the + transformation eagerly to all the elements of the sequence and does not + terminate on infinite sequences. Moreover [map_p] is not tail-recursive. + *) + val map_ep : + ('a -> ('b, out_error) result Lwt.t) -> + 'a t -> + ('b t, out_error) result Lwt.t + + (** Similar to {!filter} but wraps the transformation in [result]. Note + that, unlike {!filter}, [filter_e] is not lazy: it applies the + transformation immediately and does not terminate on infinite sequences. + Moreover [filter_e] is not tail-recursive. *) + val filter_e : + ('a -> (bool, out_error) result) -> 'a t -> ('a t, out_error) result + + (** Similar to {!filter} but wraps the transformation in {!Lwt.t}. Each + test of the predicate is done sequentially, only starting once the + previous one has resolved. Note that, unlike {!filter}, [filter_s] is not + lazy: it applies the transformation immediately and does not terminate on + infinite sequences. Moreover [filter_s] is not tail-recursive. *) + val filter_s : ('a -> bool Lwt.t) -> 'a t -> 'a t Lwt.t + + (** Similar to {!filter} but wraps the transformation in [result Lwt.t]. + Each test of the predicate is done sequentially, only starting once the + previous one has resolved. Note that, unlike {!filter}, [filter_es] is not + lazy: it applies the transformation immediately and does not terminate on + infinite sequences. Moreover [filter_es] is not tail-recursive. *) + val filter_es : + ('a -> (bool, out_error) result Lwt.t) -> + 'a t -> + ('a t, out_error) result Lwt.t + + (** Similar to {!filter_map} but within [result]. Not lazy and not + tail-recursive. *) + val filter_map_e : + ('a -> ('b option, out_error) result) -> 'a t -> ('b t, out_error) result + + (** Similar to {!filter_map} but within [Lwt.t]. Not lazy and not + tail-recursive. *) + val filter_map_s : ('a -> 'b option Lwt.t) -> 'a t -> 'b t Lwt.t + + (** Similar to {!filter_map} but within [result Lwt.t]. Not lazy and not + tail-recursive. *) + val filter_map_es : + ('a -> ('b option, out_error) result Lwt.t) -> + 'a t -> + ('b t, out_error) result Lwt.t + + (** [find_first f t] is [Some x] where [x] is the first item in [t] such that + [f x]. It is [None] if there are no such element. It does not terminate if + the sequence is infinite and the predicate is always false. *) + val find_first : ('a -> bool) -> 'a t -> 'a option + + (** [find_first_e f t] is similar to {!find_first} but wraps the search within + [result]. Specifically, [find_first_e f t] is either + - [Ok (Some x)] if forall [y] before [x] [f y = Ok false] and + [f x = Ok true], + - [Error e] if there exists [x] such that forall [y] before [x] + [f y = Ok false] and [f x = Error e], + - [Ok None] otherwise and [t] is finite, + - an expression that never returns otherwise. *) + val find_first_e : + ('a -> (bool, out_error) result) -> 'a t -> ('a option, out_error) result + + (** [find_first_s f t] is similar to {!find_first} but wrapped within + [Lwt.t]. The search is identical to [find_first_e] but each + predicate is applied when the previous one has resolved. *) + val find_first_s : ('a -> bool Lwt.t) -> 'a t -> 'a option Lwt.t + + (** [find_first_es f t] is similar to {!find_first} but wrapped within + [result Lwt.t]. The search is identical to [find_first_e] but each + predicate is applied when the previous one has resolved. *) + val find_first_es : + ('a -> (bool, out_error) result Lwt.t) -> + 'a t -> + ('a option, out_error) result Lwt.t +end diff --git a/src/lib_lwt_result_stdlib/sigs/set.ml b/src/lib_lwt_result_stdlib/sigs/set.ml new file mode 100644 index 0000000000000000000000000000000000000000..8646f5b2609edf1550e351c9764062f93771be84 --- /dev/null +++ b/src/lib_lwt_result_stdlib/sigs/set.ml @@ -0,0 +1,123 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +module type S = sig + type error (* for substitution/constraint *) + + type elt + + type t + + val empty : t + + val is_empty : t -> bool + + val mem : elt -> t -> bool + + val add : elt -> t -> t + + val singleton : elt -> t + + val remove : elt -> t -> t + + val union : t -> t -> t + + val inter : t -> t -> t + + val disjoint : t -> t -> bool + + val diff : t -> t -> t + + val compare : t -> t -> int + + val equal : t -> t -> bool + + val subset : t -> t -> bool + + val iter : (elt -> unit) -> t -> unit + + val iter_e : (elt -> (unit, error) result) -> t -> (unit, error) result + + val iter_s : (elt -> unit Lwt.t) -> t -> unit Lwt.t + + val iter_p : (elt -> unit Lwt.t) -> t -> unit Lwt.t + + val iter_es : + (elt -> (unit, error) result Lwt.t) -> t -> (unit, error) result Lwt.t + + val iter_ep : + (elt -> (unit, error) result Lwt.t) -> t -> (unit, error) result Lwt.t + + val map : (elt -> elt) -> t -> t + + val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a + + val fold_e : + (elt -> 'a -> ('a, error) result) -> t -> 'a -> ('a, error) result + + val fold_s : (elt -> 'a -> 'a Lwt.t) -> t -> 'a -> 'a Lwt.t + + val fold_es : + (elt -> 'a -> ('a, error) result Lwt.t) -> + t -> + 'a -> + ('a, error) result Lwt.t + + val for_all : (elt -> bool) -> t -> bool + + val exists : (elt -> bool) -> t -> bool + + val filter : (elt -> bool) -> t -> t + + val partition : (elt -> bool) -> t -> t * t + + val cardinal : t -> int + + val elements : t -> elt list + + val min_elt : t -> elt option + + val max_elt : t -> elt option + + val choose : t -> elt option + + val split : elt -> t -> t * bool * t + + val find : elt -> t -> elt option + + val find_first : (elt -> bool) -> t -> elt option + + val find_last : (elt -> bool) -> t -> elt option + + val of_list : elt list -> t + + val to_seq_from : elt -> t -> elt Stdlib.Seq.t + + val to_seq : t -> elt Stdlib.Seq.t + + val add_seq : elt Stdlib.Seq.t -> t -> t + + val of_seq : elt Stdlib.Seq.t -> t +end diff --git a/src/lib_lwt_result_stdlib/tezos-lwt-result-stdlib.opam b/src/lib_lwt_result_stdlib/tezos-lwt-result-stdlib.opam new file mode 100644 index 0000000000000000000000000000000000000000..2a428934eeb61f294039d814f1aa9a7d07d1ba87 --- /dev/null +++ b/src/lib_lwt_result_stdlib/tezos-lwt-result-stdlib.opam @@ -0,0 +1,19 @@ +opam-version: "2.0" +maintainer: "contact@tezos.com" +authors: [ "Tezos devteam" ] +homepage: "https://www.tezos.com/" +bug-reports: "https://gitlab.com/tezos/tezos/issues" +dev-repo: "git+https://gitlab.com/tezos/tezos.git" +license: "MIT" +depends: [ + "tezos-tooling" { with-test } + "dune" { >= "1.11" } + "ocaml" { >= "4.07" } + "tezos-error-monad" + "lwt" +] +build: [ + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} +] +synopsis: "Tezos: error-aware stdlib replacement"