Data for michokit blog post

example.ml

(* Generated code for
   pair (pair (nat %some_counter) (string %some_name))
        (or %a_variant_thing (bytes %some_data) (key %the_key))
*)
module Big_int = struct
  include Big_int

  let equal_big_int = eq_big_int

  let pp_big_int ppf bi = Format.pp_print_string ppf (string_of_big_int bi)

  type t = big_int [@@deriving show, eq]

  (* no layout here *)
end

module Pairing_layout = struct
  type t = [ `P of t * t | `V ] [@@deriving show, eq]

  (* no layout here *)
end

module Result_extras = struct
  let ( >>= ) x f = match x with Ok o -> f o | Error _ as e -> e
end

module Json_value = struct
  type t =
    [ `A of t list
    | `Bool of bool
    | `Float of float
    | `Null
    | `O of (string * t) list
    | `String of string ]
  [@@deriving show, eq]

  type parse_error = [ `Of_json of string * t ] [@@deriving show, eq]

  (* no layout here *)
end

module M_nat = struct
  type t = Int of int | Big_int of Big_int.t [@@deriving show, eq]

  (* no layout here *)

  (** Convert a value to a string in concrete Michelson syntax. *)
  let to_concrete : t -> string = function
    | Int x -> string_of_int x
    | Big_int x -> Big_int.string_of_big_int x

  (** Parse “micheline” JSON representation. *)
  let of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result =
    function
    | `O [ ("int", `String s) ] as j -> (
        try Ok (Int (int_of_string s))
        with _ -> Error (`Of_json ("int_of_string exception for Int", j)) )
    | other -> Error (`Of_json ("wrong json for M_nat", other))
end

module M_string = struct
  type t = Raw_string of string | Raw_hex_bytes of string
  [@@deriving show, eq]

  (* no layout here *)

  (** Convert a value to a string in concrete Michelson syntax. *)
  let to_concrete : t -> string = function
    | Raw_string x -> (Printf.sprintf "%S") x
    | Raw_hex_bytes x -> (fun x -> x) x

  (** Parse “micheline” JSON representation. *)
  let of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result =
    function
    | `O [ ("string", `String s) ] -> Ok (Raw_string s)
    | `O [ ("bytes", `String s) ] -> Ok (Raw_hex_bytes s)
    | other -> Error (`Of_json ("wrong json for M_string", other))
end

module M_bytes = struct
  type t = Raw_string of string | Raw_hex_bytes of string
  [@@deriving show, eq]

  (* no layout here *)

  (** Convert a value to a string in concrete Michelson syntax. *)
  let to_concrete : t -> string = function
    | Raw_string x -> (Printf.sprintf "%S") x
    | Raw_hex_bytes x -> (fun x -> x) x

  (** Parse “micheline” JSON representation. *)
  let of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result =
    function
    | `O [ ("string", `String s) ] -> Ok (Raw_string s)
    | `O [ ("bytes", `String s) ] -> Ok (Raw_hex_bytes s)
    | other -> Error (`Of_json ("wrong json for M_bytes", other))
end

module M_key = struct
  type t = Raw_b58 of string | Raw_hex_bytes of string [@@deriving show, eq]

  (* no layout here *)

  (** Convert a value to a string in concrete Michelson syntax. *)
  let to_concrete : t -> string = function
    | Raw_b58 x -> (Printf.sprintf "%S") x
    | Raw_hex_bytes x -> (fun x -> x) x

  (** Parse “micheline” JSON representation. *)
  let of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result =
    function
    | `O [ ("string", `String s) ] -> Ok (Raw_b58 s)
    | `O [ ("bytes", `String s) ] -> Ok (Raw_hex_bytes s)
    | other -> Error (`Of_json ("wrong json for M_key", other))
end

module A_variant_thing = struct
  open! Result_extras

  type t = Some_data of M_bytes.t | The_key of M_key.t [@@deriving show, eq]

  let layout () : Pairing_layout.t = `P (`V, `V)

  (** Convert a value to a string in concrete Michelson syntax. *)
  let to_concrete : t -> string =
   fun x ->
    match x with
    | Some_data x -> Printf.sprintf "(Left %s)" (M_bytes.to_concrete x)
    | The_key x -> Printf.sprintf "(Right %s)" (M_key.to_concrete x)

  (** Like {!to_concrete} but assume this variant is defining an entry point (i.e. forget about the [Left|Right] wrapping). *)
  let to_concrete_entry_point : t -> [ `Name of string ] * [ `Literal of string ]
      =
   fun x ->
    match x with
    | Some_data x -> (`Name "some_data", `Literal (M_bytes.to_concrete x))
    | The_key x -> (`Name "the_key", `Literal (M_key.to_concrete x))

  (** Parse “micheline” JSON representation. *)
  let of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result =
    function
    | `O (("prim", `String "Right") :: ("args", `A [ the_key_v ]) :: _) ->
        M_key.of_json the_key_v >>= fun the_key_v -> Ok (The_key the_key_v)
    | `O (("prim", `String "Left") :: ("args", `A [ some_data_v ]) :: _) ->
        M_bytes.of_json some_data_v >>= fun some_data_v ->
        Ok (Some_data some_data_v)
    | other -> Error (`Of_json ("wrong json for A_variant_thing", other))
end

module Storage = struct
  open! Result_extras

  type t = {
    a_variant_thing : A_variant_thing.t;
    some_counter : M_nat.t;
    some_name : M_string.t;
  }
  [@@deriving show, eq, make]

  let layout () : Pairing_layout.t = `P (`P (`V, `V), `V)

  (** Convert a value to a string in concrete Michelson syntax. *)
  let to_concrete : t -> string =
   fun x ->
    Printf.sprintf "(Pair %s %s)"
      (Printf.sprintf "(Pair %s %s)"
         (M_nat.to_concrete x.some_counter)
         (M_string.to_concrete x.some_name))
      (A_variant_thing.to_concrete x.a_variant_thing)

  (** Parse “micheline” JSON representation. *)
  let of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result =
    function
    | `O
        (("prim", `String "Pair")
        :: ( "args",
             `A
               [
                 `O
                   (("prim", `String "Pair")
                   :: ("args", `A [ some_counter; some_name ]) :: _);
                 a_variant_thing;
               ] )
           :: _) ->
        M_nat.of_json some_counter >>= fun some_counter ->
        M_string.of_json some_name >>= fun some_name ->
        A_variant_thing.of_json a_variant_thing >>= fun a_variant_thing ->
        Ok { some_counter; some_name; a_variant_thing }
    | other -> Error (`Of_json ("wrong json for Storage", other))
end

(* Generated code for
   or (address %ep1) (or (signature %sign_stuff) (unit %default))
*)
(* Removed Big_int (duplicate) *)
(* Removed Pairing_layout (duplicate) *)
(* Removed Result_extras (duplicate) *)
(* Removed Json_value (duplicate) *)
module M_address = struct
  type t = Raw_b58 of string | Raw_hex_bytes of string [@@deriving show, eq]

  (* no layout here *)

  (** Convert a value to a string in concrete Michelson syntax. *)
  let to_concrete : t -> string = function
    | Raw_b58 x -> (Printf.sprintf "%S") x
    | Raw_hex_bytes x -> (fun x -> x) x

  (** Parse “micheline” JSON representation. *)
  let of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result =
    function
    | `O [ ("string", `String s) ] -> Ok (Raw_b58 s)
    | `O [ ("bytes", `String s) ] -> Ok (Raw_hex_bytes s)
    | other -> Error (`Of_json ("wrong json for M_address", other))
end

module M_signature = struct
  type t = Raw_b58 of string | Raw_hex_bytes of string [@@deriving show, eq]

  (* no layout here *)

  (** Convert a value to a string in concrete Michelson syntax. *)
  let to_concrete : t -> string = function
    | Raw_b58 x -> (Printf.sprintf "%S") x
    | Raw_hex_bytes x -> (fun x -> x) x

  (** Parse “micheline” JSON representation. *)
  let of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result =
    function
    | `O [ ("string", `String s) ] -> Ok (Raw_b58 s)
    | `O [ ("bytes", `String s) ] -> Ok (Raw_hex_bytes s)
    | other -> Error (`Of_json ("wrong json for M_signature", other))
end

module M_unit = struct
  type t = Unit [@@deriving show, eq]

  (* no layout here *)

  (** Convert a value to a string in concrete Michelson syntax. *)
  let to_concrete : t -> string = function Unit -> "Unit"

  (** Parse “micheline” JSON representation. *)
  let of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result =
    function
    | `O (("prim", `String "Unit") :: _) -> Ok Unit
    | `O (_ :: ("prim", `String "Unit") :: _) -> Ok Unit
    | other -> Error (`Of_json ("wrong json for M_unit", other))
end

module Parameter = struct
  open! Result_extras

  type t =
    | Default of M_unit.t
    | Ep1 of M_address.t
    | Sign_stuff of M_signature.t
  [@@deriving show, eq]

  let layout () : Pairing_layout.t = `P (`V, `P (`V, `V))

  (** Convert a value to a string in concrete Michelson syntax. *)
  let to_concrete : t -> string =
   fun x ->
    match x with
    | Ep1 x -> Printf.sprintf "(Left %s)" (M_address.to_concrete x)
    | Sign_stuff x ->
        Printf.sprintf "(Right (Left %s))" (M_signature.to_concrete x)
    | Default x -> Printf.sprintf "(Right (Right %s))" (M_unit.to_concrete x)

  (** Like {!to_concrete} but assume this variant is defining an entry point (i.e. forget about the [Left|Right] wrapping). *)
  let to_concrete_entry_point : t -> [ `Name of string ] * [ `Literal of string ]
      =
   fun x ->
    match x with
    | Ep1 x -> (`Name "ep1", `Literal (M_address.to_concrete x))
    | Sign_stuff x -> (`Name "sign_stuff", `Literal (M_signature.to_concrete x))
    | Default x -> (`Name "default", `Literal (M_unit.to_concrete x))

  (** Parse “micheline” JSON representation. *)
  let of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result =
    function
    | `O
        (("prim", `String "Right")
        :: ( "args",
             `A
               [
                 `O
                   (("prim", `String "Right")
                   :: ("args", `A [ default_v ]) :: _);
               ] )
           :: _) ->
        M_unit.of_json default_v >>= fun default_v -> Ok (Default default_v)
    | `O
        (("prim", `String "Right")
        :: ( "args",
             `A
               [
                 `O
                   (("prim", `String "Left")
                   :: ("args", `A [ sign_stuff_v ]) :: _);
               ] )
           :: _) ->
        M_signature.of_json sign_stuff_v >>= fun sign_stuff_v ->
        Ok (Sign_stuff sign_stuff_v)
    | `O (("prim", `String "Left") :: ("args", `A [ ep1_v ]) :: _) ->
        M_address.of_json ep1_v >>= fun ep1_v -> Ok (Ep1 ep1_v)
    | other -> Error (`Of_json ("wrong json for Parameter", other))
