From 1bc7b45fdb752cc51492d906c77e8e3563988713 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Sun, 13 May 2018 20:20:59 +0200 Subject: [PATCH] Data_encoding: forbids nested options --- src/lib_data_encoding/encoding.ml | 43 ++++++++++++++++++- .../lib_json_typed/json_encoding.mli | 3 ++ 2 files changed, 45 insertions(+), 1 deletion(-) diff --git a/src/lib_data_encoding/encoding.ml b/src/lib_data_encoding/encoding.ml index 89749a6a1..ad7a504d2 100644 --- a/src/lib_data_encoding/encoding.ml +++ b/src/lib_data_encoding/encoding.ml @@ -467,14 +467,55 @@ let union ?(tag_size = `Uint8) cases = let kind = Kind.merge_list tag_size kinds in make @@ Union (kind, tag_size, cases) let case ?name tag encoding proj inj = Case { name ; encoding ; proj ; inj ; tag } + +let rec is_nullable: type t. t encoding -> bool = fun e -> + match e.encoding with + | Null -> true + | Empty -> false + | Ignore -> true + | Constant _ -> false + | Bool -> false + | Int8 -> false + | Uint8 -> false + | Int16 -> false + | Uint16 -> false + | Int31 -> false + | Int32 -> false + | Int64 -> false + | Z -> false + | RangedInt _ -> false + | RangedFloat _ -> false + | Float -> false + | Bytes _ -> false + | String _ -> false + | String_enum _ -> false + | Array _ -> false + | List _ -> false + | Obj _ -> false + | Objs _ -> false + | Tup _ -> false + | Tups _ -> false + | Union (_, _, cases) -> + List.exists (fun (Case { encoding = e }) -> is_nullable e) cases + | Mu (_, _, f) -> is_nullable (f e) + | Conv { encoding = e } -> is_nullable e + | Describe { encoding = e } -> is_nullable e + | Def { encoding = e } -> is_nullable e + | Splitted { json_encoding } -> Json_encoding.is_nullable json_encoding + | Dynamic_size e -> is_nullable e + | Delayed _ -> true + let option ty = + if is_nullable ty then + invalid_arg "Data_encoding.option: cannot nest nullable encodings" ; + (* TODO add a special construct `Option` in the GADT *) union ~tag_size:`Uint8 [ case (Tag 1) ty ~name:"Some" (fun x -> x) (fun x -> Some x) ; - case (Tag 0) empty + case (Tag 0) null ~name:"None" (function None -> Some () | Some _ -> None) (fun () -> None) ; diff --git a/vendors/ocplib-json-typed/lib_json_typed/json_encoding.mli b/vendors/ocplib-json-typed/lib_json_typed/json_encoding.mli index dffc00e94..3aae16d06 100644 --- a/vendors/ocplib-json-typed/lib_json_typed/json_encoding.mli +++ b/vendors/ocplib-json-typed/lib_json_typed/json_encoding.mli @@ -493,3 +493,6 @@ val repr_agnostic_custom : (** A raw JSON value in its original representation. *) val any_value : Json_repr.any encoding + +(** Returns [true] is the encoding might construct [null]. *) +val is_nullable : 't encoding -> bool