swh:1:snp:61dcfc0dd5674a0e65803e88039c122d9532074e
Tip revision: 1b800f73fb2d7604beb1eeb08a8edb0190467664 authored by Raphaƫl Proust on 16 March 2022, 10:15:19 UTC
update CHANGES.md
update CHANGES.md
Tip revision: 1b800f7
types.ml
(*****************************************************************************)
(* *)
(* Open Source License *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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. *)
(* *)
(*****************************************************************************)
open Data_encoding
type record = {a : int; b : bool; c : Z.t option; d : float}
let default_record = {a = 32; b = true; c = Some Z.one; d = 12.34}
let record_obj_enc =
conv
(fun {a; b; c; d} -> ((a, b), (c, d)))
(fun ((a, b), (c, d)) -> {a; b; c; d})
(merge_objs
(obj2 (req "a" int31) (dft "b" bool false))
(obj2 (opt "c" z) (req "d" float)))
let record_tup_enc =
conv
(fun {a; b; c; d} -> ((a, b, c), d))
(fun ((a, b, c), d) -> {a; b; c; d})
(merge_tups (tup3 int31 bool (option z)) (tup1 float))
let record_to_string {a; b; c; d} =
let c = match c with None -> "none" | Some c -> Z.to_string c in
Format.asprintf "(%d, %B, %s, %f)" a b c d
type variable_record = {p : int; q : Bytes.t}
let default_variable_record = {p = 23; q = Bytes.of_string "wwwxxyyzzz"}
let variable_record_obj_enc =
conv
(fun {p; q} -> (p, q))
(fun (p, q) -> {p; q})
(obj2 (req "p" int31) (req "q" Variable.bytes))
let variable_record_tup_enc =
conv (fun {p; q} -> (p, q)) (fun (p, q) -> {p; q}) (tup2 int31 Variable.bytes)
let variable_record_to_string {p; q} =
Format.asprintf "(%d, %a)" p Hex.pp (Hex.of_bytes q)
type variable_left_record = {x : int; y : Bytes.t; z : int}
let default_variable_left_record = {x = 98; y = Bytes.of_string "765"; z = 4321}
let variable_left_record_obj_enc =
conv
(fun {x; y; z} -> (x, y, z))
(fun (x, y, z) -> {x; y; z})
(obj3 (req "x" int31) (req "y" Variable.bytes) (req "z" int31))
let variable_left_record_tup_enc =
conv
(fun {x; y; z} -> (x, y, z))
(fun (x, y, z) -> {x; y; z})
(tup3 int31 Variable.bytes int31)
let variable_left_record_to_string {x; y; z} =
Format.asprintf "(%d, %a, %d)" x Hex.pp (Hex.of_bytes y) z
type union = A of int | B of string | C of int | D of string | E
let union_enc =
union
[
case
(Tag 1)
~title:"A"
int8
(function A i -> Some i | _ -> None)
(fun i -> A i);
case
(Tag 2)
~title:"B"
string
(function B s -> Some s | _ -> None)
(fun s -> B s);
case
(Tag 3)
~title:"C"
(obj1 (req "C" int8))
(function C i -> Some i | _ -> None)
(fun i -> C i);
case
(Tag 4)
~title:"D"
(obj2 (req "kind" (constant "D")) (req "data" string))
(function D s -> Some ((), s) | _ -> None)
(fun ((), s) -> D s);
case
(Tag 5)
~title:"E"
empty
(function E -> Some () | _ -> None)
(fun () -> E);
]
let mini_union_enc =
union
[
case
(Tag 1)
~title:"A"
int8
(function A i -> Some i | _ -> None)
(fun i -> A i);
]
let union_to_string = function
| A i -> Printf.sprintf "A %d" i
| B s -> Printf.sprintf "B %s" s
| C i -> Printf.sprintf "C %d" i
| D s -> Printf.sprintf "D %s" s
| E -> "E"
let enum_enc =
string_enum
[("one", 1); ("two", 2); ("three", 3); ("four", 4); ("five", 5); ("six", 6)]
let mini_enum_enc = string_enum [("one", 1); ("two", 2)]
let mu_list_enc enc =
mu "list" @@ fun mu_list_enc ->
union
[
case
(Tag 0)
~title:"Nil"
empty
(function [] -> Some () | _ :: _ -> None)
(fun () -> []);
case
(Tag 1)
~title:"Cons"
(obj2 (req "value" enc) (req "next" mu_list_enc))
(function x :: xs -> Some (x, xs) | [] -> None)
(fun (x, xs) -> x :: xs);
]
let bounded_list ~total ~elements enc =
check_size total (Variable.list (check_size elements enc))
module Alcotest = struct
include Alcotest
let float =
testable Fmt.float (fun f1 f2 ->
match (classify_float f1, classify_float f2) with
| FP_nan, FP_nan -> true
| _ -> f1 = f2)
let bytes =
testable
(Fmt.of_to_string (fun s ->
let (`Hex s) = Hex.of_bytes s in
s))
Bytes.equal
let z = testable (Fmt.of_to_string Z.to_string) Z.equal
let n = z
let record = testable (Fmt.of_to_string record_to_string) ( = )
let variable_record =
testable (Fmt.of_to_string variable_record_to_string) ( = )
let variable_left_record =
testable (Fmt.of_to_string variable_left_record_to_string) ( = )
let union = testable (Fmt.of_to_string union_to_string) ( = )
end