end

example.tz

parameter
  (or
    (address %ep1)
    (or
      (signature %sign_stuff)
      (unit %default)));
storage
  (pair
    (pair
      (nat %some_counter)
      (string %some_name))
    (or %a_variant_thing (bytes %some_data) (key %the_key)));
code {FAILWITH};

result_of_ocamlc_dash_i.mli

module Big_int :
  sig
    type big_int = Big_int.big_int
    val zero_big_int : big_int
    val unit_big_int : big_int
    val minus_big_int : big_int -> big_int
    val abs_big_int : big_int -> big_int
    val add_big_int : big_int -> big_int -> big_int
    val succ_big_int : big_int -> big_int
    val add_int_big_int : int -> big_int -> big_int
    val sub_big_int : big_int -> big_int -> big_int
    val pred_big_int : big_int -> big_int
    val mult_big_int : big_int -> big_int -> big_int
    val mult_int_big_int : int -> big_int -> big_int
    val square_big_int : big_int -> big_int
    val sqrt_big_int : big_int -> big_int
    val quomod_big_int : big_int -> big_int -> big_int * big_int
    val div_big_int : big_int -> big_int -> big_int
    val mod_big_int : big_int -> big_int -> big_int
    val gcd_big_int : big_int -> big_int -> big_int
    val power_int_positive_int : int -> int -> big_int
    val power_big_int_positive_int : big_int -> int -> big_int
    val power_int_positive_big_int : int -> big_int -> big_int
    val power_big_int_positive_big_int : big_int -> big_int -> big_int
    val sign_big_int : big_int -> int
    val compare_big_int : big_int -> big_int -> int
    val eq_big_int : big_int -> big_int -> bool
    val le_big_int : big_int -> big_int -> bool
    val ge_big_int : big_int -> big_int -> bool
    val lt_big_int : big_int -> big_int -> bool
    val gt_big_int : big_int -> big_int -> bool
    val max_big_int : big_int -> big_int -> big_int
    val min_big_int : big_int -> big_int -> big_int
    val num_digits_big_int : big_int -> int
    val num_bits_big_int : big_int -> int
    val string_of_big_int : big_int -> string
    val big_int_of_string : string -> big_int
    val big_int_of_string_opt : string -> big_int option
    val big_int_of_int : int -> big_int
    val is_int_big_int : big_int -> bool
    val int_of_big_int : big_int -> int
    val int_of_big_int_opt : big_int -> int option
    val big_int_of_int32 : int32 -> big_int
    val big_int_of_nativeint : nativeint -> big_int
    val big_int_of_int64 : int64 -> big_int
    val int32_of_big_int : big_int -> int32
    val int32_of_big_int_opt : big_int -> int32 option
    val nativeint_of_big_int : big_int -> nativeint
    val nativeint_of_big_int_opt : big_int -> nativeint option
    val int64_of_big_int : big_int -> int64
    val int64_of_big_int_opt : big_int -> int64 option
    val float_of_big_int : big_int -> float
    val and_big_int : big_int -> big_int -> big_int
    val or_big_int : big_int -> big_int -> big_int
    val xor_big_int : big_int -> big_int -> big_int
    val shift_left_big_int : big_int -> int -> big_int
    val shift_right_big_int : big_int -> int -> big_int
    val shift_right_towards_zero_big_int : big_int -> int -> big_int
    val extract_big_int : big_int -> int -> int -> big_int
    val nat_of_big_int : big_int -> Nat.nat
    val big_int_of_nat : Nat.nat -> big_int
    val base_power_big_int : int -> int -> big_int -> big_int
    val sys_big_int_of_string : string -> int -> int -> big_int
    val round_futur_last_digit : bytes -> int -> int -> bool
    val approx_big_int : int -> big_int -> string
    val round_big_int_to_float : big_int -> bool -> float
    val equal_big_int : big_int -> big_int -> bool
    val pp_big_int : Format.formatter -> big_int -> unit
    type t = big_int
    val pp :
      Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
    val show : t -> Ppx_deriving_runtime.string
    val equal : t -> t -> Ppx_deriving_runtime.bool
  end
module Pairing_layout :
  sig
    type t = [ `P of t * t | `V ]
    val pp :
      Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
    val show : t -> Ppx_deriving_runtime.string
    val equal : t -> t -> Ppx_deriving_runtime.bool
  end
module Result_extras :
  sig
    val ( >>= ) :
      ('a, 'b) result -> ('a -> ('c, 'b) result) -> ('c, 'b) result
  end
module Json_value :
  sig
    type t =
        [ `A of t list
        | `Bool of bool
        | `Float of float
        | `Null
        | `O of (string * t) list
        | `String of string ]
    val pp :
      Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
    val show : t -> Ppx_deriving_runtime.string
    val equal : t -> t -> Ppx_deriving_runtime.bool
    type parse_error = [ `Of_json of string * t ]
    val pp_parse_error :
      Ppx_deriving_runtime.Format.formatter ->
      parse_error -> Ppx_deriving_runtime.unit
    val show_parse_error : parse_error -> Ppx_deriving_runtime.string
    val equal_parse_error :
      parse_error -> parse_error -> Ppx_deriving_runtime.bool
  end
module M_nat :
  sig
    type t = Int of int | Big_int of Big_int.t
    val pp :
      Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
    val show : t -> Ppx_deriving_runtime.string
    val equal : t -> t -> Ppx_deriving_runtime.bool
    val to_concrete : t -> string
    val of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result
  end
module M_string :
  sig
    type t = Raw_string of string | Raw_hex_bytes of string
    val pp :
      Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
    val show : t -> Ppx_deriving_runtime.string
    val equal : t -> t -> Ppx_deriving_runtime.bool
    val to_concrete : t -> string
    val of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result
  end
module M_bytes :
  sig
    type t = Raw_string of string | Raw_hex_bytes of string
    val pp :
      Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
    val show : t -> Ppx_deriving_runtime.string
    val equal : t -> t -> Ppx_deriving_runtime.bool
    val to_concrete : t -> string
    val of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result
  end
module M_key :
  sig
    type t = Raw_b58 of string | Raw_hex_bytes of string
    val pp :
      Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
    val show : t -> Ppx_deriving_runtime.string
    val equal : t -> t -> Ppx_deriving_runtime.bool
    val to_concrete : t -> string
    val of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result
  end
module A_variant_thing :
  sig
    type t = Some_data of M_bytes.t | The_key of M_key.t
    val pp :
      Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
    val show : t -> Ppx_deriving_runtime.string
    val equal : t -> t -> Ppx_deriving_runtime.bool
    val layout : unit -> Pairing_layout.t
    val to_concrete : t -> string
    val to_concrete_entry_point :
      t -> [ `Name of string ] * [ `Literal of string ]
    val of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result
  end
module Storage :
  sig
    type t = {
      a_variant_thing : A_variant_thing.t;
      some_counter : M_nat.t;
      some_name : M_string.t;
    }
    val pp :
      Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
    val show : t -> Ppx_deriving_runtime.string
    val equal : t -> t -> Ppx_deriving_runtime.bool
    val make :
      a_variant_thing:A_variant_thing.t ->
      some_counter:M_nat.t -> some_name:M_string.t -> t
    val layout : unit -> Pairing_layout.t
    val to_concrete : t -> string
    val of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result
  end
module M_address :
  sig
    type t = Raw_b58 of string | Raw_hex_bytes of string
    val pp :
      Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
    val show : t -> Ppx_deriving_runtime.string
    val equal : t -> t -> Ppx_deriving_runtime.bool
    val to_concrete : t -> string
    val of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result
  end
module M_signature :
  sig
    type t = Raw_b58 of string | Raw_hex_bytes of string
    val pp :
      Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
    val show : t -> Ppx_deriving_runtime.string
    val equal : t -> t -> Ppx_deriving_runtime.bool
    val to_concrete : t -> string
    val of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result
  end
module M_unit :
  sig
    type t = Unit
    val pp :
      Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
    val show : t -> Ppx_deriving_runtime.string
    val equal : t -> t -> Ppx_deriving_runtime.bool
    val to_concrete : t -> string
    val of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result
  end
module Parameter :
  sig
    type t =
        Default of M_unit.t
      | Ep1 of M_address.t
      | Sign_stuff of M_signature.t
    val pp :
      Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
    val show : t -> Ppx_deriving_runtime.string
    val equal : t -> t -> Ppx_deriving_runtime.bool
    val layout : unit -> Pairing_layout.t
    val to_concrete : t -> string
    val to_concrete_entry_point :
      t -> [ `Name of string ] * [ `Literal of string ]
    val of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result
  end